
    <<ImagerPostScriptImpl.mesa>>
        <<Copyright Ó 1987 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt, June 22, 1987 3:18:29 pm PDT>>

    DIRECTORY
        Atom USING [GetPName],
        Basics USING [bitsPerWord],
        FS USING [StreamOpen],
        Imager USING [ClassRep, Context, ContextRep, Error, MakeGray],
        ImagerBackdoor USING [Clipper, IntKey, RealKey],
        ImagerBox USING [Rectangle],
    ImagerColor USING [Color, ColorOperator, ColorOperatorClassRep, ConstantColor, NarrowToOpConstantColor, OpConstantColor, 
    SampledBlack, SampledColor, SpecialColor, Structure],
    ImagerColorPrivate USING [ColorOperatorClass, ColorOperatorClassRep, Element, GrayFromColor, SampleEncoding, SGet, SSize],
        ImagerFont USING [Font, Typeface, TypefaceRep, XChar, XStringProc],
        ImagerInterpress USING [],
        ImagerInterpressBackdoor USING [VectorProc],
        ImagerInterpressPrivate USING [Data, DataRep, endPSForm, firstPSForm, Frame, FrameRep, Ref, Rep],
        ImagerPath ,
        ImagerPixelArray USING [MaxSampleValue, PixelArray, Transfer],
        ImagerPrivate USING [Class, ClassRep, DefaultDoIfVisible, DefaultDoWithBuffer, DefaultDrawBitmap, DefaultDrawObject, 
        DefaultDrawPixels, DefaultGetBounds, DefaultGetTransformation, DefaultMaskBitmap, DefaultMoveViewRectangle, 
        DefaultTestViewRectangle, DefaultTransform, DefaultViewClip, DefaultViewClipRectangleI, DefaultViewReset, 
        DefaultViewTranslateI],
        ImagerSample USING [Clear, GetBase, ObtainScratchMap, ReleaseScratchMap, RasterSampleMap, Sample],
        ImagerStroke,
        ImagerTransformation USING [ApplyPreScale, Copy, Equal, Factor, FactoredTransformation, Scale, Transformation],
        ImagerTypeface USING [TypefaceRep],
        IO USING [Close, Error, GetIndex, PutBlock, PutRope, SetLength, STREAM, UnsafePutBlock],
        PSMaster USING [ImagerVariable, PutByte, PutInt, PutIdentifier, PutIntBytes, PutName, PutOp, PutReal, PutRational, PutSequence, 
        PutSequenceText, PutString],
        RefText USING [AppendChar],
        Rope,
        Vector2 USING [VEC];

    ImagerPostScriptImpl: CEDAR PROGRAM
    IMPORTS Atom, FS, Imager, ImagerColor, ImagerColorPrivate, ImagerPath, ImagerPixelArray, ImagerSample, ImagerTransformation, IO, 
    PSMaster, RefText, Rope, ImagerPrivate, ImagerStroke
    EXPORTS Imager, ImagerColor, ImagerFont, ImagerInterpress, ImagerInterpressBackdoor
    ~ BEGIN OPEN PSMaster, ImagerInterpressPrivate;

        ROPE: TYPE ~ Rope.ROPE;
        STREAM: TYPE ~ IO.STREAM;

        VectorProc: TYPE ~ ImagerInterpressBackdoor.VectorProc;
        VEC: TYPE ~ Vector2.VEC;
        Rectangle: TYPE ~ ImagerBox.Rectangle;
        Transformation: TYPE ~ ImagerTransformation.Transformation;
        PathProc: TYPE ~ ImagerPath.PathProc;

        Color: TYPE ~ ImagerColor.Color;
        ConstantColor: TYPE ~ ImagerColor.ConstantColor;
        OpConstantColor: TYPE ~ ImagerColor.OpConstantColor;
        SpecialColor: TYPE ~ ImagerColor.SpecialColor;
        SampledColor: TYPE ~ ImagerColor.SampledColor;
        SampledBlack: TYPE ~ ImagerColor.SampledBlack;
        Typeface: TYPE ~ REF TypefaceRep;
        TypefaceRep: PUBLIC TYPE ~ ImagerTypeface.TypefaceRep;

        Sample: TYPE ~ ImagerSample.Sample;
        PixelArray: TYPE ~ ImagerPixelArray.PixelArray;

        ColorOperator: TYPE ~ ImagerColor.ColorOperator;
        ColorOperatorClassRep: PUBLIC TYPE ~ ImagerColorPrivate.ColorOperatorClassRep;

        Font: TYPE ~ ImagerFont.Font;
        XChar: TYPE ~ ImagerFont.XChar;
        XStringProc: TYPE ~ ImagerFont.XStringProc;

        IntKey: TYPE ~ ImagerBackdoor.IntKey;
        RealKey: TYPE ~ ImagerBackdoor.RealKey;
        Clipper: TYPE ~ ImagerBackdoor.Clipper;

        Context: TYPE ~ Imager.Context;
        Class: TYPE ~ ImagerPrivate.Class;
        ClassRep: PUBLIC TYPE ~ ImagerPrivate.ClassRep; -- export to Imager

        topFrameSize: NAT ~ 50;

        Rep: PUBLIC TYPE ~ ImagerInterpressPrivate.Rep;

        Fetch: PROC [data: Data, ref: REF] RETURNS [found: BOOL, index: INT] ~ {
            frame: Frame ~ data.frame;
            FOR i: NAT DECREASING IN [0..frame.size) DO
                IF frame[i]=ref THEN RETURN[found: TRUE, index: i];
                ENDLOOP;
            RETURN[found: FALSE, index: 0];
            };

        Store: PROC [data: Data, ref: REF] RETURNS [INT] ~ {
            frame: Frame ~ data.frame;
            i: NAT ~ frame.size;
            frame[i] _ ref; frame.size _ i+1;
            RETURN[i];
            };

        DoBody: PROC [data: Data, action: PROC] ~ {
            stream: STREAM ~ data.stream;
            frame: Frame ~ data.frame;
            savedSize: NAT ~ frame.size;
            PutOp[stream, beginBody];
            action[! UNWIND => frame.size _ savedSize];
            PutOp[stream, endBody];
            frame.size _ savedSize;
            };


        Create: PUBLIC PROC [fileName: ROPE, header: ROPE] RETURNS [Ref] ~ {
            stream: STREAM ~ FS.StreamOpen[fileName, $create];
            IF header = NIL THEN header _ "Interpress/Xerox/3.0 ";
            RETURN[CreateFromStream[stream, header]];
            };

        CreateFromStream: PUBLIC PROC [stream: STREAM, header: ROPE] RETURNS [Ref] ~ {
            frame: Frame ~ NEW[FrameRep[topFrameSize]];
            buffer: REF TEXT ~ NEW[TEXT[200]];
            version: NAT ~ IF Rope.Match["*3.0 ", header] THEN 3 ELSE 2;
            data: Data ~ NEW[DataRep _ [stream: stream, frame: frame, buffer: buffer, version: version]];
            context: Context ~ NEW[Imager.ContextRep _ [class: ipClass, data: data]];
            ref: Ref ~ NEW[Rep _ [page: 0, context: context, data: data]];
            frame.size _ 0;
            IO.PutRope[stream, header];
            PutOp[stream, beginBlock]; -- begin master
            PutOp[stream, beginBody]; -- begin preamble
            RETURN[ref];
            };

        DeclareFont: PUBLIC PROC [self: Ref, font: Font] ~ {
            IF self.page=0 THEN [] _ FetchFont[self.data, font];
            };
            <<>>
        DeclareColor: PUBLIC PROC [self: Ref, color: Color] ~ {
            IF self.page=0 THEN [] _ FetchColor[self.data, color];
            };
            <<>>
        DeclareColorOperator: PUBLIC PROC [self: Ref, colorOperator: ColorOperator] ~ {
            data: Data ~ self.data;
            IF self.page=0 AND data.version >= 3 THEN [] _ FetchColorOperator[data, colorOperator];
            };
            <<>>
        DeclarePixelArray: PUBLIC PROC [self: Ref, pixelArray: PixelArray] ~ {
            data: Data ~ self.data;
            IF data.version < 3 AND (pixelArray.samplesPerPixel # 1 OR pixelArray.MaxSampleValue[0] # 1) THEN RETURN;
            IF self.page=0 THEN [] _ FetchPixelArray[data, pixelArray];
            };
            <<>>
        DeclareIdentifier: PUBLIC PROC [self: Ref, identifier: ATOM] ~ {
            IF self.page=0 THEN [] _ FetchIdentifier[self.data, identifier];
            };
            <<>>
        StreamFromRef: PUBLIC PROC [self: Ref] RETURNS [stream: STREAM] ~ {
            data: Data ~ self.data;
            RETURN [data.stream];
            };

        PushInt: PUBLIC PROC [self: Ref, n: INT] ~ {
            data: Data ~ self.data;
            stream: STREAM ~ data.stream;
            PutInt[stream, n];
            };
            <<>>
        PushReal: PUBLIC PROC [self: Ref, r: REAL] ~ {
            data: Data ~ self.data;
            stream: STREAM ~ data.stream;
            PutReal[stream, r];
            };
            <<>>
        PushRational: PUBLIC PROC [self: Ref, numerator, denominator: INT] ~ {
            data: Data ~ self.data;
            stream: STREAM ~ data.stream;
            PutRational[stream, numerator, denominator];
            };
            <<>>
        PushVector: PUBLIC PROC [self: Ref, vectorProc: VectorProc] ~ {
            data: Data ~ self.data;
            stream: STREAM ~ data.stream;
            count: INT _ 0;
            putIdentifier: PROC [identifier: ATOM] ~ {
                found: BOOL; index: INT;
                [found, index] _ Fetch[data, identifier];
                IF NOT found THEN PutIdentifier[stream, Atom.GetPName[identifier]]
                ELSE FGet[stream, index];
                count _ count + 1;
                };
            putString: PROC [rope: Rope.ROPE] ~ {
                PutString[stream, rope];
                count _ count + 1;
                };
            putInt: PROC [int: INT] ~ {
                PutInt[stream, int];
                count _ count + 1;
                };
            putReal: PROC [real: REAL] ~ {
                PutReal[stream, real];
                count _ count + 1;
                };
            putRational: PROC [n, d: INT] ~ {
                PutRational[stream, n, d];
                count _ count + 1;
                };
            putTransformation: PROC [t: Transformation] ~ {
                PutTransformation[stream, t];
                count _ count + 1;
                };
            putVector: PROC [v: PROC] ~ {
                save: INT ~ count;
                count _ 0;
                v[];
                PutInt[stream, count];
                PutOp[stream, makevec];
                count _ save + 1;
                };
            putImageOp: PROC [action: PROC [Imager.Context]] ~ {
                bodyAction: PROC ~ { action[self.context] };
                PutOp[stream, makesimpleco];
                DoBody[data, bodyAction];
                count _ count + 1;
                };
            IF data.pushVectorActive THEN ERROR Imager.Error[[$InvalidOperationSequence, "Cannot call PushVector recursively"]];
            data.pushVectorActive _ TRUE;
            IF self.page#0 THEN ERROR Imager.Error[[$InvalidOperationSequence, "Cannot add to preamble after pages have begun"]];
            vectorProc[putIdentifier, putString, putInt, putReal, putRational, putTransformation, putVector, putImageOp];
            PutInt[stream, count];
            PutOp[stream, makevec];
            data.pushVectorActive _ FALSE;
            };
            <<>>
        PushPixelArray: PUBLIC PROC [self: Ref, pa: PixelArray] ~ {
            data: Data ~ self.data;
            MakePixelArray[data, pa]
            };
            <<>>
        PushColorOperator: PUBLIC PROC [self: Ref, op: ColorOperator] ~ {
            data: Data ~ self.data;
            MakeColorOperator[data, op]
            };
            <<>>
        GetContext: PUBLIC PROC [self: Ref] RETURNS [Imager.Context] = {
            data: Data ~ self.data;
            stream: STREAM ~ data.stream;
            frame: Frame ~ data.frame;
            IF self.page=0 THEN PutOp[stream, endBody]; -- end preamble
            self.page _ self.page+1;
            data.savedSize _ frame.size;
            PutOp[stream, beginBody];
            PutInt[stream, 1]; ISet[stream, priorityImportant]; -- default priorityImportant to TRUE
            RETURN [self.context];
            };

        NewPage: PUBLIC PROC [self: Ref, context: Imager.Context, last: BOOL] ~ {
            data: Data ~ self.data;
            frame: Frame ~ data.frame;
            stream: STREAM ~ data.stream;
            PutOp[stream, endBody];
            frame.size _ data.savedSize;
            IF NOT last THEN {
                self.page _ self.page+1;
                PutOp[stream, beginBody];
                IF data.version >= 3 THEN {
                    PutInt[stream, 1]; ISet[stream, priorityImportant]; -- default priorityImportant to TRUE
                    };
                };
            };

        DoPage: PUBLIC PROC [self: Ref, action: PROC [Imager.Context], scale: REAL _ 1] ~ {
            data: Data ~ self.data;
            stream: STREAM ~ data.stream;
            pageBody: PROC ~ {
                IF data.version >= 3 THEN {
                    PutInt[stream, 1]; ISet[stream, priorityImportant]; -- default priorityImportant to TRUE
                    };
                IF scale#1 THEN {
                    PutReal[stream, scale];
                    PutOp[stream, scale];
                    PutOp[stream, concatt];
                    };
                action[self.context];
                };
            IF self.page=0 THEN PutOp[stream, endBody]; -- end preamble
            self.page _ self.page+1;
            DoBody[data, pageBody];
            };

        Close: PUBLIC PROC [self: Ref] ~ {
            data: Data ~ self.data;
            Finish[self];
            IO.Close[data.stream];
            };

        Finish: PUBLIC PROC [self: Ref] ~ {
            data: Data ~ self.data;
            stream: STREAM ~ data.stream;
            IF self.page=0 THEN PutOp[stream, endBody]; -- end preamble
            PutOp[stream, endBlock]; -- end master
            };

        <<>>
        MakeVec: PROC [stream: STREAM, n: INT] ~ {
            PutInt[stream, n];
            PutOp[stream, array];
            PutOp[stream, astore];
            };

        PutVec: PROC [stream: STREAM, v: VEC] ~ {
            PutReal[stream, v.x]; PutReal[stream, v.y];
            };

        PutVecI: PROC [stream: STREAM, x, y: INTEGER] ~ {
            PutInt[stream, x]; PutInt[stream, y];
            };

        PutTransformation: PROC [stream: STREAM, m: Transformation] ~ {
        PutOp[stream, beginarray];
        PutReal[stream, m.a];
        PutReal[stream, m.d];
        PutReal[stream, m.b];
        PutReal[stream, m.e];
        PutReal[stream, m.c];
        PutReal[stream, m.f];
        PutOp[stream, endarray];
            };

        PutPath: PROC [stream: STREAM, path: PathProc, closed: BOOL _ FALSE] ~ {
            moveTo: PROC [p: VEC] ~ {
                PutVec[stream, p];
                PutOp[stream, moveto];
                };
            lineTo: PROC [p1: VEC] ~ {
                PutVec[stream, p1];
                PutOp[stream, lineto];
                };
            curveTo: PROC [p1, p2, p3: VEC] ~ {
                PutVec[stream, p1];
                PutVec[stream, p2];
                PutVec[stream, p3];
                PutOp[stream, curveto];
                };
            close: PROC ~ {
                IF closed THEN PutOp[stream, closepath];
                };
            ImagerPath.Transform[path: path, 
            moveTo: moveTo, lineTo: lineTo, curveTo: curveTo, close: close];
            };

        RectanglePath: PROC [r: Rectangle, action: PROC [PathProc]] ~ {
            x1: REAL ~ r.x; x2: REAL ~ r.x+r.w;
            y1: REAL ~ r.y; y2: REAL ~ r.y+r.h;
            path: PathProc ~ { moveTo[[x1, y1]]; lineTo[[x2, y1]]; lineTo[[x2, y2]]; lineTo[[x1, y2]] };
            action[path];
            };

        PutSampleEncoding: PROC [stream: STREAM, map: ImagerColorPrivate.SampleEncoding] ~ {
            IF map=NIL THEN PutInt[stream, 0]
            ELSE {
                FOR i: Sample IN[0..map.size) DO PutReal[stream, map[i]] ENDLOOP;
                MakeVec[stream, map.size];
                };
            };


        identity: Transformation ~ ImagerTransformation.Scale[1];

        MakeFont: PROC [data: Data, font: Font] ~ {
            stream: STREAM ~ data.stream;
            typeface: Typeface ~ font.typeface;
            name: ROPE _ typeface.name;
            IF data.version < 3 THEN {
                v: INT _ Rope.Find[name, "xc1-2-2", 0, FALSE]; -- hack to back-convert font names
                subst: ROPE ~ "xc1-1-1";
                IF v >= 0 THEN name _ Rope.Replace[base: name, start: v, len: Rope.Size[subst], with: subst];
                };
            PutName[stream, name];
            PutOp[stream, findfont];
            IF typeface.alternateMetrics # NIL AND data.version >= 3 THEN {
                IF Rope.Find[s1: typeface.alternateMetrics, s2: "/"] >= 0
                    THEN { PutName[stream, typeface.alternateMetrics] }
                    ELSE { PutIdentifier[stream, typeface.alternateMetrics] };
                PutOp[stream, alternatemetrics];
                };
            IF NOT font.charToClient.Equal[identity] THEN {
                PutTransformation[stream, font.charToClient];
                PutOp[stream, modifyfont];
                };
            };

        MakePixelArray: PROC [data: Data, pa: PixelArray] ~ {
            stream: STREAM ~ data.stream;
            samplesPerPixel: NAT ~ pa.samplesPerPixel;
            sSize: NAT ~ pa.sSize;
            fSize: NAT ~ pa.fSize;
            maxSample: Sample _ 0;
            bitsPerSample: NAT _ 0;
            PutInt[stream, sSize]; -- xPixels
            PutInt[stream, fSize]; -- yPixels
            PutInt[stream, samplesPerPixel]; -- samplesPerPixel
            IF samplesPerPixel = 1 THEN {
                maxSample _ ImagerPixelArray.MaxSampleValue[pa, 0];
                PutInt[stream, maxSample];
                PutInt[stream, 1]; -- samplesInterleaved; use 1 for compatibility with older interpress versions
                }
            ELSE {
                FOR i: NAT IN[0..samplesPerPixel) DO
                    m: Sample ~ ImagerPixelArray.MaxSampleValue[pa, i];
                    PutInt[stream, m];
                    maxSample _ MAX[maxSample, m];
                    ENDLOOP;
                MakeVec[stream, samplesPerPixel]; -- maxSampleValue
                PutInt[stream, 0]; -- samplesInterleaved
                };
            PutTransformation[stream, pa.m]; -- m
            bitsPerSample _ SELECT maxSample FROM
                1 => 1,
                IN[2..255] => 8,
                IN[256..LAST[CARDINAL]] => 16,
                ENDCASE => ERROR; -- can't handle it yet
            IF bitsPerSample=1 AND samplesPerPixel = 1
                THEN TRUSTED {
                    bigWordsPerLine: INT ~ (INT[fSize]+31)/32;
                    paddedBitsPerLine: INT ~ bigWordsPerLine*32;
                    wordsPerLine: INT ~ paddedBitsPerLine/Basics.bitsPerWord;
                    bytesPerLine: INT ~ paddedBitsPerLine/8;
                    dataByteCount: INT ~ bytesPerLine*sSize;
                    lineBuffer: ImagerSample.RasterSampleMap ~ ImagerSample.ObtainScratchMap[box: [max: [s: 1, f: paddedBitsPerLine]], bitsPerSample: 
                    1];
                    ImagerSample.Clear[lineBuffer];
                    PutSequence[stream, $sequencePackedPixelVector, 4+dataByteCount];
                    PutIntBytes[stream, 1, 2]; -- 1 bit per sample
                    PutIntBytes[stream, fSize, 2]; -- number of pixels per scan line, excluding padding
                    IO.SetLength[stream, IO.GetIndex[stream]+dataByteCount ! IO.Error => CONTINUE]; -- pre-allocate a portion of the file
                    FOR s: NAT IN[0..sSize) DO
                        ImagerPixelArray.Transfer[pa: pa, i: 0, s: s, f: 0, dst: lineBuffer, size: [1, fSize]];
                        TRUSTED {
                            rawBase: LONG POINTER ~ ImagerSample.GetBase[lineBuffer].word;
                            IO.UnsafePutBlock[stream, [base: rawBase, startIndex: 0, count: bytesPerLine]];
                            };
                        ENDLOOP;
                    ImagerSample.ReleaseScratchMap[lineBuffer];
                    }
                ELSE {
                    bytesPerSample: NAT ~ (bitsPerSample+7)/8;
                    paddedBitsPerSample: NAT ~ bytesPerSample*8;
                    bytesPerLine: INT ~ INT[bytesPerSample]*fSize;
                    lineBuffer: ImagerSample.RasterSampleMap ~ ImagerSample.ObtainScratchMap[box: [max: [s: 1, f: fSize]], bitsPerSample: 
                    paddedBitsPerSample];
                    dataByteCount: INT ~ INT[samplesPerPixel]*INT[sSize]*INT[fSize]*bytesPerSample;
                    ImagerSample.Clear[lineBuffer];
                    IO.SetLength[stream, IO.GetIndex[stream]+dataByteCount ! IO.Error => CONTINUE]; -- pre-allocate a portion of the file
                    PutSequence[stream, $sequenceLargeVector, 1+dataByteCount];
                    PutByte[stream, bytesPerSample];
                    FOR i: NAT IN [0..samplesPerPixel) DO
                        FOR s: NAT IN [0..sSize) DO
                            ImagerPixelArray.Transfer[pa: pa, i: i, s: s, f: 0, dst: lineBuffer, size: [1, fSize]];
                            TRUSTED {
                                rawBase: LONG POINTER ~ ImagerSample.GetBase[lineBuffer].word;
                                IO.UnsafePutBlock[stream, [base: rawBase, startIndex: 0, count: bytesPerLine]];
                                };
                            ENDLOOP;
                        ENDLOOP;
                    };
            PutOp[stream, makepixelarray];
            };

        gray: OpConstantColor ~ NARROW[Imager.MakeGray[0.5]];

        MakeColor: PROC [data: Data, color: Color] ~ {
            stream: STREAM ~ data.stream;
            WITH color SELECT FROM
                c: OpConstantColor => {
                    IF data.version < 3 OR c.colorOperator = gray.colorOperator
                        THEN {
                            PutReal[stream, ImagerColorPrivate.GrayFromColor[c]];
                            PutOp[stream, makegray];
                            }
                        ELSE {
                            FOR i: NAT IN [0..c.size) DO PutInt[stream, c[i]] ENDLOOP;
                            MakeVec[stream, c.size];
                            FGet[stream, FetchColorOperator[data, c.colorOperator]];
                            PutOp[stream, do];
                            };
                    };
                color: SampledColor => {
                    FGet[stream, FetchPixelArray[data, color.pa]];
                    PutTransformation[stream, color.um];
                    FGet[stream, FetchColorOperator[data, color.colorOperator]];
                    PutOp[stream, makesampledcolor];
                    };
                color: SampledBlack => {
                    FGet[stream, FetchPixelArray[data, color.pa]];
                    PutTransformation[stream, color.um];
                    PutInt[stream, IF color.clear THEN 1 ELSE 0];
                    PutOp[stream, makesampledblack];
                    };
                color: SpecialColor => {
                    IF color.name # NIL
                        THEN {
                            PutName[stream, color.name];
                            PutOp[stream, findcolor];
                            }
                        ELSE MakeColor[data, ImagerColor.NarrowToOpConstantColor[color]];
                    };
                ENDCASE => ERROR;
            };

        MakeStructure: PROC [data: Data, structure: ImagerColor.Structure] ~ TRUSTED {
            stream: STREAM ~ data.stream;
            size: INT ~ ImagerColorPrivate.SSize[structure];
            FOR i: INT IN [0..size) DO
                element: ImagerColorPrivate.Element ~ ImagerColorPrivate.SGet[structure, i];
                WITH e: element SELECT FROM
                    int => PutInt[stream, e.int];
                    real => PutReal[stream, e.real];
                    structure => MakeStructure[data, e.structure];
                    color => MakeColor[data, e.color];
                    colorOperator => FGet[stream, FetchColorOperator[data, e.colorOperator]];
                    ENDCASE => ERROR;
                ENDLOOP;
            MakeVec[stream, size];
            };

        MakeColorOperator: PROC [data: Data, colorOperator: ColorOperator] ~ {
            stream: STREAM ~ data.stream;
            colorOperatorClass: ImagerColorPrivate.ColorOperatorClass ~ colorOperator.class;
            structure: ImagerColor.Structure ~ colorOperatorClass.GetCreateData[colorOperator];
            MakeStructure[data, structure];
            PutName[stream, colorOperatorClass.name];
            PutOp[stream, findcolormodeloperator];
            PutOp[stream, do];
            IF colorOperator.renderingHints # NIL THEN {
                MakeStructure[data, colorOperator.renderingHints];
                MakeVec[stream, 2];
                PutName[stream, "Xerox/Research/AddRenderingHints"];
                PutOp[stream, findcolormodeloperator];
                PutOp[stream, do];
                };
            };


        FetchFont: PROC [data: Data, font: Font] RETURNS [INT] ~ {
            found: BOOL; index: INT;
            [found, index] _ Fetch[data, font];
            IF NOT found THEN {
                MakeFont[data, font];
                FSet[data.stream, index _ Store[data, font]];
                };
            RETURN[index];
            };

        FetchIdentifier: PROC [data: Data, identifier: ATOM] RETURNS [INT] ~ {
            found: BOOL; index: INT;
            [found, index] _ Fetch[data, identifier];
            IF NOT found THEN {
                PutIdentifier[data.stream, Atom.GetPName[identifier]];
                FSet[data.stream, index _ Store[data, identifier]];
                };
            RETURN[index];
            };

        FetchColor: PROC [data: Data, color: Color] RETURNS [INT] ~ {
            found: BOOL; index: INT;
            [found, index] _ Fetch[data, color];
            IF NOT found THEN {
                MakeColor[data, color];
                FSet[data.stream, index _ Store[data, color]];
                };
            RETURN[index];
            };

        FetchPixelArray: PROC [data: Data, pixelArray: PixelArray] RETURNS [INT] ~ {
            found: BOOL; index: INT;
            [found, index] _ Fetch[data, pixelArray];
            IF NOT found THEN {
                MakePixelArray[data, pixelArray];
                FSet[data.stream, index _ Store[data, pixelArray]];
                };
            RETURN[index];
            };

        FetchColorOperator: PROC [data: Data, colorOperator: ColorOperator] RETURNS [INT] ~ {
            found: BOOL; index: INT;
            [found, index] _ Fetch[data, colorOperator];
            IF NOT found THEN {
                MakeColorOperator[data, colorOperator];
                FSet[data.stream, index _ Store[data, colorOperator]];
                };
            RETURN[index];
            };


        PSDoSave: PROC [context: Context, action: PROC, all: BOOL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;

            IF all AND data.version >= 3 THEN {
                PutOp[stream, makesimpleco];
                DoBody[data, action];
                PutOp[stream, dosaveall];
                }
            ELSE {
                PutOp[stream, dosavesimplebody];
                DoBody[data, action];
                };
            };

        PSSetInt: PROC [context: Context, key: IntKey, val: INT] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            SELECT key FROM
                strokeEnd => {
                    PutInt[stream, SELECT val FROM
                        ORD[Imager.StrokeEnd[butt]] => 0,
                        ORD[Imager.StrokeEnd[round]] => 1,
                        ORD[Imager.StrokeEnd[square]] => 2,
                        ENDCASE => val];
                    PutOp[stream, setlinecap];
                    };
                strokeJoint => {
                    PutInt[stream, SELECT val FROM
                        ORD[Imager.StrokeEnd[miter]] => 0,
                        ORD[Imager.StrokeEnd[round]] => 1,
                        ORD[Imager.StrokeEnd[bevel]] => 2,
                        ENDCASE => val];
                    PutOp[stream, setlinejoin];
                    };
                <<priorityImportant => { PutInt[stream, val]; ISet[stream, priorityImportant] };>>
                <<noImage => { PutInt[stream, val]; ISet[stream, noImage] };>>
                ENDCASE => ERROR Imager.Error[[$unimplemented, "Unimplemented key for SetInt"]];
            };

        PSSetReal: PROC [context: Context, key: RealKey, val: REAL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            SELECT key FROM
                strokeWidth => { PutReal[stream, val]; PutPrimitive[stream, setlinewidth] };
                amplifySpace => { data.amplifySpace _ val };
                <<underlineStart => { PutReal[stream, val]; ISet[stream, underlineStart] };>>
                <<correctShrink => { PutReal[stream, val]; ISet[stream, correctShrink] };>>
                ENDCASE => ERROR Imager.Error[[$unimplemented, "Unimplemented key for SetReal"]];
            };

        PSSetFont: PROC [context: Context, font: Font] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            IF font # NIL THEN {
                PutInt[stream, FetchFont[data, font]];
                PutOp[stream, setfont];
                };
            };

        TryFetchSetColor: PROC [data: Data, color: Color] RETURNS [BOOL] ~ {
            found: BOOL; index: INT;
            [found, index] _ Fetch[data, color];
            IF found THEN {FGet[data.stream, index]; ISet[data.stream, color]};
            RETURN [found]
            };

        PSSetColor: PROC [context: Context, color: Color] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            IF TryFetchSetColor[data, color] THEN RETURN;
            WITH color SELECT FROM
                color: OpConstantColor => {
                    WITH color SELECT FROM
                        c: OpConstantColor => {
                            IF c.colorOperator = gray.colorOperator THEN {
                                PutReal[stream, ImagerColorPrivate.GrayFromColor[c]];
                                PutOp[stream, setgray];
                                RETURN;
                                };
                            MakeColor[data, color];
                            ISet[stream, color];
                            RETURN;
                            };
                        ENDCASE => NULL;
                    };
                color: SampledColor => {
                    IF data.getTDone AND color.um.form = data.getTForm THEN {
                        um: Transformation _ ImagerTransformation.Copy[color.um];
                        um.form _ 0;
                        ImagerTransformation.ApplyPreScale[um, 1];
                        PSSetSampledColor[context, color.pa, um, color.colorOperator];
                        RETURN;
                        };
                    };
                color: SampledBlack => {
                    IF data.getTDone AND color.um.form = data.getTForm THEN {
                        um: Transformation _ ImagerTransformation.Copy[color.um];
                        um.form _ 0;
                        ImagerTransformation.ApplyPreScale[um, 1];
                        PSSetSampledBlack[context, color.pa, um, color.clear];
                        RETURN;
                        };
                    };
                ENDCASE;
            FGet[stream, FetchColor[data, color]];
            ISet[stream, color];
            };

        PSSetT: PROC [context: Context, m: Transformation] ~ {
            ERROR Imager.Error[[$unimplemented, "SetT not implemented"]];
            };

        PSSetClipper: PROC [context: Context, clipper: Clipper] ~ {
            ERROR Imager.Error[[$unimplemented, "SetClipper not implemented"]];
            };

        PSGetInt: PROC [context: Context, key: IntKey] RETURNS[INT] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            };

        PSGetReal: PROC [context: Context, key: RealKey] RETURNS[REAL] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            };

        PSGetT: PROC [context: Context] RETURNS[Transformation] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            <<m: Transformation _ ImagerTransformation.Scale[1.0];>>
            <<data: Data ~ NARROW[context.data];>>
            <<IF NOT data.getTDone THEN {>>
                <<data.getTDone _ TRUE;>>
                <<IF (data.getTForm _ data.getTForm + 1) = endPSForm THEN data.getTForm _ firstPSForm;>>
                <<};>>
            <<m.form _ data.getTForm;>>
            <<RETURN [m];>>
            };

        PSGetClipper: PROC [context: Context] RETURNS[Clipper] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            };

        PSGetFont: PROC [context: Context] RETURNS[Font] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            };

        PSGetColor: PROC [context: Context] RETURNS[Color] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            };

        PSConcatT: PROC [context: Context, m: Transformation] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutTransformation[stream, m];
            PutOp[stream, concat];
            };

        PSScale2T: PROC [context: Context, s: VEC] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutVec[stream, s];
            PutOp[stream, scale];
            };

        PSRotateT: PROC [context: Context, a: REAL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutReal[stream, a];
            PutOp[stream, rotate];
            };

        PSTranslateT: PROC [context: Context, t: VEC] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutVec[stream, t];
            PutOp[stream, translate];
            };

        PSMove: PROC [context: Context, rounded: BOOL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            <<***** fix this *****>>
            PutOp[stream, getcurrentpoint];
            PutOp[stream, translate];
            };

        PSSetXY: PROC [context: Context, p: VEC] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutVec[stream, p];
            PutOp[stream, moveto];
            };

        PSSetXYRel: PROC [context: Context, v: VEC] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutVec[stream, p];
            PutOp[stream, rmoveto];
            };

        PutXString: PROC [context: Context, string: XStringProc] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            text: REF TEXT _ data.buffer;
            set: BYTE _ 0;
            action: PROC [char: XChar] ~ {
                IF char.set#set THEN {
                    text _ RefText.AppendChar[to: text, from: VAL[255]];
                    text _ RefText.AppendChar[to: text, from: VAL[set _ char.set]];
                    };
                text _ RefText.AppendChar[to: text, from: VAL[char.code]];
                };
            text.length _ 0;
            string[action];
            PutSequence[stream, $sequenceString, text.length];
            IO.PutBlock[self: stream, block: text, startIndex: 0, count: text.length];
            };

        PSShow: PROC [context: Context, string: XStringProc, xrel: BOOL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            IF xrel THEN ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            IF data.amplifySpace=1.0 THEN {
                PutXString[context, string];
                PutOp[stream, show];
                }
            ELSE {
                <<***** fix this *****>>
                ERROR Imager.Error[[$unimplemented, "Not implemented"]];
                };
            };

        PSShowBackward: PROC [context: Context, string: XStringProc] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            <<***** fix this *****>>
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            };

        PSShowAndFixedXRel: PROC [context: Context, string: XStringProc, x: REAL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutVec[stream, [x, 0]];
            PutXString[context, string];
            PutOp[stream, ashow];
            };

        PSShowText: PROC [context: Context, text: REF READONLY TEXT, start, len: NAT, xrel: BOOL] ~ {
            string: XStringProc ~ { ImagerFont.MapText[text, start, len, charAction] };
            PSShow[context, string, xrel];
            };

        PSStartUnderline: PROC [context: Context] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<PutOp[stream, startunderline];>>
            };

        PSMaskUnderline: PROC [context: Context, dy, h: REAL] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<PutReal[stream, dy];>>
            <<PutReal[stream, h];>>
            <<PutOp[stream, maskunderline];>>
            };

        PSCorrectMask: PROC [context: Context] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<PutOp[stream, correctmask];>>
            };

        PSCorrectSpace: PROC [context: Context, v: VEC] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<PutVec[stream, v];>>
            <<PutOp[stream, correctspace];>>
            };

        PSSpace: PROC [context: Context, x: REAL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutVec[stream, [x, 0]];
            PutOp[stream, rmoveto];
            };

        PSSetCorrectMeasure: PROC [context: Context, v: VEC] ~ {
            <<***** fix this *****>>
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<PutVec[stream, v];>>
            <<PutOp[stream, setcorrectmeasure];>>
            };

        PSSetCorrectTolerance: PROC [context: Context, v: VEC] ~ {
            <<***** fix this *****>>
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<PutVec[stream, v];>>
            <<PutOp[stream, setcorrecttolerance];>>
            };

        PSCorrect: PROC [context: Context, action: PROC] ~ {
            <<***** fix this *****>>
            action[];
            <<data: Data ~ NARROW[context.data];>>
            <<PutOp[data.stream, correct];>>
            <<DoBody[data, action];>>
            };

        PSDontCorrect: PROC [context: Context, action: PROC, saveCP: BOOL] ~ {
            ERROR Imager.Error[[$unimplemented, "Not implemented"]];
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<IGet[stream, correctPass];>>
            <<PutInt[stream, 0]; ISet[stream, correctPass];>>
            <<IF saveCP THEN { IGet[stream, DCScpx]; IGet[stream, DCScpy] };>>
            <<PutInt[stream, 0]; PutOp[stream, mark];>>
            <<action[];>>
            <<PutOp[stream, unmark0];>>
            <<IF saveCP THEN { ISet[stream, DCScpy]; ISet[stream, DCScpx] };>>
            <<ISet[stream, correctPass];>>
            };

        PSSetGray: PROC [context: Context, f: REAL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutReal[stream, 1-f];
            PutOp[stream, setgray];
            };

        PSSetSampledColor: PROC [context: Context, 
        pa: PixelArray, m: Transformation, colorOperator: ColorOperator] ~ {
            <<***** fix this *****>>
            SetGray[context, 0.5];
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<IF data.version < 3 THEN { PSSetGray[context, 0.5]; RETURN };>>
            <<FGet[stream, FetchPixelArray[data, pa]]; -- pa>>
            <<PutTransformation[stream, m];>>
            <<FGet[stream, FetchColorOperator[data, colorOperator]]; -- colorOperator>>
            <<PutOp[stream, setsampledcolor];>>
            };

        PSSetSampledBlack: PROC [context: Context, 
        pa: PixelArray, m: Transformation, clear: BOOL] ~ {
            <<***** fix this *****>>
            SetGray[context, 0.5];
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<FGet[stream, FetchPixelArray[data, pa]]; -- pa>>
            <<PutTransformation[stream, m];>>
            <<IF data.version < 3>>
                <<THEN {>>
                    <<IGet[stream, T];>>
                    <<PutOp[stream, concat];>>
                    <<PutInt[stream, IF clear THEN 1 ELSE 0]; -- clear>>
                    <<PutOp[stream, makesampledblack];>>
                    <<ISet[stream, color];>>
                    <<}>>
                <<ELSE {>>
                    <<PutInt[stream, IF clear THEN 1 ELSE 0]; -- clear>>
                    <<PutOp[stream, setsampledblack];>>
                    <<};>>
            };

        PSMaskFill: PROC [context: Context, path: PathProc, oddWrap: BOOL _ FALSE] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutPath[stream, path];
            PutOp[stream, IF oddWrap THEN eofill ELSE fill];
            };

        PSMaskRectangle: PROC [context: Context, r: Rectangle] ~ {
            action: PROC [path: PathProc] ~ { PSMaskFill[context, path] };
            RectanglePath[r, action];
            };

        PSMaskRectangleI: PROC [context: Context, x, y, w, h: INTEGER] ~ {
            action: PROC [path: PathProc] ~ { PSMaskFill[context, path] };
            RectanglePath[[x: x, y: y, w w, h: h], action];
            };

        PSMaskStroke: PROC [context: Context, path: PathProc, closed: BOOL _ FALSE] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            PutPath[stream, path, closed];
            PutOp[stream, stroke];
            };

        PSMaskVector: PROC [context: Context, p1, p2: VEC] ~ {
            path: PathProc ~ { moveTo[p1]; lineTo[p2] };
        PSMaskStroke[context, path];
            };

        PSMaskDashedStroke: PROC [context: Context, path: PathProc, 
        patternLen: NAT, pattern: PROC [NAT] RETURNS [REAL], offset, length: REAL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            action: PROC ~ {
                PutOp[stream, beginarray];
                FOR i: NAT IN[0..patternLen) DO PutReal[stream, pattern[i]] ENDLOOP;
                PutOp[stream, endarray];
                PutReal[stream, offset];
                <<***** fix this: length is ignored *****>>
                PutOp[stream, setdash];
                PutPath[stream, path];
                PutOp[stream, stroke];
                };
            DoGSave[data, action];
            };

        PSMaskPixel: PROC [context: Context, pa: PixelArray] ~ {
            <<***** fix this *****>>
            Imager.Error[[$unimplemented, "MaskPixel not implemented"]];
            <<data: Data ~ NARROW[context.data];>>
            <<stream: STREAM ~ data.stream;>>
            <<MakePixelArray[data, pa];>>
            <<PutOp[stream, maskpixel];>>
            };

        PSClip: PROC [context: Context, path: PathProc, oddWrap: BOOL, exclude: BOOL] ~ {
            data: Data ~ NARROW[context.data];
            stream: STREAM ~ data.stream;
            IF exclude THEN ERROR Imager.Error[[$unimplemented, "Excluding clip not implemented."]];
            PutPath[stream, path];
            PutOp[stream, IF oddWrap THEN eoclip ELSE clip];
            };

        PSClipRectangle: PROC [context: Context, r: Rectangle, exclude: BOOL] ~ {
            action: PROC [path: PathProc] ~ { PSClip[context, path, FALSE, exclude] };
            RectanglePath[r, action];
            };

        PSClipRectangleI: PROC [context: Context, x, y, w, h: INTEGER, exclude: BOOL] ~ {
            action: PROC [path: PathProc] ~ { PSClip[context, path, FALSE, exclude] };
            RectanglePath[[x: x, y: y, w w, h: h], action];
            };

        PSGetCP: PROC [context: Context, rounded: BOOL] RETURNS [VEC] ~ {
            Imager.Error[[$unimplemented, "GetCP not implemented"]];
            };

        PSGetBoundingRectangle: PROC [context: Context] RETURNS [Rectangle] ~ {
            Imager.Error[[$unimplemented, "GetBoundingRectangle not implemented"]];
            };

        ipClass: Class ~ NEW[ClassRep _ [
            type: $Interpress,
            DoSave: PSDoSave,
            SetInt: PSSetInt,
            SetReal: PSSetReal,
            SetT: PSSetT,
            SetFont: PSSetFont,
            SetColor: PSSetColor,
            SetClipper: PSSetClipper,
            GetInt: PSGetInt,
            GetReal: PSGetReal,
            GetT: PSGetT,
            GetFont: PSGetFont,
            GetColor: PSGetColor,
            GetClipper: PSGetClipper,
            ConcatT: PSConcatT,
            Scale2T: PSScale2T,
            RotateT: PSRotateT,
            TranslateT: PSTranslateT,
            Move: PSMove,
            SetXY: PSSetXY,
            SetXYRel: PSSetXYRel,
            GetCP: PSGetCP,
            StartUnderline: PSStartUnderline,
            MaskUnderline: PSMaskUnderline,
            CorrectMask: PSCorrectMask,
            CorrectSpace: PSCorrectSpace,
            Space: PSSpace,
            SetCorrectMeasure: PSSetCorrectMeasure,
            SetCorrectTolerance: PSSetCorrectTolerance,
            Correct: PSCorrect,
            DontCorrect: PSDontCorrect,
            SetGray: PSSetGray,
            SetSampledColor: PSSetSampledColor,
            SetSampledBlack: PSSetSampledBlack,
            Clip: PSClip,
            ClipRectangle: PSClipRectangle,
            ClipRectangleI: PSClipRectangleI,
            Show: PSShow,
            ShowBackward: PSShowBackward,
            MaskFill: PSMaskFill,
            MaskRectangle: PSMaskRectangle,
            MaskStroke: PSMaskStroke,
            MaskPixel: PSMaskPixel,
            ShowAndFixedXRel: PSShowAndFixedXRel,
            ShowText: PSShowText,
            MaskRectangleI: PSMaskRectangleI,
            MaskVector: PSMaskVector,
            MaskDashedStroke: PSMaskDashedStroke,
            MaskBitmap: ImagerPrivate.DefaultMaskBitmap,
            DrawBitmap: ImagerPrivate.DefaultDrawBitmap,
            DrawPixels: ImagerPrivate.DefaultDrawPixels,
            DoIfVisible: ImagerPrivate.DefaultDoIfVisible,
            DoWithBuffer: ImagerPrivate.DefaultDoWithBuffer,
            DrawObject: ImagerPrivate.DefaultDrawObject,
            GetBounds: ImagerPrivate.DefaultGetBounds,
            ViewReset: ImagerPrivate.DefaultViewReset,
            ViewTranslateI: ImagerPrivate.DefaultViewTranslateI,
            ViewClip: ImagerPrivate.DefaultViewClip,
            ViewClipRectangleI: ImagerPrivate.DefaultViewClipRectangleI,
            GetTransformation: ImagerPrivate.DefaultGetTransformation,
            Transform: ImagerPrivate.DefaultTransform,
            MoveViewRectangle: ImagerPrivate.DefaultMoveViewRectangle,
            TestViewRectangle: ImagerPrivate.DefaultTestViewRectangle
            ]];


    END.