~
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: Interpress.Master ← Interpress.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];
Interpress.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: Interpress.LogProc ~ {
msg: IO.STREAM ~ cmd.out;
msg.PutRope[
SELECT class
FROM
Interpress.classMasterError => "Master Error: ",
Interpress.classMasterWarning => "Master Warning: ",
Interpress.classAppearanceError => "Appearance Error: ",
Interpress.classAppearanceWarning => "Appearance Warning: ",
Interpress.classComment => "Comment: ",
ENDCASE => NIL
];
msg.PutRope[explanation];
msg.PutRope[" . . . "];
};
master: Interpress.Master ~ Interpress.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.PutF["[%g", IO.int[i]];
context ← Inserter[context];
Interpress.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["←"]
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]];