<> <> <> 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]; PSGraphicsImpl: CEDAR PROGRAM IMPORTS PS, BasicImager, ImagerColor, ImagerStroke, ImagerTransformation, RealFns, Vector2 EXPORTS PS, PSGraphics ~ BEGIN OPEN PS, PSGraphics; <> 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 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; <> 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]; }; <<>> <> 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]]; }; <<>> <> 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] ~ { <> <> <> < { MapSubPaths[seg.prev, subpaths]; EXIT };>> < ERROR Bug;>> <> <<>> }; 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.xbox.ur.x THEN box.ur.x _ p.x; IF p.ybox.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; }; <<>> <> 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] ~ { <> }; <<>> 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]] ~ { }; <<>> <> CopyPage: PUBLIC PROC [g: Graphics] ~ { }; <<>> FrameDevice: PUBLIC PROC [g: Graphics, matrix: Matrix, width, height: INT, proc: Any] ~ { }; <<>> NullDevice: PUBLIC PROC [g: Graphics] ~ { }; <<>> <> 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; }; <<>> <<>> <> CacheStatus: PUBLIC PROC [g: Graphics] RETURNS [CacheInfo] ~ { ERROR; }; <<>> SetCacheDevice: PUBLIC PROC [g: Graphics, w: VEC, box: Box] ~ { }; <<>> SetCharWidth: PUBLIC PROC [g: Graphics, w: VEC] ~ { }; <<>> SetCacheLimit: PUBLIC PROC [g: Graphics, blimit: INT] ~ { }; <<>> END.