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.
†IPXeroxWriterImpl.mesa

Last edited by:
Doug Wyatt, March 13, 1984 11:31:54 am PST
Michael Plass, June 15, 1984 4:16:18 pm PDT
�Ê&˜Jš
œ™J™š
œ™Jš
œ*™*J™+J˜—š
Ïk	˜	Jšœ�œ�œ˜ Jš�œ
�œ�œ˜$Jšœ�œ˜Jšœ	�œ,˜:Jšœ�œM˜ZJšœ�œ#˜-Jšœ�œ�œ˜!Jšœ�œ˜)J˜—Jšœ�œ
�˜ Jš�œ
�œ%˜/Jš�œ˜Jšœ�œ
�œ˜J˜Jš�œ�œ�œ
˜Jš�œ�œ�œ
�œ
˜Jš�œ�œ
�œ
˜J˜Jšœ�œ˜šœ
�œ˜"J˜—Jšœ�œ˜!J˜Jšœ�œæ˜�J˜Jš
Ïnœ�œ
�œ
�œ�œ˜JJ˜šœ�œ
˜%Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ"˜"Jš
œ˜Jš
œ"˜"Jš
œ˜Jš
œ!˜!Jš
œ˜J˜—J˜š
ž
œ�œ	�œ�œ�œ˜7Jšœ�œ˜Jš
œ˜J˜—Jšœ�œ
˜J˜šž
œ�œ�œ�œ˜,š�œ�˜
Jš�œ�œ�œ�œ˜)Jš�œ�œ�œ�œ˜/Jš�œ�œ˜'Jš�œ�œ˜—J˜J˜—šž	œ�œ	�œ�œ˜8Jš�œ�œ�œ˜DJš�œ�œ�œ˜DJš�œ�œ�œ˜DJš�œ�œ�œ˜DJ˜J˜—šžœ�œ	�œ�œ˜SJšœ�œ˜š�œ�˜Jšœ�œ-˜8JšœHÏc˜PJšœMŸ˜TJš�œ�œ,˜<—J˜J˜—šž
œ�œ˜,Jšœ�œ˜J˜š�œ�œ˜Jšœ�œ˜Jš�œ�œŸ˜1Jš�œ9�œ
Ÿ˜QJ˜
—Jš�œ
�œ3˜=Jš
œ˜J˜—šžœ�œ�œ˜1Jšœ�œ˜š
�œ�œ
�œ�œ�œ˜9Jšœ#�œ
˜)Jšœ1�œ˜;J˜
—š�œ˜Jš
œ˜Jš
œ5˜5J˜J˜—Jš
œ˜J˜—šžœ�œ%˜;Jšœ�œ˜Jš
œ#˜#Jš
œ#˜#Jšœ�œ	˜Jš
œ8˜8Jš
œ ˜ Jš
œ ˜ Jš
œ˜J˜—Jšœ�œ�œ
˜Jšœ�œ�œ
˜Jšœ�œ˜J˜šžœ�œ�œ˜3Jšœ�œ	˜Jšœ�œ	�œ˜š
�œ
�œ�œ
�œ
�œ˜Jšœ�œ˜Jšœ�œ˜š	�œ
�œ�œ
�œ
�˜Jš
œ3˜3Jš�œ
˜—Jš
œG˜GJš
œ&˜&Jš�œ�œ�œ
˜@Jš�œ
˜J˜—Jš�œ�œ�œ˜Cš�œ�œ˜Jšœ�œ
˜&Jš
œW˜Wš�œ�œ�œ�œ˜*Jšœ�œ
˜Jš
�œ�œ�œ�œ�œ
˜8Jš�œ�œ
�œ
˜#Jšœ"�œ
˜)J˜—J˜—š�œ�œ˜Jš
œ8˜8š�œ�œ
�œ
�œ�œ-�œ�œ˜qJš�œ�œ�œ˜?Jš
œ;˜;Jš�œ
˜J˜—J˜—š�œ	�˜Jš
œ˜Jš�œ�œ
�œ
˜%Jš�œ
�œ
�œ
�œ˜?Jš�œ
˜—Jš
œ"˜"Jš
œ˜J˜—šžœ�œ�œ˜8Jšœ�œ˜Jšœ�œ˜Jš�œ�œ
�œA˜Tš�œ�œ
�œ	�˜Jšœ�œ˜š�œ�œ
�œ�˜Jš�œ
�œ�œ
˜Jš�œ�œ@˜P—š�œ
�œ�˜Jš�œ
�œ
�œ�œ
˜/Jš�œ�œ=˜M—Jš�œ
˜—Jš
œ:˜:J˜Jš
œ˜J˜—šžœ�œ�œ˜4Jšœ�œ˜Jš
œ@˜@J˜Jš
œ˜J˜—šžœ�œ�œ˜8Jšœ�œ˜Jš
œD˜DJ˜Jš
œ˜J˜—šžœ�œ�œ˜5Jšœ�œ˜Jš
œA˜AJ˜Jš
œ˜J˜—šžœ�œ�œ˜8Jš�œC˜HJš
œ˜J˜—J˜J˜J˜Jš�œ
˜—…—"�+<