IPMasterImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, November 14, 1984 3:55:22 pm PST
DIRECTORY
Basics USING [LongNumber],
FS USING [StreamOpen],
IO,
IPMaster USING [Block, BlockRep, Body, BodyRep, BYTE, CARD, ErrorCode, ImagerVariable, Node, NodeRep, Op, Skeleton, SkeletonRep, Token, TokenType],
IPXerox USING [EncodingValue, GetToken, PutToken, SequenceType, ShortEncodingValue, ShortNumber, Token],
Real USING [NumberType, RealToPair, RoundLI],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [Concat, Fetch, FromProc, FromRefText, Index, Length, ROPE, Substr],
ShortRational USING [FromReal, Rational],
SymTab USING [Create, Fetch, Ref, Store];
IPMasterImpl: CEDAR PROGRAM
IMPORTS FS, IO, IPXerox, Real, RefText, Rope, ShortRational, SymTab
EXPORTS IPMaster
~ BEGIN OPEN IPMaster;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
ShortNumber: TYPE ~ IPXerox.ShortNumber;
EncodingValue: TYPE ~ IPXerox.EncodingValue;
ShortEncodingValue: TYPE ~ IPXerox.ShortEncodingValue;
SequenceType: TYPE ~ IPXerox.SequenceType;
Error: PUBLIC ERROR[code: ErrorCode, explanation: ROPE] ~ CODE;
EvFromOpArray: TYPE ~ ARRAY Op OF EncodingValue;
OpFromEvArray:
TYPE ~
ARRAY EncodingValue
OF Op;
evFromOp:
REF EvFromOpArray ~
NEW[EvFromOpArray ← [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, joinpixelarrays: joinpixelarrays,
finddecompressor: finddecompressor,
makegray: makegray, setgray: setgray,
findcolor: findcolor, findcoloroperator: findcoloroperator,
findcolormodeloperator: findcolormodeloperator,
makesampledcolor: makesampledcolor, makesampledblack: makesampledblack,
moveto: moveto, lineto: lineto, linetox: linetox, linetoy: linetoy,
curveto: curveto, conicto: conicto, arcto: arcto, makeoutline: makeoutline,
maskfill: maskfill, maskfillparity: maskfillparity,
maskstroke: maskstroke, maskstrokeclosed: maskstrokeclosed,
maskvector: maskvector, maskrectangle: maskrectangle,
startunderline: startunderline, maskunderline: maskunderline,
masktrapezoidx: masktrapezoidx, masktrapezoidy: masktrapezoidy,
maskpixel: maskpixel,
clipoutline: clipoutline, excludeoutline: excludeoutline,
cliprectangle: cliprectangle, excluderectangle: excluderectangle,
findfont: findfont, findfontvec: findfontvec,
modifyfont: modifyfont, setfont: setfont,
correctmask: correctmask, correctspace: correctspace, space: space,
setcorrectmeasure: setcorrectmeasure, setcorrecttolerance: setcorrecttolerance,
correct: correct,
beginBody: beginBody, endBody: endBody, beginBlock: beginBlock, endBlock: endBlock,
pageInstructions: pageInstructions, noPages: noPages,
metricMaster: metricMaster, environmentMaster: environmentMaster
]];
opFromEv:
REF OpFromEvArray ~ InvertEvFromOp[evFromOp];
InvertEvFromOp:
PROC[evFromOp:
REF EvFromOpArray]
RETURNS[opFromEv: REF OpFromEvArray] ~ {
opFromEv ← NEW[OpFromEvArray ← ALL[nil]];
FOR op: Op IN Op DO opFromEv[evFromOp[op]] ← op ENDLOOP;
};
EncodingValueFromOp:
PUBLIC
PROC[op: Op]
RETURNS[EncodingValue] ~ {
RETURN[evFromOp[op]];
};
OpFromEncodingValue:
PUBLIC
PROC[ev: EncodingValue]
RETURNS[Op] ~ {
RETURN[opFromEv[ev]];
};
SeqFromTypeArray: TYPE ~ ARRAY TokenType OF SequenceType;
TypeFromSeqArray:
TYPE ~
ARRAY SequenceType
OF TokenType;
seqFromType:
REF SeqFromTypeArray ~
NEW[SeqFromTypeArray ← [
nil: nil, op: nil, number: nil,
integer: sequenceInteger, rational: sequenceRational,
string: sequenceString, identifier: sequenceIdentifier,
comment: sequenceComment, insertFile: sequenceInsertFile,
largeVector: sequenceLargeVector,
packedPixelVector: sequencePackedPixelVector,
compressedPixelVector: sequenceCompressedPixelVector,
adaptivePixelVector: sequenceAdaptivePixelVector
]];
typeFromSeq:
REF TypeFromSeqArray ~ InvertSeqFromType[seqFromType];
InvertSeqFromType:
PROC[seqFromType:
REF SeqFromTypeArray]
RETURNS[typeFromSeq: REF TypeFromSeqArray] ~ {
typeFromSeq ← NEW[TypeFromSeqArray ← ALL[nil]];
FOR type: TokenType
IN TokenType
DO
seq: SequenceType ~ seqFromType[type];
IF seq#nil THEN typeFromSeq[seq] ← type;
ENDLOOP;
};
SequenceTypeFromTokenType:
PUBLIC
PROC[type: TokenType]
RETURNS[SequenceType] ~ {
RETURN[seqFromType[type]];
};
TokenTypeFromSequenceType:
PUBLIC
PROC[seq: SequenceType]
RETURNS[TokenType] ~ {
RETURN[typeFromSeq[seq]];
};
NonDefaultingRope: TYPE ~ ROPE ←
RopeFromOpArray:
TYPE ~
ARRAY Op
OF NonDefaultingRope;
ropeFromOp:
REF RopeFromOpArray ~
NEW[RopeFromOpArray ← [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", joinpixelarrays: "JOINPIXELARRAYS",
finddecompressor: "FINDDECOMPRESSOR",
makegray: "MAKEGRAY", setgray: "SETGRAY",
findcolor: "FINDCOLOR", findcoloroperator: "FINDCOLOROPERATOR",
findcolormodeloperator: "FINDCOLORMODELOPERATOR",
makesampledcolor: "MAKESAMPLEDCOLOR", makesampledblack: "MAKESAMPLEDBLACK",
moveto: "MOVETO", lineto: "LINETO", linetox: "LINETOX", linetoy: "LINETOY",
curveto: "CURVETO", conicto: "CONICTO", arcto: "ARCTO", makeoutline: "MAKEOUTLINE",
maskfill: "MASKFILL", maskfillparity: "MASKFILLPARITY",
maskstroke: "MASKSTROKE", maskstrokeclosed: "MASKSTROKECLOSED",
maskvector: "MASKVECTOR", maskrectangle: "MASKRECTANGLE",
startunderline: "STARTUNDERLINE", maskunderline: "MASKUNDERLINE",
masktrapezoidx: "MASKTRAPEZOIDX", masktrapezoidy: "MASKTRAPEZOIDY",
maskpixel: "MASKPIXEL",
clipoutline: "CLIPOUTLINE", excludeoutline: "EXCLUDEOUTLINE",
cliprectangle: "CLIPRECTANGLE", excluderectangle: "EXCLUDERECTANGLE",
findfont: "FINDFONT", findfontvec: "FINDFONTVEC",
modifyfont: "MODIFYFONT", setfont: "SETFONT",
correctmask: "CORRECTMASK", correctspace: "CORRECTSPACE", space: "SPACE",
setcorrectmeasure: "SETCORRECTMEASURE", setcorrecttolerance: "SETCORRECTTOLERANCE",
correct: "CORRECT",
beginBody: "{", endBody: "}", beginBlock: "BEGIN", endBlock: "END",
pageInstructions: "PAGEINSTRUCTIONS", noPages: "NOPAGES",
metricMaster: "METRICMASTER", environmentMaster: "ENVIRONMENTMASTER"
]];
opFromRope: SymTab.Ref ~ InvertRopeFromOp[ropeFromOp];
InvertRopeFromOp:
PROC[ropeFromOp:
REF RopeFromOpArray]
RETURNS[opFromRope: SymTab.Ref] ~ {
opFromRope ← SymTab.Create[mod: ORD[Op.LAST], case: FALSE];
FOR op: Op
IN Op
DO
key: ROPE ~ ropeFromOp[op];
val: OpVal ~ NEW[Op ← op];
IF SymTab.Store[x: opFromRope, key: key, val: val] THEN NULL
ELSE ERROR Error[bug, "duplicate name in ropeFromOp"];
ENDLOOP;
};
RopeFromOp:
PUBLIC
PROC[op: Op]
RETURNS[
ROPE] ~ {
RETURN[ropeFromOp[op]];
};
OpFromRope:
PUBLIC
PROC[rope:
ROPE]
RETURNS[Op] ~ {
found: BOOL; val: REF;
[found, val] ← SymTab.Fetch[x: opFromRope, key: rope];
IF found
THEN
WITH val
SELECT
FROM
val: OpVal => RETURN[val^];
ENDCASE => ERROR Error[bug, "illegal value in opFromRope"];
RETURN[nil];
};
RopeFromVarArray: TYPE ~ ARRAY ImagerVariable OF NonDefaultingRope;
ropeFromVar:
REF RopeFromVarArray ~
NEW[RopeFromVarArray ← [
DCScpx: "DCScpx", DCScpy: "DCScpy",
correctMX: "correctMX", correctMY: "correctMY",
T: "T", priorityImportant: "priorityImportant",
mediumXSize: "mediumXSize", mediumYSize: "mediumYSize",
fieldXMin: "fieldXMin", fieldYMin: "fieldYMin",
fieldXMax: "fieldXMax", fieldYMax: "fieldYMax",
showVec: "showVec", color: "color", noImage: "noImage",
strokeWidth: "strokeWidth", strokeStyle: "strokeStyle",
underlineStart: "underlineStart", amplifySpace: "amplifySpace",
correctPass: "correctPass", correctShrink: "correctShrink",
correctTX: "correctTX", correctTY: "correctTY",
strokeDashes: "strokeDashes"
]];
RopeFromImagerVariable:
PUBLIC
PROC[var: ImagerVariable]
RETURNS[
ROPE] ~ {
RETURN[ropeFromVar[var]];
};
GetHeader:
PUBLIC
PROC[stream:
STREAM, prefix:
ROPE ←
NIL]
RETURNS[suffix:
ROPE] ~ {
scratch, text: REF TEXT ← NIL;
IF prefix=NIL THEN prefix ← "Interpress/Xerox/";
FOR i:
INT
IN[0..Rope.Length[prefix])
DO
char: CHAR ~ IO.GetChar[stream];
IF char=Rope.Fetch[prefix, i] THEN NULL
ELSE ERROR Error[invalidHeader, Rope.Concat["header must begin with ", prefix]];
ENDLOOP;
text ← scratch ← RefText.ObtainScratch[100];
FOR i:
NAT
IN[0..500)
DO
ENABLE UNWIND => RefText.ReleaseScratch[scratch];
char: CHAR ~ IO.GetChar[stream];
IF char=' THEN EXIT
ELSE text ← RefText.AppendChar[text, char];
REPEAT FINISHED => ERROR Error[invalidHeader, "header too long"];
ENDLOOP;
suffix ← Rope.FromRefText[text];
RefText.ReleaseScratch[scratch];
};
GetSkeleton:
PUBLIC
PROC[stream:
STREAM]
RETURNS[Skeleton] ~ {
instructions: Body ← NIL;
block: Block ← NIL;
token: Token ← GetToken[stream];
IF token.op=$beginBody
THEN {
instructions ← GetBody[stream, token];
token ← GetToken[stream];
};
block ← GetBlock[stream, token];
RETURN[NEW[SkeletonRep ← [instructions: instructions, topBlock: block]]];
};
SkipToEndOfBody:
PUBLIC
PROC[stream:
STREAM] ~ {
DO token: Token ~ GetToken[stream];
SELECT token.op
FROM
$beginBody => SkipToEndOfBody[stream];
$endBody => EXIT;
ENDCASE => IF token.length#0 THEN SkipBytes[stream, token.length];
ENDLOOP;
};
GetBody:
PROC[stream:
STREAM, first: Token]
RETURNS[Body] ~ {
IF first.op=$beginBody
THEN {
SkipToEndOfBody[stream];
RETURN[NEW[BodyRep ← [index: first.index, length: IO.GetIndex[stream]-first.index]]];
};
IO.SetIndex[stream, first.index];
ERROR Error[invalidSkeleton, "missing {"];
};
GetBlock:
PROC[stream:
STREAM, first: Token]
RETURNS[block: Block] = {
IF first.op=$beginBlock
THEN {
noPages: BOOL ← FALSE;
preamble: Node ← NIL;
list: LIST OF Node ← NIL;
size: NAT ← 0;
token: Token ← GetToken[stream];
IF token.op=$noPages THEN { noPages ← TRUE; token ← GetToken[stream] };
preamble ← GetNode[stream, token, TRUE];
DO token ← GetToken[stream];
IF token.op=$endBlock THEN EXIT
ELSE {
page: Node ~ GetNode[stream, token];
list ← CONS[page, list]; size ← size+1;
};
ENDLOOP;
block ←
NEW[BlockRep[size] ← [
index: first.index, length: IO.GetIndex[stream]-first.index,
noPages: noPages, preamble: preamble, nodes: ]];
WHILE size>0 DO block[size ← size-1] ← list.first; list ← list.rest ENDLOOP;
RETURN[block];
};
IO.SetIndex[stream, first.index];
ERROR Error[invalidSkeleton, "missing BEGIN"];
};
GetNode:
PROC[stream:
STREAM, first: Token, preamble:
BOOL ←
FALSE]
RETURNS[Node] ~ {
pageInstructions: Body ← NIL;
token: Token ← first;
IF token.op=$pageInstructions
THEN {
IF preamble
THEN {
IO.SetIndex[stream, token.index];
ERROR Error[invalidSkeleton, "misplaced PAGEINSTRUCTIONS"];
};
token ← GetToken[stream];
pageInstructions ← GetBody[stream, token];
token ← GetToken[stream];
};
SELECT token.op
FROM
$beginBody => {
body: Body ~ GetBody[stream, token];
RETURN[
NEW[NodeRep.body ← [
index: first.index, length: IO.GetIndex[stream]-first.index,
pageInstructions: pageInstructions, content: body[body]]]];
};
$beginBlock => {
block: Block ~ GetBlock[stream, token];
RETURN[
NEW[NodeRep.block ← [
index: first.index, length: IO.GetIndex[stream]-first.index,
pageInstructions: pageInstructions, content: block[block]]]];
};
ENDCASE;
IO.SetIndex[stream, token.index];
ERROR Error[invalidSkeleton, "missing { or BEGIN"];
};
SetIndex:
PUBLIC
PROC[stream:
STREAM, index:
INT] ~ {
IO.SetIndex[stream, index];
};
CopyBytes:
PUBLIC
PROC[to:
STREAM, from:
STREAM, count:
INT]
RETURNS[copied:
INT] ~ {
buffer: REF TEXT ~ RefText.ObtainScratch[512];
rem: INT ← count;
WHILE rem>0
DO
ENABLE UNWIND => RefText.ReleaseScratch[buffer];
request: NAT ~ MIN[rem, buffer.maxLength];
length: NAT ~ IO.GetBlock[self: from, block: buffer, startIndex: 0, count: request];
IO.PutBlock[self: to, block: buffer, startIndex: 0, count: length];
rem ← rem-length;
IF length<request THEN EXIT;
ENDLOOP;
RefText.ReleaseScratch[buffer];
RETURN[count-rem];
};
CopySegment:
PUBLIC
PROC[to:
STREAM, from:
STREAM, start, length:
INT] ~ {
IO.SetIndex[from, start];
IF CopyBytes[to: to, from: from, count: length]=length THEN RETURN;
ERROR IO.EndOfStream[from];
};
Open:
PUBLIC
PROC[name:
ROPE]
RETURNS[
STREAM] ~ {
stream: STREAM ~ FS.StreamOpen[name];
suffix: ROPE ~ GetHeader[stream, "Interpress/Xerox/"];
RETURN[stream];
};
Create:
PUBLIC
PROC[name:
ROPE]
RETURNS[
STREAM] ~ {
stream: STREAM ~ FS.StreamOpen[name, $create];
stream.PutRope["Interpress/Xerox/2.1 "];
RETURN[stream];
};
CopyNode:
PROC[to:
STREAM, from:
STREAM, node: Node] ~ {
CopySegment[to: to, from: from, start: node.index, length: node.length];
};
ExtractPage:
PROC[toName, fromName:
ROPE, n:
NAT] ~ {
from: STREAM ~ Open[fromName];
skeleton: Skeleton ~ GetSkeleton[from];
to: STREAM ~ Create[toName];
PutOp[to, beginBlock];
CopyNode[to, from, skeleton.topBlock.preamble];
CopyNode[to, from, skeleton.topBlock[n-1]];
PutOp[to, endBlock];
IO.Close[to];
IO.Close[from];
};
GetToken:
PUBLIC
PROC[stream:
STREAM, flushComments:
BOOL ←
TRUE]
RETURNS[Token] ~ {
DO token: Token ← [];
-- set the defaults
index: INT ~ IO.GetIndex[stream]; -- get current index
xtoken: IPXerox.Token ~ IPXerox.GetToken[stream]; -- then get a token
WITH x: xtoken
SELECT
FROM
shortNumber => { token.type ← number; token.number ← x.number };
shortOp => { token.type ← op; token.op ← opFromEv[x.op] };
longOp => { token.type ← op; token.op ← opFromEv[x.op] };
shortSequence => { token.type ← typeFromSeq[x.type]; token.length ← x.length };
longSequence => { token.type ← typeFromSeq[x.type]; token.length ← x.length };
ENDCASE => ERROR Error[bug, "undefined token type"];
IF token.type=comment AND flushComments THEN SkipBytes[stream, token.length]
ELSE { token.index ← index; RETURN[token] };
ENDLOOP;
};
SkipBytes:
PUBLIC
PROC[stream:
STREAM, length:
INT] ~ {
IO.SetIndex[stream, IO.GetIndex[stream]+length];
};
GetByte:
PUBLIC
PROC[stream:
STREAM]
RETURNS[
BYTE] ~ {
RETURN[ORD[CHAR[IO.GetChar[stream]]]];
};
InlineGetByte:
PROC[stream:
STREAM]
RETURNS[
BYTE] ~
INLINE {
RETURN[ORD[CHAR[IO.GetChar[stream]]]];
};
GetUnsigned:
PUBLIC
PROC[stream:
STREAM, length: [0..4]]
RETURNS[
LONG
CARDINAL] ~ {
x: LONG CARDINAL ← 0;
FOR i:
NAT
IN [0..length)
DO
b: BYTE ~ InlineGetByte[stream];
x ← x*400B+b;
ENDLOOP;
RETURN[x];
};
GetSigned:
PUBLIC
PROC[stream:
STREAM, length: [0..4]]
RETURNS[
INT] ~ {
x: INT ← 0;
nonneg: BOOL ← TRUE;
FOR i:
NAT
IN [0..length)
DO
b: BYTE ~ InlineGetByte[stream];
IF i=0 THEN nonneg ← b<200B;
IF nonneg THEN x ← x*400B+b ELSE x ← x*400B+(377B-b);
ENDLOOP;
RETURN[IF nonneg THEN x ELSE -1-x];
};
GetInteger:
PUBLIC
PROC[stream:
STREAM, length:
INT]
RETURNS[
REAL] ~ {
x: REAL ← 0;
nonneg: BOOL ← TRUE;
FOR i:
INT
IN [0..length)
DO
b: BYTE ~ InlineGetByte[stream];
IF i=0 THEN nonneg ← b<200B;
IF nonneg THEN x ← x*400B+b ELSE x ← x*400B+(377B-b);
ENDLOOP;
RETURN[IF nonneg THEN x ELSE -1-x];
};
GetRational:
PUBLIC
PROC[stream:
STREAM, length:
INT]
RETURNS[
REAL] ~ {
half: NAT ~ CARDINAL[length]/2;
IF (half+half)#length THEN ERROR Error[invalidToken, "rational has odd length."];
IF half<=4
THEN {
n: INT ~ GetSigned[stream, half];
d: INT ~ GetSigned[stream, half];
RETURN[REAL[n]/REAL[d]];
}
ELSE {
n: REAL ~ GetInteger[stream, half];
d: REAL ~ GetInteger[stream, half];
RETURN[n/d];
};
};
GetRope:
PUBLIC
PROC[stream:
STREAM, length:
INT]
RETURNS[
ROPE] ~ {
getChar: PROC RETURNS[CHAR] ~ { RETURN[IO.GetChar[stream]] };
RETURN[Rope.FromProc[length, getChar]];
};
GetText:
PUBLIC
PROC[stream:
STREAM, length:
NAT, scratch:
REF
TEXT]
RETURNS[
REF
TEXT] ~ {
scratchMaxLength: NAT ~ IF scratch=NIL THEN 0 ELSE scratch.maxLength;
text: REF TEXT ~ IF length<=scratchMaxLength THEN scratch ELSE NEW[TEXT[length]];
IF IO.GetBlock[self: stream, block: text, startIndex: 0, count: length]=length THEN RETURN[text]
ELSE ERROR IO.EndOfStream[stream];
};
BytesInInt:
PROC[i:
INT]
RETURNS[[0..4]] ~ {
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];
};
PutByte:
PUBLIC
PROC[stream:
STREAM, byte:
BYTE] ~ {
IO.PutChar[stream, VAL[byte]]
};
InlinePutByte:
PROC[stream:
STREAM, byte:
BYTE] ~
INLINE {
IO.PutChar[stream, VAL[byte]]
};
PutUnsigned:
PUBLIC
PROC[stream:
STREAM, length: [0..4], val:
CARD] ~ {
IF length>3 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].hh];
IF length>2 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].hl];
IF length>1 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].lh];
IF length>0 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].ll];
};
PutSigned:
PUBLIC
PROC[stream:
STREAM, length: [0..4], val:
INT] ~ {
IF length>3 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].hh];
IF length>2 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].hl];
IF length>1 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].lh];
IF length>0 THEN InlinePutByte[stream, LOOPHOLE[val, Basics.LongNumber].ll];
};
PutOp:
PUBLIC
PROC[stream:
STREAM, op: Op] ~ {
Appends a primitive operator or symbol literal.
ev: EncodingValue ~ evFromOp[op];
IF ev IN ShortEncodingValue THEN IPXerox.PutToken[stream, [shortOp[ev]]]
ELSE IPXerox.PutToken[stream, [longOp[ev]]];
};
PutDescriptor:
PUBLIC
PROC[stream:
STREAM, type: TokenType, length:
INT] ~ {
Chooses the smallest encoding (Short Sequence or Long Sequence).
! BoundsFault if length NOT IN[0..2^24).
seq: SequenceType ~ seqFromType[type];
IF seq=nil THEN ERROR Error[bug, "invalid type for PutDescriptor"];
IF length IN BYTE THEN IPXerox.PutToken[stream, [shortSequence[seq, length]]]
ELSE IPXerox.PutToken[stream, [longSequence[seq, length]]];
};
PutInt:
PUBLIC
PROC[stream:
STREAM, n:
INT] ~ {
Appends a Number literal.
IF n IN ShortNumber THEN IPXerox.PutToken[stream, [shortNumber[n]]]
ELSE {
length: [0..4] ~ BytesInInt[n];
PutDescriptor[stream, $integer, length];
PutSigned[stream, length, n];
};
};
PutRational:
PUBLIC
PROC[stream:
STREAM, n, d:
INT] ~ {
Appends a Number literal, n/d.
! Error[invalidRational] if d is zero.
IF d=0 THEN ERROR Error[invalidRational, "zero denominator"]
ELSE {
length: [0..4] ~ MAX[BytesInInt[n], BytesInInt[d]];
PutDescriptor[stream, $rational, 2*length];
PutSigned[stream, length, n];
PutSigned[stream, length, d];
};
};
tryDecimal: BOOL ← FALSE;
tryShortRational: BOOL ← TRUE;
decimalPrecision: NAT ← 6;
maxRelativeError: REAL ← 0.00001;
PutReal:
PUBLIC
PROC[stream:
STREAM, val:
REAL] ~ {
Appends a Number literal. Chooses a rational approximation if necessary.
r: REAL ← val;
n: INT ← 0; d: INT ← 1;
IF
ABS[r]>
INT.
LAST
THEN {
tail: NAT ← 0; -- number of trailing zero bytes
WHILE ABS[r]>INT.LAST DO r ← r/256; tail ← tail+1 ENDLOOP;
PutDescriptor[stream, $integer, 4+tail];
PutSigned[stream, 4, Real.RoundLI[r]];
THROUGH [0..tail) DO PutByte[stream, 0] ENDLOOP;
RETURN;
};
IF (n ← Real.RoundLI[r])=r THEN { PutInt[stream, 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;
PutRational[stream, 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 PutInt[stream, rat.numerator]
ELSE PutRational[stream, 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*val] };
ENDLOOP;
PutRational[stream, n, d];
};
PutIdentifier:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE] ~ {
Appends an Identifier literal.
! Error[invalidIdentifier] if the rope is not a legal identifier.
length: INT ~ Rope.Length[rope];
IF length=0 THEN ERROR Error[invalidIdentifier, "identifier has zero length"];
PutDescriptor[stream, $identifier, length];
FOR i:
INT
IN[0..length)
DO
char: CHAR ~ Rope.Fetch[rope, i];
SELECT char
FROM
IN['a..'z], IN['A..'Z] => NULL;
IN['0..'9], '- => IF i=0 THEN Error[invalidIdentifier, "illegal initial char for identifier"];
ENDCASE => ERROR Error[invalidIdentifier, "illegal char in identifier"];
IO.PutChar[stream, char];
ENDLOOP;
};
PutString:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE] ~ {
Appends the encoding notation for a string. Treats '\377 as an escape code.
See the Character Code Standard, chapter 6, and Interpress, section 2.5.3.
! Error[invalidString] if the rope is not a legal string.
length: INT ~ Rope.Length[rope];
PutDescriptor[stream, $string, length];
IO.PutRope[stream, rope];
};
PutComment:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE] ~ {
Appends a comment token.
length: INT ~ Rope.Length[rope];
PutDescriptor[stream, $comment, length];
IO.PutRope[stream, rope];
};
PutInsertFile:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE] ~ {
Appends a sequenceInsertFile.
length: INT ~ Rope.Length[rope];
PutDescriptor[stream, $insertFile, length];
IO.PutRope[stream, rope];
};
PutName:
PUBLIC
PROC[stream:
STREAM, name:
ROPE] ~ {
Parses a structured name and appends tokens to build a Vector of Identifiers.
For example, "a/b/c" produces < a b c 3 MAKEVEC >; "foo" produces < foo 1 MAKEVEC >.
See Interpress, section 3.2.1.
! Error[invalidName] if the rope is not a well formed name.
size: INT ~ Rope.Length[name];
start: INT ← 0;
depth: INT ← 0;
WHILE start<size
DO
stop: INT ~ Rope.Index[s1: name, pos1: start, s2: "/"];
PutIdentifier[stream, Rope.Substr[base: name, start: start, len: stop-start]];
depth ← depth+1;
start ← stop+1;
ENDLOOP;
PutInt[stream, depth];
PutOp[stream, makevec];
};
WriteNode:
PROC[to, from:
STREAM, node: Node] ~ {
stop: INT ~ node.index+node.length;
IO.SetIndex[from, node.index];
WHILE
IO.GetIndex[from]<stop
DO
token: Token ~ GetToken[from, FALSE];
SELECT token.type
FROM
$op => to.PutF["%g ", IO.rope[ropeFromOp[token.op]]];
$number => to.PutF["%g ", IO.int[token.number]];
$integer => to.PutF["%g ", IO.real[GetInteger[from, token.length]]];
$rational => to.PutF["%g ", IO.real[GetRational[from, token.length]]];
$identifier => to.PutF["%g ", IO.rope[GetRope[from, token.length]]];
$string => to.PutF["<%g> ", IO.rope[GetRope[from, token.length]]];
$insertFile => to.PutF["++%g++ ", IO.rope[GetRope[from, token.length]]];
$comment => to.PutF["**%g** ", IO.rope[GetRope[from, token.length]]];
ENDCASE => { to.PutRope["??? "]; SkipBytes[from, token.length] };
ENDLOOP;
};
ToWrittenInternal: PROC[reader: Reader, writer: Writer, tick: PROC ← NIL] ~ {
buffer: REF TEXT ~ NEW[TEXT[500]];
prevInt: INT ← -1;
nest: INT ← 0;
page: INT ← 0;
AnnotateImagerVariable: PROC[writer: Writer, i: INT] ~ {
writer.PutAnnotation[SELECT i FROM
0 => "DCScpx", 1 => "DCScpy", 2 => "correctMX", 3 => "correctMY",
4 => "T", 5 => "priorityImportant", 6 => "mediumXSize", 7 => "mediumYSize",
8 => "fieldXMin", 9 => "fieldYMin", 10 => "fieldXMax", 11 => "fieldYMax",
12 => "showVec", 13 => "color", 14 => "noImage", 15 => "strokeWidth",
16 => "strokeEnd", 17 => "underlineStart", 18 => "amplifySpace",
19 => "correctPass", 20 => "correctShrink", 21 => "correctTX", 22 => "correctTY",
ENDCASE => "???"];
};
AnnotatePage: PROC[writer: Writer, page: INT] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ← scratch;
IF page=0 THEN text ← RefText.AppendRope[text, " Preamble "]
ELSE {
text ← RefText.AppendRope[to: text, from: " Page "];
text ← Convert.AppendInt[to: text, from: page];
text ← RefText.AppendRope[to: text, from: " "];
};
writer.PutAnnotation[RefText.TrustTextAsRope[text]];
RefText.ReleaseScratch[scratch];
};
AnnotateRational: PROC[writer: Writer, r: Rational] ~ {
value: REAL ~ REAL[r.num]/REAL[r.den];
writer.PutAnnotation[IO.PutFR["(%g)", IO.real[value]]];
};
LineBreakAfter: PROC[op: Op] RETURNS[BOOL] ~ {
SELECT op FROM
fset, pset, iset,
do, dosave, dosaveall,
pop, copy, dup, roll, exch, mark, unmark, unmark0, nop,
concatt, move, trans, show, showandxrel,
setxy, setxyrel, setxrel, setyrel, setgray, setfont,
maskfill, maskstroke, maskstrokeclosed, maskvector, maskrectangle,
startunderline, maskunderline, masktrapezoidx, masktrapezoidy, maskpixel,
clipoutline, cliprectangle,
correctmask, correctspace, setcorrectmeasure, setcorrecttolerance, space,
beginBody, endBody, beginBlock, endBlock,
metricMaster, environmentMaster => RETURN[TRUE];
ENDCASE => RETURN[FALSE];
};
NewLine: PROC[stream: STREAM, nest: INT ← 0] ~ {
stream.PutChar['\n];
THROUGH [0..nest) DO stream.PutRope[" "] ENDLOOP;
};
DO token: Token; text: REF TEXT;
[token, text] ← reader.GetToken[buffer: buffer, flushComments: FALSE];
IF token.type=eof THEN EXIT;
SELECT token.op FROM
iget, iset => IF prevInt>=0 THEN AnnotateImagerVariable[writer, prevInt];
ENDCASE;
prevInt ← -1;
SELECT token.type FROM
op => writer.PutOp[token.op];
shortNumber => writer.PutInt[prevInt ← token.shortNumber];
integer => {
i: INT ~ reader.ReadInt[token, text !
IPReader.Error => IF code=$overflow THEN GOTO Overflow];
writer.PutInt[prevInt ← i];
EXITS Overflow => writer.PutReal[reader.ReadReal[token, text]];
};
rational => {
r: Rational ~ reader.ReadRational[token, text !
IPReader.Error => IF code=$overflow THEN GOTO Overflow];
writer.PutRational[r];
AnnotateRational[writer, r];
EXITS Overflow => writer.PutReal[reader.ReadReal[token, text]];
};
real => writer.PutReal[reader.ReadReal[token, text]];
identifier => writer.PutIdentifier[RefText.TrustTextAsRope[text]];
string => writer.PutString[RefText.TrustTextAsRope[text]];
comment => writer.PutComment[RefText.TrustTextAsRope[text]];
insertfile => writer.PutInsertfile[RefText.TrustTextAsRope[text]];
annotation => NULL;
largeVector => {
lv: IPReader.LargeVector ~ reader.ReadLargeVector[token];
Put: PROC[to: STREAM] ~ { IOClasses.Copy[from: lv.source, to: to] };
writer.PutLargeVector[Put, lv.bytesPerElement, lv.type];
};
ENDCASE => ERROR;
SELECT token.op FROM
beginBody => { IF nest=0 THEN AnnotatePage[writer, page]; nest ← nest+1 };
endBody => { nest ← nest-1;
IF nest=0 THEN { page ← page+1; IF tick#NIL THEN tick[] } };
ENDCASE;
IF LineBreakAfter[token.op] THEN NewLine[writer.stream, nest];
ENDLOOP;
};
ToEncoded: PUBLIC PROC[from, to: ROPE, tick: PROC ← NIL] ~ {
reader: Reader ~ IPReader.Open[from];
writer: Writer ~ IPWriter.Open[to, $Xerox];
Close: PROC ~ { IPReader.Close[reader]; IPWriter.Close[writer] };
ToXeroxInternal[reader, writer, tick ! UNWIND => Close[]];
Close[];
};
ToXeroxInternal: PROC[reader: Reader, writer: Writer, tick: PROC ← NIL] ~ {
buffer: REF TEXT ~ NEW[TEXT[500]];
nest: INT ← 0;
DO token: Token; text: REF TEXT;
[token, text] ← IPReader.GetToken[reader: reader, buffer: buffer, flushComments: FALSE];
IF token.type=eof THEN EXIT;
SELECT token.type FROM
op => writer.PutOp[token.op];
shortNumber => writer.PutInt[token.shortNumber];
integer => writer.PutInt[reader.ReadInt[token, text]];
rational => writer.PutRational[reader.ReadRational[token, text]];
real => writer.PutReal[reader.ReadReal[token, text]];
identifier => writer.PutIdentifier[RefText.TrustTextAsRope[text]];
string => writer.PutString[RefText.TrustTextAsRope[text]];
insertfile => writer.PutInsertfile[RefText.TrustTextAsRope[text]];
comment => writer.PutComment[RefText.TrustTextAsRope[text]];
largeVector => {
lv: IPReader.LargeVector ~ reader.ReadLargeVector[token];
Put: PROC[to: STREAM] ~ { IOClasses.Copy[from: lv.source, to: to] };
writer.PutLargeVector[Put, lv.bytesPerElement, lv.type];
};
annotation => NULL;
ENDCASE => ERROR;
SELECT token.op FROM
beginBody => { nest ← nest+1 };
endBody => { nest ← nest-1; IF nest=0 THEN { IF tick#NIL THEN tick[] } };
ENDCASE;
ENDLOOP;
};
END.