IPXeroxWriterImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, August 23, 1984 1:33:01 pm PDT
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.