~
BEGIN
Transformation: TYPE ~ ImagerTransformation.Transformation;
Context: TYPE ~ Imager.Context;
ROPE: TYPE ~ Rope.ROPE;
ShowTextProc:
TYPE ~
PROC [context: Imager.Context, text:
REF
READONLY
TEXT, start, len:
NAT, xrel:
BOOL];
DefaultShowText: ShowTextProc ¬
NIL;
insertMarkStart: ROPE ¬ "<==<";
insertMarkSize: INT ¬ Rope.Size[insertMarkStart];
insertMarkEnd: CHAR ¬ '<;
InserterShowText: ShowTextProc ~ {
len ¬ MIN[NAT[text.length-start], len];
IF
NOT xrel
AND len > insertMarkSize+1
AND text[start+len-1] = insertMarkEnd
AND Rope.Run[s1: RefText.TrustTextAsRope[text], pos1: start, s2: insertMarkStart] = insertMarkSize
AND Imager.GetProp[context, $Arrow] =
NIL
THEN {
name: ROPE ~ Rope.Flatten[RefText.TrustTextAsRope[text], start+insertMarkSize, len-insertMarkSize-1];
master: InterpressInterpreter.Master ¬ InterpressInterpreter.Open[name, NIL ! FS.Error => {SIGNAL Complain[error.explanation]; GOTO Botched}];
action:
PROC ~ {
m: ImagerTransformation.Transformation ¬ NARROW[Imager.GetProp[context, $T]];
Imager.PutProp[context, $Arrow, $Arrow];
Imager.Move[context];
Imager.ConcatT[context, m.TranslateTo[[0,0]].Invert];
InterpressInterpreter.DoPage[master: master, page: 1, context: context, log: NIL];
};
Imager.DoSaveAll[context, action];
RETURN;
EXITS Botched => len ¬ len};
DefaultShowText[context, text, start, len, xrel];
RETURN};
DefaultConcatT: PROC[context: Context, m: Transformation] ¬ NIL;
InserterConcatT:
PROC[context: Context, m: Transformation] ~ {
old: Transformation ~ NARROW[Imager.GetProp[context, $T]];
Imager.PutProp[context, $T, m.Concat[old]];
DefaultConcatT[context, m];
};
DefaultScale2T: PROC[context: Context, s: Imager.VEC] ¬ NIL;
InserterScale2T:
PROC[context: Context, s: Imager.
VEC] ~ {
old: Transformation ~ NARROW[Imager.GetProp[context, $T]];
Imager.PutProp[context, $T, old.PreScale2[s]];
DefaultScale2T[context, s];
};
DefaultRotateT: PROC[context: Context, a: REAL] ¬ NIL;
InserterRotateT:
PROC[context: Context, a:
REAL] ~ {
old: Transformation ~ NARROW[Imager.GetProp[context, $T]];
Imager.PutProp[context, $T, old.PreRotate[a]];
DefaultRotateT[context, a];
};
Class: TYPE ~ REF ClassRep;
ClassRep:
PUBLIC
TYPE ~ ImagerPrivate.ClassRep;
-- export to Imager.
Inserter:
PROC [context: Imager.Context]
RETURNS [Imager.Context] ~ {
class: Class ~ context.class;
classCopy: Class ~ NEW[ClassRep ¬ class];
new: Imager.Context ~ NEW[Imager.ContextRep ¬ [class: classCopy, state: context.state, data: context.data, propList: NIL]];
IF DefaultShowText = NIL THEN DefaultShowText ¬ classCopy.ShowText;
IF DefaultShowText#classCopy.ShowText THEN ERROR;
IF DefaultConcatT = NIL THEN DefaultConcatT ¬ classCopy.ConcatT;
IF DefaultConcatT#classCopy.ConcatT THEN ERROR;
IF DefaultScale2T = NIL THEN DefaultScale2T ¬ classCopy.Scale2T;
IF DefaultScale2T#classCopy.Scale2T THEN ERROR;
IF DefaultRotateT = NIL THEN DefaultRotateT ¬ classCopy.RotateT;
IF DefaultRotateT#classCopy.RotateT THEN ERROR;
classCopy.ShowText ¬ InserterShowText;
classCopy.ConcatT ¬ InserterConcatT;
classCopy.Scale2T ¬ InserterScale2T;
classCopy.RotateT ¬ InserterRotateT;
RETURN [new];
};
header:
ROPE ¬ "Interpress/Xerox/3.0 ";
InterpressArrowsAction:
PROC [inputName:
ROPE, outputName:
ROPE, cmd: Commander.Handle, cmds:
IO.
STREAM] ~ {
Log: InterpressInterpreter.LogProc ~ {
msg: IO.STREAM ~ cmd.out;
msg.PutRope[
SELECT class
FROM
InterpressInterpreter.classMasterError => "Master Error: ",
InterpressInterpreter.classMasterWarning => "Master Warning: ",
InterpressInterpreter.classAppearanceError => "Appearance Error: ",
InterpressInterpreter.classAppearanceWarning => "Appearance Warning: ",
InterpressInterpreter.classComment => "Comment: ",
ENDCASE => NIL
];
msg.PutRope[explanation];
msg.PutRope[" . . . "];
};
master: InterpressInterpreter.Master ~ InterpressInterpreter.Open[inputName, Log];
output: ImagerInterpress.Ref ~ ImagerInterpress.Create[outputName, header];
FOR i:
INT
IN [1..master.pages]
DO
Paint:
PROC [context: Imager.Context] ~ {
cmd.out.PutF1["[%g", IO.int[i]];
context ¬ Inserter[context];
InterpressInterpreter.DoPage[master: master, page: i, context: context, log: Log];
cmd.out.PutRope["] "];
};
Process.CheckForAbort[];
ImagerInterpress.DoPage[self: output, action: Paint, scale: 1];
ENDLOOP;
ImagerInterpress.Close[output];
};
ActionProc:
TYPE ~
PROC [inputName:
ROPE, outputName:
ROPE, cmd: Commander.Handle, cmds:
IO.
STREAM];
FindFullName:
PROC [inputName:
ROPE]
RETURNS [
ROPE] ~ {
fullFName: ROPE ¬ NIL;
fullFName ¬ FS.FileInfo[inputName].fullFName;
RETURN [fullFName]
};
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];
};
GetCmdToken:
PROC [stream:
IO.
STREAM]
RETURNS [rope:
ROPE] = {
rope ¬ NIL;
rope ¬ stream.GetTokenRope[CmdTokenBreak ! IO.EndOfStream => CONTINUE].token;
};
Command: Commander.CommandProc ~ {
refAction: REF ActionProc ~ NARROW[cmd.procData.clientData];
stream: IO.STREAM ¬ IO.RIS[cmd.commandLine];
outputName: ROPE ¬ GetCmdToken[stream];
secondTokenIndex: INT ¬ IO.GetIndex[stream];
gets: ROPE ¬ GetCmdToken[stream];
inputName: ROPE ¬ NIL;
IF
NOT (gets.Equal["←"] OR 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];
IF outputName =
NIL
THEN {
outputName ¬ inputName;
};
inputName ¬ FindFullName[inputName !
FS.Error => {
IF error.group = user THEN {result ¬ $Failure; msg ¬ error.explanation; GOTO Quit}
}];
cmd.out.PutRope["Reading "];
cmd.out.PutRope[inputName];
cmd.out.PutRope[" . . . "];
refAction[inputName, outputName, cmd, stream ! Complain => {cmd.err.PutRope[complaint]; cmd.err.PutRope["\n"]; RESUME}];
outputName ¬ FindFullName[outputName !
FS.Error => {
outputName ¬ "Output file(s)"; CONTINUE};
];
cmd.out.PutRope[outputName];
cmd.out.PutRope[" written.\n"];
EXITS Quit => NULL
};
Complain:
SIGNAL [complaint:
ROPE] ~
CODE;
Commander.Register["InterpressArrows", Command, "Merge figures into an Interpress file using <==<file< convention: [output ←] input\n", NEW[ActionProc ¬ InterpressArrowsAction]];