<<>> <> <> <> <> <> <> <> <<>> 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]; IPToolsCommand: CEDAR PROGRAM IMPORTS Commander, CommandTool, Convert, FS, Imager, ImagerColorFns, ImagerInterpress, ImagerTransformation, Interpress, IO, IPMaster, ProcessProps, RefText, Rope, RopeFile ~ 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}]; <> { 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]; }; < {>> <> <<>> <> <<};>> 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 ~ { <> 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] ~ { <> 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] ~ { <> 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 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) { 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]; <> <> <> <> <> <> 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; <> WHILE tokenIndex { 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 ( _ {translate | rotate | scale | scale2 })\n"; Commander.Register["IPWrittenFromXerox", Command, docIPWrittenFromXerox, NEW[ActionProc _ IPWrittenFromXeroxAction]]; Commander.Register["IPXeroxFromWritten", Command, docIPXeroxFromWritten, NEW[ActionProc _ IPXeroxFromWrittenAction]]; Commander.Register["InterpressOverlay", InterpressOverlayCmd, docInterpressOverlay]; END.