[Cyan]<PreISLCedar>Stolfi>JunoCursorMenu>JunoCursorTest.mesa!1

JunoCursorTest.mesa

Coded by: Jorge Stolfi May 22, 1984 4:20:42 pm PDT

A random testing program for JunoCursorMenu & impl.

DIRECTORY

JunoCursorMenu USING
[CreateCursorMenu, AddCursor, PickUpCursor, RemoveCursor, HighlightCursor],
TIPUser USING [InstantiateNewTIPTable],
Process USING [SecondsToTicks, Pause, Detach],
Graphics USING [SetColor, black, Path, Context, NewPath, MoveTo,
LineTo, CurveTo, DrawStroke, DrawArea, SetPaintMode],
IO USING [Put, PutChar, PutRope, CR, refAny, STREAM],
ViewerIO USING [CreateViewerStreams],
Interminal USING [MousePosition],
ViewerClasses USING
[ViewerClass, Viewer, NotifyProc, PaintProc, DestroyProc,
ViewerClassRec, ViewerRec],
ViewerOps USING [RegisterViewerClass, CreateViewer, PaintViewer, DestroyViewer];

JunoCursorTest: MONITOR

IMPORTS

JunoCursorMenu,
ViewerOps,
TIPUser,
Graphics,
Process,
IO,
ViewerIO

BEGIN OPEN JunoCursorMenu, Graphics;

- - - - VIEWER PAINTING

Item: TYPE = REF ItemRec;

ItemKind: TYPE = {stroke, area};

Coords: TYPE = Interminal.MousePosition;

ItemRec: TYPE = RECORD [kind: ItemKind, path: Path, center: Coords];

olditems, items: LIST OF Item ← NIL; -- protected by monitor lock

GetItems: ENTRY PROC RETURNS [list: LIST OF Item] =

BEGIN
RETURN [items];
END;

DeleteItem: PROC [c: Coords] =

BEGIN

champ, champa: LIST OF Item ← NIL;

DoDelete: ENTRY PROC =

BEGIN

i, ia: LIST OF Item ← NIL;

Dist: PROC [p, q: Coords] RETURNS [REAL] = INLINE
{RETURN [ABS[p.mouseX-q.mouseX]+ABS[p.mouseY-q.mouseY]]};

FOR i ← items, i.rest WHILE i # NIL DO
IF champ=NIL OR Dist[i.first.center, c] < Dist[champ.first.center, c] THEN
{champ ← i; champa ← ia};
ia ← i
ENDLOOP;
IF champ=NIL THEN RETURN;
IF champa = NIL THEN items ← champ.rest ELSE champa.rest ← champ.rest;
olditems ← champ.rest

END;

DoDelete[];
IF champ#NIL THEN
{ViewerOps.PaintViewer
[viewer: viewer, hint: client, clearClient: FALSE, whatChanged: champ.first]}

END;

AddItem: PROC [item: Item] =

BEGIN

DoAdd: ENTRY PROC = {items ← CONS [item, items]};

DoAdd[];
ViewerOps.PaintViewer
[viewer: viewer, hint: client, clearClient: FALSE, whatChanged: item]

END;

DrawItem: PROCEDURE [context: Context, item: Item] =

BEGIN
SELECT item.kind FROM
stroke => DrawStroke[context, item.path];
area => DrawArea[context, item.path];
ENDCASE => ERROR;
END;

PaintMe: ViewerClasses.PaintProc = TRUSTED
-- [self: Viewer, context: Context, whatChanged: REF ANY, clear: BOOL]

BEGIN

SetColor[context, black];
[] ← SetPaintMode[context, invert];
IF whatChanged = NIL THEN

{FOR p: LIST OF Item ← GetItems[], p.rest WHILE p # NIL DO
DrawItem[context, p.first]
ENDLOOP}

ELSE

{WITH whatChanged SELECT FROM
item: Item => {DrawItem[context, item]};
ENDCASE => ERROR}

END;

- - - - MOUSE & KEYBOARD INPUT PROCESSING

debug: BOOL ← FALSE; -- if true, prints all things passed to the parent's notifier

currentCursor: ATOM ← NIL;

prevp: Coords;

npoints: INTEGER ← 0; -- num of points already moused in last command

NotifyMe: ViewerClasses.NotifyProc = TRUSTED
-- [self : ViewerClasses.Viewer, input : LIST OF REF ANY]

BEGIN

IF debug THEN
{out.Put [IO.refAny[input]]; out.PutChar [IO.CR]};

IF input=NIL THEN RETURN;
WITH input.first SELECT FROM

atom: ATOM =>

BEGIN

SELECT atom FROM

$Debug => RETURN;

$Cursor =>

BEGIN

currentCursor ← NARROW [input.rest.first];
npoints ← 0;
IF currentCursor = $Bomb THEN Process.Detach[FORK PlayAround]

END;

$Click =>

BEGIN

SELECT currentCursor FROM

$Pencil =>

IF npoints = 0 THEN

{prevp ← NARROW [input.rest.first, REF Coords]^;
npoints ← npoints + 1}

ELSE

{path: Path ← NewPath[2];
newp: Coords = NARROW [input.rest.first, REF Coords]^;
MoveTo[path, prevp.mouseX, prevp.mouseY];
LineTo[path, newp.mouseX, newp.mouseY];
AddItem[NEW [ItemRec ←
[kind: stroke,
path: path,
center: [mouseX: (prevp.mouseX+newp.mouseX)/2,
mouseY: (prevp.mouseY+newp.mouseY)/2,
color: FALSE]]]];
prevp ← newp; npoints ← npoints + 1};

$Compass =>

IF npoints = 0 THEN

{prevp ← NARROW [input.rest.first, REF Coords]^;
npoints ← npoints + 1}

ELSE

{path: Path ← NewPath[5];
newp: Coords = NARROW [input.rest.first, REF Coords]^;
rx: REAL ← newp.mouseX-prevp.mouseX;
ry: REAL ← newp.mouseY-prevp.mouseY;
t: REAL;
MoveTo[path, newp.mouseX, newp.mouseY];
THROUGH [1..4] DO
CurveTo [path,
prevp.mouseX+rx-0.55*ry, prevp.mouseY+ry+0.55*rx,
prevp.mouseX-ry+0.55*rx, prevp.mouseY+rx+0.55*ry,
prevp.mouseX-ry, prevp.mouseY+rx];
t ← rx; rx ← -ry; ry ← t
ENDLOOP;
AddItem[NEW [ItemRec ←
[kind: stroke,
path: path,
center: prevp]]];
npoints ← 0};

$Eraser =>

{DeleteItem[NARROW [input.rest.first, REF Coords]^]};

ENDCASE => RETURN;

END;

ENDCASE => {}

END;

ENDCASE => {}

END;

- - - - QUITTING

DestroyMe: ViewerClasses.DestroyProc = TRUSTED
-- [self: Viewer]

BEGIN
out.PutRope ["\nQuts!\n"];
ViewerOps.DestroyViewer[bugs]
END;

- - - - DEMO: CURSOR MASKING, SELECTION, AND REMOVAL BY CLIENT

PlayAround: PROC =

BEGIN

out.PutRope["Prepare for the unexpected...\n"];
Process.Pause[Process.SecondsToTicks[4]];
out.PutRope["Deleting $Bomb...\n"];
RemoveCursor[cursorMenu, $Bomb ! ABORTED => CONTINUE];
Process.Pause[Process.SecondsToTicks[4]];
out.PutRope["Picking $Snowman...\n"];
PickUpCursor[cursorMenu, $Snowman];
Process.Pause[Process.SecondsToTicks[4]];
out.PutRope["masking $VerTee, $Parallels...\n"];
HighlightCursor[cursorMenu, $VerTee, TRUE];
HighlightCursor[cursorMenu, $Parallels, TRUE];
Process.Pause[Process.SecondsToTicks[4]];
out.PutRope["Picking $Pencil...\n"];
PickUpCursor[cursorMenu, $Pencil];
Process.Pause[Process.SecondsToTicks[4]];
out.PutRope["un-masking $VerTee...\n"];
HighlightCursor[cursorMenu, $VerTee, FALSE];
out.PutRope["Done playing\n"];

END;

- - - - VIEWER SETUP

in, out: IO.STREAM; -- debugging typescript viewer

JunoClass: ViewerClasses.ViewerClass ←

NEW [ViewerClasses.ViewerClassRec ← [

paint: PaintMe, --called whenever the viewer should repaint
notify: NotifyMe, --TIP input events
destroy: DestroyMe,
tipTable: TIPUser.InstantiateNewTIPTable["JunoCursorTest.Tip"],
cursor: questionMark,
coordSys: top,
clipChildren: TRUE

] ];

viewer, cursorMenu, bugs: ViewerClasses.Viewer;

ViewerOps.RegisterViewerClass[$JunoTest, JunoClass];

bugs ← ViewerOps.CreateViewer

[flavor: $Typescript,
info:
[name: "Juno Test Log",
file: "JunoTest.log",
iconic: FALSE,
column: right]];

[in, out] ← ViewerIO.CreateViewerStreams[name: "Juno Test Log", viewer: bugs];
out.PutRope["\nJunoCursorMenu Test\n"];

viewer ← ViewerOps.CreateViewer

[flavor: $JunoTest,
info:
[name: "Juno Test Image",
iconic: FALSE,
column: left]];

- - - - CURSOR MENU SETUP

cursorMenu ← CreateCursorMenu
[parent: viewer,
x: 20, y: 10,
rows: 3, cols: 7];

AddCursor [cursorMenu, $Pencil,

"Polygonal: click two or more vertices",
[4440B, 4440B, 4440B, 4440B, 4440B, 4440B, 4440B,
4440B, 4040B, 4040B, 2100B, 2100B, 1600B, 1600B, 400B, 400B],
1, 1, -8, -16, TRUE];

AddCursor [cursorMenu, $Compass,

"Circles: click center and radius",
[060000B, 070000B, 074000B, 076100B, 067300B, 063600B, 061600B, 063700B,
076140B, 070060B, 060010B, 060000B, 060000B, 040000B, 040000B, 040000B],
1, 2, 0, -16, TRUE];

AddCursor [cursorMenu, $Eraser,

"Click near center of item to be erased",
[125240B, 052500B, 125200B, 052400B, 125000B, 052001B, 124002B, 050005B,
134012B, 066025B, 133052B, 055525B, 126652B, 053525B, 125252B, 052525B],
3, 1, -5, -4, TRUE];

AddCursor [cursorMenu, $Typewriter,

"Not implemented",
[0,0,0,0, 17760B, 10020B, 10020B, 37770B, 40004B, 45244B,
100002B, 132532B, 100002B, 117762B, 40004B, 37770B],
1, 7, -5, -4, TRUE];

AddCursor [cursorMenu, $HorTee,

"Not implemented",
[0B, 0B, 20000B, 60000B, 60000B, 60000B, 160000B, 177777B,
177777B, 160000B,060000B, 060000B, 060000B, 020000B, 0b, 0b],
2, 1, -9, -6, TRUE];

AddCursor [cursorMenu, $VerTee,

"Not implemented",
[1700B, 17770B, 37774B, 600B, 600B, 600B, 600B,
600B, 600B, 600B, 600B, 600B, 600B, 600B, 600B, 600B],
2, 2, -10, -9, TRUE];

AddCursor [cursorMenu, $Parallels,

"Not implemented",
[1040B, 1040B, 1040B, 1040B, 1040B, 1040B, 1040B, 1040B,
1040B, 1040B, 1040B, 1040B, 1040B, 1040B, 1040B, 1040B],
2, 3, -7, -8, TRUE];

AddCursor [cursorMenu, $Eye,

"Not implemented",
[000000B, 000000B, 003740B, 014030B, 021704B, 043742B, 047462B, 107461B,
147762B, 027764B, 017770B, 003740B, 000000B, 000000B, 000000B, 000000B],
3, 4, -9, -12, FALSE];

AddCursor [cursorMenu, $Snowman,

"Not implemented",
[1700B, 1700B, 37774B, 4020B, 11110B, 10010B, 4020B, 3140B,
14030B, 20004B, 40002B, 40002B, 40002B, 20004B, 14030B, 3740B],
3, 5, -9, -12, FALSE];

AddCursor [cursorMenu, $Hatching,

"Not implemented",
[177777B, 104103B, 110205B, 120411B, 141021B, 102041B, 104103B, 110205B,
120411B, 141021B, 102041B, 104103B, 110205B, 120411B, 141021B, 177777B],
3, 6, -8, -8, FALSE];

AddCursor [cursorMenu, $Bomb,

"Tests selection, masking, and removal of cursors by client",
[000000B, 005000B, 002000B, 005000B, 002400B, 000200B, 000200B, 000700B,
003760B, 003760B, 007770B, 007770B, 007770B, 003760B, 003760B, 000700B],
3, 7, -9, -12, FALSE]

END.