<< 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.