IPUtilsImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Michael Plass, October 17, 1985 11:41:49 am PDT
Nickell, September 20, 1985 3:28:35 pm PDT
Doug Wyatt, November 21, 1985 5:44:28 pm PST
DIRECTORY
Atom USING [MakeAtom],
Commander,
CommandTool USING [ArgumentVector, Parse],
Convert USING [RealFromRope],
FS,
Imager USING [Context, ConcatT],
ImagerInterpress USING [Close, Create, DoPage, Ref],
ImagerTransformation USING [Scale, PreRotate, PreScale, PreScale2, PreTranslate, Transformation],
Interpress USING [DoPage, LogProc, Open, OpenMaster],
IO,
IPMaster,
RefText USING [InlineAppendChar, ObtainScratch, ReleaseScratch, ReserveChars, TrustTextAsRope],
Rope;
IPUtilsImpl: CEDAR PROGRAM
IMPORTS Atom, Commander, CommandTool, Convert, FS, Imager, ImagerInterpress, ImagerTransformation, Interpress, IO, IPMaster, RefText, Rope
~ BEGIN OPEN IPMaster;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Version: TYPE ~ IPMaster.Version;
UtilErrorDesc: TYPE ~ RECORD [code: ATOM, index: INT, explanation: ROPE];
UtilError: ERROR[error: UtilErrorDesc] ~ CODE;
Open:
PUBLIC
PROC [name:
ROPE]
RETURNS [
STREAM] ~ {
stream: STREAM ~ FS.StreamOpen[name, $read, rawStreamOptions];
header: ROPE ~ IPMaster.GetHeader[stream, "Interpress/"];
encoding: ATOM ← NIL;
version: Version ← [0, 0];
class: ATOM ← NIL;
classVersion: Version ← [0, 0];
count: NAT ← 0;
headerPart: IPMaster.PartActionType ~ {
SELECT count
FROM
0 => encoding ← Atom.MakeAtom[Rope.Substr[base, start, len]];
1 => version ← IPMaster.VersionFromRope[base, start, len];
2 => class ← Atom.MakeAtom[Rope.Substr[base, start, len]];
3 => classVersion ← IPMaster.VersionFromRope[base, start, len];
ENDCASE => quit ← TRUE;
count ← count+1;
};
[] ← IPMaster.MapParts[base: header, delimiter: '/, action: headerPart];
SELECT encoding
FROM
$Xerox => NULL;
ENDCASE => ERROR IPMaster.Error[[code: $invalidEncoding,
explanation: IO.PutFR1["%g is not a valid encoding type.", IO.atom[encoding]]]];
RETURN[stream];
};
Create:
PUBLIC
PROC [name:
ROPE]
RETURNS [
STREAM] ~ {
stream: STREAM ~ FS.StreamOpen[name, $create];
stream.PutRope["Interpress/Xerox/2.1 "];
RETURN[stream];
};
ExtractPage:
PROC [toName, fromName:
ROPE, n:
NAT] ~ {
OPEN IPMaster;
CopyNode:
PROC [to:
STREAM, from:
STREAM, node: Node] ~ {
CopySegment[to: to, from: from, start: node.index, length: node.length];
};
from: STREAM ~ Open[fromName];
skeleton: Skeleton ~ GetSkeleton[from];
to: STREAM ~ Create[toName];
PutOp[to, beginBlock];
CopyNode[to, from, skeleton.topBlock.preamble];
CopyNode[to, from, skeleton.topBlock[n-1]];
PutOp[to, endBlock];
IO.Close[to];
IO.Close[from];
};
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
OpenWritten: PROC [name: ROPE] RETURNS [STREAM] ~ { RETURN[FS.StreamOpen[name]] };
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]--;
};
MapVector: PROC [text: REF TEXT, action: PROC [CARDINAL]] ~ {
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;
ENDCASE => action[char];
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, IPMaster.EncodingValueFromOp[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 ~ 2;
stop: NAT ~ text.length-2;
IPMaster.PutSequenceText[out, $sequenceInsertFile, 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, rawStreamOptions];
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];
};
rawStreamOptions: FS.StreamOptions ~ [tiogaRead: FALSE, commitAndReopenTransOnFlush: TRUE, truncatePagesOnClose: TRUE, finishTransOnClose: TRUE, closeFSOpenFileOnClose: TRUE];
WrittenFromXerox:
PUBLIC
PROC [writtenName, xeroxName:
ROPE] ~ {
OPEN IPMaster;
inStream: STREAM ~ FS.StreamOpen[xeroxName, $read, rawStreamOptions];
outStream: STREAM ~ FS.StreamOpen[writtenName, create];
prefix: ROPE ~ "Interpress/";
header: ROPE ~ GetHeader[inStream, prefix];
outStream.PutF["-- File: %g -- \n", IO.rope[xeroxName]];
outStream.PutF["-- Header: %g%g -- \n", IO.rope[prefix], IO.rope[header]];
WrittenFromXeroxStream[out: outStream, in: inStream];
IO.Close[outStream];
IO.Close[inStream];
};
IPOverlayLogProc: Interpress.LogProc ~ {
PROC [master: OpenMaster, class: ErrorClass, code: ATOM, explanation: ROPE];
};
InterpressOverlay:
PROC [output, input1, input2:
ROPE, m: ImagerTransformation.Transformation, logProc: Interpress.LogProc] ~ {
ref: ImagerInterpress.Ref ~ ImagerInterpress.Create[fileName: output];
master1: Interpress.OpenMaster ~ Interpress.Open[fileName: input1, logProc: logProc];
master2: Interpress.OpenMaster ~ Interpress.Open[fileName: input2, logProc: 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.
Interpress.DoPage[master: master1, page: page, context: context];
Imager.ConcatT[context: context, m: m];
Interpress.DoPage[master: master2, page: page2, context: context];
};
page2: INT ~ ((page-1) MOD master2.pages)+1; --Cycle through the second master as needed
ImagerInterpress.DoPage[self: ref, action: WriteAction];
ENDLOOP;
ImagerInterpress.Close[self: ref];
};
Run: TYPE ~ RECORD[start, len: INT];
MaxInt: INT ~ INT.LAST;
WrittenFromXeroxStream:
PROC [out, in:
STREAM, stopIndex:
INT ← MaxInt] ~ {
token: Token ← [];
tokenBeginIndex: INT ← 0;
prev: 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: 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[token.index], 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[token.index]]
ELSE out.PutF["-- Page %g [%g] -- ", IO.int[page], IO.int[token.index]];
};
EndPage: PROC ~ { page ← page+1 };
NoteImagerVariable:
PROC ~ {
Val: TYPE ~ [0..ImagerVariable.LAST.ORD];
IF prev.type=num
THEN {
n: INTEGER ~ prev.num;
IF n IN Val THEN out.PutF1["--%g-- ", IO.rope[RopeFromImagerVariable[VAL[n]]]]
ELSE ReportWarning[IO.PutFR1["Invalid IGET/ISET index (%g)", IO.int[n]]];
};
};
PutIndirectDescriptor:
PROC [startByte, length:
INT] ~ {
sourceName: ROPE ← FS.GetName[FS.OpenFileFromStream[in]].fullFName;
out.PutF[" --$InsertBytesFromXeroxFile %g %g %g -- ", IO.rope[sourceName], IO.int[startByte], IO.int[length]];
};
BeginSequence:
PROC [seq: SequenceType, startIndex:
INT] ~ {
sequenceBeginIndex ← startIndex;
SELECT sequenceType ← seq
FROM
sequenceString, sequenceIdentifier, sequenceInsertFile, sequenceComment,
sequenceInteger, sequenceRational, sequenceReal => 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 ← IO.GetBlock[self: in, block: text, startIndex: text.length, count: len];
IF nBytesRead#len THEN ERROR IO.EndOfStream[in];
};
runs => {
prevTail: LIST OF Run ~ runsTail;
runsTail ← LIST[[start: IO.GetIndex[in], len: length]];
IF prevTail=NIL THEN runsHead ← runsTail ELSE prevTail.rest ← runsTail;
SkipBytes[in, length];
};
ENDCASE => SkipBytes[in, 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;
IF invalid
THEN {
out.PutRope["placeholder-for-invalid-identifier "];
ReportError[IO.PutFR1["\"%g\" is an invalid identifier", IO.text[text]]];
}
ELSE
IF
NOT lowerCase
THEN {
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]]];
}
ELSE out.PutF1["%g ", IO.text[text]];
};
sequenceInsertFile => {
out.PutF1["++%g++ ", IO.text[text]];
};
sequenceComment => {
out.PutF1["**%g** ", IO.text[text]];
};
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 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 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
IO.GetIndex[in]<stopIndex
DO
-- for each Token
newLine: BOOL ← FALSE;
token ← GetToken[stream: in, flushComments: FALSE ! IO.EndOfStream => EXIT];
IF sequenceData#nil
THEN {
IF token.seq=sequenceContinued THEN { ExtendSequence[token.len]; LOOP }
ELSE FinishSequence[token.index];
};
SELECT token.type
FROM
op => {
op: IPMaster.Op ~ IPMaster.OpFromEncodingValue[token.op];
newLine ← TRUE;
SELECT 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, makefont => newLine ← FALSE;
ENDCASE;
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, token.index]; 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 = '← 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;
};
ActionProc:
TYPE ~
PROC [inputName:
ROPE, outputName:
ROPE, cmd: Commander.Handle, cmds:
IO.
STREAM];
IPWrittenFromXeroxAction: ActionProc ~ {
WrittenFromXerox[writtenName: outputName, xeroxName: inputName];
};
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: " "];
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]
]]
};
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];
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] ~
INLINE {
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: IPOverlayLogProc];
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.