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