IPWrittenWriterImpl.mesa
Last edited by:
Doug Wyatt, March 8, 1984 7:03:05 pm PST
DIRECTORY
Ascii USING [Lower],
IO USING [char, int, Put, PutChar, PutRope, real, STREAM],
IPBasic USING [Op, Rational],
IPWriter USING [Class, ClassRep, Error, Register, Writer],
IPWritten USING [EncodingTable, EncodingTableRep],
Rope USING [Fetch, Length, ROPE];
IPWrittenWriterImpl: CEDAR PROGRAM
IMPORTS Ascii, IO, IPWriter, Rope
EXPORTS IPWritten
~ BEGIN OPEN IPWriter, IPWritten;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Op: TYPE ~ IPBasic.Op;
Rational: TYPE ~ IPBasic.Rational;
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: "{", endBody: "}", beginBlock: "BEGIN", endBlock: "END", pageInstructions: "PAGEINSTRUCTIONS", noPages: "NOPAGES", metricMaster: "METRICMASTER", environmentMaster: "ENVIRONMENTMASTER", beginVec: "[", comma: ",", endVec: "]"]];
GetEncodingTable: PUBLIC PROC RETURNS[EncodingTable] ~ { RETURN[encode] };
writtenWriter: Class ~
NEW[ClassRep ← [
encoding: $Written,
putOp: WrittenPutOp,
putInt: WrittenPutInt,
putReal: WrittenPutReal,
putRational: WrittenPutRational,
putIdentifier: WrittenPutIdentifier,
putString: WrittenPutString,
putInsertfile: WrittenPutInsertfile,
putComment: WrittenPutComment,
putAnnotation: WrittenPutAnnotation
]];
WrittenPutOp:
PROC[writer: Writer, op: Op] = {
stream: STREAM ~ writer.stream;
rope: ROPE ~ encode[op];
IF rope=NIL THEN ERROR Error[$illegalArgument, "Illegal argument to PutOp."];
stream.PutRope[rope];
stream.PutChar[' ];
};
WrittenPutInt:
PROC[writer: Writer, value:
INT] = {
stream: STREAM ~ writer.stream;
stream.Put[IO.int[value]];
stream.PutChar[' ];
};
WrittenPutRational:
PROC[writer: Writer, value: Rational] = {
stream: STREAM ~ writer.stream;
stream.Put[IO.int[value.num], IO.char['/], IO.int[value.den]];
stream.PutChar[' ];
};
WrittenPutReal:
PROC[writer: Writer, value:
REAL] = {
stream: STREAM ~ writer.stream;
stream.Put[IO.real[value]];
stream.PutChar[' ];
};
WrittenPutIdentifier:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
ok: BOOL ← FALSE;
len: INT ~ rope.Length[];
IF len=0 THEN ERROR Error[$illegalArgument, "Identifier must have nonzero length."];
FOR i:
INT
IN[0..len)
DO
char: CHAR ~ rope.Fetch[i];
SELECT char
FROM
IN['a..'z] => ok ← TRUE; -- ok if we see at least one lower case character
IN['A..'Z] => NULL;
IN['0..'9], '- => IF i=0 THEN Error[$illegalArgument, "Identifier must begin with a letter."];
ENDCASE => ERROR Error[$illegalArgument, "Identifier contains an illegal character."]
ENDLOOP;
IF ok THEN stream.PutRope[rope]
ELSE FOR i: INT IN[0..len) DO stream.PutChar[Ascii.Lower[rope.Fetch[i]]] ENDLOOP;
stream.PutChar[' ];
};
WrittenPutString:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
stream.PutChar['<];
FOR i:
INT
IN[0..rope.Length)
DO
char: CHAR ~ rope.Fetch[i];
SELECT char
FROM
'>, '#, <40C, >176C => {
stream.PutChar['#];
stream.Put[IO.int[char-0C]];
stream.PutChar['#];
};
ENDCASE => stream.PutChar[char];
ENDLOOP;
stream.PutChar['>];
stream.PutChar[' ];
};
WrittenPutComment:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
stream.PutRope["**"];
stream.PutRope[rope];
stream.PutRope["**"];
stream.PutChar[' ];
};
WrittenPutInsertfile:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
stream.PutRope["++ "];
stream.PutRope[rope];
stream.PutRope[" ++"];
stream.PutChar[' ];
};
WrittenPutAnnotation:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
stream.PutRope["--"];
stream.PutRope[rope];
stream.PutRope["--"];
stream.PutChar[' ];
};
Register[writtenWriter];
END.