<> <> <> <<>> DIRECTORY Basics USING [LongNumber], FS USING [StreamOpen], IO, IPMaster USING [Block, BlockRep, Body, BodyRep, BYTE, CARD, ErrorCode, ImagerVariable, Node, NodeRep, Op, Skeleton, SkeletonRep, Token, TokenType], IPXerox USING [EncodingValue, GetToken, PutToken, SequenceType, ShortEncodingValue, ShortNumber, Token], Real USING [NumberType, RealToPair, RoundLI], RefText USING [AppendChar, ObtainScratch, ReleaseScratch], Rope USING [Concat, Fetch, FromProc, FromRefText, Index, Length, ROPE, Substr], ShortRational USING [FromReal, Rational], SymTab USING [Create, Fetch, Ref, Store]; IPMasterImpl: CEDAR PROGRAM IMPORTS FS, IO, IPXerox, Real, RefText, Rope, ShortRational, SymTab EXPORTS IPMaster ~ BEGIN OPEN IPMaster; ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; ShortNumber: TYPE ~ IPXerox.ShortNumber; EncodingValue: TYPE ~ IPXerox.EncodingValue; ShortEncodingValue: TYPE ~ IPXerox.ShortEncodingValue; SequenceType: TYPE ~ IPXerox.SequenceType; Error: PUBLIC ERROR[code: ErrorCode, explanation: ROPE] ~ CODE; EvFromOpArray: TYPE ~ ARRAY Op OF EncodingValue; OpFromEvArray: TYPE ~ ARRAY EncodingValue OF Op; evFromOp: REF EvFromOpArray ~ NEW[EvFromOpArray _ [nil: nil, get: get, makeveclu: makeveclu, makevec: makevec, shape: shape, openvec: openvec, getprop: getprop, getp: getp, mergeprop: mergeprop, frame: frame, fget: fget, fset: fset, poolop: poolop, pool: pool, pget: pget, pset: pset, env: env, makepool: makepool, nopool: nopool, makeco: makeco, makesimpleco: makesimpleco, do: do, dosave: dosave, dosaveall: dosaveall, dobody: dobody, dosavebody: dosavebody, dosaveallbody: dosaveallbody, dosavesimplebody: dosavesimplebody, makecompiledimage: makecompiledimage, pop: pop, copy: copy, dup: dup, roll: roll, exch: exch, mark: mark, unmark: unmark, unmark0: unmark0, count: count, nop: nop, error: error, if: if, ifelse: ifelse, ifcopy: ifcopy, loop: loop, eq: eq, eqname: eqname, gt: gt, ge: ge, and: and, or: or, not: not, type: type, add: add, sub: sub, neg: neg, abs: abs, floor: floor, ceiling: ceiling, trunc: trunc, round: round, mul: mul, div: div, mod: mod, rem: rem, max: max, min: min, sqrt: sqrt, exp: exp, log: log, sin: sin, cos: cos, atan: atan, iget: iget, iset: iset, dround: dround, maket: maket, opent: opent, translate: translate, rotate: rotate, scale: scale, scale2: scale2, concat: concat, invert: invert, transform: transform, transformvec: transformvec, roundxy: roundxy, roundxyvec: roundxyvec, concatt: concatt, move: move, trans: trans, show: show, showandxrel: showandxrel, setxy: setxy, setxyrel: setxyrel, setxrel: setxrel, setyrel: setyrel, getcp: getcp, getcprounded: getcprounded, makepixelarray: makepixelarray, extractpixelarray: extractpixelarray, joinpixelarrays: joinpixelarrays, finddecompressor: finddecompressor, makegray: makegray, setgray: setgray, findcolor: findcolor, findcoloroperator: findcoloroperator, findcolormodeloperator: findcolormodeloperator, makesampledcolor: makesampledcolor, makesampledblack: makesampledblack, moveto: moveto, lineto: lineto, linetox: linetox, linetoy: linetoy, curveto: curveto, conicto: conicto, arcto: arcto, makeoutline: makeoutline, maskfill: maskfill, maskfillparity: maskfillparity, maskstroke: maskstroke, maskstrokeclosed: maskstrokeclosed, maskvector: maskvector, maskrectangle: maskrectangle, startunderline: startunderline, maskunderline: maskunderline, masktrapezoidx: masktrapezoidx, masktrapezoidy: masktrapezoidy, maskpixel: maskpixel, clipoutline: clipoutline, excludeoutline: excludeoutline, cliprectangle: cliprectangle, excluderectangle: excluderectangle, findfont: findfont, findfontvec: findfontvec, modifyfont: modifyfont, setfont: setfont, correctmask: correctmask, correctspace: correctspace, space: space, setcorrectmeasure: setcorrectmeasure, setcorrecttolerance: setcorrecttolerance, correct: correct, beginBody: beginBody, endBody: endBody, beginBlock: beginBlock, endBlock: endBlock, pageInstructions: pageInstructions, noPages: noPages, metricMaster: metricMaster, environmentMaster: environmentMaster ]]; opFromEv: REF OpFromEvArray ~ InvertEvFromOp[evFromOp]; InvertEvFromOp: PROC[evFromOp: REF EvFromOpArray] RETURNS[opFromEv: REF OpFromEvArray] ~ { opFromEv _ NEW[OpFromEvArray _ ALL[nil]]; FOR op: Op IN Op DO opFromEv[evFromOp[op]] _ op ENDLOOP; }; EncodingValueFromOp: PUBLIC PROC[op: Op] RETURNS[EncodingValue] ~ { RETURN[evFromOp[op]]; }; OpFromEncodingValue: PUBLIC PROC[ev: EncodingValue] RETURNS[Op] ~ { RETURN[opFromEv[ev]]; }; SeqFromTypeArray: TYPE ~ ARRAY TokenType OF SequenceType; TypeFromSeqArray: TYPE ~ ARRAY SequenceType OF TokenType; seqFromType: REF SeqFromTypeArray ~ NEW[SeqFromTypeArray _ [ nil: nil, op: nil, number: nil, integer: sequenceInteger, rational: sequenceRational, string: sequenceString, identifier: sequenceIdentifier, comment: sequenceComment, insertFile: sequenceInsertFile, largeVector: sequenceLargeVector, packedPixelVector: sequencePackedPixelVector, compressedPixelVector: sequenceCompressedPixelVector, adaptivePixelVector: sequenceAdaptivePixelVector ]]; typeFromSeq: REF TypeFromSeqArray ~ InvertSeqFromType[seqFromType]; InvertSeqFromType: PROC[seqFromType: REF SeqFromTypeArray] RETURNS[typeFromSeq: REF TypeFromSeqArray] ~ { typeFromSeq _ NEW[TypeFromSeqArray _ ALL[nil]]; FOR type: TokenType IN TokenType DO seq: SequenceType ~ seqFromType[type]; IF seq#nil THEN typeFromSeq[seq] _ type; ENDLOOP; }; SequenceTypeFromTokenType: PUBLIC PROC[type: TokenType] RETURNS[SequenceType] ~ { RETURN[seqFromType[type]]; }; TokenTypeFromSequenceType: PUBLIC PROC[seq: SequenceType] RETURNS[TokenType] ~ { RETURN[typeFromSeq[seq]]; }; NonDefaultingRope: TYPE ~ ROPE _; RopeFromOpArray: TYPE ~ ARRAY Op OF NonDefaultingRope; ropeFromOp: REF RopeFromOpArray ~ NEW[RopeFromOpArray _ [nil: NIL, get: "GET", makeveclu: "MAKEVECLU", makevec: "MAKEVEC", shape: "SHAPE", openvec: "OPENVEC", getprop: "GETPROP", getp: "GETP", mergeprop: "MERGEPROP", frame: "FRAME", fget: "FGET", fset: "FSET", poolop: "POOLOP", pool: "POOL", pget: "PGET", pset: "PSET", env: "ENV", makepool: "MAKEPOOL", nopool: "NOPOOL", makeco: "MAKECO", makesimpleco: "MAKESIMPLECO", do: "DO", dosave: "DOSAVE", dosaveall: "DOSAVEALL", dobody: "DOBODY", dosavebody: "DOSAVEBODY", dosaveallbody: "DOSAVEALLBODY", dosavesimplebody: "DOSAVESIMPLEBODY", makecompiledimage: "MAKECOMPILEDIMAGE", pop: "POP", copy: "COPY", dup: "DUP", roll: "ROLL", exch: "EXCH", mark: "MARK", unmark: "UNMARK", unmark0: "UNMARK0", count: "COUNT", nop: "NOP", error: "ERROR", if: "IF", ifelse: "IFELSE", ifcopy: "IFCOPY", loop: "LOOP", eq: "EQ", eqname: "EQNAME", gt: "GT", ge: "GE", and: "AND", or: "OR", not: "NOT", type: "TYPE", add: "ADD", sub: "SUB", neg: "NEG", abs: "ABS", floor: "FLOOR", ceiling: "CEILING", trunc: "TRUNC", round: "ROUND", mul: "MUL", div: "DIV", mod: "MOD", rem: "REM", max: "MAX", min: "MIN", sqrt: "SQRT", exp: "EXP", log: "LOG", sin: "SIN", cos: "COS", atan: "ATAN", iget: "IGET", iset: "ISET", dround: "DROUND", maket: "MAKET", opent: "OPENT", translate: "TRANSLATE", rotate: "ROTATE", scale: "SCALE", scale2: "SCALE2", concat: "CONCAT", invert: "INVERT", transform: "TRANSFORM", transformvec: "TRANSFORMVEC", roundxy: "ROUNDXY", roundxyvec: "ROUNDXYVEC", concatt: "CONCATT", move: "MOVE", trans: "TRANS", show: "SHOW", showandxrel: "SHOWANDXREL", setxy: "SETXY", setxyrel: "SETXYREL", setxrel: "SETXREL", setyrel: "SETYREL", getcp: "GETCP", getcprounded: "GETCPROUNDED", makepixelarray: "MAKEPIXELARRAY", extractpixelarray: "EXTRACTPIXELARRAY", joinpixelarrays: "JOINPIXELARRAYS", finddecompressor: "FINDDECOMPRESSOR", makegray: "MAKEGRAY", setgray: "SETGRAY", findcolor: "FINDCOLOR", findcoloroperator: "FINDCOLOROPERATOR", findcolormodeloperator: "FINDCOLORMODELOPERATOR", makesampledcolor: "MAKESAMPLEDCOLOR", makesampledblack: "MAKESAMPLEDBLACK", moveto: "MOVETO", lineto: "LINETO", linetox: "LINETOX", linetoy: "LINETOY", curveto: "CURVETO", conicto: "CONICTO", arcto: "ARCTO", makeoutline: "MAKEOUTLINE", maskfill: "MASKFILL", maskfillparity: "MASKFILLPARITY", maskstroke: "MASKSTROKE", maskstrokeclosed: "MASKSTROKECLOSED", maskvector: "MASKVECTOR", maskrectangle: "MASKRECTANGLE", startunderline: "STARTUNDERLINE", maskunderline: "MASKUNDERLINE", masktrapezoidx: "MASKTRAPEZOIDX", masktrapezoidy: "MASKTRAPEZOIDY", maskpixel: "MASKPIXEL", clipoutline: "CLIPOUTLINE", excludeoutline: "EXCLUDEOUTLINE", cliprectangle: "CLIPRECTANGLE", excluderectangle: "EXCLUDERECTANGLE", findfont: "FINDFONT", findfontvec: "FINDFONTVEC", modifyfont: "MODIFYFONT", setfont: "SETFONT", correctmask: "CORRECTMASK", correctspace: "CORRECTSPACE", space: "SPACE", setcorrectmeasure: "SETCORRECTMEASURE", setcorrecttolerance: "SETCORRECTTOLERANCE", correct: "CORRECT", beginBody: "{", endBody: "}", beginBlock: "BEGIN", endBlock: "END", pageInstructions: "PAGEINSTRUCTIONS", noPages: "NOPAGES", metricMaster: "METRICMASTER", environmentMaster: "ENVIRONMENTMASTER" ]]; opFromRope: SymTab.Ref ~ InvertRopeFromOp[ropeFromOp]; OpVal: TYPE ~ REF Op; InvertRopeFromOp: PROC[ropeFromOp: REF RopeFromOpArray] RETURNS[opFromRope: SymTab.Ref] ~ { opFromRope _ SymTab.Create[mod: ORD[Op.LAST], case: FALSE]; FOR op: Op IN Op DO key: ROPE ~ ropeFromOp[op]; val: OpVal ~ NEW[Op _ op]; IF SymTab.Store[x: opFromRope, key: key, val: val] THEN NULL ELSE ERROR Error[bug, "duplicate name in ropeFromOp"]; ENDLOOP; }; RopeFromOp: PUBLIC PROC[op: Op] RETURNS[ROPE] ~ { RETURN[ropeFromOp[op]]; }; OpFromRope: PUBLIC PROC[rope: ROPE] RETURNS[Op] ~ { found: BOOL; val: REF; [found, val] _ SymTab.Fetch[x: opFromRope, key: rope]; IF found THEN WITH val SELECT FROM val: OpVal => RETURN[val^]; ENDCASE => ERROR Error[bug, "illegal value in opFromRope"]; RETURN[nil]; }; RopeFromVarArray: TYPE ~ ARRAY ImagerVariable OF NonDefaultingRope; ropeFromVar: REF RopeFromVarArray ~ NEW[RopeFromVarArray _ [ DCScpx: "DCScpx", DCScpy: "DCScpy", correctMX: "correctMX", correctMY: "correctMY", T: "T", priorityImportant: "priorityImportant", mediumXSize: "mediumXSize", mediumYSize: "mediumYSize", fieldXMin: "fieldXMin", fieldYMin: "fieldYMin", fieldXMax: "fieldXMax", fieldYMax: "fieldYMax", showVec: "showVec", color: "color", noImage: "noImage", strokeWidth: "strokeWidth", strokeStyle: "strokeStyle", underlineStart: "underlineStart", amplifySpace: "amplifySpace", correctPass: "correctPass", correctShrink: "correctShrink", correctTX: "correctTX", correctTY: "correctTY", strokeDashes: "strokeDashes" ]]; RopeFromImagerVariable: PUBLIC PROC[var: ImagerVariable] RETURNS[ROPE] ~ { RETURN[ropeFromVar[var]]; }; GetHeader: PUBLIC PROC[stream: STREAM, prefix: ROPE _ NIL] RETURNS[suffix: ROPE] ~ { scratch, text: REF TEXT _ NIL; IF prefix=NIL THEN prefix _ "Interpress/Xerox/"; FOR i: INT IN[0..Rope.Length[prefix]) DO char: CHAR ~ IO.GetChar[stream]; IF char=Rope.Fetch[prefix, i] THEN NULL ELSE ERROR Error[invalidHeader, Rope.Concat["header must begin with ", prefix]]; ENDLOOP; text _ scratch _ RefText.ObtainScratch[100]; FOR i: NAT IN[0..500) DO ENABLE UNWIND => RefText.ReleaseScratch[scratch]; char: CHAR ~ IO.GetChar[stream]; IF char=' THEN EXIT ELSE text _ RefText.AppendChar[text, char]; REPEAT FINISHED => ERROR Error[invalidHeader, "header too long"]; ENDLOOP; suffix _ Rope.FromRefText[text]; RefText.ReleaseScratch[scratch]; }; GetSkeleton: PUBLIC PROC[stream: STREAM] RETURNS[Skeleton] ~ { instructions: Body _ NIL; block: Block _ NIL; token: Token _ GetToken[stream]; IF token.op=$beginBody THEN { instructions _ GetBody[stream, token]; token _ GetToken[stream]; }; block _ GetBlock[stream, token]; RETURN[NEW[SkeletonRep _ [instructions: instructions, topBlock: block]]]; }; SkipToEndOfBody: PUBLIC PROC[stream: STREAM] ~ { DO token: Token ~ GetToken[stream]; SELECT token.op FROM $beginBody => SkipToEndOfBody[stream]; $endBody => EXIT; ENDCASE => IF token.length#0 THEN SkipBytes[stream, token.length]; ENDLOOP; }; GetBody: PROC[stream: STREAM, first: Token] RETURNS[Body] ~ { IF first.op=$beginBody THEN { SkipToEndOfBody[stream]; RETURN[NEW[BodyRep _ [index: first.index, length: IO.GetIndex[stream]-first.index]]]; }; IO.SetIndex[stream, first.index]; ERROR Error[invalidSkeleton, "missing {"]; }; GetBlock: PROC[stream: STREAM, first: Token] RETURNS[block: Block] = { IF first.op=$beginBlock THEN { noPages: BOOL _ FALSE; preamble: Node _ NIL; list: LIST OF Node _ NIL; size: NAT _ 0; token: Token _ GetToken[stream]; IF token.op=$noPages THEN { noPages _ TRUE; token _ GetToken[stream] }; preamble _ GetNode[stream, token, TRUE]; DO token _ GetToken[stream]; IF token.op=$endBlock THEN EXIT ELSE { page: Node ~ GetNode[stream, token]; list _ CONS[page, list]; size _ size+1; }; ENDLOOP; block _ NEW[BlockRep[size] _ [ index: first.index, length: IO.GetIndex[stream]-first.index, noPages: noPages, preamble: preamble, nodes: ]]; WHILE size>0 DO block[size _ size-1] _ list.first; list _ list.rest ENDLOOP; RETURN[block]; }; IO.SetIndex[stream, first.index]; ERROR Error[invalidSkeleton, "missing BEGIN"]; }; GetNode: PROC[stream: STREAM, first: Token, preamble: BOOL _ FALSE] RETURNS[Node] ~ { pageInstructions: Body _ NIL; token: Token _ first; IF token.op=$pageInstructions THEN { IF preamble THEN { IO.SetIndex[stream, token.index]; ERROR Error[invalidSkeleton, "misplaced PAGEINSTRUCTIONS"]; }; token _ GetToken[stream]; pageInstructions _ GetBody[stream, token]; token _ GetToken[stream]; }; SELECT token.op FROM $beginBody => { body: Body ~ GetBody[stream, token]; RETURN[NEW[NodeRep.body _ [ index: first.index, length: IO.GetIndex[stream]-first.index, pageInstructions: pageInstructions, content: body[body]]]]; }; $beginBlock => { block: Block ~ GetBlock[stream, token]; RETURN[NEW[NodeRep.block _ [ index: first.index, length: IO.GetIndex[stream]-first.index, pageInstructions: pageInstructions, content: block[block]]]]; }; ENDCASE; IO.SetIndex[stream, token.index]; ERROR Error[invalidSkeleton, "missing { or BEGIN"]; }; SetIndex: PUBLIC PROC[stream: STREAM, index: INT] ~ { IO.SetIndex[stream, index]; }; CopyBytes: PUBLIC PROC[to: STREAM, from: STREAM, count: INT] RETURNS[copied: INT] ~ { buffer: REF TEXT ~ RefText.ObtainScratch[512]; rem: INT _ count; WHILE rem>0 DO ENABLE UNWIND => RefText.ReleaseScratch[buffer]; request: NAT ~ MIN[rem, buffer.maxLength]; length: NAT ~ IO.GetBlock[self: from, block: buffer, startIndex: 0, count: request]; IO.PutBlock[self: to, block: buffer, startIndex: 0, count: length]; rem _ rem-length; IF length { token.type _ number; token.number _ x.number }; shortOp => { token.type _ op; token.op _ opFromEv[x.op] }; longOp => { token.type _ op; token.op _ opFromEv[x.op] }; shortSequence => { token.type _ typeFromSeq[x.type]; token.length _ x.length }; longSequence => { token.type _ typeFromSeq[x.type]; token.length _ x.length }; ENDCASE => ERROR Error[bug, "undefined token type"]; IF token.type=comment AND flushComments THEN SkipBytes[stream, token.length] ELSE { token.index _ index; RETURN[token] }; ENDLOOP; }; SkipBytes: PUBLIC PROC[stream: STREAM, length: INT] ~ { IO.SetIndex[stream, IO.GetIndex[stream]+length]; }; GetByte: PUBLIC PROC[stream: STREAM] RETURNS[BYTE] ~ { RETURN[ORD[CHAR[IO.GetChar[stream]]]]; }; InlineGetByte: PROC[stream: STREAM] RETURNS[BYTE] ~ INLINE { RETURN[ORD[CHAR[IO.GetChar[stream]]]]; }; GetUnsigned: PUBLIC PROC[stream: STREAM, length: [0..4]] RETURNS[LONG CARDINAL] ~ { x: LONG CARDINAL _ 0; FOR i: NAT IN [0..length) DO b: BYTE ~ InlineGetByte[stream]; x _ x*400B+b; ENDLOOP; RETURN[x]; }; <<>> GetSigned: PUBLIC PROC[stream: STREAM, length: [0..4]] RETURNS[INT] ~ { x: INT _ 0; nonneg: BOOL _ TRUE; FOR i: NAT IN [0..length) DO b: BYTE ~ InlineGetByte[stream]; IF i=0 THEN nonneg _ b<200B; IF nonneg THEN x _ x*400B+b ELSE x _ x*400B+(377B-b); ENDLOOP; RETURN[IF nonneg THEN x ELSE -1-x]; }; <<>> GetInteger: PUBLIC PROC[stream: STREAM, length: INT] RETURNS[REAL] ~ { x: REAL _ 0; nonneg: BOOL _ TRUE; FOR i: INT IN [0..length) DO b: BYTE ~ InlineGetByte[stream]; IF i=0 THEN nonneg _ b<200B; IF nonneg THEN x _ x*400B+b ELSE x _ x*400B+(377B-b); ENDLOOP; RETURN[IF nonneg THEN x ELSE -1-x]; }; <<>> GetRational: PUBLIC PROC[stream: STREAM, length: INT] RETURNS[REAL] ~ { half: NAT ~ CARDINAL[length]/2; IF (half+half)#length THEN ERROR Error[invalidToken, "rational has odd length."]; IF half<=4 THEN { n: INT ~ GetSigned[stream, half]; d: INT ~ GetSigned[stream, half]; RETURN[REAL[n]/REAL[d]]; } ELSE { n: REAL ~ GetInteger[stream, half]; d: REAL ~ GetInteger[stream, half]; RETURN[n/d]; }; }; <<>> GetRope: PUBLIC PROC[stream: STREAM, length: INT] RETURNS[ROPE] ~ { getChar: PROC RETURNS[CHAR] ~ { RETURN[IO.GetChar[stream]] }; RETURN[Rope.FromProc[length, getChar]]; }; GetText: PUBLIC PROC[stream: STREAM, length: NAT, scratch: REF TEXT] RETURNS[REF TEXT] ~ { scratchMaxLength: NAT ~ IF scratch=NIL THEN 0 ELSE scratch.maxLength; text: REF TEXT ~ IF length<=scratchMaxLength THEN scratch ELSE NEW[TEXT[length]]; IF IO.GetBlock[self: stream, block: text, startIndex: 0, count: length]=length THEN RETURN[text] ELSE ERROR IO.EndOfStream[stream]; }; BytesInInt: PROC[i: INT] RETURNS[[0..4]] ~ { SELECT i FROM IN[-LONG[200B]..LONG[200B]) => RETURN[1]; IN[-LONG[100000B]..LONG[100000B]) => RETURN[2]; IN[-40000000B..40000000B) => RETURN[3]; ENDCASE => RETURN[4]; }; PutByte: PUBLIC PROC[stream: STREAM, byte: BYTE] ~ { IO.PutChar[stream, VAL[byte]] }; InlinePutByte: PROC[stream: STREAM, byte: BYTE] ~ INLINE { IO.PutChar[stream, VAL[byte]] }; PutUnsigned: PUBLIC PROC[stream: STREAM, length: [0..4], val: CARD] ~ { IF length>3 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].hh]; IF length>2 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].hl]; IF length>1 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].lh]; IF length>0 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].ll]; }; PutSigned: PUBLIC PROC[stream: STREAM, length: [0..4], val: INT] ~ { IF length>3 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].hh]; IF length>2 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].hl]; IF length>1 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].lh]; IF length>0 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].ll]; }; PutOp: PUBLIC PROC[stream: STREAM, op: Op] ~ { <> ev: EncodingValue ~ evFromOp[op]; IF ev IN ShortEncodingValue THEN IPXerox.PutToken[stream, [shortOp[ev]]] ELSE IPXerox.PutToken[stream, [longOp[ev]]]; }; <<>> PutDescriptor: PUBLIC PROC[stream: STREAM, type: TokenType, length: INT] ~ { <> <> seq: SequenceType ~ seqFromType[type]; IF seq=nil THEN ERROR Error[bug, "invalid type for PutDescriptor"]; IF length IN BYTE THEN IPXerox.PutToken[stream, [shortSequence[seq, length]]] ELSE IPXerox.PutToken[stream, [longSequence[seq, length]]]; }; PutInt: PUBLIC PROC[stream: STREAM, n: INT] ~ { <> IF n IN ShortNumber THEN IPXerox.PutToken[stream, [shortNumber[n]]] ELSE { length: [0..4] ~ BytesInInt[n]; PutDescriptor[stream, $integer, length]; PutSigned[stream, length, n]; }; }; <<>> PutRational: PUBLIC PROC[stream: STREAM, n, d: INT] ~ { <> <> IF d=0 THEN ERROR Error[invalidRational, "zero denominator"] ELSE { length: [0..4] ~ MAX[BytesInInt[n], BytesInInt[d]]; PutDescriptor[stream, $rational, 2*length]; PutSigned[stream, length, n]; PutSigned[stream, length, d]; }; }; tryDecimal: BOOL _ FALSE; tryShortRational: BOOL _ TRUE; decimalPrecision: NAT _ 6; maxRelativeError: REAL _ 0.00001; PutReal: PUBLIC PROC[stream: STREAM, val: REAL] ~ { <> r: REAL _ val; n: INT _ 0; d: INT _ 1; IF ABS[r]>INT.LAST THEN { tail: NAT _ 0; -- number of trailing zero bytes WHILE ABS[r]>INT.LAST DO r _ r/256; tail _ tail+1 ENDLOOP; PutDescriptor[stream, $integer, 4+tail]; PutSigned[stream, 4, Real.RoundLI[r]]; THROUGH [0..tail) DO PutByte[stream, 0] ENDLOOP; RETURN; }; IF (n _ Real.RoundLI[r])=r THEN { PutInt[stream, n]; RETURN }; IF tryDecimal THEN { type: Real.NumberType; exp10: INTEGER; [type: type, fr: n, exp10: exp10] _ Real.RealToPair[r: r, precision: decimalPrecision]; IF type=$normal AND exp10 IN[-9..0) THEN { e: NAT _ -exp10; WHILE (n MOD 10)=0 AND e>0 DO n _ n/10; e _ e-1 ENDLOOP; THROUGH [0..e) DO d _ d*10 ENDLOOP; PutRational[stream, n, d]; RETURN; }; }; IF tryShortRational THEN { rat: ShortRational.Rational _ ShortRational.FromReal[r]; IF rat.denominator # 0 AND ABS[REAL[rat.numerator]/REAL[rat.denominator] - r] <= maxRelativeError * ABS[r] THEN { IF rat.denominator = 1 THEN PutInt[stream, rat.numerator] ELSE PutRational[stream, rat.numerator, rat.denominator]; RETURN; }; }; THROUGH [0..30) DO r _ r*2; d _ d*2; IF (n _ Real.RoundLI[r])=r THEN EXIT; REPEAT FINISHED => { d _ INT.LAST; n _ Real.RoundLI[d*val] }; ENDLOOP; PutRational[stream, n, d]; }; PutIdentifier: PUBLIC PROC[stream: STREAM, rope: ROPE] ~ { <> <> length: INT ~ Rope.Length[rope]; IF length=0 THEN ERROR Error[invalidIdentifier, "identifier has zero length"]; PutDescriptor[stream, $identifier, length]; FOR i: INT IN[0..length) DO char: CHAR ~ Rope.Fetch[rope, i]; SELECT char FROM IN['a..'z], IN['A..'Z] => NULL; IN['0..'9], '- => IF i=0 THEN Error[invalidIdentifier, "illegal initial char for identifier"]; ENDCASE => ERROR Error[invalidIdentifier, "illegal char in identifier"]; IO.PutChar[stream, char]; ENDLOOP; }; PutString: PUBLIC PROC[stream: STREAM, rope: ROPE] ~ { <> <> <> length: INT ~ Rope.Length[rope]; PutDescriptor[stream, $string, length]; IO.PutRope[stream, rope]; }; PutComment: PUBLIC PROC[stream: STREAM, rope: ROPE] ~ { <> length: INT ~ Rope.Length[rope]; PutDescriptor[stream, $comment, length]; IO.PutRope[stream, rope]; }; PutInsertFile: PUBLIC PROC[stream: STREAM, rope: ROPE] ~ { <> length: INT ~ Rope.Length[rope]; PutDescriptor[stream, $insertFile, length]; IO.PutRope[stream, rope]; }; <<>> PutName: PUBLIC PROC[stream: STREAM, name: ROPE] ~ { <> <; "foo" produces < foo 1 MAKEVEC >.>> <> <> size: INT ~ Rope.Length[name]; start: INT _ 0; depth: INT _ 0; WHILE start to.PutF["%g ", IO.rope[ropeFromOp[token.op]]]; $number => to.PutF["%g ", IO.int[token.number]]; $integer => to.PutF["%g ", IO.real[GetInteger[from, token.length]]]; $rational => to.PutF["%g ", IO.real[GetRational[from, token.length]]]; $identifier => to.PutF["%g ", IO.rope[GetRope[from, token.length]]]; $string => to.PutF["<%g> ", IO.rope[GetRope[from, token.length]]]; $insertFile => to.PutF["++%g++ ", IO.rope[GetRope[from, token.length]]]; $comment => to.PutF["**%g** ", IO.rope[GetRope[from, token.length]]]; ENDCASE => { to.PutRope["??? "]; SkipBytes[from, token.length] }; ENDLOOP; }; <<>> <> <> <> <> <> <> <> <<0 => "DCScpx", 1 => "DCScpy", 2 => "correctMX", 3 => "correctMY",>> <<4 => "T", 5 => "priorityImportant", 6 => "mediumXSize", 7 => "mediumYSize",>> <<8 => "fieldXMin", 9 => "fieldYMin", 10 => "fieldXMax", 11 => "fieldYMax",>> <<12 => "showVec", 13 => "color", 14 => "noImage", 15 => "strokeWidth",>> <<16 => "strokeEnd", 17 => "underlineStart", 18 => "amplifySpace",>> <<19 => "correctPass", 20 => "correctShrink", 21 => "correctTX", 22 => "correctTY",>> < "???"];>> <<};>> <> <> <> <> <> <> <> <> <<};>> <> <> <<};>> <> <> <> <<};>> <> <> <> <> <> <> <> <> <> <> <> <> < RETURN[TRUE];>> < RETURN[FALSE];>> <<};>> <> <> <> <<};>> <> <<[token, text] _ reader.GetToken[buffer: buffer, flushComments: FALSE];>> <> <> < IF prevInt>=0 THEN AnnotateImagerVariable[writer, prevInt];>> <> <> <> < writer.PutOp[token.op];>> < writer.PutInt[prevInt _ token.shortNumber];>> < {>> <> < IF code=$overflow THEN GOTO Overflow];>> <> < writer.PutReal[reader.ReadReal[token, text]];>> <<};>> < {>> <> < IF code=$overflow THEN GOTO Overflow];>> <> <> < writer.PutReal[reader.ReadReal[token, text]];>> <<};>> < writer.PutReal[reader.ReadReal[token, text]];>> < writer.PutIdentifier[RefText.TrustTextAsRope[text]];>> < writer.PutString[RefText.TrustTextAsRope[text]];>> < writer.PutComment[RefText.TrustTextAsRope[text]];>> < writer.PutInsertfile[RefText.TrustTextAsRope[text]];>> < NULL;>> < {>> <> <> <> <<};>> < ERROR;>> <> < { IF nest=0 THEN AnnotatePage[writer, page]; nest _ nest+1 };>> < { nest _ nest-1;>> <> <> <> <> <<};>> <<>> <> <> <> <> < Close[]];>> <> <<};>> <<>> <> <> <> <> <<[token, text] _ IPReader.GetToken[reader: reader, buffer: buffer, flushComments: FALSE];>> <> <> < writer.PutOp[token.op];>> < writer.PutInt[token.shortNumber];>> < writer.PutInt[reader.ReadInt[token, text]];>> < writer.PutRational[reader.ReadRational[token, text]];>> < writer.PutReal[reader.ReadReal[token, text]];>> < writer.PutIdentifier[RefText.TrustTextAsRope[text]];>> < writer.PutString[RefText.TrustTextAsRope[text]];>> < writer.PutInsertfile[RefText.TrustTextAsRope[text]];>> < writer.PutComment[RefText.TrustTextAsRope[text]];>> < {>> <> <> <> <<};>> < NULL;>> < ERROR;>> <> < { nest _ nest+1 };>> < { nest _ nest-1; IF nest=0 THEN { IF tick#NIL THEN tick[] } };>> <> <> <<};>> <<>> END.