
    <<PSGraphicsPrimitivesImpl.mesa>>
        <<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt, July 14, 1987 1:11:58 pm PDT>>

    <<PostScript graphics primitives.>>
    <<>>
    DIRECTORY
        PS,
        PSGraphics;

    PSGraphicsPrimitivesImpl: CEDAR PROGRAM
    IMPORTS PS, PSGraphics
    ~ BEGIN OPEN PSGraphics, PS;
<<Graphics state operators>>
    gsave: PROC [self: Root] ~ {
        GSave[self.graphics];
        };

    grestore: PROC [self: Root] ~ {
        GRestore[self.graphics, FALSE];
        };

    grestoreall: PROC [self: Root] ~ {
        GRestore[self.graphics, TRUE];
        };

    initgraphics: PROC [self: Root] ~ {
        InitGraphics[self.graphics];
        };

    setlinewidth: PROC [self: Root] ~ {
        lineWidth: REAL ~ PopReal[self];
        SetLineWidth[self.graphics, lineWidth];
        };

    currentlinewidth: PROC [self: Root] ~ {
        lineWidth: REAL ~ CurrentLineWidth[self.graphics];
        PushReal[self, lineWidth];
        };

    setlinecap: PROC [self: Root] ~ {
        int: INT ~ PopInt[self];
        cap: LineCap ~ SELECT int FROM 0 => butt, 1 => round, 2 => square,
            ENDCASE => ERROR Error[rangecheck];
        SetLineCap[self.graphics, cap];
        };

    currentlinecap: PROC [self: Root] ~ {
        cap: LineCap ~ CurrentLineCap[self.graphics];
        PushInt[self, SELECT cap FROM butt => 0, round => 1, square => 2,
            ENDCASE => ERROR Bug];
        };

    setlinejoin: PROC [self: Root] ~ {
        int: INT ~ PopInt[self];
        join: LineJoin ~ SELECT int FROM 0 => miter, 1 => round, 2 => bevel,
            ENDCASE => ERROR Error[rangecheck];
        SetLineJoin[self.graphics, join];
        };

    currentlinejoin: PROC [self: Root] ~ {
        join: LineJoin ~ CurrentLineJoin[self.graphics];
        PushInt[self, SELECT join FROM miter => 0, round => 1, bevel => 2,
            ENDCASE => ERROR Bug];
        };

    setmiterlimit: PROC [self: Root] ~ {
        miterLimit: REAL ~ PopReal[self];
        SetMiterLimit[self.graphics, miterLimit];
        };

    currentmiterlimit: PROC [self: Root] ~ {
        miterLimit: REAL ~ CurrentMiterLimit[self.graphics];
        PushReal[self, miterLimit];
        };

    setdash: PROC [self: Root] ~ {
        dash: Dash;
        dash.offset _ PopReal[self];
        dash.array _ PopArray[self];
        SetDash[self.graphics, dash];
        };

    currentdash: PROC [self: Root] ~ {
        dash: Dash ~ CurrentDash[self.graphics];
        PushArray[self, dash.array];
        PushReal[self, dash.offset];
        };

    setflat: PROC [self: Root] ~ {
        flatness: REAL ~ PopReal[self];
        SetFlat[self.graphics, flatness];
        };

    currentflat: PROC [self: Root] ~ {
        flatness: REAL ~ CurrentFlat[self.graphics];
        PushReal[self, flatness];
        };

    setgray: PROC [self: Root] ~ {
        gray: REAL ~ PopReal[self];
        SetGray[self.graphics, gray];
        };

    currentgray: PROC [self: Root] ~ {
        gray: REAL ~ CurrentGray[self.graphics];
        PushReal[self, gray];
        };

    sethsbcolor: PROC [self: Root] ~ {
        hsbColor: HSBColor;
        hsbColor.brt _ PopReal[self];
        hsbColor.sat _ PopReal[self];
        hsbColor.hue _ PopReal[self];
        SetHSBColor[self.graphics, hsbColor];
        };

    currenthsbcolor: PROC [self: Root] ~ {
        hsbColor: HSBColor ~ CurrentHSBColor[self.graphics];
        PushReal[self, hsbColor.hue];
        PushReal[self, hsbColor.sat];
        PushReal[self, hsbColor.brt];
        };

    setrgbcolor: PROC [self: Root] ~ {
        rgbColor: RGBColor;
        rgbColor.blue _ PopReal[self];
        rgbColor.green _ PopReal[self];
        rgbColor.red _ PopReal[self];
        SetRGBColor[self.graphics, rgbColor];
        };

    currentrgbcolor: PROC [self: Root] ~ {
        rgbColor: RGBColor ~ CurrentRGBColor[self.graphics];
        PushReal[self, rgbColor.red];
        PushReal[self, rgbColor.green];
        PushReal[self, rgbColor.blue];
        };

    setscreen: PROC [self: Root] ~ {
        screen: Screen;
        screen.proc _ PopProc[self];
        screen.angle _ PopReal[self];
        screen.freq _ PopReal[self];
        SetScreen[self.graphics, screen];
        };

    currentscreen: PROC [self: Root] ~ {
        screen: Screen ~ CurrentScreen[self.graphics];
        PushReal[self, screen.freq];
        PushReal[self, screen.angle];
        PushAny[self, screen.proc];
        };

    settransfer: PROC [self: Root] ~ {
        transfer: Any ~ PopProc[self];
        SetTransfer[self.graphics, transfer];
        };

    currenttransfer: PROC [self: Root] ~ {
        transfer: Any ~ CurrentTransfer[self.graphics];
        PushAny[self, transfer];
        };

<<Coordinate system and matrix operators>>
    matrix: PROC [self: Root] ~ {
        array: Array ~ ArrayCreate[6];
        PushMatrix[self, array, IdentMatrix[]];
        };

    initmatrix: PROC [self: Root] ~ {
        SetMatrix[self.graphics, DefaultMatrix[self.graphics]];
        };

    identmatrix: PROC [self: Root] ~ {
        array: Array ~ PopArray[self];
        PushMatrix[self, array, IdentMatrix[]];
        };

    defaultmatrix: PROC [self: Root] ~ {
        array: Array ~ PopArray[self];
        PushMatrix[self, array, DefaultMatrix[self.graphics]];
        };

    currentmatrix: PROC [self: Root] ~ {
        array: Array ~ PopArray[self];
        PushMatrix[self, array, CurrentMatrix[self.graphics]];
        };

    setmatrix: PROC [self: Root] ~ {
        matrix: Matrix ~ PopMatrix[self];
        SetMatrix[self.graphics, matrix];
        };

    translate: PROC [self: Root] ~ {
        IF TopType[self]=array THEN {
            array: Array ~ PopArray[self];
            t: VEC ~ PopVec[self];
            PushMatrix[self, array, Translate[t]];
            }
        ELSE {
            t: VEC ~ PopVec[self];
            Concat[self.graphics, Translate[t]];
            };
        };

    scale: PROC [self: Root] ~ {
        IF TopType[self]=array THEN {
            array: Array ~ PopArray[self];
            s: VEC ~ PopVec[self];
            PushMatrix[self, array, Scale[s]];
            }
        ELSE {
            s: VEC ~ PopVec[self];
            Concat[self.graphics, Scale[s]];
            };
        };

    rotate: PROC [self: Root] ~ {
        IF TopType[self]=array THEN {
            array: Array ~ PopArray[self];
            angle: REAL ~ PopReal[self];
            PushMatrix[self, array, Rotate[angle]];
            }
        ELSE {
            angle: REAL ~ PopReal[self];
            Concat[self.graphics, Rotate[angle]];
            };
        };

    concat: PROC [self: Root] ~ {
        matrix: Matrix ~ PopMatrix[self];
        Concat[self.graphics, matrix];
        };

    concatmatrix: PROC [self: Root] ~ {
        array3: Array ~ PopArray[self];
        matrix2: Matrix ~ PopMatrix[self];
        matrix1: Matrix ~ PopMatrix[self];
        PushMatrix[self, array3, ConcatMatrix[matrix1, matrix2]];
        };

    transform: PROC [self: Root] ~ {
        matrix: Matrix ~ IF TopType[self]=array
            THEN PopMatrix[self]
            ELSE CurrentMatrix[self.graphics];
        p: VEC ~ PopVec[self];
        PushVec[self, Transform[p, matrix]];
        };

    dtransform: PROC [self: Root] ~ {
        matrix: Matrix ~ IF TopType[self]=array
            THEN PopMatrix[self]
            ELSE CurrentMatrix[self.graphics];
        p: VEC ~ PopVec[self];
        PushVec[self, DTransform[p, matrix]];
        };

    itransform: PROC [self: Root] ~ {
        matrix: Matrix ~ IF TopType[self]=array
            THEN PopMatrix[self]
            ELSE CurrentMatrix[self.graphics];
        p: VEC ~ PopVec[self];
        PushVec[self, ITransform[p, matrix]];
        };

    idtransform: PROC [self: Root] ~ {
        matrix: Matrix ~ IF TopType[self]=array
            THEN PopMatrix[self]
            ELSE CurrentMatrix[self.graphics];
        p: VEC ~ PopVec[self];
        PushVec[self, IDTransform[p, matrix]];
        };

    invertmatrix: PROC [self: Root] ~ {
        array2: Array ~ PopArray[self];
        matrix1: Matrix ~ PopMatrix[self];
        PushMatrix[self, array2, InvertMatrix[matrix1]];
        };

<<Path construction operators>>
    newpath: PROC [self: Root] ~ {
        NewPath[self.graphics];
        };

    currentpoint: PROC [self: Root] ~ {
        PushVec[self, CurrentPoint[self.graphics]];
        };

    moveto: PROC [self: Root] ~ {
        p: VEC ~ PopVec[self];
        MoveTo[self.graphics, p];
        };

    rmoveto: PROC [self: Root] ~ {
        d: VEC ~ PopVec[self];
        RMoveTo[self.graphics, d];
        };

    lineto: PROC [self: Root] ~ {
        p: VEC ~ PopVec[self];
        LineTo[self.graphics, p];
        };

    rlineto: PROC [self: Root] ~ {
        d: VEC ~ PopVec[self];
        RLineTo[self.graphics, d];
        };

    arc: PROC [self: Root] ~ {
        ang2: REAL ~ PopReal[self];
        ang1: REAL ~ PopReal[self];
        r: REAL ~ PopReal[self];
        p: VEC ~ PopVec[self];
        Arc[self.graphics, p, r, ang1, ang2, counterclockwise];
        };

    arcn: PROC [self: Root] ~ {
        ang2: REAL ~ PopReal[self];
        ang1: REAL ~ PopReal[self];
        r: REAL ~ PopReal[self];
        p: VEC ~ PopVec[self];
        Arc[self.graphics, p, r, ang1, ang2, clockwise];
        };

    arcto: PROC [self: Root] ~ {
        r: REAL ~ PopReal[self];
        p2: VEC ~ PopVec[self];
        p1: VEC ~ PopVec[self];
        t1, t2: VEC;
        [t1, t2] _ ArcTo[self.graphics, p1, p2, r];
        PushVec[self, t1];
        PushVec[self, t2];
        };

    curveto: PROC [self: Root] ~ {
        p3: VEC ~ PopVec[self];
        p2: VEC ~ PopVec[self];
        p1: VEC ~ PopVec[self];
        CurveTo[self.graphics, p1, p2, p3];
        };

    rcurveto: PROC [self: Root] ~ {
        d3: VEC ~ PopVec[self];
        d2: VEC ~ PopVec[self];
        d1: VEC ~ PopVec[self];
        RCurveTo[self.graphics, d1, d2, d3];
        };

    closepath: PROC [self: Root] ~ {
        ClosePath[self.graphics];
        };

    flattenpath: PROC [self: Root] ~ {
        FlattenPath[self.graphics];
        };

    reversepath: PROC [self: Root] ~ {
        ReversePath[self.graphics];
        };

    strokepath: PROC [self: Root] ~ {
        StrokePath[self.graphics];
        };

    charpath: PROC [self: Root] ~ {
        bool: BOOL ~ PopBool[self];
        string: String ~ PopString[self];
        CharPath[self.graphics, string, bool];
        };

    clippath: PROC [self: Root] ~ {
        ClipPath[self.graphics];
        };

    pathbbox: PROC [self: Root] ~ {
        box: Box ~ PathBBox[self.graphics];
        PushVec[self, box.ll];
        PushVec[self, box.ur];
        };

    pathforall: PROC [self: Root] ~ {
        close: Any ~ PopProc[self];
        curve: Any ~ PopProc[self];
        line: Any ~ PopProc[self];
        move: Any ~ PopProc[self];
        moveAction: PROC [p: VEC] ~ {
            PushVec[self, p];
            Execute[self, move];
            };
        lineAction: PROC [p: VEC] ~ {
            PushVec[self, p];
            Execute[self, line];
            };
        curveAction: PROC [p1, p2, p3: VEC] ~ {
            PushVec[self, p1];
            PushVec[self, p2];
            PushVec[self, p3];
            Execute[self, curve];
            };
        closeAction: PROC ~ {
            Execute[self, close];
            };
        PathForAll[self.graphics, moveAction, lineAction, curveAction, closeAction
        ! Exit => CONTINUE];
        };

    initclip: PROC [self: Root] ~ {
        InitClip[self.graphics];
        };

    clip: PROC [self: Root] ~ {
        Clip[self.graphics, nz];
        };

    eoclip: PROC [self: Root] ~ {
        Clip[self.graphics, eo];
        };

<<Painting operators>>
    erasepage: PROC [self: Root] ~ {
        ErasePage[self.graphics];
        };

    fill: PROC [self: Root] ~ {
        Fill[self.graphics, nz];
        };

    eofill: PROC [self: Root] ~ {
        Fill[self.graphics, eo];
        };

    stroke: PROC [self: Root] ~ {
        Stroke[self.graphics];
        };

    image: PROC [self: Root] ~ {
        proc: Any ~ PopProc[self];
        matrix: Matrix ~ PopMatrix[self];
        bitsPerSample: INT ~ PopInt[self];
        height: INT ~ PopInt[self];
        width: INT ~ PopInt[self];
        stringProc: PROC RETURNS [String] ~ {
            Execute[self, proc];
            RETURN [PopString[self]];
            };
        Image[self.graphics, width, height, bitsPerSample, matrix, stringProc];
        };

    imagemask: PROC [self: Root] ~ {
        proc: Any ~ PopProc[self];
        matrix: Matrix ~ PopMatrix[self];
        invert: BOOL ~ PopBool[self];
        height: INT ~ PopInt[self];
        width: INT ~ PopInt[self];
        stringProc: PROC RETURNS [String] ~ {
            Execute[self, proc];
            RETURN [PopString[self]];
            };
        ImageMask[self.graphics, width, height, invert, matrix, stringProc];
        };

<<Device setup and output operators>>
    showpage: PROC [self: Root] ~ {
        CopyPage[self.graphics];
        ErasePage[self.graphics];
        };

    copypage: PROC [self: Root] ~ {
        CopyPage[self.graphics];
        };

    framedevice: PROC [self: Root] ~ {
        proc: Any ~ PopProc[self];
        height: INT ~ PopInt[self];
        width: INT ~ PopInt[self];
        matrix: Matrix ~ PopMatrix[self];
        FrameDevice[self.graphics, matrix, width, height, proc];
        };

    nulldevice: PROC [self: Root] ~ {
        NullDevice[self.graphics];
        };

<<Character and font operators>>
    definefont: PROC [self: Root] ~ {
        font: Dict ~ PopDict[self];
        key: Any ~ PopAny[self];
        PushDict[self, DefineFont[self.graphics, key, font]];
        };

    scalefont: PROC [self: Root] ~ {
        scale: REAL ~ PopReal[self];
        font: Dict ~ PopDict[self];
        PushDict[self, MakeFont[font, Scale[[scale, scale]]]];
        };

    makefont: PROC [self: Root] ~ {
        matrix: Matrix ~ PopMatrix[self];
        font: Dict ~ PopDict[self];
        PushDict[self, MakeFont[font, matrix]];
        };

    setfont: PROC [self: Root] ~ {
        font: Dict ~ PopDict[self];
        SetFont[self.graphics, font];
        };

    currentfont: PROC [self: Root] ~ {
        font: Dict ~ CurrentFont[self.graphics];
        PushDict[self, font];
        };

    show: PROC [self: Root] ~ {
        string: String ~ PopString[self];
        Show[self.graphics, string];
        };

    ashow: PROC [self: Root] ~ {
        string: String ~ PopString[self];
        a: VEC ~ PopVec[self];
        AShow[self.graphics, a, string];
        };

    widthshow: PROC [self: Root] ~ {
        string: String ~ PopString[self];
        char: CHAR ~ CharFromInt[PopInt[self]];
        c: VEC ~ PopVec[self];
        WidthShow[self.graphics, c, char, string];
        };

    awidthshow: PROC [self: Root] ~ {
        string: String ~ PopString[self];
        a: VEC ~ PopVec[self];
        char: CHAR ~ CharFromInt[PopInt[self]];
        c: VEC ~ PopVec[self];
        AWidthShow[self.graphics, c, char, a, string];
        };

    kshow: PROC [self: Root] ~ {
        string: String ~ PopString[self];
        proc: Any ~ PopProc[self];
        action: PROC [c1, c2: CHAR] ~ {
            PushInt[self, IntFromChar[c1]];
            PushInt[self, IntFromChar[c2]];
            Execute[self, proc];
            };
        KShow[self.graphics, action, string];
        };

    stringwidth: PROC [self: Root] ~ {
        string: String ~ PopString[self];
        PushVec[self, StringWidth[self.graphics, string]];
        };

<<Font cache operators>>
    cachestatus: PROC [self: Root] ~ {
    info: CacheInfo ~ CacheStatus[self.graphics];
    PushInt[self, info.bsize];
    PushInt[self, info.bmax];
    PushInt[self, info.msize];
    PushInt[self, info.mmax];
    PushInt[self, info.csize];
    PushInt[self, info.cmax];
    PushInt[self, info.blimit];
        };

    setcachedevice: PROC [self: Root] ~ {
    ur: VEC ~ PopVec[self];
    ll: VEC ~ PopVec[self];
    w: VEC ~ PopVec[self];
    SetCacheDevice[self.graphics, w, [ll, ur]];
        };

    setcharwidth: PROC [self: Root] ~ {
    w: VEC ~ PopVec[self];
    SetCharWidth[self.graphics, w];
        };

    setcachelimit: PROC [self: Root] ~ {
    blimit: INT ~ PopInt[self];
    SetCacheLimit[self.graphics, blimit];
        };

<<Registration>>
GraphicsPrimitives: PROC [primitive: PrimitiveProc] ~ {
primitive["gsave", gsave];
    primitive["grestore", grestore];
    primitive["grestoreall", grestoreall];
    primitive["initgraphics", initgraphics];
    primitive["setlinewidth", setlinewidth];
    primitive["currentlinewidth", currentlinewidth];
    primitive["setlinecap", setlinecap];
    primitive["currentlinecap", currentlinecap];
    primitive["setlinejoin", setlinejoin];
    primitive["currentlinejoin", currentlinejoin];
    primitive["setmiterlimit", setmiterlimit];
    primitive["currentmiterlimit", currentmiterlimit];
    primitive["setdash", setdash];
    primitive["currentdash", currentdash];
    primitive["setflat", setflat];
    primitive["currentflat", currentflat];
    primitive["setgray", setgray];
    primitive["currentgray", currentgray];
    primitive["sethsbcolor", sethsbcolor];
    primitive["currenthsbcolor", currenthsbcolor];
    primitive["setrgbcolor", setrgbcolor];
    primitive["currentrgbcolor", currentrgbcolor];
    primitive["setscreen", setscreen];
    primitive["currentscreen", currentscreen];
    primitive["settransfer", settransfer];
    primitive["currenttransfer", currenttransfer];
primitive["matrix", matrix];
    primitive["initmatrix", initmatrix];
    primitive["identmatrix", identmatrix];
    primitive["defaultmatrix", defaultmatrix];
    primitive["currentmatrix", currentmatrix];
    primitive["setmatrix", setmatrix];
    primitive["translate", translate];
    primitive["scale", scale];
    primitive["rotate", rotate];
    primitive["concat", concat];
    primitive["concatmatrix", concatmatrix];
    primitive["transform", transform];
    primitive["dtransform", dtransform];
    primitive["itransform", itransform];
    primitive["idtransform", idtransform];
    primitive["invertmatrix", invertmatrix];
primitive["newpath", newpath];
    primitive["currentpoint", currentpoint];
    primitive["moveto", moveto];
    primitive["rmoveto", rmoveto];
    primitive["lineto", lineto];
    primitive["rlineto", rlineto];
    primitive["arc", arc];
    primitive["arcn", arcn];
    primitive["arcto", arcto];
    primitive["curveto", curveto];
    primitive["rcurveto", rcurveto];
    primitive["closepath", closepath];
    primitive["flattenpath", flattenpath];
    primitive["reversepath", reversepath];
    primitive["strokepath", strokepath];
    primitive["charpath", charpath];
    primitive["clippath", clippath];
    primitive["pathbbox", pathbbox];
    primitive["pathforall", pathforall];
    primitive["initclip", initclip];
    primitive["clip", clip];
    primitive["eoclip", eoclip];
primitive["erasepage", erasepage];
    primitive["fill", fill];
    primitive["eofill", eofill];
    primitive["stroke", stroke];
    primitive["image", image];
    primitive["imagemask", imagemask];
primitive["showpage", showpage];
    primitive["copypage", copypage];
    primitive["framedevice", framedevice];
    primitive["nulldevice", nulldevice];
primitive["definefont", definefont];
    <<RegisterAny[self, "findfont", xxx];>>
    primitive["scalefont", scalefont];
    primitive["makefont", makefont];
    primitive["setfont", setfont];
    primitive["currentfont", currentfont];
    primitive["show", show];
    primitive["ashow", ashow];
    primitive["widthshow", widthshow];
    primitive["awidthshow", awidthshow];
    primitive["kshow", kshow];
    primitive["stringwidth", stringwidth];
    <<RegisterAny[self, "FontDirectory", xxx];>>
    <<RegisterAny[self, "StandardEncoding", xxx];>>
primitive["cachestatus", cachestatus];
    primitive["setcachedevice", setcachedevice];
    primitive["setcharwidth", setcharwidth];
    primitive["setcachelimit", setcachelimit];
};

RegisterPrimitives[GraphicsPrimitives];

END.