DIRECTORY
Atom USING [GetPName],
BasicTime USING [Now],
Commander USING [CommandProc, Handle, Register],
Convert USING [Error, IntFromRope, RopeFromTime],
FS USING [ComponentPositions, Error, ExpandName, FileInfo],
Imager USING [Context, Error, PixelArray, Transformation],
ImagerColorOperator USING [GrayLinearColorModel],
ImagerFastShow USING [Create],
ImagerInterpressFragment USING [Close, Create, PushColorOperator, PushInt, PushPixelArray, PushVector, Ref, VectorProc, StreamFromRef],
ImagerOps USING [PixelArrayFromPixelMaps],
ImagerPixelArray USING [FromAIS, MaxSampleValue],
ImagerPixelMap USING [Clear, Create, PixelMap, Trim],
ImagerTransformation USING [Create],
Interpress USING [DoPage, LogProc, Master, Open],
IO USING [atom, CharClass, EndOfStream, GetIndex, GetTokenRope, int, PutF, PutFR, PutRope, RIS, rope, SetIndex, STREAM],
IPMaster USING [PutInt, PutOp, PutRational],
PixelMapOps USING [StoreAIS],
Real USING [Round],
Rope USING [Cat, Equal, Index, ROPE, Substr];


MakeRESImpl: CEDAR PROGRAM
IMPORTS Atom, BasicTime, Commander, Convert, FS, Imager, ImagerColorOperator, ImagerInterpressFragment, ImagerFastShow, ImagerOps, ImagerPixelArray, ImagerPixelMap, ImagerTransformation, Interpress, IO, IPMaster, PixelMapOps, Real, Rope
~ BEGIN

ROPE: TYPE ~ Rope.ROPE;
resHeader: ROPE _ "Interpress/Xerox/2.1/RasterEncoding/1.0 ";
resSignature: INT = 13086;

Complain: ERROR [complaint: ROPE] ~ CODE;

MakeRESFromAIS: PROC [inputName, outputName: ROPE] ~ {
ip: ImagerInterpressFragment.Ref ~ ImagerInterpressFragment.Create[outputName, resHeader];
pa: Imager.PixelArray _ ImagerPixelArray.FromAIS[inputName];
IF ImagerPixelArray.MaxSampleValue[pa, 0] # 1 THEN
Complain["AIS file must have only 1 bits per sample"];
PushRESImage[inputName, ip, pa, 300];
ImagerInterpressFragment.Close[ip];
};

PushRESImage: PROC [inputName: Rope.ROPE, ip: ImagerInterpressFragment.Ref, pa: Imager.PixelArray, res: INT] ~ {
PushScaleVector: PROC ~ {
stream: IO.STREAM _ ImagerInterpressFragment.StreamFromRef[ip];
IF res # 72 AND res # 300 THEN Complain["RES bitmap resolution must be 72 or 300"];
IPMaster.PutRational[stream, 254, res*10000];
IPMaster.PutOp[stream, dup];
IPMaster.PutInt[stream, 2];
IPMaster.PutOp[stream, makevec];
};
attributeVector: ImagerInterpressFragment.VectorProc ~ {
putIdentifier[$name];
putString[inputName];
putIdentifier[$creationTime];
putString[Convert.RopeFromTime[from: BasicTime.Now[], end: seconds]];
};
PushScaleVector[];
ImagerInterpressFragment.PushInt[ip, pa.sSize];
ImagerInterpressFragment.PushInt[ip, pa.fSize];
ImagerInterpressFragment.PushInt[ip, 0]; -- no mask image
ImagerInterpressFragment.PushPixelArray[ip, pa];
ImagerInterpressFragment.PushColorOperator[ip, ImagerColorOperator.GrayLinearColorModel[sWhite: 0, sBlack: 1, maxSampleValue: 0, sampleMap: NIL]]; -- bitmap values
ImagerInterpressFragment.PushVector[ip, attributeVector];
ImagerInterpressFragment.PushInt[ip, resSignature];
};

ActionProc: TYPE ~ PROC [inputName: ROPE, outputName: ROPE, cmd: Commander.Handle, cmds: IO.STREAM];

MakeRESFromAISAction: ActionProc ~ {
MakeRESFromAIS[inputName, outputName];
};

Direction: TYPE ~ {left, right, up, down};
ScanMode: TYPE ~ RECORD [slow, fast: Direction];

SFToXY: PROC [scanMode: ScanMode, sSize, fSize: INT] RETURNS [Imager.Transformation] ~ {
a: REAL ~ SELECT scanMode.slow FROM right => 1.0, left => -1.0, ENDCASE => 0.0;
b: REAL ~ SELECT scanMode.fast FROM right => 1.0, left => -1.0, ENDCASE => 0.0;
d: REAL ~ SELECT scanMode.slow FROM up => 1.0, down => -1.0, ENDCASE => 0.0;
e: REAL ~ SELECT scanMode.fast FROM up => 1.0, down => -1.0, ENDCASE => 0.0;
tX: REAL ~ MAX[-(a*sSize + b*fSize), 0];
tY: REAL ~ MAX[-(d*sSize + e*fSize), 0];
RETURN[ImagerTransformation.Create[a, b, tX, d, e, tY]];
};

MakeAISFromInterpressAction: ActionProc ~ {
Log: Interpress.LogProc ~ {
cmd.out.PutF["Interpress error (class %g) %g: %g\n", IO.int[class], IO.atom[code], IO.rope[explanation]];
};
master: Interpress.Master ~ Interpress.Open[inputName, Log];
res: INT ~ Convert.IntFromRope[GetCmdToken[cmds]];
sSize: NAT ~ Real.Round[res*8.5];
fSize: NAT ~ Real.Round[res*11.0];
pixelMap: ImagerPixelMap.PixelMap _ ImagerPixelMap.Create[lgBitsPerPixel: 0, bounds: [0, 0, sSize, fSize]];
context: Imager.Context ~ ImagerFastShow.Create[pm: pixelMap, pixelsPerInch: res, pixelUnits: FALSE];
pa: Imager.PixelArray _ NIL;
ImagerPixelMap.Clear[pixelMap];
Interpress.DoPage[master: master, page: 1, context: context, log: Log];
pixelMap _ ImagerPixelMap.Trim[pixelMap];
PixelMapOps.StoreAIS[Rope.Cat[outputName, ".ais"], [pixelMap, TRUE, NIL]];
};

MakeRESFromInterpressAction: ActionProc ~ {
Log: Interpress.LogProc ~ {
cmd.out.PutF["Interpress error (class %g) %g: %g\n", IO.int[class], IO.atom[code], IO.rope[explanation]];
};
master: Interpress.Master ~ Interpress.Open[inputName, Log];
res: INT ~ Convert.IntFromRope[GetCmdToken[cmds]];
sSize: NAT ~ Real.Round[res*8.5];
fSize: NAT ~ Real.Round[res*11.0];
pixelMap: ImagerPixelMap.PixelMap _ ImagerPixelMap.Create[lgBitsPerPixel: 0, bounds: [0, 0, sSize, fSize]];
context: Imager.Context ~ ImagerFastShow.Create[pm: pixelMap, pixelsPerInch: res, pixelUnits: FALSE];
pa: Imager.PixelArray _ NIL;
ip: ImagerInterpressFragment.Ref ~ ImagerInterpressFragment.Create[outputName, resHeader];
ImagerPixelMap.Clear[pixelMap];
Interpress.DoPage[master: master, page: 1, context: context, log: Log];
pixelMap _ ImagerPixelMap.Trim[pixelMap];
pa _ ImagerOps.PixelArrayFromPixelMaps[
pms: LIST[pixelMap],
um: SFToXY[[slow: down, fast: right], pixelMap.sSize, pixelMap.fSize]
];
IF ImagerPixelArray.MaxSampleValue[pa, 0] # 1 THEN
Complain["AIS file must have only 1 bits per sample"];
PushRESImage[inputName, ip, pa, res];
ImagerInterpressFragment.Close[ip];
};

FindFullName: PROC [inputName: ROPE] RETURNS [ROPE] ~ {
fullFName: ROPE _ NIL;
fullFName _ FS.FileInfo[inputName].fullFName;
RETURN [fullFName]
};

Command: Commander.CommandProc ~ {
refAction: REF ActionProc ~ NARROW[cmd.procData.clientData];
stream: IO.STREAM _ IO.RIS[cmd.commandLine];
outputName: Rope.ROPE _ GetCmdToken[stream];
secondTokenIndex: INT _ IO.GetIndex[stream];
gets: Rope.ROPE _ GetCmdToken[stream];
inputName: Rope.ROPE _ NIL;
IF NOT gets.Equal["_"] THEN {
inputName _ outputName;
outputName _ NIL;
stream.SetIndex[secondTokenIndex];
}
ELSE inputName _ GetCmdToken[stream];
IF inputName = NIL THEN RETURN[result: $Failure, msg: cmd.procData.doc];
inputName _ FindFullName[inputName ! FS.Error => {
IF error.group = user THEN {result _ $Failure; msg _ error.explanation; GOTO Quit}
}];
IF outputName = NIL THEN {
outputName _ MakeOutputName[inputName, cmd.procData.doc];
};
cmd.out.PutRope["Converting "];
cmd.out.PutRope[inputName];
cmd.out.PutRope[" . . . "];
refAction^[inputName, outputName, cmd, stream !
Convert.Error => {result _ $Failure; msg _ "Syntax error in command line: expected a number"; GOTO Quit};
Complain => {result _ $Failure; msg _ complaint; GOTO Quit};
FS.Error => {result _ $Failure; msg _ error.explanation; GOTO Quit};
Imager.Error => {result _ $Failure; msg _ IO.PutFR["Imager.Error[[$%g, %g]]", IO.rope[Atom.GetPName[error.code]], IO.rope[error.explanation]]; GOTO Quit}
];
outputName _ FindFullName[outputName ! FS.Error => {
outputName _ "Output file(s)"; CONTINUE};
];
cmd.out.PutRope[outputName];
cmd.out.PutRope[" written.\n"];
EXITS Quit => NULL
};

GetCmdToken: PROC [stream: IO.STREAM] RETURNS [rope: Rope.ROPE] = {
rope _ NIL;
rope _ stream.GetTokenRope[CmdTokenBreak ! IO.EndOfStream => CONTINUE].token;
};

CmdTokenBreak: PROC [char: CHAR] RETURNS [IO.CharClass] = {
IF char = '_ THEN RETURN [break];
IF char = '  OR char = '\t OR char = ', OR char = '; OR char = '\n THEN RETURN [sepr];
RETURN [other];
};

MakeOutputName: PROC [inputName: Rope.ROPE, doc: Rope.ROPE] RETURNS [Rope.ROPE] ~ {
start: INT _ Rope.Index[s1: doc, s2: " to "]+4;
end: INT _ Rope.Index[s1: doc, pos1: start, s2: " "];
cp: FS.ComponentPositions;
[inputName, cp] _ FS.ExpandName[inputName];
RETURN [Rope.Cat[Rope.Substr[inputName, cp.base.start, cp.base.length], ".", Rope.Substr[doc, start, end-start]]];
};

Commander.Register["MakeRESFromAIS", Command, "Convert an AIS image to RES format image", NEW[ActionProc _ MakeRESFromAISAction]];

Commander.Register["MakeRESBitmapFromInterpress", Command, "Convert an Interpress file to RES format bitmap ([<outputFileName> _]  <inputFileName>   <resolution>)", NEW[ActionProc _ MakeRESFromInterpressAction]];

Commander.Register["MakeAISBitmapFromInterpress", Command, "Convert an Interpress file to AIS format bitmap ([<outputFileName> _]  <inputFileName>   <resolution>)", NEW[ActionProc _ MakeAISFromInterpressAction]];


END.

ήMakeRESImpl.mesa
Copyright c 1986 by Xerox Corporation.  All rights reserved.
Rick Beach, July 1, 1986 2:27:23 pm PDT
Michael Plass, June 20, 1986 12:47:04 pm PDT

Stolen shamelessly from MakeFIS, wherein a Font Interchange Standard Interpress master is created to contain an Interpress Font.

the scale vector must conform to several limitations imposed by ancient implementations
The result transforms [s, f] to [x, y], given the source (e.g., pixel array) scan mode.

Κ"˜š
œ™Icodešœ
Οm
œ1™<K™'K™,—K™š
Οk	˜	Jšœžœ˜Jšœ
žœ˜Jšœ
žœ!˜0Jšœžœ$˜1Jšžœ
žœ3˜;Jšœžœ.˜:Jšœžœ˜1Jšœžœ
˜Jšœžœi˜‡
Jšœ
žœ˜*Jšœžœ˜1Jšœžœ!˜5Jšœžœ
˜$Jšœžœ!˜1Jšžœ
žœSžœžœ˜xKšœ	žœ˜,Kšœžœ˜Jšœžœ	˜Jšœžœžœ
˜-—K˜K˜KšΠlnœž
˜Kšžœ&žœ˜
žœ#˜μ
šœž˜K˜K™€
K™Kšžœžœžœ
˜Kšœžœ.˜=šœžœ	˜K˜—KšΟnœžœ
žœžœ
˜)K˜š œžœžœ˜6Kš
œZ˜ZK˜<šžœ,ž˜2Kš
œ6˜6—K˜%Kš
œ#˜#K˜K˜—š œžœžœ@žœ˜pš œžœ˜Kš
œW™WKšœžœ
žœ.˜?Kšžœ
žœžœ5˜SKš
œ-˜-K˜K˜K˜ K˜—š œ)˜8Kš
œ˜Kš
œ˜Kš
œ˜Kš
œE˜EK˜—Kš
œ˜Kš
œ/˜/Kš
œ/˜/Kšœ)Οc˜9Kš
œ0˜0K•StartOfExpansion`[sWhite: REAL, sBlack: REAL, maxSampleValue: ImagerSample.Sample _ 0B (0), sampleMap: PROC [...]šœŒ
žœ‘˜£
Kš
œ9˜9Kš
œ3˜3K˜K˜—š
œžœžœ
žœžœžœ
žœ˜dK˜—š œ˜$K˜&Kš
œ˜K˜—Kšœžœ˜*šœ
žœžœ˜0K˜—š œžœ$žœžœ˜XKš	œžœžœžœžœ˜OKš	œžœžœžœžœ˜OKš	œžœžœžœžœ˜LKš	œžœžœžœžœ˜LKšœžœžœ˜(Kšœžœžœ˜(Kšžœ2˜8Kš
œ˜K˜K™WK™—š œ˜+š œ˜Kšœ5žœ
žœ
žœ˜iKš
œ˜—Kš
œ<˜<Kšœžœ*˜2Kšœžœ˜!Kšœžœ˜"K–D[lgBitsPerPixel: 
[0..4], bounds: 
ImagerPixelMap.DeviceRectangle]š
œk˜kK–„
[pm: 
ImagerPixelMap.PixelMap, pixelsPerInch: 
REAL _ 72.0, pixelUnits: 
BOOL _ FALSE, fontTuner: 
ImagerRaster.FontTuner _ NIL]šœ^žœ˜eKšœžœ
˜Kš
œ˜Kš
œG˜GJ–F[pixelMap: 
ImagerPixelMap.PixelMap, background: 
CARDINAL _ 0B (0)]š
œ)˜)Jšœ>žœžœ˜JKš
œ˜K˜—š œ˜+š œ˜Kšœ5žœ
žœ
žœ˜iKš
œ˜—Kš
œ<˜<Kšœžœ*˜2Kšœžœ˜!Kšœžœ˜"K–D[lgBitsPerPixel: 
[0..4], bounds: 
ImagerPixelMap.DeviceRectangle]š
œk˜kK–„
[pm: 
ImagerPixelMap.PixelMap, pixelsPerInch: 
REAL _ 72.0, pixelUnits: 
BOOL _ FALSE, fontTuner: 
ImagerRaster.FontTuner _ NIL]šœ^žœ˜eKšœžœ
˜Kš
œZ˜ZKš
œ˜Kš
œG˜GJ–F[pixelMap: 
ImagerPixelMap.PixelMap, background: 
CARDINAL _ 0B (0)]š
œ)˜)š
œ'˜'Kšœžœ˜Kš
œE˜EKš
œ˜—šžœ,ž˜2Kš
œ6˜6—K˜%Kš
œ#˜#Kš
œ˜K˜—š
 œžœ
žœžœžœ˜7Kšœžœžœ
˜Kšœžœ˜-Kšžœ˜Kš
œ˜K˜—š œ˜"Kšœžœžœ˜<Kš	œžœ
žœžœ
žœ˜,Kšœžœ˜,Kšœžœžœ˜,Kšœžœ˜&Kšœžœžœ
˜šžœ
žœžœ˜Kš
œ˜Kšœ
žœ
˜Kš
œ"˜"Kš
œ
˜
—Kšžœ!˜%Kšžœ
žœ
žœ
žœ*˜Hšœ%žœ˜2Kšžœžœ.žœ˜RKš
œ˜—šžœžœ
žœ˜Kš
œ9˜9Kš
œ˜—Kš
œ˜Kš
œ˜Kš
œ˜š
œ/˜/Kšœ^žœ˜iKšœ1žœ˜<Kšžœ7žœ˜DKš	œ*žœ"žœ"žœžœ˜™
K˜—šœ'žœ˜4Kšœžœ˜)Kš
œ˜—Kš
œ˜Kš
œ˜Kšžœ	ž˜K˜K˜—–

"cedar" styleš œžœ
žœ
žœžœ
žœ˜CK–

"cedar" stylešœžœ
˜K–

"cedar" stylešœ+žœžœ˜MKš
œ˜K˜—–

"cedar" styleš
 
œžœžœžœžœ˜;Kšžœžœ
žœ	˜!Kšžœžœžœžœžœžœ
žœ˜VKšžœ	˜Kš
œ˜K˜—š œžœžœžœžœžœ˜SKšœžœ%˜/Kšœžœ-˜5Kšœžœ˜Kšœžœ˜+Kšžœl˜rKš
œ˜K˜—šœZžœ%˜‚
K˜—šœ₯
žœ,˜Τ
K˜—šœ₯
žœ,˜Τ
K˜——K˜Kšžœ
˜—…—!Μ.Μ