DIRECTORY
Basics USING [BYTE, LongNumber, UnsafeBlock],
IO,
IPBasic USING [Op, Rational, XeroxPixelVectorType],
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

ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
BYTE: TYPE ~ Basics.BYTE;

Op: TYPE ~ IPBasic.Op;
Rational: TYPE ~ IPBasic.Rational;

Writer: TYPE ~ IPWriter.Writer;

maxRelativeError: REAL _ 0.00001;

encode: IPXerox.EncodingTable ~ NEW[IPXerox.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[IPXerox.EncodingTable] ~ { RETURN[encode] };

xeroxWriter: IPWriter.Class ~ NEW[IPWriter.ClassRep _ [
encoding: $Xerox,
putOp: XeroxPutOp,
putInt: XeroxPutInt,
putReal: XeroxPutReal,
putRational: XeroxPutRational,
putIdentifier: XeroxPutIdentifier,
putString: XeroxPutString,
putInsertfile: XeroxPutInsertfile,
putComment: XeroxPutComment,
putAnnotation: XeroxPutAnnotation,
putLargeVector: XeroxPutLargeVector
]];


AppendByte: PROC[stream: STREAM, byte: BYTE] ~ INLINE { stream.PutChar[VAL[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: IPXerox.SequenceType, length: INT] ~ {
IF length IN[0..377B] THEN AppendShortSequenceDescriptor[stream, type, length]
ELSE AppendLongSequenceDescriptor[stream, type, length];
};

AppendShortSequenceDescriptor: PROC[stream: STREAM,
type: IPXerox.SequenceType, length: INT[0..377B]] ~ {
AppendByte[stream, 300B+ORD[type]];
AppendByte[stream, length];
};

AppendLongSequenceDescriptor: PROC[stream: STREAM,
type: IPXerox.SequenceType, length: INT--[0..77777777B]--] ~ {
IF length NOT IN[0..77777777B] THEN ERROR IPWriter.Error[$bug, "Invalid sequence length."];
AppendByte[stream, 340B+ORD[type]];
AppendInt[stream, length, 3];
};

XeroxPutOp: PROC[writer: Writer, op: Op] ~ {
stream: STREAM ~ writer.stream;
ev: IPXerox.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 IPWriter.Error[$illegalArgument, "PutOp[nil] is illegal."];
};

XeroxPutInt: PROC[writer: Writer, value: INT] ~ {
stream: STREAM ~ writer.stream;
IF value IN IPXerox.ShortNumber THEN {
x: [0..77777B] ~ value-IPXerox.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 IPWriter.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 IPWriter.Error[$illegalArgument, "Identifier must begin with a letter."]
ELSE SELECT char FROM
IN['a..'z], IN['A..'Z], IN['0..'9], '- => NULL;
ENDCASE => ERROR IPWriter.Error[$illegalArgument, "Illegal character in identifier."];
ENDLOOP;
AppendSequenceDescriptor[stream, $sequenceIdentifier, len];
IO.PutRope[stream, 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 IPWriter.Error[$unimplemented, "Xerox encoding doesn't have annotations."];
};

lvProcs: REF IO.StreamProcs ~ IO.CreateStreamProcs[
variety: $output,
class: $InterpressLargeVectorOutputXerox,
unsafePutBlock: LVUnsafePutBlock,
getIndex: LVGetIndex
];

LVData: TYPE ~ REF LVDataRep;
LVDataRep: TYPE ~ RECORD[
master: STREAM, -- stream on the master file
index: INT -- current index = number of bytes put
];

LVUnsafePutBlock: PROC[self: STREAM, block: Basics.UnsafeBlock] ~ {
data: LVData ~ NARROW[self.streamData];
IO.UnsafePutBlock[data.master, block];
data.index _ data.index+block.count;
};

LVGetIndex: PROC[self: STREAM] RETURNS[INT] ~ {
data: LVData ~ NARROW[self.streamData];
RETURN[data.index];
};

XeroxPutLargeVector: PROC[writer: Writer,
putBytes: PROC[STREAM],
bytesPerElement: [0..256),
type: IPBasic.XeroxPixelVectorType _ $nil] ~ {
stream: STREAM ~ writer.stream;
lvData: LVData ~ NEW[LVDataRep _ [master: stream, index: 0]];
lvStream: STREAM ~ IO.CreateStream[streamProcs: lvProcs, streamData: lvData];
descriptorIndex, dataStartIndex, dataStopIndex: INT;
sequenceType: IPXerox.SequenceType _ $sequenceLargeVector;
IF bytesPerElement=2 THEN sequenceType _ SELECT type FROM
$nil => $sequenceLargeVector,
$packed => $sequencePackedPixelVector,
$compressed => $sequenceCompressedPixelVector,
$adaptive => $sequenceAdaptivePixelVector,
ENDCASE => ERROR;
descriptorIndex _ IO.GetIndex[stream];
AppendLongSequenceDescriptor[stream, $nil, 0]; -- placeholder
dataStartIndex _ IO.GetIndex[stream];
IF sequenceType=$sequenceLargeVector THEN AppendByte[stream, bytesPerElement];
putBytes[lvStream];
IO.Close[lvStream];
dataStopIndex _ IO.GetIndex[stream];
IO.SetIndex[stream, descriptorIndex]; -- fill in the real sequence descriptor
AppendLongSequenceDescriptor[stream, sequenceType, dataStopIndex-dataStartIndex];
IO.SetIndex[stream, dataStopIndex];
IF (lvData.index MOD bytesPerElement)=0 THEN NULL
ELSE ERROR IPWriter.Error[$illegalArgument,
"Large vector length must be a multiple of bytesPerElement."];
IF type#$nil AND sequenceType=$sequenceLargeVector THEN {
XeroxPutIdentifier[writer, "Xerox"];
XeroxPutIdentifier[writer, SELECT type FROM
$packed => "packed", $compressed => "compressed", $adaptive => "adaptive",
ENDCASE => ERROR];
XeroxPutInt[writer, 2];
XeroxPutOp[writer, $makevec];
XeroxPutOp[writer, $finddecompressor];
XeroxPutOp[writer, $do];
};
};

IPWriter.Register[xeroxWriter];

END.
‚IPXeroxWriterImpl.mesa
Copyright c 1984 Xerox Corporation.  All rights reserved.
Doug Wyatt, August 23, 1984 1:33:01 pm PDT
�Ê
Û˜š
œ™Jšœ
Ïm
œ.™9Jš
œ*™*—J˜š
Ïk	˜	Jšœžœžœ˜-Jšžœ
˜Jšœžœ&˜3Jšœ	žœ,˜:JšœžœM˜ZJšœžœ#˜-Jšœžœžœ˜!Jšœžœ˜)J˜—Jšœžœ
ž˜ Jšžœ
žœ%˜/Jšžœ˜Jšœž˜J˜Jšžœžœžœ
˜Jšžœžœžœ
žœ
˜Jšžœžœ
žœ
˜J˜Jšœžœ˜šœ
žœ˜"J˜—Jšœžœ˜J˜Jšœžœ˜!J˜Jšœ žœî˜‘J˜Jš
Ïnœžœ
žœ
žœžœ˜RJ˜šœžœ˜7Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ"˜"Jš
œ˜Jš
œ"˜"Jš
œ˜Jš
œ"˜"Jš
œ#˜#Jš
œ˜J˜—J˜šŸ
œžœ	žœžœžœžœ
˜TJ˜—Jšœžœ
˜J˜šŸ
œžœžœžœ˜,šžœž˜
Jšžœžœžœžœ˜)Jšžœžœžœžœ˜/Jšžœžœ˜'Jšžœžœ˜—J˜J˜—šŸ	œžœ	žœžœ˜8Jšžœžœžœ˜DJšžœžœžœ˜DJšžœžœžœ˜DJšžœžœžœ˜DJ˜J˜—šŸœžœ	žœ
˜.Jšœ$žœ˜,Jšžœžœ
žœ4˜NJšžœ4˜8J˜J˜—šŸœžœ	žœ
˜3Jšœ$žœ˜5Jšœžœ˜#Jš
œ˜J˜J˜—šŸœžœ	žœ
˜2Jšœ$žÏcœ˜>Jš
žœžœ
žœžœ
žœ2˜[Jšœžœ˜#Jš
œ˜J˜J˜—šŸ
œžœ˜,Jšœžœ˜J˜'šžœžœ˜Jšœžœ˜Jšžœžœ ˜1Jšžœ9žœ
 ˜QJ˜
—Jšžœ
žœ<˜FJš
œ˜J˜—šŸœžœžœ˜1Jšœžœ˜šžœžœžœ˜&Jšœ+žœ
˜1Jšœ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šžœžœ
žœJ˜]šžœžœ
žœ	ž˜Jšœžœ˜šžœžœ
žœž˜Jšžœ
žœžœ
˜JšžœžœI˜Y—šžœ
žœž˜Jšžœ
žœ
žœžœ
˜/JšžœžœF˜V—Jšžœ
˜—Jš
œ;˜;Jšžœ˜Jš
œ˜J˜—šŸœžœžœ˜4Jšœžœ˜Jš
œ@˜@J˜Jš
œ˜J˜—šŸœžœžœ˜8Jšœžœ˜Jš
œE˜EJ˜Jš
œ˜J˜—šŸœžœžœ˜5Jšœžœ˜Jš
œB˜BJ˜Jš
œ˜J˜—šŸœžœžœ˜8JšžœL˜QJš
œ˜J˜—šœ	žœ
žœžœ˜3Jš
œ˜Jš
œ)˜)Jš
œ!˜!J˜Jš
œ˜J˜—Jšœžœžœ˜šœžœžœ
˜Jšœžœ ˜,Jšœžœ
 &˜1J˜J˜—šŸœžœžœ ˜CJšœžœ˜'Jšžœ$˜&J˜$J˜J˜—š
Ÿ
œžœžœžœ
žœ˜/Jšœžœ˜'Jšžœ
˜J˜J˜—šŸœžœ˜)Jšœ
žœ
žœ˜Jš
œ˜Jš
œ.˜.Jšœžœ˜Jšœžœ)˜=Jšœ
žœžœ8˜MJšœ0žœ
˜4Jš
œ:˜:šžœžœžœž˜9Jš
œ˜Jš
œ&˜&Jš
œ.˜.Jš
œ*˜*Jšžœžœ
˜—Jšœžœ˜&Jšœ/ ˜=Jšœžœ˜%Jšžœ#žœ%˜NJš
œ˜Jšžœ˜Jšœžœ˜$Jšžœ$ '˜MJš
œQ˜QJšžœ!˜#Jšžœžœžœ
ž˜1šžœ
žœ!˜+Jš
œ>˜>—šžœžœ#žœ˜9J˜$šœžœž˜+Jš
œJ˜JJšžœžœ˜—Jš
œ˜Jš
œ˜Jš
œ&˜&Jš
œ˜J˜—J˜J˜—J˜J˜Jšžœ
˜—…—-8q