
    <<ImagerInterpressPreambleImpl.mesa>>
        <<Copyright © 1984, 1985 by Xerox Corporation.  All rights reserved.>>
        <<Michael Plass, June 16, 1986 1:53:16 pm PDT>>
        <<Tim Diebert: October 9, 1985 9:44:55 am PDT>>
        <<Doug Wyatt, November 21, 1985 3:14:29 pm PST>>
        <<Rick Beach, June 17, 1986 4:37:46 pm PDT>>

    DIRECTORY
        Atom,
        Basics,
        FS USING [StreamOpen],
        Imager,
        ImagerBackdoor USING [Clipper, IntKey, RealKey],
        ImagerColor,
        ImagerColorDefs USING [Color, ColorOperator, ColorOperatorImplRep, ConstantColor, ConstantColorImplRep, PixelArray, SampledColor],
        ImagerColorOperator,
        ImagerColorOperatorPrivate USING [ColorOperatorImpl, ColorOperatorImplRep, SampleMap],
        ImagerColorPrivate USING [ConstantColorImpl, ConstantColorImplRep],
        ImagerFont USING [Font, XChar, XStringProc],
        ImagerInterpressPreamble USING [VectorProc],
        ImagerOps,
        ImagerPath USING [Filter, PathProc],
        ImagerPixelArray USING [GetSamples, MaxSampleValue, PixelArray, UnsafeGetBits],
        ImagerPixelMap,
        ImagerPrivate USING [Class, ClassRep],
        ImagerSample USING [GetPointer, NewBuffer, Sample, SampleBuffer, UnsafePutF, UnsafeSamples],
        ImagerTransformation,
        IO USING [Close, Error, GetIndex, PutBlock, PutRope, SetLength, STREAM, UnsafePutBlock],
        IPMaster USING [ImagerVariable, PutByte, PutIdentifier, PutInt, PutIntBytes, PutName, PutOp, PutReal, PutSequence, PutSequenceText, 
        PutString],
        PrincOpsUtils USING [LongZero],
        Real,
        RefText USING [AppendChar],
        Rope USING [ROPE],
        Vector2 USING [VEC];

    ImagerInterpressPreambleImpl: CEDAR PROGRAM
    IMPORTS Atom, Basics, FS, Imager, ImagerColor, ImagerColorOperator, ImagerOps, ImagerPath, ImagerPixelArray, ImagerPixelMap, 
    ImagerSample, ImagerTransformation, IO, IPMaster, PrincOpsUtils, Real, RefText
    EXPORTS Imager, ImagerColorDefs, ImagerInterpressPreamble
    ~ BEGIN OPEN IPMaster;

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

    BYTE: TYPE ~ Basics.BYTE;
    VEC: TYPE ~ Vector2.VEC;
    Rectangle: TYPE ~ ImagerTransformation.Rectangle;
    Transformation: TYPE ~ ImagerTransformation.Transformation;
    PathProc: TYPE ~ ImagerPath.PathProc;

    Color: TYPE ~ ImagerColorDefs.Color;
    ConstantColor: TYPE ~ ImagerColorDefs.ConstantColor;
    SampledColor: TYPE ~ ImagerColorDefs.SampledColor;
    ConstantColorImpl: TYPE ~ ImagerColorPrivate.ConstantColorImpl;
    ConstantColorImplRep: PUBLIC TYPE ~ ImagerColorPrivate.ConstantColorImplRep;

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

    ColorOperator: TYPE ~ ImagerColorDefs.ColorOperator;
    ColorOperatorImpl: TYPE ~ ImagerColorOperatorPrivate.ColorOperatorImpl;
    ColorOperatorImplRep: PUBLIC TYPE ~ ImagerColorOperatorPrivate.ColorOperatorImplRep;

    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

    firstIPForm: NAT ~ 100;
    endIPForm: NAT ~ 1000;
    Data: TYPE ~ REF DataRep;
    DataRep: TYPE ~ RECORD[
        stream: STREAM,
        frame: Frame _ NIL,
        buffer: REF TEXT _ NIL,
        pushVectorActive: BOOL _ FALSE,
        getTDone: BOOL _ FALSE,
        getTForm: NAT _ firstIPForm,
        savedSize: NAT _ 0
        ];

    Frame: TYPE ~ REF FrameRep;
    FrameRep: TYPE ~ RECORD [size: NAT, entries: SEQUENCE max: NAT OF REF];

    topFrameSize: NAT ~ 50;

    Ref: TYPE ~ REF Rep;
    Rep: PUBLIC TYPE ~ RECORD[
        page: INT _ 0,
        context: Imager.Context _ NIL,
        data: Data _ NIL
        ];


    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] _ [size: 0, entries: ]];
        buffer: REF TEXT ~ NEW[TEXT[200]];
        data: Data ~ NEW[DataRep _ [stream: stream, frame: frame, buffer: buffer]];
        context: Context ~ NEW[Imager.ContextRep _ [class: ipClass, data: data]];
        IO.PutRope[stream, header];
        PutOp[stream, beginBlock]; -- begin master
        PutOp[stream, beginBody]; -- begin preamble
        RETURN[NEW[Rep _ [page: 0, context: context, data: data]]];
        };

    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] ~ {
        IF self.page=0 THEN [] _ FetchColorOperator[self.data, colorOperator];
        };
        <<>>
    DeclarePixelArray: PUBLIC PROC [self: Ref, pixelArray: PixelArray] ~ {
        IF self.page=0 THEN [] _ FetchPixelArray[self.data, pixelArray];
        };
        <<>>
    DeclareIdentifier: PUBLIC PROC [self: Ref, identifier: ATOM] ~ {
        IF self.page=0 THEN [] _ FetchIdentifier[self.data, identifier];
        };
        <<>>
    PushInt: PUBLIC PROC [self: Ref, n: INT] ~ {
        data: Data ~ self.data;
        stream: STREAM ~ data.stream;
        PutInt[stream, n];
        };
        <<>>
    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;
            };
        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, 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 last THEN NULL ELSE {
            self.page _ self.page+1;
            PutOp[stream, beginBody];
            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 ~ {
            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, makevec];
        };

    FGet: PROC [stream: STREAM, index: INT] ~ {
        PutInt[stream, index]; PutOp[stream, fget];
        };

    FSet: PROC [stream: STREAM, index: INT] ~ {
        PutInt[stream, index]; PutOp[stream, fset];
        };

    IGet: PROC [stream: STREAM, v: ImagerVariable] ~ {
        PutInt[stream, ORD[v]]; PutOp[stream, iget];
        };

    ISet: PROC [stream: STREAM, v: ImagerVariable] ~ {
        PutInt[stream, ORD[v]]; PutOp[stream, iset];
        };

    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];
        };

    PutRectangle: PROC [stream: STREAM, r: Rectangle] ~ {
        PutReal[stream, r.x]; PutReal[stream, r.y]; PutReal[stream, r.w]; PutReal[stream, r.h];
        };

    PutRectangleI: PROC [stream: STREAM, x, y, w, h: INTEGER] ~ {
        PutInt[stream, x]; PutInt[stream, y]; PutInt[stream, w]; PutInt[stream, h];
        };

    PutTransformation: PROC [stream: STREAM, m: Transformation] ~ {
        f: ImagerTransformation.FactoredTransformation ~ ImagerTransformation.Factor[m];
        depth: NAT _ 0;
        IF f.r1#0 THEN {
            PutReal[stream, f.r1]; PutOp[stream, rotate];
            depth _ depth+1;
            };
        IF f.s.x#f.s.y THEN {
            PutVec[stream, f.s]; PutOp[stream, scale2];
            depth _ depth+1;
            }
        ELSE IF f.s.x#1 THEN {
            PutReal[stream, f.s.x]; PutOp[stream, scale];
            depth _ depth+1;
            };
        IF f.r2#0 THEN {
            PutReal[stream, f.r2]; PutOp[stream, rotate];
            depth _ depth+1;
            };
        IF f.t.x#0 OR f.t.y#0 THEN {
            PutVec[stream, f.t]; PutOp[stream, translate];
            depth _ depth+1;
            };
        WHILE depth>1 DO PutOp[stream, concat]; depth _ depth-1 ENDLOOP;
        IF depth=0 THEN { PutInt[stream, 1]; PutOp[stream, scale] };
        };

    PutPath: PROC [stream: STREAM, path: PathProc, close: PROC] ~ {
        p0: VEC _ [0, 0];
        moveTo: PROC [p: VEC] ~ {
            PutVec[stream, p];
            PutOp[stream, moveto];
            p0 _ p;
            };
        lineTo: PROC [p1: VEC] ~ {
            IF p1.y=p0.y THEN {
                PutReal[stream, p1.x];
                PutOp[stream, linetox];
                }
            ELSE IF p1.x=p0.x THEN {
                PutReal[stream, p1.y];
                PutOp[stream, linetoy];
                }
            ELSE {
                PutVec[stream, p1];
                PutOp[stream, lineto];
                };
            p0 _ p1;
            };
        curveTo: PROC [p1, p2, p3: VEC] ~ {
            PutVec[stream, p1];
            PutVec[stream, p2];
            PutVec[stream, p3];
            PutOp[stream, curveto];
            p0 _ p3;
            };
        conicTo: PROC [p1, p2: VEC, r: REAL] ~ {
            PutVec[stream, p1];
            PutVec[stream, p2];
            PutReal[stream, r];
            PutOp[stream, conicto];
            p0 _ p2;
            };
        arcTo: PROC [p1, p2: VEC] ~ {
            PutVec[stream, p1];
            PutVec[stream, p2];
            PutOp[stream, arcto];
            p0 _ p2;
            };
        ImagerPath.Filter[path: path, moveTo: moveTo, lineTo: lineTo, 
        curveTo: curveTo, conicTo: conicTo, arcTo: arcTo, close: close];
        };

    PutSampleMap: PROC [stream: STREAM, map: ImagerColorOperatorPrivate.SampleMap] ~ {
        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;
        PutName[stream, font.name];
        PutOp[stream, findfont];
        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;
            rawWords: REF Basics.RawWords ~ NEW[Basics.RawWords[wordsPerLine]];
            rawBase: LONG POINTER ~ @rawWords[0];
            PrincOpsUtils.LongZero[where: rawBase, nwords: wordsPerLine];
            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.UnsafeGetBits[pa: pa, i: 0, s: s, f: 0, dst: [word: rawBase, bit: 0], dstBpl: paddedBitsPerLine, width: fSize, 
                height: 1, srcFunc: null, dstFunc: null];
                IO.UnsafePutBlock[stream, [base: rawBase, startIndex: 0, count: bytesPerLine]];
                ENDLOOP;
            }
        ELSE {
            bytesPerSample: NAT ~ bitsPerSample/8;
            bytesPerLine: INT ~ INT[bytesPerSample]*fSize;
            buffer: ImagerSample.SampleBuffer ~ ImagerSample.NewBuffer[1, fSize];
            block: REF TEXT ~ NEW[TEXT[bytesPerLine]];
            dataByteCount: INT ~ INT[samplesPerPixel]*INT[sSize]*INT[fSize]*bytesPerSample;
            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.GetSamples[pa: pa, i: i, s: s, f: 0, buffer: buffer, count: fSize];
                    TRUSTED {
                        samples: ImagerSample.UnsafeSamples ~ ImagerSample.GetPointer[buffer, 0, 0, fSize];
                        base: LONG POINTER ~ LOOPHOLE[block, LONG POINTER]+SIZE[TEXT[0]];
                        ImagerSample.UnsafePutF[samples: samples, count: fSize, s: 0, f: 0, 
                        base: base, wordsPerLine: 0, bitsPerSample: bitsPerSample];
                        };
                    IO.PutBlock[self: stream, block: block, startIndex: 0, count: bytesPerLine];
                    ENDLOOP;
                ENDLOOP;
            };
        PutOp[stream, makepixelarray];
        };

    MakeColorFromRGB: PROC [stream: STREAM, rgb: ImagerColor.RGB] ~ {
        PutInt[stream, Real.Round[rgb.R*1000]];
        PutInt[stream, Real.Round[rgb.G*1000]];
        PutInt[stream, Real.Round[rgb.B*1000]];
        MakeVec[stream, 3];
        PutReal[stream, 1000];
        MakeVec[stream, 1];
        PutName[stream, "Xerox/Research/RGBLinear"];
        PutOp[stream, findcolormodeloperator];
        PutOp[stream, do];
        PutOp[stream, do];
        };

    MakeColor: PROC [data: Data, color: Color] ~ {
        stream: STREAM ~ data.stream;
        WITH color SELECT FROM
            color: ConstantColor => {
                impl: ConstantColorImpl ~ color.impl;
                WITH impl: impl SELECT FROM
                    rgb => {MakeColorFromRGB[stream, impl.val]};
                    gray => {
                        PutReal[stream, impl.f];
                        PutOp[stream, makegray];
                        };
                    cie => {MakeColorFromRGB[stream, ImagerColor.RGBFromCIE[impl.val]]};
                    ENDCASE => {
                        PutReal[stream, 1-impl.Y]; -- ought to check for other variants
                        PutOp[stream, makegray];
                        };
                };
            color: SampledColor => {
                opClass: ATOM ~ ImagerColorOperator.GetColorOperatorClass[color.colorOperator];
                IF opClass = $SampledBlack OR opClass = $SampledBlackClear THEN {
                    FGet[stream, FetchPixelArray[data, color.pa]];
                    PutTransformation[stream, color.um];
                    PutInt[stream, IF opClass = $SampledBlackClear THEN 1 ELSE 0]; -- clear
                    PutOp[stream, makesampledblack];
                    }
                ELSE {
                    FGet[stream, FetchPixelArray[data, color.pa]];
                    PutTransformation[stream, color.um];
                    FGet[stream, FetchColorOperator[data, color.colorOperator]];
                    PutOp[stream, makesampledcolor];
                    };
                };
            ENDCASE => ERROR;
        };

    MakeColorOperator: PROC [data: Data, colorOperator: ColorOperator] ~ {
        impl: ColorOperatorImpl ~ colorOperator.impl;
        stream: STREAM ~ data.stream;
        WITH impl SELECT FROM
            impl: REF ColorOperatorImplRep.grayLinear => {
                PutReal[stream, impl.sWhite];
                PutReal[stream, impl.sBlack];
                PutSampleMap[stream, impl.map];
                MakeVec[stream, 3];
                PutName[stream, "Xerox/GrayLinear"];
                };
            impl: REF ColorOperatorImplRep.grayDensity => {
                PutReal[stream, impl.sWhite];
                PutReal[stream, impl.sBlack];
                PutReal[stream, impl.dBlack];
                PutSampleMap[stream, impl.map];
                MakeVec[stream, 4];
                PutName[stream, "Xerox/GrayDensity"];
                };
            impl: REF ColorOperatorImplRep.grayVisual => {
                PutReal[stream, impl.sWhite];
                PutReal[stream, impl.sBlack];
                PutSampleMap[stream, impl.map];
                MakeVec[stream, 3];
                PutName[stream, "Xerox/GrayVisual"];
                };
            impl: REF ColorOperatorImplRep.map => {
                FOR i: Sample IN[0..impl.size) DO MakeColor[data, impl[i]] ENDLOOP;
                MakeVec[stream, impl.size];
                PutName[stream, "Xerox/Map"];
                };
            impl: REF ColorOperatorImplRep.rgbLinear => {
                PutReal[stream, impl.maxSampleValue];
                MakeVec[stream, 1];
                PutName[stream, "Xerox/Research/RGBLinear"];
                };
            ENDCASE => ERROR Imager.Error[[code: $unimplemented, 
            explanation: "Color operator has unknown type."]];
        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];
        };


    IPDoSave: PROC [context: Context, action: PROC, all: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        getTDone: BOOL ~ data.getTDone;
        IF all THEN {
            PutOp[stream, makesimpleco];
            DoBody[data, action];
            PutOp[stream, dosaveall];
            }
        ELSE {
            PutOp[stream, dosavesimplebody];
            DoBody[data, action];
            };
        data.getTDone _ FALSE;
        };

    IPSetInt: PROC [context: Context, key: IntKey, val: INT] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        SELECT key FROM
            priorityImportant => { PutInt[stream, val]; ISet[stream, priorityImportant] };
            noImage => { PutInt[stream, val]; ISet[stream, noImage] };
            strokeEnd => { PutInt[stream, val]; ISet[stream, strokeEnd] };
            strokeJoint => { PutInt[stream, val]; ISet[stream, strokeJoint] };
            ENDCASE => ERROR Imager.Error[[$unimplemented, "Unimplemented key for SetInt"]];
        };

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

    IPSetFont: 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];
            };
        };

    IPSetColor: PROC [context: Context, color: Color] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        WITH color SELECT FROM
            color: ConstantColor => {
                impl: ConstantColorImpl ~ color.impl;
                WITH impl: impl SELECT FROM
                    gray => { PutReal[stream, impl.f]; PutOp[stream, setgray]; RETURN };
                    ENDCASE;
                };
            color: SampledColor => {
                IF data.getTDone AND color.um.form = data.getTForm THEN {
                    opClass: ATOM ~ ImagerColorOperator.GetColorOperatorClass[color.colorOperator];
                    um: Transformation _ ImagerTransformation.Copy[color.um];
                    um.form _ 0;
                    ImagerTransformation.ApplyPreScale[um, 1];
                    IF opClass = $SampledBlack OR opClass = $SampledBlackClear THEN
                        IPSetSampledBlack[context, color.pa, um, opClass=$SampledBlackClear]
                    ELSE IPSetSampledColor[context, color.pa, um, color.colorOperator];
                    RETURN;
                    };
                };
            ENDCASE;
        FGet[stream, FetchColor[data, color]];
        ISet[stream, color];
        };

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

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

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

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

    IPGetT: PROC [context: Context] RETURNS[Transformation] ~ {
        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) = endIPForm THEN data.getTForm _ firstIPForm;
            };
        m.form _ data.getTForm;
        RETURN [m];
        };

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

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

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

    IPConcatT: PROC [context: Context, m: Transformation] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutTransformation[stream, m];
        PutOp[stream, concatt];
        data.getTDone _ FALSE;
        };

    IPScale2T: PROC [context: Context, s: VEC] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        IF s.x=s.y THEN { PutReal[stream, s.x]; PutOp[stream, scale] }
        ELSE { PutVec[stream, s]; PutOp[stream, scale2] };
        PutOp[stream, concatt];
        data.getTDone _ FALSE;
        };

    IPRotateT: PROC [context: Context, a: REAL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutReal[stream, a]; PutOp[stream, rotate];
        PutOp[stream, concatt];
        data.getTDone _ FALSE;
        };

    IPTranslateT: PROC [context: Context, t: VEC] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutVec[stream, t]; PutOp[stream, translate];
        PutOp[stream, concatt];
        data.getTDone _ FALSE;
        };

    IPMove: PROC [context: Context, rounded: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutOp[stream, IF rounded THEN trans ELSE move];
        data.getTDone _ FALSE;
        };

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

    IPSetXYRel: PROC [context: Context, v: VEC] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        IF v.y=0 THEN { PutReal[stream, v.x]; PutOp[stream, setxrel] }
        ELSE IF v.x=0 THEN { PutReal[stream, v.y]; PutOp[stream, setyrel] }
        ELSE { PutVec[stream, v]; PutOp[stream, setxyrel] };
        };

    IPShow: PROC [context: Context, string: XStringProc, xrel: BOOL] ~ {
        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];
        PutOp[stream, IF xrel THEN showandxrel ELSE show];
        };

    IPShowText: PROC [context: Context, text: REF READONLY TEXT, start, len: NAT, xrel: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutSequenceText[stream, $sequenceString, text, start, len];
        PutOp[stream, IF xrel THEN showandxrel ELSE show];
        };

    IPStartUnderline: PROC [context: Context] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutOp[stream, startunderline];
        };

    IPMaskUnderline: PROC [context: Context, dy, h: REAL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutReal[stream, dy];
        PutReal[stream, h];
        PutOp[stream, maskunderline];
        };

    IPCorrectMask: PROC [context: Context] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutOp[stream, correctmask];
        };

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

    IPSpace: PROC [context: Context, x: REAL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutReal[stream, x];
        PutOp[stream, space];
        };

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

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

    IPCorrect: PROC [context: Context, action: PROC] ~ {
        data: Data ~ NARROW[context.data];
        PutOp[data.stream, correct];
        DoBody[data, action];
        };

    IPDontCorrect: PROC [context: Context, action: PROC, saveCP: BOOL] ~ {
        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];
        };

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

    IPSetSampledColor: PROC [context: Context, 
    pa: PixelArray, m: Transformation, colorOperator: ColorOperator] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        FGet[stream, FetchPixelArray[data, pa]]; -- pa
        PutTransformation[stream, m];
        PutInt[stream, ORD[ImagerVariable[T]]];
        PutOp[stream, iget];
        PutOp[stream, concat]; -- um = <m 4 IGET CONCAT>
        FGet[stream, FetchColorOperator[data, colorOperator]]; -- colorOperator
        PutOp[stream, makesampledcolor];
        PutInt[stream, ORD[ImagerVariable[color]]];
        PutOp[stream, iset];
        };

    IPSetSampledBlack: PROC [context: Context, 
    pa: PixelArray, m: Transformation, clear: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        FGet[stream, FetchPixelArray[data, pa]]; -- pa
        PutTransformation[stream, m];
        PutInt[stream, ORD[ImagerVariable[T]]];
        PutOp[stream, iget];
        PutOp[stream, concat]; -- um = <m 4 IGET CONCAT>
        PutInt[stream, IF clear THEN 1 ELSE 0]; -- clear
        PutOp[stream, makesampledblack];
        PutInt[stream, ORD[ImagerVariable[color]]];
        PutOp[stream, iset];
        };

    PutOutline: PROC [stream: STREAM, path: PathProc, oddWrap: BOOL] ~ {
        depth: INT _ 0; count: PROC ~ { depth _ depth+1 };
        PutPath[stream, path, count];
        PutInt[stream, depth];
        PutOp[stream, IF oddWrap THEN makeoutlineodd ELSE makeoutline];
        };

    IPMaskFill: PROC [context: Context, path: PathProc, oddWrap: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutOutline[stream, path, oddWrap];
        PutOp[stream, maskfill];
        };

    IPMaskRectangle: PROC [context: Context, r: Rectangle] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutRectangle[stream, r];
        PutOp[stream, maskrectangle];
        };

    IPMaskRectangleI: PROC [context: Context, x, y, w, h: INTEGER] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutRectangleI[stream, x, y, w, h];
        PutOp[stream, maskrectangle];
        };

    IPMaskStroke: PROC [context: Context, path: PathProc, closed: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        stroke: PROC ~ { PutOp[stream, IF closed THEN maskstrokeclosed ELSE maskstroke] };
        PutPath[stream, path, stroke];
        };

    IPMaskVector: PROC [context: Context, p1, p2: VEC] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutVec[stream, p1];
        PutVec[stream, p2];
        PutOp[stream, maskvector];
        };

    IPMaskDashedStroke: PROC [context: Context, path: PathProc, 
    patternLen: NAT, pattern: PROC [NAT] RETURNS [REAL], offset, length: REAL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        dashedStroke: PROC ~ {
            FOR i: NAT IN[0..patternLen) DO PutReal[stream, pattern[i]] ENDLOOP;
            MakeVec[stream, patternLen];
            PutReal[stream, offset];
            PutReal[stream, length];
            PutOp[stream, maskdashedstroke];
            };
        PutPath[stream, path, dashedStroke];
        };

    IPMaskPixel: PROC [context: Context, pa: PixelArray] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        MakePixelArray[data, pa];
        PutOp[stream, maskpixel];
        };

    rMinus90: Transformation ~ ImagerTransformation.Rotate[-90];
    IPMaskBits: PROC [context: Context, base: LONG POINTER, wordsPerLine: NAT, 
    sMin, fMin, sSize, fSize: NAT, tx, ty: INTEGER] ~ TRUSTED {
        data: Data ~ NARROW[context.data];
        pm: ImagerPixelMap.PixelMap _ ImagerPixelMap.CreateFrameBuffer[pointer: base, words: Basics.LongMult[wordsPerLine, sMin+sSize], 
        lgBitsPerPixel: 0, rast: wordsPerLine, lines: sMin+sSize, ref: NIL].Clip[[sMin, fMin, sSize, fSize]].ShiftMap[-sMin, -fMin];
        m: Transformation ~ ImagerTransformation.PostTranslate[rMinus90, [tx, ty]];
        pa: PixelArray ~ ImagerOps.PixelArrayFromPixelMaps[LIST[pm] ,m];
        Imager.MaskPixel[context: context, pa: pa];
        };

    IPClip: PROC [context: Context, path: PathProc, oddWrap: BOOL, exclude: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        depth: INT _ 0; count: PROC ~ { depth _ depth+1 };
        PutPath[stream, path, count];
        PutInt[stream, depth];
        PutOp[stream, IF oddWrap THEN makeoutlineodd ELSE makeoutline];
        IF exclude THEN ERROR Imager.Error[[$unimplemented, "Excluding clip not implemented."]];
        PutOp[stream, clipoutline];
        };

    IPClipRectangle: PROC [context: Context, r: Rectangle, exclude: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutRectangle[stream, r];
        IF exclude THEN ERROR Imager.Error[[$unimplemented, "Excluding clip not implemented."]];
        PutOp[stream, cliprectangle];
        };

    IPClipRectangleI: PROC [context: Context, x, y, w, h: INTEGER, exclude: BOOL] ~ {
        data: Data ~ NARROW[context.data];
        stream: STREAM ~ data.stream;
        PutRectangleI[stream, x, y, w, h];
        IF exclude THEN ERROR Imager.Error[[$unimplemented, "Excluding clip not implemented."]];
        PutOp[stream, cliprectangle];
        };

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

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

    ipClass: Class ~ NEW[ClassRep _ [
        type: $Interpress,
        DoSave: IPDoSave,
        SetInt: IPSetInt,
        SetReal: IPSetReal,
        SetT: IPSetT,
        SetFont: IPSetFont,
        SetColor: IPSetColor,
        SetClipper: IPSetClipper,
        GetInt: IPGetInt,
        GetReal: IPGetReal,
        GetT: IPGetT,
        GetFont: IPGetFont,
        GetColor: IPGetColor,
        GetClipper: IPGetClipper,
        ConcatT: IPConcatT,
        Scale2T: IPScale2T,
        RotateT: IPRotateT,
        TranslateT: IPTranslateT,
        Move: IPMove,
        SetXY: IPSetXY,
        SetXYRel: IPSetXYRel,
        Show: IPShow,
        ShowText: IPShowText,
        StartUnderline: IPStartUnderline,
        MaskUnderline: IPMaskUnderline,
        CorrectMask: IPCorrectMask,
        CorrectSpace: IPCorrectSpace,
        Space: IPSpace,
        SetCorrectMeasure: IPSetCorrectMeasure,
        SetCorrectTolerance: IPSetCorrectTolerance,
        Correct: IPCorrect,
        DontCorrect: IPDontCorrect,
        SetGray: IPSetGray,
        SetSampledColor: IPSetSampledColor,
        SetSampledBlack: IPSetSampledBlack,
        MaskFill: IPMaskFill,
        MaskRectangle: IPMaskRectangle,
        MaskRectangleI: IPMaskRectangleI,
        MaskStroke: IPMaskStroke,
        MaskVector: IPMaskVector,
        MaskDashedStroke: IPMaskDashedStroke,
        MaskPixel: IPMaskPixel,
        MaskBits: IPMaskBits,
        Clip: IPClip,
        ClipRectangle: IPClipRectangle,
        ClipRectangleI: IPClipRectangleI,
        GetCP: IPGetCP,
        GetBoundingRectangle: NIL
        ]];


    END.