<> <<>> <> <> <> DIRECTORY Basics USING [BYTE, LongNumber], IO USING [PutChar, PutRope, STREAM], IPBasic USING [Op, Rational], IPWriter USING [Class, ClassRep, Error, Register, Writer], IPXerox USING [EncodingTable, EncodingTableRep, EncodingValue, SequenceType, ShortNumber], Real USING [NumberType, RealToPair, RoundLI], Rope USING [Fetch, Length, ROPE], ShortRational USING [Rational, FromReal]; IPXeroxWriterImpl: CEDAR PROGRAM IMPORTS IO, IPWriter, Real, Rope, ShortRational EXPORTS IPXerox ~ BEGIN OPEN IPWriter, IPXerox; ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; BYTE: TYPE ~ Basics.BYTE; Op: TYPE ~ IPBasic.Op; Rational: TYPE ~ IPBasic.Rational; maxRelativeError: REAL _ 0.00001; encode: EncodingTable ~ NEW[EncodingTableRep _ [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, finddecompressor: finddecompressor, makegray: makegray, findcolor: findcolor, findcoloroperator: findcoloroperator, findcolormodeloperator: findcolormodeloperator, makesampledcolor: makesampledcolor, makesampledblack: makesampledblack, setgray: setgray, moveto: moveto, lineto: lineto, linetox: linetox, linetoy: linetoy, curveto: curveto, conicto: conicto, arcto: arcto, makeoutline: makeoutline, maskfill: maskfill, maskstroke: maskstroke, maskstrokeclosed: maskstrokeclosed, maskvector: maskvector, maskrectangle: maskrectangle, startunderline: startunderline, maskunderline: maskunderline, masktrapezoidx: masktrapezoidx, masktrapezoidy: masktrapezoidy, maskpixel: maskpixel, clipoutline: clipoutline, cliprectangle: cliprectangle, findfont: findfont, findfontvec: findfontvec, modifyfont: modifyfont, setfont: setfont, correctmask: correctmask, correctspace: correctspace, correct: correct, setcorrectmeasure: setcorrectmeasure, setcorrecttolerance: setcorrecttolerance, space: space, beginBody: beginBody, endBody: endBody, beginBlock: beginBlock, endBlock: endBlock, pageInstructions: pageInstructions, noPages: noPages, metricMaster: metricMaster, environmentMaster: environmentMaster, beginVec: nil, comma: nil, endVec: nil]]; GetEncodingTable: PUBLIC PROC RETURNS[EncodingTable] ~ { RETURN[encode] }; xeroxWriter: Class ~ NEW[ClassRep _ [ encoding: $Xerox, putOp: XeroxPutOp, putInt: XeroxPutInt, putReal: XeroxPutReal, putRational: XeroxPutRational, putIdentifier: XeroxPutIdentifier, putString: XeroxPutString, putInsertfile: XeroxPutInsertfile, putComment: XeroxPutComment, putAnnotation: XeroxPutAnnotation ]]; AppendByte: PROC[stream: STREAM, byte: BYTE] ~ INLINE { stream.PutChar[LOOPHOLE[byte]]; }; NBytes: TYPE ~ [0..4]; BytesInInt: PROC[i: INT] RETURNS[NBytes] ~ { 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]; }; AppendInt: PROC[stream: STREAM, int: INT, b: NBytes] ~ { IF b>3 THEN AppendByte[stream, LOOPHOLE[int, Basics.LongNumber].hh]; IF b>2 THEN AppendByte[stream, LOOPHOLE[int, Basics.LongNumber].hl]; IF b>1 THEN AppendByte[stream, LOOPHOLE[int, Basics.LongNumber].lh]; IF b>0 THEN AppendByte[stream, LOOPHOLE[int, Basics.LongNumber].ll]; }; AppendSequenceDescriptor: PROC[stream: STREAM, type: SequenceType, length: INT] ~ { x: [0..40B) ~ LOOPHOLE[type]; SELECT length FROM <0 => ERROR Error[$bug, "Sequence length is negative."]; <=377B => { AppendByte[stream, 300B+x]; AppendInt[stream, length, 1] }; -- short <=77777777B => { AppendByte[stream, 340B+x]; AppendInt[stream, length, 3] }; -- long ENDCASE => ERROR Error[$bug, "Sequence length is too big."]; }; XeroxPutOp: PROC[writer: Writer, op: Op] ~ { stream: STREAM ~ writer.stream; ev: EncodingValue ~ encode[op]; IF ev#nil THEN { x: [0..17777B] ~ LOOPHOLE[ev]; IF x<40B THEN AppendByte[stream, 200B+x] -- short ELSE { AppendByte[stream, 240B+x/400B]; AppendByte[stream, x MOD 400B] }; -- long } ELSE ERROR Error[$illegalArgument, "PutOp[nil] is illegal."]; }; XeroxPutInt: PROC[writer: Writer, value: INT] ~ { stream: STREAM ~ writer.stream; IF value IN[ShortNumber.FIRST .. ShortNumber.LAST] THEN { x: [0..77777B] ~ value-ShortNumber.FIRST; AppendByte[stream, x/400B]; AppendByte[stream, x MOD 400B]; } ELSE { b: NBytes ~ BytesInInt[value]; AppendSequenceDescriptor[stream, sequenceInteger, b]; AppendInt[stream, value, b]; }; }; XeroxPutRational: PROC[writer: Writer, value: Rational] ~ { stream: STREAM ~ writer.stream; bn: NBytes ~ BytesInInt[value.num]; bd: NBytes ~ BytesInInt[value.den]; b: NBytes ~ MAX[bn, bd]; AppendSequenceDescriptor[stream, sequenceRational, 2*b]; AppendInt[stream, value.num, b]; AppendInt[stream, value.den, b]; }; tryDecimal: BOOL _ FALSE; tryShortRational: BOOL _ TRUE; decimalPrecision: NAT _ 6; XeroxPutReal: PROC[writer: Writer, value: REAL] ~ { r: REAL _ value; n: INT _ 0; d: INT _ 1; IF ABS[r]>INT.LAST THEN { stream: STREAM ~ writer.stream; trailingZeroBytes: NAT _ 0; WHILE ABS[r]>INT.LAST DO r _ r/256; trailingZeroBytes _ trailingZeroBytes+1; ENDLOOP; AppendSequenceDescriptor[stream, sequenceInteger, 4+trailingZeroBytes]; AppendInt[stream, Real.RoundLI[r], 4]; THROUGH [0..trailingZeroBytes) DO AppendByte[stream, 0] ENDLOOP; RETURN; }; IF (n _ Real.RoundLI[r])=r THEN { XeroxPutInt[writer, 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; XeroxPutRational[writer, [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 { XeroxPutInt[writer, n]; RETURN }; XeroxPutRational[writer, [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*value] }; ENDLOOP; XeroxPutRational[writer, [n, d]]; }; XeroxPutIdentifier: PROC[writer: Writer, rope: ROPE] ~ { stream: STREAM ~ writer.stream; len: INT ~ rope.Length[]; IF len=0 THEN ERROR Error[$illegalArgument, "Identifier may not have zero length."]; FOR i: INT IN[0..len) DO char: CHAR ~ rope.Fetch[i]; IF i=0 THEN SELECT char FROM IN['a..'z], IN['A..'Z] => NULL; ENDCASE => ERROR Error[$illegalArgument, "Identifier must begin with a letter."] ELSE SELECT char FROM IN['a..'z], IN['A..'Z], IN['0..'9], '- => NULL; ENDCASE => ERROR Error[$illegalArgument, "Illegal character in identifier."]; ENDLOOP; AppendSequenceDescriptor[stream, sequenceIdentifier, len]; stream.PutRope[rope]; }; XeroxPutString: PROC[writer: Writer, rope: ROPE] ~ { stream: STREAM ~ writer.stream; AppendSequenceDescriptor[stream, sequenceString, rope.Length[]]; stream.PutRope[rope]; }; XeroxPutInsertfile: PROC[writer: Writer, rope: ROPE] ~ { stream: STREAM ~ writer.stream; AppendSequenceDescriptor[stream, sequenceInsertfile, rope.Length[]]; stream.PutRope[rope]; }; XeroxPutComment: PROC[writer: Writer, rope: ROPE] ~ { stream: STREAM ~ writer.stream; AppendSequenceDescriptor[stream, sequenceComment, rope.Length[]]; stream.PutRope[rope]; }; XeroxPutAnnotation: PROC[writer: Writer, rope: ROPE] ~ { ERROR Error[$unimplemented, "Xerox encoding doesn't have annotations."]; }; Register[xeroxWriter]; END.