
    <<PSMatrixImpl.mesa>>
        <<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt, March 24, 1987 4:25:00 pm PST>>

    <<PostScript implementation: graphics state.>>
    <<>>
    DIRECTORY
        PS USING [Array, ArrayCreate, ArrayGetReal, ArrayPutReal, Error, Matrix, PopArray, PopReal, PopVec, PushArray, PushVec, Register, 
        RegisterPrimitives, Root, TopType, VEC],
        RealFns USING [CosDeg, SinDeg];

    PSMatrixImpl: CEDAR PROGRAM
    IMPORTS PS, RealFns
    ~ BEGIN OPEN PS;
<<Coordinate system and matrix operators>>
    GetMatrix: PROC [array: Array] RETURNS [Matrix] ~ {
        IF array.length=6 THEN RETURN [[
            a: ArrayGetReal[array, 0],
            b: ArrayGetReal[array, 1],
            c: ArrayGetReal[array, 2],
            d: ArrayGetReal[array, 3],
            tx: ArrayGetReal[array, 4],
            ty: ArrayGetReal[array, 5]
            ]]
        ELSE ERROR Error[typecheck];
        };

    PutMatrix: PROC [array: Array, matrix: Matrix] ~ {
        IF array.length=6 THEN {
            ArrayPutReal[array, 0, matrix.a];
            ArrayPutReal[array, 1, matrix.b];
            ArrayPutReal[array, 2, matrix.c];
            ArrayPutReal[array, 3, matrix.d];
            ArrayPutReal[array, 4, matrix.tx];
            ArrayPutReal[array, 5, matrix.ty];
            }
        ELSE ERROR Error[typecheck];
        };

    Identity: PROC RETURNS [Matrix] ~ {
        RETURN [[a: 1, b: 0, c: 0, d: 1, tx: 0, ty: 0]];
        };

    Translate: PROC [t: VEC] RETURNS [Matrix] ~ {
        RETURN [[a: 1, b: 0, c: 0, d: 1, tx: t.x, ty: t.y]];
        };

    Scale: PROC [s: VEC] RETURNS [Matrix] ~ {
        RETURN [[a: s.x, b: 0, c: 0, d: s.y, tx: 0, ty: 0]];
        };

    Rotate: PROC [angle: REAL] RETURNS [Matrix] ~ {
        cos: REAL ~ RealFns.CosDeg[angle];
        sin: REAL ~ RealFns.SinDeg[angle];
        RETURN [[a: cos, b: sin, c: -sin, d: cos, tx: 0, ty: 0]];
        };

    Concat: PROC [m1, m2: Matrix] RETURNS [Matrix] ~ {
        RETURN [[
            a: m1.a*m2.a+m1.b*m2.c,
            b: m1.a*m2.b+m1.b*m2.d,
            c: m1.c*m2.a+m1.d*m2.c,
            d: m1.c*m2.b+m1.d*m2.d,
            tx: m1.tx*m2.a+m1.ty*m2.c+m2.tx,
            ty: m1.tx*m2.b+m1.ty*m2.d+m2.ty
            ]];
        };

    Transform: PROC [p: VEC, m: Matrix] RETURNS [VEC] ~ {
        RETURN [[x: m.a*p.x+m.c*p.y+m.tx, y: m.b*p.x+m.d*p.y+m.ty]];
        };

    DTransform: PROC [d: VEC, m: Matrix] RETURNS [VEC] ~ {
        RETURN [[x: m.a*d.x+m.c*d.y, y: m.b*d.x+m.d*d.y]];
        };

    ITransform: PROC [p: VEC, m: Matrix] RETURNS [VEC] ~ {
        RETURN [Transform[p, Invert[m]]];
        };

    IDTransform: PROC [d: VEC, m: Matrix] RETURNS [VEC] ~ {
        RETURN [DTransform[d, Invert[m]]];
        };

    Invert: PROC [m: Matrix] RETURNS [Matrix] ~ {
        det: REAL ~ m.a*m.d - m.b*m.c;
        RETURN [[a: m.d/det, b: -m.b/det, c: -m.c/det, d: m.a/det,
        tx: (m.c*m.ty - m.d*m.tx)/det, ty: (m.b*m.tx - m.a*m.ty)/det]];
        };


    Pmatrix: PROC [self: Root] ~ {
        array: Array ~ ArrayCreate[6];
        PutMatrix[array, Identity[]];
        PushArray[self.ostack, array];
        };

    Pinitmatrix: PROC [self: Root] ~ {
        <<******** fix this ********>>
        };

    Pidentmatrix: PROC [self: Root] ~ {
        array: Array ~ PopArray[self.ostack];
        PutMatrix[array, Identity[]];
        PushArray[self.ostack, array];
        };

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

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

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

    Ptranslate: PROC [self: Root] ~ {
        IF TopType[self.ostack]=array THEN {
            array: Array ~ PopArray[self.ostack];
            t: VEC ~ PopVec[self.ostack];
            PutMatrix[array, Translate[t]];
            PushArray[self.ostack, array];
            }
        ELSE {
            t: VEC ~ PopVec[self.ostack];
            self.graphics.CTM _ Concat[Translate[t], self.graphics.CTM];
            };
        };

    Pscale: PROC [self: Root] ~ {
        IF TopType[self.ostack]=array THEN {
            array: Array ~ PopArray[self.ostack];
            s: VEC ~ PopVec[self.ostack];
            PutMatrix[array, Scale[s]];
            PushArray[self.ostack, array];
            }
        ELSE {
            s: VEC ~ PopVec[self.ostack];
            self.graphics.CTM _ Concat[Scale[s], self.graphics.CTM];
            };
        };

    Protate: PROC [self: Root] ~ {
        IF TopType[self.ostack]=array THEN {
            array: Array ~ PopArray[self.ostack];
            angle: REAL ~ PopReal[self.ostack];
            PutMatrix[array, Rotate[angle]];
            PushArray[self.ostack, array];
            }
        ELSE {
            angle: REAL ~ PopReal[self.ostack];
            self.graphics.CTM _ Concat[Rotate[angle], self.graphics.CTM];
            };
        };

    Pconcat: PROC [self: Root] ~ {
        array: Array ~ PopArray[self.ostack];
        self.graphics.CTM _ Concat[GetMatrix[array], self.graphics.CTM];
        };

    Pconcatmatrix: PROC [self: Root] ~ {
        array3: Array ~ PopArray[self.ostack];
        array2: Array ~ PopArray[self.ostack];
        array1: Array ~ PopArray[self.ostack];
        PutMatrix[array3, Concat[GetMatrix[array1], GetMatrix[array2]]];
        PushArray[self.ostack, array3];
        };

    DoTransform: PROC [self: Root, op: PROC [VEC, Matrix] RETURNS [VEC]] ~ {
        IF TopType[self.ostack]=array THEN {
            array: Array ~ PopArray[self.ostack];
            p: VEC ~ PopVec[self.ostack];
            PushVec[self.ostack, op[p, GetMatrix[array]]];
            }
        ELSE {
            p: VEC ~ PopVec[self.ostack];
            PushVec[self.ostack, op[p, self.graphics.CTM]];
            };
        };

    Ptransform: PROC [self: Root] ~ { DoTransform[self, Transform] };

    Pdtransform: PROC [self: Root] ~ { DoTransform[self, DTransform] };

    Pitransform: PROC [self: Root] ~ { DoTransform[self, ITransform] };

    Pidtransform: PROC [self: Root] ~ { DoTransform[self, IDTransform] };

    Pinvertmatrix: PROC [self: Root] ~ {
        array2: Array ~ PopArray[self.ostack];
        array1: Array ~ PopArray[self.ostack];
        PutMatrix[array2, Invert[GetMatrix[array1]]];
        PushArray[self.ostack, array2];
        };

<<Registration>>
Primitives: PROC [self: Root] ~ {
    Register[self, "matrix", Pmatrix];
    Register[self, "initmatrix", Pinitmatrix];
    Register[self, "identmatrix", Pidentmatrix];
    Register[self, "defaultmatrix", Pdefaultmatrix];
    Register[self, "currentmatrix", Pcurrentmatrix];
    Register[self, "setmatrix", Psetmatrix];
    Register[self, "translate", Ptranslate];
    Register[self, "scale", Pscale];
    Register[self, "rotate", Protate];
    Register[self, "concat", Pconcat];
    Register[self, "concatmatrix", Pconcatmatrix];
    Register[self, "transform", Ptransform];
    Register[self, "dtransform", Pdtransform];
    Register[self, "itransform", Pitransform];
    Register[self, "idtransform", Pidtransform];
    Register[self, "invertmatrix", Pinvertmatrix];
};

RegisterPrimitives[Primitives];

END.