DIRECTORY
Commander USING [CommandProc, Handle, Register],
CommandTool USING [ArgumentVector, Parse],
Convert USING [RealFromRope],
FS USING [binaryStreamOptions, Close, ComponentPositions, Error, ExpandName, FileInfo, Open, OpenFile, StreamOpen],
Imager USING [ConcatT, Context, SetColor],
ImagerColorFns USING [ColorFromCMYK],
ImagerInterpress USING [Close, Create, DoPage, Ref],
ImagerTransformation USING [PreRotate, PreScale, PreScale2, PreTranslate, Scale, Transformation],
Interpress USING [DoPage, LogProc, Master, Open],
IO USING [Backup, CharClass, Close, EndOfStream, GetBlock, GetChar, GetIndex, GetInt, GetTokenRope, int, PutBlock, PutChar, PutF, PutF1, PutFR1, PutRope, real, RIS, rope, SetIndex, STREAM, text],
IPMaster USING [GetToken, ImagerVariable, IntFromSequenceData, Op, OpFromEncodingValue, OpFromRope, PutInt, PutOp, PutRational, PutReal, PutSequence, PutSequenceText, RealFromSequenceData, RopeFromImagerVariable, RopeFromOp, SequenceType, Token],
ProcessProps USING [GetProp],
RefText USING [InlineAppendChar, ObtainScratch, ReleaseScratch, ReserveChars, TrustTextAsRope],
Rope USING [AppendChars, Cat, Concat, Equal, Find, FromRefText, Index, Match, ROPE, Run, Size, Substr],
RopeFile USING [Create];
~
BEGIN
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
UtilErrorDesc: TYPE ~ RECORD [code: ATOM, index: INT ← -1, explanation: ROPE ← NIL];
UtilError: PUBLIC ERROR [error: UtilErrorDesc] ~ CODE;
State:
TYPE ~ {null, op, id, plus, minus, star, int, rat1, rat2, rat, dot, real1, realF,
real2, real3, realE, str1, vec1, com1, com2, file1, file2, note1, note2,
single, string, vector, comment, insertFile, annotation
};
FinalState: TYPE ~ State[single..State.LAST]; -- these terminate scanning
GetWrittenToken:
PROC [stream:
STREAM]
RETURNS [state: State, rope:
ROPE, index:
INT] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[100];
s: State ← null; r: ROPE ← NIL; i: INT ← 0;
action:
PROC [state: State, text:
REF
TEXT, index:
INT]
RETURNS [
BOOL] ~ {
s ← state; r ← Rope.FromRefText[text]; i ← index; RETURN[TRUE];
};
[] ← MapWrittenTokens[stream, scratch, action];
RefText.ReleaseScratch[scratch];
RETURN[state: s, rope: r, index: i];
};
MapWrittenTokens:
PROC [stream:
STREAM, buffer:
REF
TEXT,
action: PROC [state: State, text: REF TEXT, index: INT] RETURNS [BOOL]
] RETURNS [quit: BOOL ← FALSE] ~ {
char: CHAR; peeked: BOOL ← FALSE;
Cleanup: PROC ~ { IF peeked THEN { IO.Backup[stream, char]; peeked ← FALSE } };
UNTIL quit
DO
state: State ← null;
index: INT ← IO.GetIndex[stream];
text: REF TEXT ← buffer;
text.length ← 0;
UNTIL state
IN FinalState
DO
-- scan a token
IF peeked
THEN { index ← index-1; peeked ← FALSE }
ELSE char ← IO.GetChar[stream ! IO.EndOfStream => EXIT];
SELECT state
FROM
null =>
SELECT char
FROM
<=' => { index ← index+1; LOOP }; -- skip white space
IN['0..'9] => state ← int; -- begin number
IN['A..'Z] => state ← op; -- begin op
IN['a..'z] => state ← id; -- begin identifier
'< => state ← str1; -- begin string
'( => state ← vec1; -- begin largeVector
'+ => state ← plus; -- might begin number or insertfile
'- => state ← minus; -- might begin number or annotation
'* => state ← star; -- might begin comment
'. => state ← dot; -- might begin real
ENDCASE => state ← single; -- single char
op =>
SELECT char
FROM
-- A..Z | op ( A..Z | 0..9 )
IN['A..'Z], IN['0..'9] => NULL;
IN['a..'z], '- => state ← id;
ENDCASE => GOTO Back;
id =>
SELECT char
FROM
-- a..z | op ( a..z | - ) | id ( a..z | A..Z | 0..9 | - )
IN['a..'z], IN['A..'Z], IN['0..'9], '- => NULL;
ENDCASE => GOTO Back;
plus =>
SELECT char
FROM
-- +
IN['0..'9] => state ← int;
'+ => state ← file1;
'. => state ← real1;
ENDCASE => GOTO Back;
minus =>
SELECT char
FROM
-- -
IN['0..'9] => state ← int;
'- => state ← note1;
'. => state ← real1;
ENDCASE => GOTO Back;
star =>
SELECT char
FROM
-- *
'* => state ← com1;
ENDCASE => GOTO Back;
int =>
SELECT char
FROM
-- ?( + | - ) 0..9 | int 0..9
IN['0..'9] => NULL;
'/ => state ← rat1;
'. => state ← realF;
'E, 'e => state ← real2;
ENDCASE => GOTO Back;
rat1 =>
SELECT char
FROM
-- int /
IN['0..'9] => state ← rat;
'+, '- => state ← rat2;
ENDCASE => GOTO Back;
rat2 =>
SELECT char
FROM
-- int / ( + | - )
IN['0..'9] => state ← rat;
ENDCASE => GOTO Back;
rat =>
SELECT char
FROM
-- int / ?( + | - ) 0..9 | rat 0..9
IN['0..'9] => NULL;
ENDCASE => GOTO Back;
dot =>
SELECT char
FROM
-- .
IN['0..'9] => state ← realF;
ENDCASE => GOTO Back;
real1 =>
SELECT char
FROM
-- ( + | - ) .
IN['0..'9] => state ← realF;
ENDCASE => GOTO Back;
realF =>
SELECT char
FROM
-- int . | ( + | - ) . 0..9 | realF 0..9
IN['0..'9] => NULL;
'E, 'e => state ← real2;
ENDCASE => GOTO Back;
real2 =>
SELECT char
FROM
-- ( int | realF ) ( E | e )
IN['0..'9] => state ← realE;
'+, '- => state ← real3;
ENDCASE => GOTO Back;
real3 =>
SELECT char
FROM
-- ( int | realF ) ( E | e ) ( + | - )
IN['0..'9] => state ← realE;
ENDCASE => GOTO Back;
realE =>
SELECT char
FROM
-- ( int | realF ) ( E | e ) ?( + | - ) 0..9 | realE 0..9
IN['0..'9] => NULL;
ENDCASE => GOTO Back;
str1 =>
SELECT char
FROM
-- < ...
'> => state ← string; -- < ... >
ENDCASE => NULL;
vec1 =>
SELECT char
FROM
-- ( ...
') => state ← vector; -- ( ... )
ENDCASE => NULL;
com1 =>
SELECT char
FROM
-- * * ...
'* => state ← com2;
ENDCASE => NULL;
com2 =>
SELECT char
FROM
-- * * ... *
'* => state ← comment; -- * * ... * *
ENDCASE => state ← com1;
file1 =>
SELECT char
FROM
-- + + ...
'+ => state ← file2;
ENDCASE => NULL;
file2 =>
SELECT char
FROM
-- + + ... +
'+ => state ← insertFile; -- + + ... + +
ENDCASE => state ← file1;
note1 =>
SELECT char
FROM
-- - - ...
'- => state ← note2;
ENDCASE => NULL;
note2 =>
SELECT char
FROM
-- - - ... -
'- => state ← annotation; -- - - ... - -
ENDCASE => state ← note1;
ENDCASE => ERROR; -- unknown state
text ← RefText.InlineAppendChar[to: text, from: char];
REPEAT Back => peeked ← TRUE;
ENDLOOP;
quit ← action[state: state, text: text, index: index ! UNWIND => Cleanup[]];
IF state=null THEN EXIT;
ENDLOOP;
IF peeked THEN Cleanup[];
};
IntFromText:
PROC [text:
REF
TEXT, start:
NAT ← 0, len:
NAT ←
NAT.
LAST]
RETURNS [
INT] ~ {
rem: NAT ~ text.length-start;
sign: CHAR ← '+;
card: LONG CARDINAL ← 0;
magL: LONG CARDINAL ~ INT.LAST;
magF: LONG CARDINAL ~ magL+1;
FOR i:
NAT
IN[start..start+
MIN[len, rem])
DO
char: CHAR ~ text[i];
SELECT char
FROM
IN['0..'9] => IF card<=magF/10 THEN card ← card*10+(char-'0) ELSE GOTO Overflow;
ENDCASE => IF i=start THEN sign ← char ELSE GOTO SyntaxError;
ENDLOOP;
SELECT sign
FROM
'+ => IF card<=magL THEN RETURN[card] ELSE GOTO Overflow;
'- => IF card<=magF THEN RETURN[-card] ELSE GOTO Overflow;
ENDCASE => GOTO SyntaxError;
EXITS
SyntaxError => ERROR UtilError[[$syntaxError]];
Overflow => ERROR UtilError[[$overflow]];
};
MapString:
PROC [text:
REF
TEXT, action:
PROC [
CHAR]] ~ {
state: {begin, body, esc1, esc2, esc3, end} ← begin;
FOR i:
NAT
IN[0..text.length)
DO
char: CHAR ~ text[i];
val: [0..377B];
SELECT state
FROM
begin =>
SELECT char
FROM
'< => state ← body;
ENDCASE => GOTO SyntaxError;
body =>
SELECT char
FROM
'> => state ← end;
'\\ => state ← esc1;
ENDCASE => action[char];
esc1 =>
SELECT char
FROM
IN['0..'3] => { val ← char-'0; state ← esc2 };
'N, 'n, 'R, 'r => { action['\n]; state ← body };
'T, 't => { action['\t]; state ← body };
'B, 'b => { action['\b]; state ← body };
'F, 'f => { action['\f]; state ← body };
'L, 'l => { action['\l]; state ← body };
'\\ => { action['\\]; state ← body };
'\' => { action['\']; state ← body };
'\" => { action['\"]; state ← body };
ENDCASE => GOTO SyntaxError;
esc2 =>
SELECT char
FROM
IN['0..'7] => { val ← val*8+(char-'0); state ← esc3 };
ENDCASE => GOTO SyntaxError;
esc3 =>
SELECT char
FROM
IN['0..'7] => { val ← val*8+(char-'0); action[VAL[val]]; state ← body };
ENDCASE => GOTO SyntaxError;
end => GOTO SyntaxError;
ENDCASE => ERROR;
ENDLOOP;
IF state#end THEN GOTO SyntaxError;
EXITS SyntaxError => ERROR UtilError[[$syntaxError]];
};
XeroxFromWritten:
PROC [in, out, version:
ROPE] ~ {
inStream: STREAM ~ FS.StreamOpen[in];
oldVersionExists: BOOL ← TRUE;
oldVersion: FS.OpenFile;
oldVersion ← FS.Open[name: out ! FS.Error => {oldVersionExists ← FALSE; CONTINUE}];
This hack is to keep from overwriting the old version right away.
{
outStream: STREAM ~ FS.StreamOpen[out, $create];
IF version = NIL THEN version ← "3.0";
outStream.PutRope["Interpress/Xerox/"];
outStream.PutRope[version];
outStream.PutChar[' ];
XeroxFromWrittenStream[out: outStream, in: inStream];
IO.Close[outStream];
IO.Close[inStream];
};
IF oldVersionExists THEN FS.Close[oldVersion];
};
XeroxFromWrittenStream:
PROC [out, in:
STREAM] ~ {
buffer: REF TEXT ~ NEW[TEXT[200]];
action:
PROC [state: State, text:
REF
TEXT, index:
INT]
RETURNS [
BOOL ←
FALSE] ~ {
SELECT state
FROM
null => NULL;
op => {
op: IPMaster.Op ~ IPMaster.OpFromRope[RefText.TrustTextAsRope[text]];
IF op=nil
THEN
ERROR UtilError[[code: $undefinedOp, index: index,
explanation: IO.PutFR1["\"%g\" is an undefined primitive.", IO.text[text]]]];
IPMaster.PutOp[out, op];
};
id => {
IPMaster.PutSequenceText[out, $sequenceIdentifier, text];
};
int => {
int: INT ~ IntFromText[text];
IPMaster.PutInt[out, int];
};
rat => {
FOR s:
NAT
IN[0..text.length)
DO
IF text[s]='/
THEN {
n: INT ~ IntFromText[text: text, len: s];
d: INT ~ IntFromText[text: text, start: s+1];
IPMaster.PutRational[out, n, d];
EXIT;
};
REPEAT
FINISHED =>
ERROR UtilError[[code: $bug, index: index,
explanation: "Malformed rational number."]];
ENDLOOP;
};
realF, realE => {
real: REAL ~ Convert.RealFromRope[RefText.TrustTextAsRope[text]];
IPMaster.PutReal[out, real];
};
single =>
SELECT text[0]
FROM
'{ => IPMaster.PutOp[out, beginBody];
'} => IPMaster.PutOp[out, endBody];
'[ => {
IPMaster.PutInt[out, 0];
IPMaster.PutOp[out, mark];
};
'] => {
IPMaster.PutOp[out, count];
IPMaster.PutOp[out, makevec];
IPMaster.PutInt[out, 1];
IPMaster.PutOp[out, unmark];
};
', => NULL;
ENDCASE =>
ERROR UtilError[[code: $syntaxError, index: index,
explanation: "Illegal character."]];
string => {
length: INT ← 0;
count: PROC [c: CHAR] ~ { length ← length+1 };
put: PROC [c: CHAR] ~ { IO.PutChar[out, c] };
MapString[text, count];
IPMaster.PutSequence[out, $sequenceString, length];
MapString[text, put];
};
vector => {
GetChar['(];
GetChar[')];
};
comment => {
start: NAT ~ 2;
stop: NAT ~ text.length-2;
IPMaster.PutSequenceText[out, $sequenceComment, text, start, stop-start];
};
insertFile => {
start: NAT ~ 6;
stop: NAT ~ text.length-2;
seq: IPMaster.SequenceType ← nil;
IF text[2] = 'S AND text[3] = 'I AND text[5] = ' THEN {SELECT text[4] FROM 'F => seq ← $sequenceInsertFile; 'M => seq ← $sequenceInsertMaster ENDCASE};
IF seq = nil THEN ERROR UtilError[[code: $syntaxError, index: index, explanation: "insert file is not tagged SIF or SIM"]];
IPMaster.PutSequenceText[out, seq, text, start, stop-start];
};
annotation => {
IF buffer[2] = '$
THEN {
rope: ROPE ~ Rope.FromRefText[buffer];
s: IO.STREAM ~ IO.RIS[rope];
IO.SetIndex[s, 3];
IF Rope.Equal[GetCmdToken[s], "InsertBytesFromXeroxFile"]
THEN {
xName: ROPE ~ GetCmdToken[s];
start: INT ~ IO.GetInt[s];
length: INT ~ IO.GetInt[s];
xStream: IO.STREAM ~ FS.StreamOpen[xName, $read, FS.binaryStreamOptions];
txt: REF TEXT ~ NEW[TEXT[1000]];
residual: INT ← length;
IO.SetIndex[xStream, start];
UNTIL residual=0
DO
d: INT ~ MIN[residual, txt.maxLength];
zero: [0..0] ~ IO.GetBlock[self: xStream, block: txt, startIndex: 0, count: d]-d;
IO.PutBlock[out, txt];
residual ← residual-d;
ENDLOOP;
IO.Close[xStream];
};
IO.Close[s];
};
};
str1, vec1, com1, com2, file1, file2, note1, note2 => ERROR IO.EndOfStream[in];
ENDCASE => ERROR UtilError[[code: $syntaxError, index: index, explanation: "Syntax error."]];
};
[] ← MapWrittenTokens[in, buffer, action];
};
Complain: PUBLIC ERROR [explanation: ROPE] ~ CODE;
maxHeaderLength: INT ← 200;
WrittenFromXerox:
PUBLIC
PROC [writtenName, xeroxName:
ROPE, realComments:
BOOL] ~ {
prefix: ROPE ~ "Interpress/Xerox/";
inFullFName: ROPE ~ FS.FileInfo[xeroxName].fullFName;
inRope: ROPE ~ RopeFile.Create[name: inFullFName, raw: TRUE];
headerLength: INT ~ Rope.Find[Rope.Substr[inRope, 0, maxHeaderLength], " "];
IF headerLength<0
OR Rope.Run[s1: inRope, s2: prefix] # Rope.Size[prefix]
THEN {
ERROR UtilError[[$headerError, 0, Rope.Concat[inFullFName, " is not a Interpress master in the Xerox encoding"]]];
}
ELSE {
header: ROPE ~ Rope.Substr[inRope, 0, headerLength];
rest: ROPE ~ Rope.Substr[inRope, headerLength+1];
outStream: STREAM ~ FS.StreamOpen[writtenName, $create];
outStream.PutF["-- File: %g -- \n", IO.rope[inFullFName]];
outStream.PutF["-- Header: %g -- \n", IO.rope[header]];
WrittenFromXeroxRope[out: outStream, in: rest, headerLengthIncludingSpace: headerLength+1, inFullFName: inFullFName, realComments: realComments];
IO.Close[outStream];
};
};
InterpressOverlay:
PROC [output, input1, input2:
ROPE, m: ImagerTransformation.Transformation, logProc: Interpress.LogProc] ~ {
prevMsg: ROPE ← NIL;
matchCount: INT ← 0;
Log: Interpress.LogProc ~ {
PROC [class: INT, code: ATOM, explanation: ROPE];
WITH ProcessProps.GetProp[$ErrOut]
SELECT
FROM
errOut:
IO.
STREAM => {
IF Rope.Equal[explanation, prevMsg]
THEN {matchCount ← matchCount + 1}
ELSE {
IF matchCount > 0
THEN {
IO.PutF[errOut, " (and %g more)\n", IO.int[matchCount]];
};
IO.PutRope[errOut, explanation];
IF explanation # NIL THEN IO.PutChar[errOut, '\n];
prevMsg ← explanation;
matchCount ← 0;
};
};
ENDCASE => NULL;
};
ref: ImagerInterpress.Ref ~ ImagerInterpress.Create[fileName: output];
master1: Interpress.Master ~ Interpress.Open[fileName: input1, log: logProc];
master2: Interpress.Master ~ Interpress.Open[fileName: input2, log: logProc];
FOR page:
INT
IN [1..master1.pages]
DO
WriteAction:
PROC [context: Imager.Context] ~ {
Write out the corresponding page of the first input, then apply the transformation, then write out the corresponding page of the second input.
context.SetColor [ImagerColorFns.ColorFromCMYK [[0.0, 0.0, 0.0, 1.0]]];
Interpress.DoPage[master: master1, page: page, context: context, log: logProc];
Imager.ConcatT[context: context, m: m];
Interpress.DoPage[master: master2, page: page2, context: context, log: logProc];
};
page2: INT ~ ((page-1) MOD master2.pages)+1; --Cycle through the second master as needed
ImagerInterpress.DoPage[self: ref, action: WriteAction];
ENDLOOP;
Log[-1, NIL, NIL];
ImagerInterpress.Close[self: ref];
};
Run: TYPE ~ RECORD[start, len: INT];
MaxInt: INT ~ INT.LAST;
WrittenFromXeroxRope:
PROC [out:
STREAM, in:
ROPE, inFullFName:
ROPE, headerLengthIncludingSpace:
INT, realComments:
BOOL] ~ {
The rope "in" does not include the header.
stopIndex: INT ← Rope.Size[in];
tokenIndex: INT ← 0;
index: INT ← 0;
token: IPMaster.Token ← [];
prev: IPMaster.Token ← [];
ErrorType: TYPE ~ {error, warning};
errorRope: ARRAY ErrorType OF ROPE ~ [error: "Error", warning: "Warning"];
errorCount: ARRAY ErrorType OF INT ← [0, 0];
sequenceData: {nil, text, runs, skip} ← nil;
sequenceType: IPMaster.SequenceType ← nil;
sequenceBeginIndex: INT ← 0;
sequenceLength: INT ← 0;
sequenceRuns: INT ← 0;
text: REF TEXT ← NIL;
buffer: REF TEXT ~ NEW[TEXT[200]];
runsHead, runsTail: LIST OF Run ← NIL;
Report:
PROC [type: ErrorType, explanation:
ROPE] ~ {
out.PutF["-- %g [%g]: %g. -- ",
IO.rope[errorRope[type]], IO.int[tokenIndex+headerLengthIncludingSpace], IO.rope[explanation]];
errorCount[type] ← errorCount[type]+1;
};
ReportError: PROC [explanation: ROPE] ~ { Report[error, explanation] };
ReportWarning: PROC [explanation: ROPE] ~ { Report[warning, explanation] };
SummarizeErrors:
PROC ~ {
out.PutRope["\n-- "];
FOR type: ErrorType
IN ErrorType
DO
count: INT ~ errorCount[type];
rope: ROPE ~ errorRope[type];
SELECT count
FROM
0 => out.PutF1["no %gs", IO.rope[rope]];
1 => out.PutF1["1 %g", IO.rope[rope]];
ENDCASE => out.PutF["%g %gs", IO.int[count], IO.rope[rope]];
IF type<ErrorType.LAST THEN out.PutRope[", "];
ENDLOOP;
out.PutRope["--\n"];
};
page: INT ← 0; -- current page number
nest: INT ← 0; -- depth of { } nesting
BeginPage:
PROC ~ {
IF page=0
THEN out.PutF1["-- Preamble [%g] -- ", IO.int[tokenIndex+headerLengthIncludingSpace]]
ELSE out.PutF["-- Page %g [%g] -- ", IO.int[page], IO.int[tokenIndex+headerLengthIncludingSpace]];
};
EndPage: PROC ~ { page ← page+1 };
NoteImagerVariable:
PROC ~ {
Val: TYPE ~ [0..IPMaster.ImagerVariable.LAST.ORD];
IF prev.type=num
THEN {
n: INTEGER ~ prev.num;
IF n
IN Val
THEN out.PutF1["--%g-- ", IO.rope[IPMaster.RopeFromImagerVariable[VAL[n]]]]
ELSE ReportWarning[IO.PutFR1["Invalid IGET/ISET index (%g)", IO.int[n]]];
};
};
PutIndirectDescriptor:
PROC [startByte, length:
INT] ~ {
sourceName: ROPE ← inFullFName;
out.PutF[" --$InsertBytesFromXeroxFile %g %g %g -- ", IO.rope[sourceName], IO.int[startByte+headerLengthIncludingSpace], IO.int[length]];
};
BeginSequence:
PROC [seq: IPMaster.SequenceType, startIndex:
INT] ~ {
sequenceBeginIndex ← startIndex;
SELECT sequenceType ← seq
FROM
sequenceString, sequenceIdentifier, sequenceInsertFile, sequenceInsertMaster, sequenceComment,
sequenceInteger, sequenceRational => sequenceData ← text;
sequenceLargeVector, sequencePackedPixelVector, sequenceCompressedPixelVector, sequenceAdaptivePixelVector => sequenceData ← runs;
ENDCASE => sequenceData ← skip;
SELECT sequenceData
FROM
text => { text ← buffer; text.length ← 0 };
runs => { runsHead ← runsTail ← NIL };
ENDCASE;
sequenceLength ← 0;
};
ExtendSequence:
PROC [length:
INT] ~ {
SELECT sequenceData
FROM
text => {
len: NAT ~ length;
nBytesRead: NAT ← 0;
IF (text.maxLength-text.length)<len THEN text ← RefText.ReserveChars[text, len];
nBytesRead ← Rope.AppendChars[buffer: text, rope: in, start: index, len: len];
index ← index + nBytesRead;
IF nBytesRead#len THEN ReportError["Unexpected end of master"];
};
runs => {
prevTail: LIST OF Run ~ runsTail;
runsTail ← LIST[[start: index, len: length]];
IF prevTail=NIL THEN runsHead ← runsTail ELSE prevTail.rest ← runsTail;
index ← index + length;
};
ENDCASE => index ← index + length;
sequenceRuns ← sequenceRuns+1;
sequenceLength ← sequenceLength+length;
};
FinishSequence:
PROC [endIndex:
INT] ~ {
SELECT sequenceType
FROM
sequenceString => {
state: {run, esc, esc2, ext, ext2} ← run;
set: BYTE ← 0;
warning: BOOL ← FALSE;
out.PutRope["<"];
FOR i:
NAT
IN[0..text.length)
DO
c: CHAR ~ text[i];
SELECT state
FROM
run => IF c='\377 THEN state ← esc;
esc => IF c='\377 THEN state ← esc2 ELSE { set ← ORD[c]; state ← run };
esc2 => { state ← ext; IF c='\000 THEN NULL ELSE warning ← TRUE };
ext => IF c='\377 THEN state ← esc ELSE { set ← ORD[c]; state ← ext2 };
ext2 => { state ← ext; IF c='\377 THEN warning ← TRUE };
ENDCASE => ERROR;
IF set=0 AND c IN['\040..'\176] AND NOT(c='> OR c='\\)
THEN out.PutChar[c]
ELSE out.PutF1["\\%03b", IO.int[ORD[c]]];
ENDLOOP;
IF NOT(state=run OR state=ext) THEN warning ← TRUE;
out.PutRope["> "];
IF warning THEN ReportWarning["Invalid string encoding."];
};
sequenceIdentifier => {
invalid, lowerCase: BOOL ← FALSE;
IF text.length=0 THEN invalid ← TRUE;
FOR i:
NAT
IN [0..text.length)
DO
SELECT text[i]
FROM
IN['A..'Z] => NULL;
IN['a..'z] => lowerCase ← TRUE;
IN['0..'9] => IF i=0 THEN invalid ← TRUE;
'- => IF i=0 THEN invalid ← TRUE ELSE lowerCase ← TRUE;
ENDCASE => invalid ← TRUE;
ENDLOOP;
SELECT
TRUE
FROM
invalid => {
out.PutRope["placeholder-for-invalid-identifier "];
ReportError[IO.PutFR1["\"%g\" is an invalid identifier", IO.text[text]]];
};
NOT lowerCase => {
FOR i:
NAT
IN[0..text.length)
DO
char: CHAR ~ text[i];
out.PutChar[IF char IN['A..'Z] THEN 'a+(char-'A) ELSE char];
ENDLOOP;
out.PutChar[' ];
ReportWarning[IO.PutFR1["\"%g\" changed to lower case", IO.text[text]]];
};
ENDCASE => { out.PutF1["%g ", IO.text[text]] };
};
sequenceInsertFile => {
FOR i:
NAT
IN [0..text.length)
DO
IF text[i] = '+ THEN ReportError["plus sign in file name"];
ENDLOOP;
out.PutF1["++SIF %g++ ", IO.text[text]];
};
sequenceInsertMaster => {
FOR i:
NAT
IN [0..text.length)
DO
IF text[i] = '+ THEN ReportError["plus sign in file name"];
ENDLOOP;
out.PutF1["++SIM %g++ ", IO.text[text]];
};
sequenceComment => {
changed: INT ← 0;
FOR i:
NAT
IN [0..text.length)
DO
IF text[i] = '* THEN { text[i] ← '@; changed ← changed + 1 };
ENDLOOP;
out.PutF1["**%g** ", IO.text[text]];
IF changed # 0 THEN ReportWarning[IO.PutFR1["%g asterisks changed to atsigns", IO.int[changed]]];
};
sequenceInteger => {
len: NAT ~ text.length;
IF len<=4
THEN {
val: INT ~ IPMaster.IntFromSequenceData[text];
out.PutF1["%g ", IO.int[val]];
}
ELSE {
val: REAL ~ IPMaster.RealFromSequenceData[text];
out.PutF1["%g ", IO.real[val]];
ReportWarning[IO.PutFR1["Long sequenceInteger (length=%g)", IO.int[len]]];
};
};
sequenceRational => {
len: NAT ~ text.length;
half: NAT ~ len/2;
IF half<=4
THEN {
n: INT ~ IPMaster.IntFromSequenceData[text: text, start: 0, len: half];
d: INT ~ IPMaster.IntFromSequenceData[text: text, start: half, len: half];
out.PutF["%g/%g ", IO.int[n], IO.int[d]];
IF d=0
THEN ReportError["Zero denominator"]
ELSE { IF realComments THEN out.PutF1["--(%g)-- ", IO.real[REAL[n]/REAL[d]]] };
}
ELSE {
n: REAL ~ IPMaster.RealFromSequenceData[text: text, start: 0, len: half];
d: REAL ~ IPMaster.RealFromSequenceData[text: text, start: half, len: half];
out.PutF["%g/%g ", IO.real[n], IO.real[d]];
IF d=0 THEN ReportError["Zero denominator"] ELSE { IF realComments THEN out.PutF1["--(%g)-- ", IO.real[n/d]] };
ReportWarning[IO.PutFR1["Long sequenceRational (length=%g)", IO.int[len]]];
};
IF (half+half)#len
THEN ReportError[
IO.PutFR1["Invalid sequenceRational (length=%g)", IO.int[len]]];
};
sequenceLargeVector => {
out.PutF1["-- sequenceLargeVector (%g bytes) -- ", IO.int[sequenceLength]];
PutIndirectDescriptor[sequenceBeginIndex, endIndex-sequenceBeginIndex];
};
sequencePackedPixelVector => {
out.PutF1["-- sequencePackedPixelVector (%g bytes) -- ", IO.int[sequenceLength]];
PutIndirectDescriptor[sequenceBeginIndex, endIndex-sequenceBeginIndex];
};
sequenceCompressedPixelVector => {
out.PutF1["-- sequenceCompressedPixelVector (%g bytes) -- ", IO.int[sequenceLength]];
PutIndirectDescriptor[sequenceBeginIndex, endIndex-sequenceBeginIndex];
};
sequenceAdaptivePixelVector => {
out.PutF1["-- sequenceAdaptivePixelVector (%g bytes) -- ", IO.int[sequenceLength]];
PutIndirectDescriptor[sequenceBeginIndex, endIndex-sequenceBeginIndex];
};
sequenceContinued => ReportError["Misplaced sequenceContinued"];
ENDCASE => ReportError[IO.PutFR1["Invalid sequence type (%g)", IO.int[ORD[sequenceType]]]];
IF sequenceRuns>1 THEN ReportWarning[IO.PutFR1["Continued sequence (%g runs)", IO.int[sequenceRuns]]];
SELECT sequenceData
FROM
text => { text ← NIL };
runs => { runsHead ← runsTail ← NIL };
ENDCASE;
sequenceData ← nil;
sequenceType ← nil;
sequenceRuns ← 0;
sequenceLength ← 0;
};
WHILE index < stopIndex
DO
-- for each Token
newLine: BOOL ← FALSE;
tokenIndex ← index;
[token, index] ← IPMaster.GetToken[encoding: in, start: index];
IF sequenceData#nil
THEN {
IF token.seq=sequenceContinued
THEN { ExtendSequence[token.len]; LOOP }
ELSE FinishSequence[tokenIndex];
};
SELECT token.type
FROM
op => {
op: IPMaster.Op ~ IPMaster.OpFromEncodingValue[token.op];
newLine ← TRUE;
SELECT token.op
FROM
beginBody => { IF nest=0 THEN BeginPage[]; nest ← nest+1 };
endBody => { nest ← nest-1; IF nest=0 THEN EndPage[] };
iget, iset => NoteImagerVariable[];
makesimpleco, dosavesimplebody, if, ifelse, ifcopy, correct, scale, scale2, rotate, translate, makevec, makeveclu => newLine ← FALSE;
ENDCASE => NULL;
IF op#nil
THEN out.PutF1["%g ", IO.rope[IPMaster.RopeFromOp[op]]]
ELSE ReportError[IO.PutFR1["Invalid encoding value (%g)", IO.int[ORD[token.op]]]];
};
num => out.PutF1["%g ", IO.int[token.num]];
seq => { BeginSequence[token.seq, tokenIndex]; ExtendSequence[token.len] };
ENDCASE => ERROR;
IF newLine
THEN {
out.PutChar['\n];
THROUGH [0..nest) DO out.PutChar['\t] ENDLOOP;
};
prev ← token;
ENDLOOP;
SummarizeErrors[];
};
CmdTokenBreak:
PROC [char:
CHAR]
RETURNS [
IO.CharClass] = {
IF char = '← OR 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] = {
DO
rope: ROPE ← NIL;
rope ← stream.GetTokenRope[CmdTokenBreak ! IO.EndOfStream => CONTINUE].token;
IF NOT Rope.Match[pattern: "-*", object: rope, case: FALSE] THEN RETURN [rope];
ENDLOOP;
};
QuotedTokenBreak:
PROC [char:
CHAR]
RETURNS [
IO.CharClass] = {
IF char = '" THEN RETURN [break];
RETURN [other];
};
GetQuotedToken:
PROC [stream:
IO.
STREAM]
RETURNS [
ROPE] = {
rope: ROPE ← NIL;
rope ← stream.GetTokenRope[QuotedTokenBreak ! IO.EndOfStream => CONTINUE].token;
[] ← stream.GetTokenRope[QuotedTokenBreak ! IO.EndOfStream => CONTINUE]; --skip over final quote
RETURN [rope];
};
ActionProc: TYPE ~ PROC [inputName: ROPE, outputName: ROPE, cmd: Commander.Handle, cmds: IO.STREAM];
IPWrittenFromXeroxAction: ActionProc ~ {
rSwitch: BOOL ~ Rope.Match[pattern: "* -r*", object: cmd.commandLine, case: FALSE];
WrittenFromXerox[writtenName: outputName, xeroxName: inputName, realComments: NOT rSwitch];
};
IPXeroxFromWrittenAction: ActionProc ~ {
version: ROPE ← GetCmdToken[cmds];
XeroxFromWritten[in: inputName, out: outputName, version: version];
};
FindFullName:
PROC [inputName:
ROPE]
RETURNS [
ROPE] ~ {
fullFName: ROPE ← NIL;
fullFName ← FS.FileInfo[inputName].fullFName;
RETURN [fullFName]
};
MakeOutputName:
PROC [inputName:
ROPE, doc:
ROPE]
RETURNS [
ROPE] ~ {
start: INT ← Rope.Index[s1: doc, s2: " to "]+4;
end: INT ← Rope.Index[s1: doc, pos1: start, s2: " "];
space: INT;
cp: FS.ComponentPositions;
[inputName, cp] ← FS.ExpandName[inputName];
space ← Rope.Index[s1: Rope.Substr[inputName, cp.base.start, cp.base.length], s2: " "]; -- = cp.base.length if no spaces in the base
RETURN [Rope.Cat[Rope.Substr[inputName, cp.base.start, space], ".", Rope.Substr[doc, start, end-start]]] --if spaces were in the base, this uses just the first word
};
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 outputName.Equal["\""]
THEN {
--reset and do it again, allowing spaces in name
stream.SetIndex[secondTokenIndex];
outputName ← GetQuotedToken[stream];
secondTokenIndex ← IO.GetIndex[stream];
gets ← GetCmdToken[stream];
};
IF
NOT gets.Equal["←"]
THEN {
inputName ← outputName;
outputName ← NIL;
stream.SetIndex[secondTokenIndex];
}
ELSE {
inputName ← GetCmdToken[stream];
IF inputName.Equal["\""] THEN inputName ← GetQuotedToken[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["Reading "];
cmd.out.PutRope[inputName];
cmd.out.PutRope[" . . . "];
refAction^[inputName, outputName, cmd, stream];
outputName ← FindFullName[outputName];
cmd.out.PutRope[outputName];
cmd.out.PutRope[" written.\n"];
EXITS Quit => NULL
};
InterpressOverlayCmd: Commander.CommandProc ~ {
ENABLE {
FS.Error => {
result ← $Failure;
msg ← error.explanation;
GOTO Failure;
};
};
IsIt:
PROC [rope:
ROPE, parmsNeeded:
INT]
RETURNS [
BOOLEAN] ~ {
RETURN [Rope.Equal[rope, tokens[tokenIndex], FALSE] AND tokens.argc > tokenIndex+parmsNeeded];
};
SkipArgs: PROC [args: INT] ~ INLINE {tokenIndex ← args+tokenIndex+1};
Real:
PROC [index:
INT]
RETURNS [real:
REAL] ~ {
RETURN [Convert.RealFromRope[r: tokens[index]]];
};
tokens: CommandTool.ArgumentVector ~ CommandTool.Parse[cmd: cmd];
Arg 0 .../InterpressOverlay
Arg 1 output
Arg 2 ←
Arg 3 input1
Arg 4 input2
Arg 5+ Transformation options...
tokenIndex: INT ← 5; --Initialized to start of transformation options
m: ImagerTransformation.Transformation ← ImagerTransformation.Scale[s: 1];
IF tokens.argc < 5 OR ~Rope.Equal[s1: "←", s2: tokens[2]] THEN GOTO BadSyntax;
Go through the transformation options...
WHILE tokenIndex<tokens.argc
DO
SELECT
TRUE
FROM
IsIt["translate", 2] => {
m ← ImagerTransformation.PreTranslate[m: m, t: [Real[tokenIndex+1], Real[tokenIndex+2]]];
SkipArgs[2];
};
IsIt["rotate", 1] => {
m ← ImagerTransformation.PreRotate[m: m, r: Real[tokenIndex+1]];
SkipArgs[1];
};
IsIt["scale", 1] => {
m ← ImagerTransformation.PreScale[m: m, s: Real[tokenIndex+1]];
SkipArgs[1];
};
IsIt["scale2", 2] => {
m ← ImagerTransformation.PreScale2[m: m, s: [Real[tokenIndex+1], Real[tokenIndex+2]]];
SkipArgs[2];
};
ENDCASE => GOTO BadSyntax;
ENDLOOP;
InterpressOverlay[output: tokens[1], input1: tokens[3], input2: tokens[4], m: m, logProc: NIL];
EXITS
BadSyntax => {
RETURN [msg: docInterpressOverlay, result: $Failure];
};
Failure => {};
};
docIPWrittenFromXerox: ROPE ~ "Convert Interpress Xerox encoding to written encoding (output ← input)\n";
docIPXeroxFromWritten: ROPE ~ "Convert Interpress written encoding to Interpress Xerox encoding (output ← input version)\n";
docInterpressOverlay:
ROPE ~ "Merge two interpress masters (<output> ← <input1> <input2> {translate <x> <y> | rotate <angle> | scale <scale> | scale2 <sx> <sy>})\n";
Commander.Register["IPWrittenFromXerox", Command, docIPWrittenFromXerox, NEW[ActionProc ← IPWrittenFromXeroxAction]];
Commander.Register["IPXeroxFromWritten", Command, docIPXeroxFromWritten, NEW[ActionProc ← IPXeroxFromWrittenAction]];
Commander.Register["InterpressOverlay", InterpressOverlayCmd, docInterpressOverlay];
END.