IPXeroxEncodingImpl:
CEDAR
PROGRAM
IMPORTS Inline, IO, IPEncoding, Real, Rope, RopeReader
= BEGIN OPEN IPXeroxEncoding, IPEncoding, IPBasic;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
EncodeTable: TYPE = ARRAY PrimitiveOrSymbol OF DefinedEncodingValue;
DecodeTable: TYPE = ARRAY DefinedEncodingValue OF PrimitiveOrSymbol;
encode:
REF
READONLY EncodeTable =
NEW[EncodeTable =
[nil: nil, abs: abs, add: add, and: and, arcto: arcto, atan: atan, ceiling: ceiling, clipoutline: clipoutline, cliprectangle: cliprectangle, concat: concat, concatt: concatt, conicto: conicto, copy: copy, correct: correct, correctmask: correctmask, correctspace: correctspace, cos: cos, count: count, curveto: curveto, div: div, do: do, dobody: dobody, dosave: dosave, dosaveall: dosaveall, dosaveallbody: dosaveallbody, dosavebody: dosavebody, dosavesimplebody: dosavesimplebody, dround: dround, dup: dup, env: env, eq: eq, eqn: eqn, exch: exch, exp: exp, fget: fget, findcolor: findcolor, findcolormodeloperator: findcolormodeloperator, findcoloroperator: findcoloroperator, finddecompressor: finddecompressor, findfont: findfont, findfontvec: findfontvec, floor: floor, frame: frame, fset: fset, ge: ge, get: get, getcp: getcp, getcprounded: getcprounded, getp: getp, getprop: getprop, gt: gt, if: if, ifcopy: ifcopy, ifelse: ifelse, iget: iget, invert: invert, iset: iset, lineto: lineto, linetox: linetox, linetoy: linetoy, log: log, loop: loop, makeco: makeco, makecompiledimage: makecompiledimage, makegray: makegray, makeoutline: makeoutline, makepixelarray: makepixelarray, makepool: makepool, makesampledblack: makesampledblack, makesampledcolor: makesampledcolor, makesimpleco: makesimpleco, maket: maket, makevec: makevec, makeveclu: makeveclu, mark: mark, maskfill: maskfill, maskpixel: maskpixel, maskrectangle: maskrectangle, maskstroke: maskstroke, maskstrokeclosed: maskstrokeclosed, masktrapezoidx: masktrapezoidx, masktrapezoidy: masktrapezoidy, maskunderline: maskunderline, maskvector: maskvector, max: max, mergeprop: mergeprop, min: min, mod: mod, modifyfont: modifyfont, move: move, moveto: moveto, mul: mul, neg: neg, nop: nop, nopool: nopool, not: not, opent: opent, openvec: openvec, or: or, pget: pget, pool: pool, poolop: poolop, pop: pop, pset: pset, rem: rem, roll: roll, rotate: rotate, round: round, roundxy: roundxy, roundxyvec: roundxyvec, scale: scale, scale2: scale2, setcorrectmeasure: setcorrectmeasure, setcorrecttolerance: setcorrecttolerance, setfont: setfont, setgray: setgray, setxrel: setxrel, setxy: setxy, setxyrel: setxyrel, setyrel: setyrel, shape: shape, show: show, showandxrel: showandxrel, sin: sin, space: space, sqrt: sqrt, startunderline: startunderline, sub: sub, trans: trans, transform: transform, transformvec: transformvec, translate: translate, trunc: trunc, type: type, unmark: unmark, unmark0: unmark0, beginBody: beginBody, endBody: endBody, beginBlock: beginBlock, endBlock: endBlock, pageInstructions: pageInstructions, noPages: noPages, beginVec: nil, comma: nil, endVec: nil]];
decode: REF READONLY DecodeTable = CreateDecodeTable[encode];
CreateDecodeTable:
PROC[encode:
REF
READONLY EncodeTable]
RETURNS[REF READONLY DecodeTable] = {
decode: REF DecodeTable = NEW[DecodeTable ← ALL[nil]];
FOR op: PrimitiveOrSymbol IN PrimitiveOrSymbol DO decode[encode[op]] ← op ENDLOOP;
RETURN[decode];
};
readerProcs:
REF
READONLY ReaderProcs =
NEW[ReaderProcs = [
GetToken: GetToken,
GetInt: GetInt,
GetRational: GetRational,
GetReal: GetReal,
GetRope: GetRope
]];
NewReader:
PROC[ropeReader: RopeReader.Ref]
RETURNS[Reader] = {
self: Reader =
NEW[ReaderRep ← [procs:
NIL,
ropeReader: NIL, buffer: NIL, bytesRemaining: 0, startingIndex: 0]];
self.procs ← readerProcs;
self.ropeReader ← ropeReader;
self.startingIndex ← ropeReader.GetIndex[];
RETURN[self];
};
BYTE: TYPE = [0..256);
Get:
PROC[self: Reader]
RETURNS[
BYTE] =
INLINE {
RETURN[LOOPHOLE[self.ropeReader.Get[]]] };
Peek:
PROC[self: Reader]
RETURNS[
BYTE] =
INLINE {
RETURN[LOOPHOLE[self.ropeReader.Peek[]]] };
GetIndex:
PROC[self: Reader]
RETURNS[
INT] =
INLINE {
RETURN[self.ropeReader.GetIndex[]] };
SetIndex:
PROC[self: Reader, index:
INT] =
INLINE {
self.ropeReader.SetIndex[index] };
BumpIndex:
PROC[self: Reader, offset:
INT] =
INLINE {
self.ropeReader.BumpIndex[offset] };
SetIndexAndPeek:
PROC[self: Reader, index:
INT]
RETURNS[
BYTE] =
INLINE {
SetIndex[self, index]; RETURN[Peek[self]] };
GetBaseRope:
PROC[self: Reader]
RETURNS[
ROPE] =
INLINE {
RETURN[self.ropeReader.GetRope[]] };
GetDescriptor:
PROC[self: Reader]
RETURNS[
INT] = {
a: BYTE = Get[self];
IF a<300B THEN ERROR Error["not a sequence"]
ELSE IF a<340B THEN RETURN[Get[self]] -- Short Sequence
ELSE {
-- Long Sequence
b: BYTE = Get[self];
c: BYTE = Get[self];
d: BYTE = Get[self];
RETURN[(b*256+c)*256+d];
};
};
Seq: PROC[a: BYTE] RETURNS[SequenceType] = INLINE { RETURN[LOOPHOLE[a MOD 40B]] };
Continued:
PROC[self: Reader]
RETURNS[
BOOL] =
INLINE { a:
BYTE = Peek[self];
RETURN[a>=300B AND Seq[a]=sequenceContinued] };
SkipSequence:
PROC[self: Reader]
RETURNS[
INT] = {
length: INT ← 0;
DO n:
INT = GetDescriptor[self];
BumpIndex[self, n];
length ← length+n;
IF NOT Continued[self] THEN EXIT;
ENDLOOP;
RETURN[length];
};
MapSequence:
PROC[self: Reader, proc:
PROC[
BYTE]] = {
DO n:
INT = GetDescriptor[self];
THROUGH [0..n) DO proc[Get[self]] ENDLOOP;
IF NOT Continued[self] THEN EXIT;
ENDLOOP;
};
TextFromSequence:
PROC[self: Reader, text:
REF
TEXT] = {
DO n:
INT = GetDescriptor[self];
count: NAT = self.ropeReader.GetString[text, n];
IF count<n THEN BumpIndex[self, n-count];
IF NOT Continued[self] THEN EXIT;
ENDLOOP;
};
RopeFromSequence:
PROC[self: Reader]
RETURNS[
ROPE] = {
base: ROPE = GetBaseRope[self];
rope: ROPE ← NIL;
DO n:
INT = GetDescriptor[self];
substr: ROPE = base.Substr[GetIndex[self], n];
BumpIndex[self, n];
IF rope=NIL THEN rope ← substr ELSE rope ← rope.Concat[substr];
IF NOT Continued[self] THEN EXIT;
ENDLOOP;
RETURN[rope];
};
GetToken:
PROC[self: Reader, index:
INT]
RETURNS[Token] = {
token: Token ← nullToken;
peek: BYTE;
SetIndex[self, index];
token.index ← index;
{ peek ← Peek[self ! RopeReader.ReadOffEnd =>
GOTO Eof];
EXITS Eof => { token.type ← eof; token.next ← index; RETURN[token] } };
IF peek<200B
THEN {
-- Short Number
a: BYTE = Get[self];
b: BYTE = Get[self];
token.number ← a*256+b-shortNumberBias;
token.type ← number;
}
ELSE
IF peek<300B
THEN {
-- Op
ev: EncodingValue ← nil;
IF peek<240B
THEN {
-- Short Op
a: BYTE = Get[self];
ev ← LOOPHOLE[a MOD 40B];
token.op ← decode[ev];
}
ELSE {
-- Long Op
a: BYTE = Get[self];
b: BYTE = Get[self];
ev ← LOOPHOLE[(a MOD 40B)*256+b];
IF ev<=LAST[DefinedEncodingValue] THEN token.op ← decode[ev];
};
IF token.op=nil THEN ERROR Error["undefined encoding-value"];
token.type ← op;
}
ELSE {
-- Sequence
type: SequenceType = LOOPHOLE[peek MOD 40B];
length: INT = SkipSequence[self];
token.length ← length;
SELECT type
FROM
sequenceString => token.type ← string;
sequenceInteger => token.type ← (IF length<=4 THEN int ELSE real);
sequenceRational => token.type ← (IF length<=8 THEN rational ELSE real);
sequenceIdentifier => token.type ← identifier;
sequenceComment => token.type ← comment;
sequenceContinued => ERROR Error["misplaced sequenceContinued"];
sequenceLargeVector => token.type ← largeVec;
sequencePackedPixelVector => token.type ← largeVec;
sequenceCompressedPixelVector => token.type ← largeVec;
sequenceInsertFile => token.type ← insertFile;
ENDCASE => ERROR Error["undefined sequence type"];
};
token.next ← GetIndex[self];
RETURN[token];
};
BeginSequence:
PROC[self: Reader, index:
INT]
RETURNS[SequenceType] = {
peek: BYTE = SetIndexAndPeek[self, index];
IF peek<300B THEN ERROR;
self.bytesRemaining ← GetDescriptor[self];
RETURN[LOOPHOLE[peek MOD 40B]];
};
DGet:
PROC[self: Reader]
RETURNS[
BYTE] = {
UNTIL self.bytesRemaining>0 DO self.bytesRemaining ← GetDescriptor[self] ENDLOOP;
self.bytesRemaining ← self.bytesRemaining-1;
RETURN[Get[self]];
};
DPeek:
PROC[self: Reader]
RETURNS[
BYTE] = {
UNTIL self.bytesRemaining>0 DO self.bytesRemaining ← GetDescriptor[self] ENDLOOP;
RETURN[Peek[self]];
};
ReadInt:
PROC[self: Reader, n:
NAT]
RETURNS[
INT] = {
i: INT ← 0;
IF n>4 THEN ERROR Error["too many bytes for an int"];
IF DPeek[self]<128
THEN {
THROUGH[0..n) DO i ← i*256+DGet[self] ENDLOOP;
}
ELSE {
-- negative
THROUGH[0..n) DO i ← i*256+(255-DGet[self]) ENDLOOP;
i ← -1-i;
};
RETURN[i];
};
ReadReal:
PROC[self: Reader, n:
NAT]
RETURNS[
REAL] = {
r: REAL ← 0;
IF DPeek[self]<128
THEN {
THROUGH[0..n) DO r ← r*256+DGet[self] ENDLOOP;
}
ELSE {
-- negative
THROUGH[0..n) DO r ← r*256+(255-DGet[self]) ENDLOOP;
r ← -1-r;
};
RETURN[r];
};
GetInt:
PROC[self: Reader, token: Token]
RETURNS[
INT] = {
type: SequenceType = BeginSequence[self, token.index];
IF type=sequenceInteger
THEN {
length: NAT = token.length;
int: INT = ReadInt[self, length];
RETURN[int];
}
ELSE ERROR Error["wrong token type"];
};
GetRational:
PROC[self: Reader, token: Token]
RETURNS[Rational] = {
type: SequenceType = BeginSequence[self, token.index];
IF type=sequenceRational
THEN {
length: NAT = token.length;
IF (length
MOD 2)=0
THEN {
num: INT = ReadInt[self, length/2];
den: INT = ReadInt[self, length/2];
RETURN[[num, den]];
}
ELSE ERROR Error["invalid length for sequenceRational"];
}
ELSE ERROR Error["wrong token type"];
};
GetReal:
PROC[self: Reader, token: Token]
RETURNS[
REAL] = {
type: SequenceType = BeginSequence[self, token.index];
SELECT type
FROM
sequenceInteger => {
length: NAT = token.length;
real: REAL = ReadReal[self, length];
RETURN[real];
};
sequenceRational => {
length: NAT = token.length;
IF (length
MOD 2)=0
THEN {
num: REAL = ReadReal[self, length/2];
den: REAL = ReadReal[self, length/2];
RETURN[num/den];
}
ELSE ERROR Error["invalid length for sequenceRational"];
};
ENDCASE => ERROR Error["wrong token type"];
};
GetRope:
PROC[self: Reader, token: Token]
RETURNS[
ROPE] = {
SetIndex[self, token.index];
IF token.type>number THEN RETURN[RopeFromSequence[self]]
ELSE ERROR Error["wrong token type"];
};
writerProcs:
REF
READONLY WriterProcs =
NEW[WriterProcs = [
PutOp: PutOp,
PutInt: PutInt,
PutRational: PutRational,
PutReal: PutReal,
PutRope: PutRope
]];
NewWriter:
PROC[stream:
STREAM]
RETURNS[Writer] = {
self: Writer = NEW[WriterRep ← [procs: writerProcs, stream: stream]];
RETURN[self];
};
PutByte: PROC[s: STREAM, b: BYTE] = INLINE { s.PutChar[LOOPHOLE[b]] };
PutOp:
PROC[self: Writer, op: IPBasic.PrimitiveOrSymbol] = {
s: STREAM = self.stream;
ev: EncodingValue = encode[op];
IF ev#nil
THEN {
x: [0..17777B] = LOOPHOLE[ev];
IF x<40B THEN PutByte[s, 200B+x] -- Short Op
ELSE { PutByte[s, 240B+x/400B]; PutByte[s, x MOD 400B] }; -- Long Op
}
ELSE ERROR Error["invalid op"];
};
ExtractByte:
PROC[i:
INT, b:
NAT]
RETURNS[
BYTE] = {
SELECT b
FROM
0 => RETURN[Inline.LowByte[Inline.LowHalf[i]]];
1 => RETURN[Inline.HighByte[Inline.LowHalf[i]]];
2 => RETURN[Inline.LowByte[Inline.HighHalf[i]]];
3 => RETURN[Inline.HighByte[Inline.HighHalf[i]]];
ENDCASE => RETURN[IF i<0 THEN 377B ELSE 0];
};
BytesInInt:
PROC[i:
INT]
RETURNS[
NAT] = {
SELECT i
FROM
IN[-200B..200B) => RETURN[1];
IN[-LONG[100000B]..100000B) => RETURN[2];
IN[-40000000B..40000000B) => RETURN[3];
ENDCASE => RETURN[4];
};
WriteInt:
PROC[s:
STREAM, i:
INT, nBytes:
NAT] = {
FOR k:
NAT
DECREASING
IN[0..nBytes)
DO
PutByte[s, ExtractByte[i, k]];
ENDLOOP;
};
PutDescriptor:
PROC[s:
STREAM, type: SequenceType, length:
INT] = {
x: [0..40B) = LOOPHOLE[type];
SELECT length
FROM
<0 => ERROR Error["sequence length negative"];
<=377B => { PutByte[s, 300B+x]; WriteInt[s, length, 1] }; -- Short Sequence
<=77777777B => { PutByte[s, 340B+x]; WriteInt[s, length, 3] }; -- Long Sequence
ENDCASE => ERROR Error["sequence length too large"];
};
PutInt:
PROC[self: Writer, i:
INT] = {
s: STREAM = self.stream;
IF i
IN[-shortNumberBias..77777B-shortNumberBias]
THEN {
x: [0..77777B] = i+shortNumberBias;
PutByte[s, x/400B]; PutByte[s, x MOD 400B];
}
ELSE {
b: NAT = BytesInInt[i];
PutDescriptor[s, sequenceInteger, b];
WriteInt[s, i, b];
};
};
PutRational:
PROC[self: Writer, r: Rational] = {
s: STREAM = self.stream;
bn: NAT = BytesInInt[r.num];
bd: NAT = BytesInInt[r.den];
b: NAT = MAX[bn, bd];
PutDescriptor[s, sequenceRational, 2*b];
WriteInt[s, r.num, b];
WriteInt[s, r.den, b];
};
PowerIndex: TYPE = [0..9];
PowerArray: TYPE = ARRAY PowerIndex OF INT;
power:
REF
READONLY PowerArray =
NEW[PowerArray =
[1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000]];
PutReal:
PROC[self: Writer, r:
REAL] = {
s: STREAM = self.stream;
type: Real.NumberType; fr: INT; exp10: INTEGER;
[type, fr, exp10] ← Real.RealToPair[r, Real.DefaultSinglePrecision];
SELECT type
FROM
normal =>
IF exp10=0 THEN PutInt[self, fr]
ELSE {
e: INTEGER ← -exp10;
f: INT ← fr;
THROUGH[0..10) WHILE (f MOD 10)=0 DO f ← f/10; e ← e-1 ENDLOOP;
IF e IN PowerIndex THEN PutRational[self, [f, power[e]]]
ELSE ERROR Error["PutReal failed"];
};
zero => PutInt[self, 0];
ENDCASE => ERROR Error["abnormal REAL"];
};
PutRope:
PROC[self: Writer, type: TokenType, text:
ROPE] = {
s: STREAM = self.stream;
sequenceType: SequenceType =
SELECT type
FROM
identifier => sequenceIdentifier,
string => sequenceString,
comment => sequenceComment,
insertFile => sequenceInsertFile,
ENDCASE => ERROR Error["wrong token type for PutRope"];
length: INT = Rope.Length[text];
PutDescriptor[s, sequenceType, length];
s.PutRope[text];
};
IPEncoding.Register["Xerox", [2,0], NewReader, NewWriter];
END.