DIRECTORY
PS USING [Any, ArrayCreate, Bug, Dict, Error, String],
PSGraphics,
BasicImager USING [Clip, Fill, OutlineProc, Ref, SetColor],
ImagerColor USING [ColorFromGray, ConstantColor],
ImagerPath USING [PathProc],
ImagerStroke USING [PathFromStroke],
ImagerTransformation USING [Create, Transformation],
RealFns USING [SinDeg, CosDeg],
Vector2 USING [Add];
Types
Graphics: TYPE ~ REF GraphicsRep;
GraphicsRep:
PUBLIC
TYPE ~
RECORD [
stack: GraphicsStack,
validColor, validClipper: BOOL
];
GraphicsStack: TYPE ~ REF GraphicsStackRep;
GraphicsStackRep:
TYPE ~
RECORD [
CTM: Matrix,
color: Color,
path: Path,
clipper: ClipList,
font: Dict,
lineWidth: REAL,
lineCap: LineCap,
lineJoin: LineJoin,
screen: Screen,
transfer: Transfer,
flatness: REAL,
miterLimit: REAL,
dash: Dash,
device: Device,
rest: GraphicsStack
];
Color: TYPE ~ ImagerColor.ConstantColor;
Path: TYPE ~ REF PathRep;
PathRep: TYPE ~ RECORD [next: Path, tag: PathTag, p: VEC];
PathTag: TYPE ~ {move, line, curve1, curve2, curve3, close};
Path: TYPE ~ REF PathSegmentRep;
PathSegmentRep:
TYPE ~
RECORD [
prev: Path,
variant:
SELECT tag: *
FROM
move => [p: VEC],
line => [p: VEC],
curve => [p1, p2, p3: VEC],
close => [p: VEC],
ENDCASE
];
ClipList: TYPE ~ LIST OF ClipOutline;
ClipOutline: TYPE ~ RECORD [path: Path, eo: BOOL];
Device: TYPE ~ BasicImager.Ref;
Graphics state operators
GSave:
PUBLIC
PROC [g: Graphics] ~ {
before: GraphicsStack ~ g.stack;
after: GraphicsStack ~ NEW [GraphicsStackRep ← before^];
after.rest ← before;
g.stack ← after;
};
GRestore:
PUBLIC
PROC [g: Graphics] ~ {
before: GraphicsStack ~ g.stack;
after: GraphicsStack ~ before.rest;
IF after#
NIL
THEN {
g.stack ← after;
IF after.color#before.color THEN g.validColor ← FALSE;
IF after.clipper#before.clipper THEN g.validClipper ← FALSE;
};
};
GRestoreAll:
PUBLIC
PROC [g: Graphics] ~ {
UNTIL g.stack.rest=NIL DO GRestore[g] ENDLOOP;
};
undashed: Dash ~ [array:
PS.ArrayCreate[0], offset: 0];
InitGraphics:
PUBLIC
PROC [g: Graphics] ~ {
InitMatrix[g];
NewPath[g];
InitClip[g];
SetLineWidth[g, 1];
SetLineCap[g, butt];
SetLineJoin[g, miter];
SetDash[g, undashed];
SetGray[g, 0];
SetMiterLimit[g, 10];
};
SetLineWidth:
PUBLIC
PROC [g: Graphics, lineWidth:
REAL] ~ {
g.stack.lineWidth ← lineWidth;
};
CurrentLineWidth:
PUBLIC
PROC [g: Graphics]
RETURNS [
REAL] ~ {
RETURN [g.stack.lineWidth];
};
SetLineCap:
PUBLIC
PROC [g: Graphics, lineCap: LineCap] ~ {
g.stack.lineCap ← lineCap;
};
CurrentLineCap:
PUBLIC
PROC [g: Graphics]
RETURNS [LineCap] ~ {
RETURN [g.stack.lineCap];
};
SetLineJoin:
PUBLIC
PROC [g: Graphics, lineJoin: LineJoin] ~ {
g.stack.lineJoin ← lineJoin;
};
CurrentLineJoin:
PUBLIC
PROC [g: Graphics]
RETURNS [LineJoin] ~ {
RETURN [g.stack.lineJoin];
};
SetMiterLimit:
PUBLIC
PROC [g: Graphics, miterLimit:
REAL] ~ {
g.stack.miterLimit ← miterLimit;
};
CurrentMiterLimit:
PUBLIC
PROC [g: Graphics]
RETURNS [
REAL] ~ {
RETURN [g.stack.miterLimit];
};
SetDash:
PUBLIC
PROC [g: Graphics, dash: Dash] ~ {
g.stack.dash ← dash;
};
CurrentDash:
PUBLIC
PROC [g: Graphics]
RETURNS [Dash] ~ {
RETURN [g.stack.dash];
};
SetFlat:
PUBLIC
PROC [g: Graphics, flatness:
REAL] ~ {
g.stack.flatness ← flatness;
};
CurrentFlat:
PUBLIC
PROC [g: Graphics]
RETURNS [
REAL] ~ {
RETURN [g.stack.flatness];
};
SetColor:
PUBLIC
PROC [g: Graphics, color: Color] ~ {
g.stack.color ← color;
g.validColor ← FALSE;
};
CurrentColor:
PUBLIC
PROC [g: Graphics]
RETURNS [Color] ~ {
RETURN [g.stack.color];
};
ColorFromGray:
PROC [gray:
REAL]
RETURNS [Color] ~ {
RETURN [ImagerColor.ColorFromGray[1-gray]];
};
GrayFromColor:
PROC [color: Color]
RETURNS [
REAL] ~ {
***** FIX THIS *****
RETURN [0];
};
ColorFromHSB:
PROC [hsbColor: HSBColor]
RETURNS [Color] ~ {
***** FIX THIS *****
RETURN [NIL];
};
HSBFromColor:
PROC [color: Color]
RETURNS [HSBColor] ~ {
***** FIX THIS *****
RETURN [[0,0,0]];
};
ColorFromRGB:
PROC [rgbColor: RGBColor]
RETURNS [Color] ~ {
***** FIX THIS *****
RETURN [NIL];
};
RGBFromColor:
PROC [color: Color]
RETURNS [RGBColor] ~ {
***** FIX THIS *****
RETURN [[0,0,0]];
};
SetGray:
PUBLIC
PROC [g: Graphics, gray:
REAL] ~ {
SetColor[g, ColorFromGray[gray]];
};
CurrentGray:
PUBLIC
PROC [g: Graphics]
RETURNS [
REAL] ~ {
RETURN [GrayFromColor[CurrentColor[g]]];
};
SetHSBColor:
PUBLIC
PROC [g: Graphics, hsbColor: HSBColor] ~ {
SetColor[g, ColorFromHSB[hsbColor]];
};
CurrentHSBColor:
PUBLIC
PROC [g: Graphics]
RETURNS [HSBColor] ~ {
RETURN [HSBFromColor[CurrentColor[g]]];
};
SetRGBColor:
PUBLIC
PROC [g: Graphics, rgbColor: RGBColor] ~ {
SetColor[g, ColorFromRGB[rgbColor]];
};
CurrentRGBColor:
PUBLIC
PROC [g: Graphics]
RETURNS [RGBColor] ~ {
RETURN [RGBFromColor[CurrentColor[g]]];
};
SetScreen:
PUBLIC
PROC [g: Graphics, screen: Screen] ~ {
g.stack.screen ← screen;
};
CurrentScreen:
PUBLIC
PROC [g: Graphics]
RETURNS [Screen] ~ {
RETURN [g.stack.screen];
};
SetTransfer:
PUBLIC
PROC [g: Graphics, transfer: Transfer] ~ {
g.stack.transfer ← transfer;
};
CurrentTransfer:
PUBLIC
PROC [g: Graphics]
RETURNS [Transfer] ~ {
RETURN [g.stack.transfer];
};
Coordinate system and matrix operators
DefaultMatrixFromDevice:
PROC [device: Device, result: Matrix]
RETURNS [Matrix] ~ {
RETURN [result]; -- ***** fix this ***** --
};
InitMatrix:
PUBLIC
PROC [g: Graphics] ~ {
g.stack.CTM ← DefaultMatrixFromDevice[g.stack.device, g.stack.CTM];
};
DefaultMatrix:
PUBLIC
PROC [g: Graphics, result: Matrix]
RETURNS [Matrix] ~ {
RETURN [DefaultMatrixFromDevice[g.stack.device, result]];
};
CurrentMatrix:
PUBLIC
PROC [g: Graphics, result: Matrix]
RETURNS [Matrix] ~ {
result^ ← g.stack.CTM^;
RETURN [result];
};
SetMatrix:
PUBLIC
PROC [g: Graphics, matrix: Matrix] ~ {
g.stack.CTM^ ← matrix^;
};
Concat:
PUBLIC
PROC [g: Graphics, matrix: Matrix] ~ {
g.stack.CTM ← ConcatMatrix[matrix, g.stack.CTM, g.stack.CTM];
};
IdentMatrix:
PUBLIC
PROC [result: Matrix]
RETURNS [Matrix] ~ {
result^ ← [a: 1, b: 0, c: 0, d: 1, tx: 0, ty: 0];
RETURN [result];
};
Translate:
PUBLIC
PROC [t:
VEC, result: Matrix]
RETURNS [Matrix] ~ {
result^ ← [a: 1, b: 0, c: 0, d: 1, tx: t.x, ty: t.y];
RETURN [result];
};
Scale:
PUBLIC
PROC [s:
VEC, result: Matrix]
RETURNS [Matrix] ~ {
result^ ← [a: s.x, b: 0, c: 0, d: s.y, tx: 0, ty: 0];
RETURN [result];
};
Rotate:
PUBLIC
PROC [angle:
REAL, result: Matrix]
RETURNS [Matrix] ~ {
cos: REAL ~ RealFns.CosDeg[angle];
sin: REAL ~ RealFns.SinDeg[angle];
result^ ← [a: cos, b: sin, c: -sin, d: cos, tx: 0, ty: 0];
RETURN [result];
};
ConcatMatrix:
PUBLIC
PROC [matrix1, matrix2: Matrix, result: Matrix]
RETURNS [Matrix] ~ {
m1: MatrixRep ~ matrix1^;
m2: MatrixRep ~ matrix2^;
result^ ← [
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
];
RETURN [result];
};
InvertMatrix:
PUBLIC
PROC [matrix: Matrix, result: Matrix]
RETURNS [Matrix] ~ {
m: MatrixRep ~ matrix^;
det: REAL ~ m.a*m.d-m.b*m.c;
result^ ← [
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
];
RETURN [result];
};
Transform:
PUBLIC
PROC [p:
VEC, matrix: Matrix]
RETURNS [
VEC] ~ {
RETURN [[
x: matrix.a*p.x+matrix.c*p.y+matrix.tx,
y: matrix.b*p.x+matrix.d*p.y+matrix.ty
]];
};
DTransform:
PUBLIC
PROC [d:
VEC, matrix: Matrix]
RETURNS [
VEC] ~ {
RETURN [[
x: matrix.a*d.x+matrix.c*d.y,
y: matrix.b*d.x+matrix.d*d.y
]];
};
ITransform:
PUBLIC
PROC [p:
VEC, matrix: Matrix]
RETURNS [
VEC] ~ {
RETURN [IDTransform[[p.x-matrix.tx, p.y-matrix.ty], matrix]];
};
IDTransform:
PUBLIC
PROC [d:
VEC, matrix: Matrix]
RETURNS [
VEC] ~ {
det: REAL ~ matrix.a*matrix.d-matrix.b*matrix.c;
RETURN[[(d.x*matrix.d-d.y*matrix.c)/det, (d.y*matrix.a-d.x*matrix.b)/det]];
};
Path construction operators
GetLP:
PROC [path: Path]
RETURNS [
VEC] ~ {
IF path=NIL THEN ERROR Error[nocurrentpoint];
WITH path
SELECT
FROM
seg: REF PathSegmentRep.move => RETURN[seg.p];
seg: REF PathSegmentRep.line => RETURN[seg.p];
seg: REF PathSegmentRep.curve => RETURN[seg.p3];
seg: REF PathSegmentRep.close => RETURN[seg.p];
ENDCASE => ERROR Bug;
};
GetFP:
PROC [path: Path]
RETURNS [
VEC] ~ {
FOR seg: Path ← path, seg.prev
UNTIL seg=
NIL
DO
WITH seg
SELECT
FROM
seg: REF PathSegmentRep.move => RETURN[seg.p];
seg: REF PathSegmentRep.close => RETURN[seg.p];
ENDCASE;
ENDLOOP;
ERROR Error[nocurrentpoint];
};
MapPath:
PROC [path: Path, move: MoveAction, line: LineAction, curve: CurveAction,
close: CloseAction ←
NIL] ~ {
IF path=NIL THEN RETURN;
MapPath[path.prev, move, line, curve, close];
WITH path
SELECT
FROM
seg: REF PathSegmentRep.move => move[seg.p];
seg: REF PathSegmentRep.line => line[seg.p];
seg: REF PathSegmentRep.curve => curve[seg.p1, seg.p2, seg.p3];
seg: REF PathSegmentRep.close => IF close#NIL THEN close[];
ENDCASE => ERROR Bug;
};
SubPathProc: TYPE ~ PROC [path: ImagerPath.PathProc, closed: BOOL];
MapSubPaths:
PROC [path: Path, subpath: SubPathProc] ~ {
subpath: SubPathProc ~ {
FOR seg: Path ← path, seg.prev UNTIL seg=NIL DO
SELECT seg.type FROM
move, close => { MapSubPaths[seg.prev, subpaths]; EXIT };
ENDCASE => ERROR Bug;
ENDLOOP;
};
AppendMove:
PROC [path: Path, p:
VEC]
RETURNS [Path] ~ {
IF path#NIL AND path.tag=move THEN path ← path.prev; -- delete previous move
RETURN [NEW[PathSegmentRep ← [prev: path, variant: move[p]]]];
};
AppendLine:
PROC [path: Path, p:
VEC]
RETURNS [Path] ~ {
IF path=NIL THEN ERROR Error[nocurrentpoint];
RETURN [NEW[PathSegmentRep ← [prev: path, variant: line[p]]]];
};
AppendCurve:
PROC [path: Path, p1, p2, p3:
VEC]
RETURNS [Path] ~ {
IF path=NIL THEN ERROR Error[nocurrentpoint];
RETURN [NEW[PathSegmentRep ← [prev: path, variant: curve[p1, p2, p3]]]];
};
AppendClose:
PROC [path: Path]
RETURNS [Path] ~ {
IF path=NIL THEN RETURN [NIL]; -- noop if empty path
IF path.tag=close THEN RETURN [path]; -- noop if already closed
RETURN [NEW[PathSegmentRep ← [prev: path, variant: close[]]]];
};
NewPath:
PUBLIC
PROC [g: Graphics] ~ {
g.stack.path ← NIL;
};
CurrentPoint:
PUBLIC
PROC [g: Graphics]
RETURNS [
VEC] ~ {
RETURN [ITransform[GetLP[g.stack.path], g.stack.CTM]];
};
MoveTo:
PUBLIC
PROC [g: Graphics, p:
VEC] ~ {
g.stack.path ← AppendMove[g.stack.path, Transform[p, g.stack.CTM]];
};
RMoveTo:
PUBLIC
PROC [g: Graphics, d:
VEC] ~ {
cp: VEC ~ GetLP[g.stack.path];
g.stack.path ← AppendMove[g.stack.path, Vector2.Add[cp, DTransform[d, g.stack.CTM]]];
};
LineTo:
PUBLIC
PROC [g: Graphics, p:
VEC] ~ {
g.stack.path ← AppendLine[g.stack.path, Transform[p, g.stack.CTM]];
};
RLineTo:
PUBLIC
PROC [g: Graphics, d:
VEC] ~ {
cp: VEC ~ GetLP[g.stack.path];
g.stack.path ← AppendLine[g.stack.path, Vector2.Add[cp, DTransform[d, g.stack.CTM]]];
};
Arc:
PUBLIC
PROC [g: Graphics, p:
VEC, r:
REAL, ang1, ang2:
REAL, sense: ArcSense] ~ {
};
ArcTo:
PUBLIC
PROC [g: Graphics, p1, p2:
VEC, r:
REAL]
RETURNS [t1, t2:
VEC] ~ {
};
CurveTo:
PUBLIC
PROC [g: Graphics, p1, p2, p3:
VEC] ~ {
g.stack.path ← AppendCurve[g.stack.path,
Transform[p1, g.stack.CTM],
Transform[p2, g.stack.CTM],
Transform[p3, g.stack.CTM]
];
};
RCurveTo:
PUBLIC
PROC [g: Graphics, d1, d2, d3:
VEC] ~ {
cp: VEC ~ GetLP[g.stack.path];
g.stack.path ← AppendCurve[g.stack.path,
Vector2.Add[cp, DTransform[d1, g.stack.CTM]],
Vector2.Add[cp, DTransform[d2, g.stack.CTM]],
Vector2.Add[cp, DTransform[d3, g.stack.CTM]]
];
};
ClosePath:
PUBLIC
PROC [g: Graphics] ~ {
g.stack.path ← AppendClose[g.stack.path];
};
FlattenPath:
PUBLIC
PROC [g: Graphics] ~ {
};
ReversePath:
PUBLIC
PROC [g: Graphics] ~ {
};
StrokePath:
PUBLIC
PROC [g: Graphics] ~ {
};
CharPath:
PUBLIC
PROC [g: Graphics, string: String, bool:
BOOL] ~ {
};
ClipPath:
PUBLIC
PROC [g: Graphics] ~ {
};
GetBBox:
PROC [path: Path]
RETURNS [box: Box] ~ {
first: BOOL ← TRUE;
point:
PROC [p:
VEC] ~ {
IF first THEN { box.ll ← box.ur ← p; first ← FALSE }
ELSE {
IF p.x<box.ll.x THEN box.ll.x ← p.x ELSE IF p.x>box.ur.x THEN box.ur.x ← p.x;
IF p.y<box.ll.y THEN box.ll.y ← p.y ELSE IF p.y>box.ur.y THEN box.ur.y ← p.y;
};
};
curve: PROC [p1, p2, p3: VEC] ~ { point[p1]; point[p2]; point[p3] };
close: PROC ~ { };
MapPath[path, point, point, curve, close];
IF first THEN ERROR Error[nocurrentpoint];
};
PathBBox:
PUBLIC
PROC [g: Graphics]
RETURNS [Box] ~ {
tbox: Box ~ GetBBox[g.stack.path];
p0: VEC ~ ITransform[[tbox.ll.x, tbox.ll.y], g.stack.CTM];
p1: VEC ~ ITransform[[tbox.ur.x, tbox.ll.y], g.stack.CTM];
p2: VEC ~ ITransform[[tbox.ur.x, tbox.ur.y], g.stack.CTM];
p3: VEC ~ ITransform[[tbox.ll.x, tbox.ur.y], g.stack.CTM];
RETURN [[
ll: [x: MIN[p0.x, p1.x, p2.x, p3.x], y: MIN[p0.y, p1.y, p2.y, p3.y]],
ur: [x: MAX[p0.x, p1.x, p2.x, p3.x], y: MAX[p0.y, p1.y, p2.y, p3.y]]
]];
};
PathForAll:
PUBLIC
PROC [g: Graphics, move: MoveAction, line: LineAction, curve: CurveAction, close: CloseAction] ~ {
MapPath[g.stack.path, move, line, curve, close];
};
InitClip:
PUBLIC
PROC [g: Graphics] ~ {
};
Clip:
PUBLIC
PROC [g: Graphics, eo:
BOOL] ~ {
g.stack.clipper ← CONS [[g.stack.path, eo], g.stack.clipper];
g.validClipper ← FALSE;
};
Painting operators
ValidateColor:
PROC [g: Graphics] ~ {
BasicImager.SetColor[g.stack.device, g.stack.color];
g.validColor ← TRUE;
};
ValidateClipper:
PROC [g: Graphics] ~ {
outlines:
PROC [outline: BasicImager.OutlineProc] ~ {
FOR list: ClipList ← g.stack.clipper, list.rest
UNTIL list=
NIL
DO
path: ImagerPath.PathProc ~ { MapPath[list.first.path, moveTo, lineTo, curveTo] };
outline[path, list.first.eo];
ENDLOOP;
};
BasicImager.Clip[g.stack.device, outlines];
g.validClipper ← TRUE;
};
ErasePage:
PUBLIC
PROC [g: Graphics] ~ {
BasicImager.Erase[g.stack.device];
};
Fill:
PUBLIC
PROC [g: Graphics, eo:
BOOL] ~ {
path: ImagerPath.PathProc ~ { MapPath[g.stack.path, moveTo, lineTo, curveTo] };
IF NOT g.validColor THEN ValidateColor[g];
IF NOT g.validClipper THEN ValidateClipper[g];
BasicImager.Fill[g.stack.device, path, eo];
NewPath[g];
};
Stroke:
PUBLIC
PROC [g: Graphics] ~ {
width: REAL ~ g.stack.lineWidth;
end:
INT ~
SELECT g.stack.lineCap
FROM
butt => 0, round => 2, square => 1, ENDCASE => ERROR Bug;
joint:
INT ~
SELECT g.stack.lineJoin
FROM
miter => 0, round => 2, bevel => 1, ENDCASE => ERROR Bug;
CTM: Matrix ~ g.stack.CTM;
m: ImagerTransformation.Transformation ~ ImagerTransformation.Create[
a: CTM.a, b: CTM.c, c: CTM.tx, d: CTM.b, e: CTM.d, f: CTM.ty];
subpath:
PROC [path: ImagerPath.PathProc, closed:
BOOL] ~ {
fillPath: ImagerPath.PathProc ~ {
ImagerStroke.PathFromStroke[path: path, closed: closed,
width: width, end: end, joint: joint, m: m,
moveTo: moveTo, lineTo: lineTo, conicTo: conicTo];
};
BasicImager.Fill[g.stack.device, fillPath, FALSE];
};
IF NOT g.validColor THEN ValidateColor[g];
IF NOT g.validClipper THEN ValidateClipper[g];
MapSubPaths[g.stack.path, subpath];
ImagerTransformation.Destroy[m];
NewPath[g];
};
Image:
PUBLIC
PROC [g: Graphics, width, height:
INT, bitsPerSample:
INT, matrix: Matrix,
stringProc:
PROC
RETURNS [String]] ~ {
};
ImageMask:
PUBLIC
PROC [g: Graphics, width, height:
INT, invert:
BOOL, matrix: Matrix,
stringProc:
PROC
RETURNS [String]] ~ {
};
Character and font operators
DefineFont:
PUBLIC
PROC [g: Graphics, key: Any, font: Dict]
RETURNS [Dict] ~ {
ERROR;
};
FindFont:
PUBLIC
PROC [g: Graphics, key: Any]
RETURNS [Dict] ~ {
ERROR;
};
MakeFont:
PUBLIC
PROC [font: Dict, matrix: Matrix]
RETURNS [Dict] ~ {
ERROR;
};
SetFont:
PUBLIC
PROC [g: Graphics, font: Dict] ~ {
g.stack.font ← font;
};
CurrentFont:
PUBLIC
PROC [g: Graphics]
RETURNS [Dict] ~ {
RETURN [g.stack.font];
};
Show:
PUBLIC
PROC [g: Graphics, string: String] ~ {
};
AShow:
PUBLIC
PROC [g: Graphics, a:
VEC, string: String] ~ {
};
WidthShow:
PUBLIC
PROC [g: Graphics, c:
VEC, char:
CHAR, string: String] ~ {
};
AWidthShow:
PUBLIC
PROC [g: Graphics, c:
VEC, char:
CHAR, a:
VEC, string: String] ~ {
};
KShow:
PUBLIC
PROC [g: Graphics, action:
PROC [
CHAR,
CHAR], string: String] ~ {
};
StringWidth:
PUBLIC
PROC [g: Graphics, string: String]
RETURNS [
VEC] ~ {
ERROR;
};