-- COGDrawTest.mesa: Test of viewers for geometrical drawings
-- last modified by Stolfi - October 12, 1982 12:30 am
-- To Run: run COGAll; run COGDrawTest
DIRECTORY
IO USING [PutF, GetChar],
Rope USING [ROPE],
GraphicsColor USING [red],
Real USING [],
Graphics USING [SetColor, DrawArea, Path, NewPath],
COGDebug USING [in, out],
COGCart USING [Box],
COGHomo USING [Point, Add, Vector, Way, Random],
COGDrawing;
COGDrawTest: CEDAR PROGRAM
IMPORTS
IO, COGDebug, COGHomo, COGDrawing, Graphics =
BEGIN
OPEN
COGDrawing, Homo: COGHomo, Cart: COGCart, Bug: COGDebug,
Real, Rope, GraphicsColor, IO;
SegmentRec: TYPE = RECORD [org, dest: Homo.Point];
dr: Drawing = MakeDrawing["Bananas", [min: [-1.0, -1.0], max: [1.0, 1.0]]];
seg: REF SegmentRec = NEW[SegmentRec ← [[0.0, 0.0, 1.0], [1.0, 0.0, 1.0]]];
dot: REF Homo.Point = NEW[Homo.Point ← [0.0, 0.0, 1.0]];
pol: LIST OF Homo.Point = LIST [[1.0, 0.0, 1.0], [0.0, 1.0, 1.0], [-1.0, 0.0, 1.0], [0.0, -1.0, 1.0]];
segobj: Object = Make [SegPainter, [data: seg]];
polobj: Object = Make [PolPainter, [data: pol, color: red]];
dotobj: Object = Make [DotPainter, [data: dot, size: 3]];
smallBox: Cart.Box = [min: [-0.5, -0.5], max: [0.5, 0.5]];
SegPainter: PainterProc =
BEGIN
seg: REF SegmentRec = NARROW [parms.data];
DrawSegment [context, sf, seg.org, seg.dest, parms.size, parms.color]
END;
DotPainter: PainterProc =
BEGIN
dot: REF Homo.Point = NARROW [parms.data];
DrawDot [context, sf, dot^, parms.size, parms.color]
END;
PolPainter: PainterProc =
TRUSTED
BEGIN
pol: LIST OF Homo.Point ← NARROW [parms.data];
path: Graphics.Path ← Graphics.NewPath[10];
IF pol = NIL THEN RETURN;
COGDrawing.MoveTo [path, sf, pol.first]; pol ← pol.rest;
WHILE pol # NIL DO
COGDrawing.LineTo [path, sf, pol.first]; pol ← pol.rest
ENDLOOP;
Graphics.SetColor [context, parms.color];
Graphics.DrawArea [context, path]
END;
ResetSeg: MenuProc =
BEGIN
DoErase [dr, segobj];
seg^ ← [[0.0, 0.0, 1.0], [1.0, 0.0, 1.0]];
DoPaint [dr, segobj];
DoErase [dr, dotobj];
dot^ ← [0.0, 0.0, 1.0];
DoPaint [dr, dotobj]
END;
PullSeg: MouseProc =
BEGIN
dt: LIST OF REF ANY = NARROW [eventData];
DoErase [dr, segobj];
IF dt.first = $Org THEN
{seg.org ← [x, y, 1.0] ; dt.first ← $Dest}
ELSE
{seg.dest ← [x, y, 1.0]; dt.first ← $Org};
DoPaint [dr, segobj]
END;
PutPoint: MouseProc =
BEGIN
ndot: REF Homo.Point = NEW[Homo.Point ← [x, y, 1.0]];
Add [dr, Make [DotPainter, [data: ndot]], 4]
END;
ShiftEm: ObjectAction =
BEGIN
WITH obj.parms.data SELECT FROM
dot: REF Homo.Point =>
{DoErase [dr, obj];
dot^ ← Homo.Way [0.03, Homo.Add [dot^, Homo.Random[smallBox]], [0.0, 0.0, 1.0]];
DoPaint[dr, obj]};
seg: REF SegmentRec =>
{DoErase [dr, obj];
seg.org ← Homo.Way [0.05, Homo.Add [seg.org, Homo.Random[smallBox]], [0.0, 0.0, 1.0]];
seg.dest ← Homo.Way [0.05, Homo.Add [seg.dest, Homo.Random[smallBox]], [0.0, 0.0, 1.0]];
DoPaint[dr, obj]};
ENDCASE => {DoPaint[dr, obj]}
END;
Bug.out.PutF["Starting: say something:\n"];
[] ← Bug.in.GetChar[];
Add [dr, dotobj, 3];
Add [dr, segobj, 3];
Add [dr, polobj, 2];
AddMenuAction [dr, "ResetSeg", ResetSeg, NIL, write];
AddMouseAction [dr, [button: red], PullSeg, LIST [$Org], write];
AddMouseAction [dr, [button: blue], PutPoint, NIL, none];
WHILE Alive[dr] DO
[] ← ModifyAll [dr, ShiftEm, NIL, FALSE, FALSE];
ENDLOOP
END...