
    <<PS4Impl.mesa>>
        <<Copyright Ó 1986 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt, October 29, 1986 6:51:05 pm PST>>

    <<PostScript implementation: graphics state.>>
    <<>>
    DIRECTORY
        PS;

    PS4Impl: CEDAR PROGRAM
    IMPORTS PS
    ~ BEGIN OPEN PS;
<<Graphics state operators>>
HSBColor: TYPE ~ RECORD [hue, sat, brt: REAL];
RGBColor: TYPE ~ RECORD [red, green, blue: REAL];

ColorFromGray: PROC [gray: REAL] RETURNS [Color] ~ {
RETURN [NIL];
};

ColorFromHSB: PROC [hsb: HSBColor] RETURNS [Color] ~ {
RETURN [NIL];
};

ColorFromRGB: PROC [rgb: RGBColor] RETURNS [Color] ~ {
RETURN [NIL];
};

GrayFromColor: PROC [color: Color] RETURNS [REAL] ~ {
RETURN [0];
};

HSBFromColor: PROC [color: Color] RETURNS [HSBColor] ~ {
RETURN [[0,0,0]];
};

RGBFromColor: PROC [color: Color] RETURNS [RGBColor] ~ {
RETURN [[0,0,0]];
};

<<Primitives>>
<<Graphics state operators>>
    Pgsave: PROC [self: Root] ~ {
    new: GState ~ NEW [GStateRep _ self.graphics^];
    new.rest _ self.graphics;
    self.graphics _ new;
        };

    Pgrestore: PROC [self: Root] ~ {
        IF self.graphics.rest#NIL THEN self.graphics _ self.graphics.rest;
        };

    Pgrestoreall: PROC [self: Root] ~ {
        WHILE self.graphics.rest#NIL DO self.graphics _ self.graphics.rest ENDLOOP;
        };

    Pinitgraphics: PROC [self: Root] ~ {
        <<******** fix this ********>>
        <<InitGraphics[self.graphics];>>
        };

    Psetlinewidth: PROC [self: Root] ~ {
        self.graphics.lineWidth _ PopReal[self.ostack];
        };

    Pcurrentlinewidth: PROC [self: Root] ~ {
        PushReal[self.ostack, self.graphics.lineWidth];
        };

    Psetlinecap: PROC [self: Root] ~ {
        int: INT ~ PopInt[self.ostack];
        IF int IN[0..2] THEN self.graphics.lineCap _ VAL[CARDINAL[int]]
        ELSE ERROR Error[rangecheck];
        };

    Pcurrentlinecap: PROC [self: Root] ~ {
        PushInt[self.ostack, ORD[self.graphics.lineCap]];
        };

    Psetlinejoin: PROC [self: Root] ~ {
        int: INT ~ PopInt[self.ostack];
        IF int IN[0..2] THEN self.graphics.lineJoin _ VAL[CARDINAL[int]]
        ELSE ERROR Error[rangecheck];
        };

    Pcurrentlinejoin: PROC [self: Root] ~ {
        PushInt[self.ostack, ORD[self.graphics.lineJoin]];
        };

    Psetmiterlimit: PROC [self: Root] ~ {
        self.graphics.miterLimit _ PopReal[self.ostack];
        };

    Pcurrentmiterlimit: PROC [self: Root] ~ {
        PushReal[self.ostack, self.graphics.miterLimit];
        };

    Psetdash: PROC [self: Root] ~ {
        offset: REAL ~ PopReal[self.ostack];
        array: Array ~ PopArray[self.ostack];
        self.graphics.dashArray _ array;
        self.graphics.dashOffset _ offset;
        };

    Pcurrentdash: PROC [self: Root] ~ {
        PushArray[self.ostack, self.graphics.dashArray];
        PushReal[self.ostack, self.graphics.dashOffset];
        };

    Psetflat: PROC [self: Root] ~ {
        self.graphics.flatness _ PopReal[self.ostack];
        };

    Pcurrentflat: PROC [self: Root] ~ {
        PushReal[self.ostack, self.graphics.flatness];
        };

    Psetgray: PROC [self: Root] ~ {
        gray: REAL ~ PopReal[self.ostack];
        self.graphics.color _ ColorFromGray[gray];
        };

    Pcurrentgray: PROC [self: Root] ~ {
        PushReal[self.ostack, GrayFromColor[self.graphics.color]];
        };

    Psethsbcolor: PROC [self: Root] ~ {
        hsb: HSBColor;
        hsb.brt _ PopReal[self.ostack];
        hsb.sat _ PopReal[self.ostack];
        hsb.hue _ PopReal[self.ostack];
        self.graphics.color _ ColorFromHSB[hsb];
        };

    Pcurrenthsbcolor: PROC [self: Root] ~ {
        hsb: HSBColor ~ HSBFromColor[self.graphics.color];
        PushReal[self.ostack, hsb.hue];
        PushReal[self.ostack, hsb.sat];
        PushReal[self.ostack, hsb.brt];
        };

    Psetrgbcolor: PROC [self: Root] ~ {
        rgb: RGBColor;
        rgb.blue _ PopReal[self.ostack];
        rgb.green _ PopReal[self.ostack];
        rgb.red _ PopReal[self.ostack];
        self.graphics.color _ ColorFromRGB[rgb];
        };

    Pcurrentrgbcolor: PROC [self: Root] ~ {
        rgb: RGBColor ~ RGBFromColor[self.graphics.color];
        PushReal[self.ostack, rgb.red];
        PushReal[self.ostack, rgb.green];
        PushReal[self.ostack, rgb.blue];
        };

    Psetscreen: PROC [self: Root] ~ {
        proc: Array ~ PopArray[self.ostack];
        angle: REAL ~ PopReal[self.ostack];
        frequency: REAL ~ PopReal[self.ostack];
        self.graphics.screenFrequency _ frequency;
        self.graphics.screenAngle _ angle;
        self.graphics.screenProc _ proc;
        };

    Pcurrentscreen: PROC [self: Root] ~ {
        PushReal[self.ostack, self.graphics.screenFrequency];
        PushReal[self.ostack, self.graphics.screenAngle];
        PushArray[self.ostack, self.graphics.screenProc];
        };

    Psettransfer: PROC [self: Root] ~ {
        proc: Array ~ PopArray[self.ostack];
        self.graphics.transfer _ proc;
        };

    Pcurrenttransfer: PROC [self: Root] ~ {
        PushArray[self.ostack, self.graphics.transfer];
        };

<<Coordinate system and matrix operators>>
    TransformationFromMatrix: PROC [matrix: Array] RETURNS [t: Transformation] ~ {
        IF matrix.length#6 THEN ERROR Error[typecheck];
        RETURN [[
            a: RealFromAny[ArrayGet[matrix, 0]],
            b: RealFromAny[ArrayGet[matrix, 1]],
            c: RealFromAny[ArrayGet[matrix, 2]],
            d: RealFromAny[ArrayGet[matrix, 3]],
            tx: RealFromAny[ArrayGet[matrix, 4]],
            ty: RealFromAny[ArrayGet[matrix, 5]]
            ]];
        };

    MatrixFromTransformation: PROC [matrix: Array, t: Transformation] RETURNS [Array] ~ {
        IF matrix.length#6 THEN ERROR Error[typecheck];
        ArrayPut[matrix, 0, AnyFromReal[t.a]];
        ArrayPut[matrix, 1, AnyFromReal[t.b]];
        ArrayPut[matrix, 2, AnyFromReal[t.c]];
        ArrayPut[matrix, 3, AnyFromReal[t.d]];
        ArrayPut[matrix, 4, AnyFromReal[t.tx]];
        ArrayPut[matrix, 5, AnyFromReal[t.ty]];
        RETURN [matrix];
        };

    identity: Transformation _ [1.0, 0.0, 0.0, 1.0, 0.0, 0.0];

    Pmatrix: PROC [self: Root] ~ {
        matrix: Array ~ ArrayNew[6];
        PushArray[self.ostack, MatrixFromTransformation[matrix, identity]];
        };

    Pinitmatrix: PROC [self: Root] ~ {
        };

    Pidentmatrix: PROC [self: Root] ~ {
        matrix: Array ~ PopArray[self.ostack];
        PushArray[self.ostack, MatrixFromTransformation[matrix, identity]];
        };

    Pdefaultmatrix: PROC [self: Root] ~ {
        matrix: Array ~ PopArray[self.ostack];
        <<******** fix this ********>>
        PushArray[self.ostack, matrix];
        };

    Pcurrentmatrix: PROC [self: Root] ~ {
        matrix: Array ~ PopArray[self.ostack];
        PushArray[self.ostack, MatrixFromTransformation[matrix, self.graphics.CTM]];
        };

    Psetmatrix: PROC [self: Root] ~ {
        matrix: Array ~ PopArray[self.ostack];
        self.graphics.CTM _ TransformationFromMatrix[matrix];
        };

    Ptranslate: PROC [self: Root] ~ {
        };

    Pscale: PROC [self: Root] ~ {
        };

    Protate: PROC [self: Root] ~ {
        };

    Pconcat: PROC [self: Root] ~ {
        };

    Pconcatmatrix: PROC [self: Root] ~ {
        };

    Ptransform: PROC [self: Root] ~ {
        };

    Pdtransform: PROC [self: Root] ~ {
        };

    Pitransform: PROC [self: Root] ~ {
        };

    Pidtransform: PROC [self: Root] ~ {
        };

    Pinvertmatrix: PROC [self: Root] ~ {
        };


Register4: PROC [self: Root] ~ {
    Register[self, "gsave", Pgsave];
    Register[self, "grestore", Pgrestore];
    Register[self, "grestoreall", Pgrestoreall];
    Register[self, "initgraphics", Pinitgraphics];
    Register[self, "setlinewidth", Psetlinewidth];
    Register[self, "currentlinewidth", Pcurrentlinewidth];
    Register[self, "setlinecap", Psetlinecap];
    Register[self, "currentlinecap", Pcurrentlinecap];
    Register[self, "setlinejoin", Psetlinejoin];
    Register[self, "currentlinejoin", Pcurrentlinejoin];
    Register[self, "setmiterlimit", Psetmiterlimit];
    Register[self, "currentmiterlimit", Pcurrentmiterlimit];
    Register[self, "setdash", Psetdash];
    Register[self, "currentdash", Pcurrentdash];
    Register[self, "setflat", Psetflat];
    Register[self, "currentflat", Pcurrentflat];
    Register[self, "setgray", Psetgray];
    Register[self, "currentgray", Pcurrentgray];
    Register[self, "sethsbcolor", Psethsbcolor];
    Register[self, "currenthsbcolor", Pcurrenthsbcolor];
    Register[self, "setrgbcolor", Psetrgbcolor];
    Register[self, "currentrgbcolor", Pcurrentrgbcolor];
    Register[self, "setscreen", Psetscreen];
    Register[self, "currentscreen", Pcurrentscreen];
    Register[self, "settransfer", Psettransfer];
    Register[self, "currenttransfer", Pcurrenttransfer];
};

RegisterPrimitives[Register4];

END.