<> <> <> DIRECTORY Ascii USING [Lower], IO USING [char, Close, CreateStream, CreateStreamProcs, int, Put, PutChar, PutRope, real, STREAM, StreamProcs], IPBasic USING [Op, Rational, XeroxPixelVectorType], 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 ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; Op: TYPE ~ IPBasic.Op; Rational: TYPE ~ IPBasic.Rational; Writer: TYPE ~ IPWriter.Writer; encode: IPWritten.EncodingTable ~ NEW[IPWritten.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[IPWritten.EncodingTable] ~ { RETURN[encode] }; writtenWriter: IPWriter.Class ~ NEW[IPWriter.ClassRep _ [ encoding: $Written, putOp: WrittenPutOp, putInt: WrittenPutInt, putReal: WrittenPutReal, putRational: WrittenPutRational, putIdentifier: WrittenPutIdentifier, putString: WrittenPutString, putInsertfile: WrittenPutInsertfile, putComment: WrittenPutComment, putAnnotation: WrittenPutAnnotation, putLargeVector: WrittenPutLargeVector ]]; WrittenPutOp: PROC[writer: Writer, op: Op] = { stream: STREAM ~ writer.stream; rope: ROPE ~ encode[op]; IF rope=NIL THEN ERROR IPWriter.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 IPWriter.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 IPWriter.Error[$illegalArgument, "Identifier must begin with a letter."]; ENDCASE => ERROR IPWriter.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[' ]; }; PutHexByte: PROC[stream: STREAM, b: [0..256)] ~ { PutHexDigit: PROC[stream: STREAM, h: [0..16)] ~ INLINE { IO.PutChar[stream, IF h<10 THEN '0+h ELSE 'A+h-10] }; PutHexDigit[stream, b/16]; PutHexDigit[stream, b MOD 16]; }; lvProcs: REF IO.StreamProcs ~ IO.CreateStreamProcs[ variety: $output, class: $InterpressLargeVectorOutputWritten, putChar: LVPutChar, getIndex: LVGetIndex ]; LVData: TYPE ~ REF LVDataRep; LVDataRep: TYPE ~ RECORD[ master: STREAM, -- stream on the master file index: INT, -- current index = number of bytes put bytesPerElement: [0..256) ]; LVPutChar: PROC[self: STREAM, char: CHAR] ~ { data: LVData ~ NARROW[self.streamData]; PutHexByte[data.master, ORD[char]]; data.index _ data.index+1; IF (data.index MOD data.bytesPerElement)=0 THEN IO.PutChar[data.master, ' ]; -- space after each element }; LVGetIndex: PROC[self: STREAM] RETURNS[INT] ~ { data: LVData ~ NARROW[self.streamData]; RETURN[data.index]; }; WrittenPutLargeVector: PROC[writer: Writer, putBytes: PROC[STREAM], bytesPerElement: [0..256), type: IPBasic.XeroxPixelVectorType _ $nil ] ~ { stream: STREAM ~ writer.stream; lvData: LVData ~ NEW[LVDataRep _ [ master: stream, bytesPerElement: bytesPerElement, index: 0]]; lvStream: STREAM ~ IO.CreateStream[streamProcs: lvProcs, streamData: lvData]; IO.PutRope[stream, "( "]; PutHexByte[stream, bytesPerElement]; IO.PutChar[stream, ' ]; putBytes[lvStream]; IO.Close[lvStream]; IF (lvData.index MOD bytesPerElement)=0 THEN NULL ELSE ERROR IPWriter.Error[$illegalArgument, "Large vector length must be a multiple of bytesPerElement."]; IO.PutRope[stream, ") "]; }; IPWriter.Register[writtenWriter]; END.