<< JunoUserEventsImpl.mesa (ex JunoKeyboardImpl + JunoGerm + pieces of JunoTop and JunoGraphicsImpl)>> <<>> <> <> DIRECTORY Graphics USING [Box, Context, ClipBox], ViewerClasses USING [Viewer, ViewerClass, ViewerClassRec, NotifyProc, DestroyProc, PaintProc], MessageWindow USING [Append, Blink], Process USING[Detach], JunoButtons USING [Face, Justification, Hue, Device], ViewRec USING [ViewInterface, RVQuaViewer], ViewerOps USING [PaintViewer, RegisterViewerClass, CreateViewer, DestroyViewer], JunoGraphics USING [PaintBuffer, picChanged, ViewerToJuno], JunoCursorMenu USING [CreateCursorMenu, AddCursor, PickUpCursor], TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords], Terminal USING [Virtual, Current, WaitForBWVerticalRetrace], Rope USING [ROPE, Cat], Atom USING [MakeAtom], IO USING [STREAM, PutRope], ViewerIO USING [CreateViewerStreams], ViewerTools USING [GetSelectionContents], JunoUserEvents; JunoUserEventsImpl: CEDAR MONITOR IMPORTS JunoGraphics, JunoCursorMenu, Terminal, ViewerOps, ViewerTools, Graphics, ViewRec, Rope, Atom, TIPUser, IO, ViewerIO, Process, MessageWindow EXPORTS JunoUserEvents, JunoButtons = BEGIN OPEN JunoUserEvents, Curs: JunoCursorMenu, Buttons: JunoButtons, Gr: JunoGraphics, Rope, IO; << DEBUGGING>> << - - - - DEBUGGING STREAMS>> bugin, bugout: PUBLIC IO.STREAM; selfDebug: BOOL _ FALSE; -- should be TRUE if this module uses bugin/bugout by itself << THE USER EVENT QUEUE>> << - - - - QUEUE VARIABLES>> qSize: INTEGER = 200; queue: ARRAY [0..qSize) OF Event; front, count: INTEGER _ 0; <> <> queueClosed: BOOL _ TRUE; -- if TRUE, rejects further input into the queue nonEmpty, nonFull: CONDITION; -- status of queue << - - - - INSERTION AND DELETION>> AppendOne: INTERNAL PROC [ev: Event] = {queue[(front+count) MOD qSize] _ ev; count _ count + 1; IF ev.type = Quit THEN queueClosed _ TRUE}; AppendEvents: PUBLIC PROC [ev1, ev2, ev3, ev4, ev5: Event _ [type: Null]] = BEGIN DoAppend: ENTRY PROC [nev: INTEGER] = INLINE {WHILE count+nev > qSize AND NOT queueClosed DO WAIT nonFull ENDLOOP; IF queueClosed THEN RETURN; IF ev1.type # Null THEN AppendOne[ev1]; IF ev2.type # Null THEN AppendOne[ev2]; IF ev3.type # Null THEN AppendOne[ev3]; IF ev4.type # Null THEN AppendOne[ev4]; IF ev5.type # Null THEN AppendOne[ev5]; NOTIFY nonEmpty}; Cnt: PROC [ev: Event] RETURNS [INTEGER] = INLINE {RETURN [IF ev.type # Null THEN 1 ELSE 0]}; DoAppend [Cnt[ev1]+Cnt[ev2]+Cnt[ev3]+Cnt[ev4]+Cnt[ev5]] END; Pop: ENTRY PROC RETURNS [ev: Event] = <> <> BEGIN WHILE count = 0 DO WAIT nonEmpty ENDLOOP; ev _ queue[front]; count _ count - 1; front _ front + 1; IF front = qSize THEN front _ 0; BROADCAST nonFull END; << - - - - STARTUP AND FINALIZATION>> OpenEventStream: ENTRY PROC = <> BEGIN ENABLE {UNWIND => NULL}; IF selfDebug THEN bugout.PutRope["enter OpenEventStream\n"]; IF NOT queueClosed THEN ERROR; front _ 0; count _ 0; queueClosed _ FALSE; TRUSTED {Process.Detach[FORK Filter[]]}; BROADCAST nonFull; IF selfDebug THEN bugout.PutRope["exit OpenEventStream\n"] END; CloseEventStream: ENTRY PROC = <> BEGIN ENABLE {UNWIND => NULL}; IF selfDebug THEN bugout.PutRope["enter CloseEventStream\n"]; AppendOne[[type: Quit]]; NOTIFY nonEmpty; IF selfDebug THEN bugout.PutRope["exit CloseEventStream\n"] END; << THE IMAGE VIEWER>> << - - - - VIEWER AND OTHER VARIABLES>> imageViewer: PUBLIC ViewerClasses.Viewer _ NIL; menuBox: Graphics.Box _ [0, 0, 0, 0]; viewerDead: BOOLEAN _ FALSE; <> << - - - - VIEWER PROCEDURES>> PaintImageViewer: ViewerClasses.PaintProc = <> <> TRUSTED BEGIN Graphics.ClipBox[self: context, box: menuBox, exclude: TRUE]; Gr.PaintBuffer[viewer: self, context: context, viewerChanged: whatChanged = NIL] END; AppendTIPEvent: ENTRY ViewerClasses.NotifyProc = <<[self : ViewerClasses.Viewer, input : LIST OF REF ANY]>> TRUSTED BEGIN ENABLE {UNWIND => NULL}; IF input # NIL THEN {first: REF = input.first; rest: LIST OF REF ANY = input.rest; IF queueClosed OR count+1 > qSize THEN RETURN; -- if too many TIP events, just ignore them WITH first SELECT FROM atom: ATOM => SELECT atom FROM $MouseUp, $MouseDown => {cTIP: TIPUser.TIPScreenCoords = NARROW [rest.rest.first]; AppendOne[ [type: IF atom = $MouseUp THEN MouseUp ELSE MouseDown, value: rest.first, coords: Gr.ViewerToJuno[self, [cTIP.mouseX, cTIP.mouseY]]]]}; $End => {AppendOne[[type: End, value: rest.first]]}; $BackSpace => {AppendOne[[type: BackSpace]]}; $Cursor => {AppendOne[[type: Cursor, value: rest.first]]}; ENDCASE => {ERROR Unexpected}; char: REF CHAR => {AppendOne[[type: Char, value: char]]}; coords: TIPUser.TIPScreenCoords => {cc: EventCoords _ Gr.ViewerToJuno[self, [coords.mouseX, coords.mouseY]]; -- !!! should ignore click if outside currrent picture area (bitmap buffer) AppendOne[[type: Roll, value: NIL, coords: cc]]}; -- value will be set later ENDCASE => {SIGNAL Unexpected}; NOTIFY nonEmpty} END; DestroyImageViewer: ViewerClasses.DestroyProc = <<[self: Viewer]>> TRUSTED BEGIN AppendEvents [[type: Quit]]; viewerDead _ TRUE END; << - - - - SCREEN REFRESHER>> RefreshViewer: PROC = <> BEGIN DO IF viewerDead THEN RETURN; BEGIN t: Terminal.Virtual = Terminal.Current[]; Terminal.WaitForBWVerticalRetrace [t]; --! Should there be one or two calls? Terminal.WaitForBWVerticalRetrace [t] END; IF Gr.picChanged THEN {ViewerOps.PaintViewer [viewer: imageViewer, hint: client, clearClient: FALSE, whatChanged: $Refresh]} ENDLOOP END; << - - - - CURSOR MENU SETUP>> SetUpCursorMenu: PROC [initialCursor: ATOM] RETURNS [mBox: Graphics.Box] = BEGIN OPEN Curs; cm: ViewerClasses.Viewer _ CreateCursorMenu [parent: imageViewer, x: -1, y: -2, rows: 15, cols: 1]; mBox _ [xmin: cm.wx, ymin: cm.wy, xmax: cm.wx+cm.ww, ymax: cm.wy+cm.wh]; AddCursor [name: $Pencil, menu: cm, help: "Draws straight line or Bezier arc. Click two or four points, then ESC.", bits: [004440B, 004440B, 004440B, 004440B, 004440B, 004440B, 004440B, 004440B, 004040B, 004040B, 002100B, 002100B, 001600B, 001600B, 000400B, 000400B], row: 1, col: 1, hotX: -8, hotY: -16]; PickUpCursor [menu: cm, name: $Pencil]; AddCursor [name: $Typewriter, menu: cm, help: "Inserts a text label. Click reference point, type text, end with ESC.", bits: [000000B, 000000B, 000000B, 000000B, 017760B, 010020B, 010020B, 037770B, 045244B, 040004B, 100002B, 132532B, 100002B, 117762B, 040004B, 037770B], row: 2, col: 1, hotX: -5, hotY: -4]; AddCursor [name: $CallProc, menu: cm, help: "Calls a Juno procedure. Select procedure name, click arguments, end with ESC", bits: [040001B, 020002B, 010004B, 004010B, 002020B, 001040B, 000500B, 000200B, 000500B, 001040B, 002020B, 004010B, 010004B, 020002B, 040001B, 000000B], row: 3, col: 1, hotX: -8, hotY: -8]; AddCursor [name: $HorTee, menu: cm, help: "Horizontal alignment constraint. Click two points, end with ESC", bits: [000000B, 000000B, 020000B, 060000B, 060000B, 060000B, 160000B, 177777B, 177777B, 160000B, 060000B, 060000B, 060000B, 020000B, 000000B, 000000B], row: 5, col: 1, hotX: -9, hotY: -6]; AddCursor [name: $VerTee, menu: cm, help: "Vertical alignment constraint. Click two points, end with ESC", bits: [001700B, 017770B, 037774B, 000600B, 000600B, 000600B, 000600B, 000600B, 000600B, 000600B, 000600B, 000600B, 000600B, 000600B, 000600B, 000600B], row: 6, col: 1, hotX: -10, hotY: -9]; AddCursor [name: $Compass, menu: cm, help: "Congruence constraint. Click two pairs of points, end with ESC", bits: [004000B, 004000B, 006000B, 016000B, 013000B, 011000B, 031540B, 020700B, 023600B, 076200B, 040300B, 040100B, 140140B, 100040B, 100040B, 100000B], row: 7, col: 1, hotX: 0, hotY: -16]; AddCursor [name: $Parallels, menu: cm, help: "Parallelism constraint. Click two pairs of points, end with ESC", bits: [001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B, 001040B], row: 8, col: 1, hotX: -7, hotY: -8]; AddCursor [name: $RightAngle, menu: cm, help: "Perpendicularity constraint. Click two pairs of points, end with ESC", bits: [040000B, 060000B, 060000B, 050000B, 044000B, 044000B, 042000B, 041000B, 041000B, 044400B, 046200B, 046200B, 045100B, 040040B, 040040B, 077760B], row: 9, col: 1, hotX: -7, hotY: -8]; AddCursor [name: $Snowman, menu: cm, help: "Yellow-click points to be to frozen or unfrozen.", bits: [001700B, 001700B, 037774B, 004020B, 011110B, 010010B, 004020B, 003140B, 014030B, 020004B, 040002B, 040002B, 040002B, 020004B, 014030B, 003740B], row: 11, col: 1, hotX: -9, hotY: -12]; AddCursor [name: $MoveArrow, menu: cm, help: "Moves things. Click from-to pairs, end with ESC or TAB. Use baloon selection to get affine map.", bits: [000000B, 000000B, 000000B, 000400B, 001600B, 003700B, 007740B, 017760B, 037770B, 003700B, 003700B, 003700B, 003700B, 003700B, 003700B, 003700B], row: 12, col: 1, hotX: -8, hotY: -3]; AddCursor [name: $CopyArrow, menu: cm, help: "Copies things. Click from/to pairs, end with ESC or TAB. Use baloon selection to get affine map.", bits: [000400B, 001200B, 002100B, 004440B, 011620B, 033730B, 007740B, 017760B, 037770B, 003700B, 003700B, 003700B, 003700B, 003700B, 003700B, 003700B], row: 13, col: 1, hotX: -8, hotY: 0]; AddCursor [name: $Eraser, menu: cm, help: "Erases baloon-selected things.", bits: [004440B, 004440B, 004440B, 004440B, 004440B, 004440B, 004440B, 007740B, 004040B, 004040B, 004040B, 004040B, 004040B, 004040B, 004040B, 003700B], row: 14, col: 1, hotX: -8, hotY: -16]; AddCursor [name: $MakeProc, menu: cm, help: "Makes a symbolic procedure. Baloon-select body, click one or more formal parameters, end with ESC.", bits: [040001B, 020002B, 010004B, 004010B, 002020B, 001040B, 000500B, 000200B, 000200B, 000200B, 000200B, 000200B, 000200B, 000200B, 000200B, 000000B], row: 15, col: 1, hotX: 8, hotY: 8]; PickUpCursor[cm, initialCursor] END; << - - - - VIEWER SETUP>> CreateImageViewer: PROC [initialCursor: ATOM] = BEGIN imageViewer _ ViewerOps.CreateViewer [flavor: $JunoImage, info: [name: "Juno Image", iconic: FALSE, column: left], paint: FALSE]; menuBox _ SetUpCursorMenu[initialCursor]; ViewerOps.PaintViewer [viewer: imageViewer, hint: all]; TRUSTED {Process.Detach[FORK RefreshViewer[]]} END; << THE BUTTONS VIEWER>> << - - - - THE VIEWER >> buttonsViewer: ViewerClasses.Viewer _ NIL; << - - - - BUTTON PROCEDURES >> << These procedures are exported to the JunoButtons interface and invoked through ViewRec>> Hardcopy: PUBLIC PROC [filename: Rope.ROPE, device: Buttons.Device] = {AppendCmd[$Hardcopy, [type: Rope, value: filename], [type: Atom, value: SELECT device FROM Puffin => $Puffin, Raven => $Raven, PlateMaker => $PlateMaker, ENDCASE => ERROR]]}; Redraw: PUBLIC PROC = {AppendCmd[$Redraw]}; Solve: PUBLIC PROC = {AppendCmd[$Solve]}; StartOver: PUBLIC PROC = {AppendCmd[$StartOver]}; SetFont: PUBLIC PROC [fontName: ROPE] = {AppendCmd[$SetFont, [type: Rope, value: fontName]]}; SetFontSize: PUBLIC PROC [pointSize: INT] = {AppendCmd [$SetFontSize, [type: Real, value: NEW[REAL _ pointSize]]]}; SetFontFace: PUBLIC PROC [face: Buttons.Face] = {AppendCmd [$SetFontFace, [type: Atom, value: SELECT face FROM plain => $plain, italic => $italic, bold => $bold, boldItalic => $boldItalic, ENDCASE => ERROR]]}; SetJustification: PUBLIC PROC [justification: Buttons.Justification] = {AppendCmd [$SetJustification, [type: Atom, value: SELECT justification FROM left => $left, center => $center, right => $right, ENDCASE => ERROR]]}; SetLineWidth: PUBLIC PROC [width: REAL] = {AppendCmd [$SetLineWidth, [type: Real, value: NEW[REAL _ width]]]}; SetColor: PUBLIC PROC [color: Buttons.Hue] = {AppendCmd [$SetColor, [type: Atom, value: SELECT color FROM black => $black, white => $white, gray => $gray, red => $red, orange => $orange, yellow => $yellow, green => $green, blue => $blue, purple => $purple, ENDCASE => ERROR]]}; LoadX: PUBLIC PROC = {AppendCmd [$LoadX, [type: Atom, value: Atom.MakeAtom[ViewerTools.GetSelectionContents[]]]]}; Parse: PUBLIC PROC = {AppendCmd [$Parse]}; << - - - - MISCELLANEOUS PROCS >> AppendCmd: PROC [button: ATOM, arg1, arg2, arg3: Event _ [type: Null]] = {AppendEvents [[type: Button, value: button], arg1, arg2, arg3, [type: End, value: $None]]}; << - - - - SETUP >> CreateButtonsViewer: PROC = BEGIN buttonsViewer _ ViewRec.RVQuaViewer [ViewRec.ViewInterface [name: "JunoButtons", viewerInit: [iconic: FALSE, name: "Juno Buttons"]]]; END; << THE EVENT STREAM >> << - - - - FILTER OUTPUT BUFFER >> out: Event _ [type: Null]; -- one-event buffer on output of event filter outFull, outEmpty: CONDITION; -- status of output buffer Unexpected: SIGNAL = CODE; -- Syntax error in event stream <> Deliver: ENTRY PROC [ev: Event] = <> <> BEGIN WHILE out.type#Null DO WAIT outEmpty ENDLOOP; out _ ev; BROADCAST outFull END; Next: PUBLIC ENTRY PROC RETURNS [ev: Event] = <> <> BEGIN UNTIL out.type#Null DO WAIT outFull ENDLOOP; ev _ out; IF out.type # Quit THEN {out _ [type: Null]; BROADCAST outEmpty}; IF ev.type # Roll AND selfDebug THEN {bugout.PutRope["exit Next - "]; bugout.PutRope[SELECT ev.type FROM Cursor => "Cursor\n", Button => "Button\n", Char => "Char\n", MouseUp => "MouseUp\n", MouseDown => "MouseDown\n", Roll => "Roll\n", BackSpace => "BackSpace\n", End => "End\n", Quit => "Quit\n", Null => "Null\n", Real => "Real\n", Rope => "Rope\n", Atom => "Atom\n", ENDCASE => "ERROR\n"]} END; << - - - - THE EVENT FILTER >> Filter: PROC = <> BEGIN lastCursor: REF _ $Missing; -- should be ATOM, but why risk a NARROW fault? ev: Event _ Pop[]; ScreamAndSkip: PROC = <> {ENABLE {ABORTED => CONTINUE}; -- If the user aborts the Unexpected signal SIGNAL Unexpected; ev _ Pop[]}; BlinkAndSkip: PROC [rope: ROPE] = <> {Blink[rope]; ev _ Pop[]}; FilterMouseClick: PROC = <> BEGIN color: REF = ev.value; -- should be ATOM, but why risk a NARROW fault? lastPos: EventCoords _ ev.coords; FakeMouseUp: PROC = {Deliver[[type: MouseUp, value: color, coords: lastPos]]}; Deliver[ev]; ev _ Pop[]; DO SELECT ev.type FROM MouseUp => {lastPos _ ev.coords; IF ev.value = color THEN {Deliver[ev]; ev _ Pop[]; RETURN} ELSE {BlinkAndSkip["funny mouse click"]}}; Roll => {lastPos _ ev.coords; ev.value _ color; Deliver[ev]; ev _ Pop[]}; MouseDown => {IF ev.value = color THEN {FakeMouseUp[]; RETURN} ELSE {lastPos _ ev.coords; BlinkAndSkip["funny mouse click"]}}; Cursor, Button, Char, BackSpace, End, Atom, Real, Rope, Quit => {FakeMouseUp[]; RETURN}; ENDCASE => {ScreamAndSkip[]; FakeMouseUp[]; RETURN}; ENDLOOP; END; FakeCursor: PROC = INLINE {Deliver[[type: Cursor, value: lastCursor]]}; FilterCommandBody: PROC [cmdType: EventType] = <> BEGIN FakeEnd: PROC = INLINE {Deliver[[type: End, value: $None]]}; DO SELECT ev.type FROM Cursor, Button, Quit => {FakeEnd[]; RETURN}; MouseDown => {FilterMouseClick[]}; Char, Atom, Real, Rope, BackSpace => {Deliver[ev]; ev _ Pop[]}; End => {-- Always fake a Cursor between a legitimate Endand the next event. -- This makes the response of JunoTop a bit livelier. Deliver[ev]; FakeCursor[]; ev_ Pop[] }; Roll => {ev _ Pop[]}; MouseUp => {BlinkAndSkip["funny mouse click"]}; ENDCASE => {ScreamAndSkip[]}; ENDLOOP; END; << Body of Filter:>> DO ENABLE {ABORTED => LOOP}; <> SELECT ev.type FROM Cursor, Button => {cmdType: EventType = ev.type; IF cmdType = Cursor THEN lastCursor _ ev.value; Deliver[ev]; ev _ Pop[]; FilterCommandBody[cmdType]}; Quit => {Deliver[ev]; RETURN}; -- close shop Char, BackSpace, Atom, Real, Rope, MouseDown, End => -- Cursor command interrupted by Button? {FakeCursor[]; FilterCommandBody[Cursor]}; Roll => -- leftover from interrupted roll {ev _ Pop[]}; MouseUp => -- leftover from interrupted roll {BlinkAndSkip["funny mouse click"]; WHILE ev.type = MouseUp OR ev.type = Roll DO ev _ Pop[] ENDLOOP}; ENDCASE => {ScreamAndSkip[]}; ENDLOOP END; << ERROR MESSAGES>> << - - - - BLINK WINDOW >> Blink: PUBLIC PROC [item1, item2, item3, item4, item5: ROPE _ NIL] = BEGIN MessageWindow.Append[Cat[item1, item2, item3, item4, item5], TRUE]; MessageWindow.Blink[] END; << SETUP AND TERMINATION>> StartUp: PUBLIC PROC [debug: BOOL _ FALSE] = BEGIN JunoImageClass: ViewerClasses.ViewerClass _ NEW [ViewerClasses.ViewerClassRec _ [ paint: PaintImageViewer, -- called whenever the viewer should repaint notify: AppendTIPEvent, -- TIP input events destroy: DestroyImageViewer, tipTable: TIPUser.InstantiateNewTIPTable["JunoImage.Tip"], clipChildren: TRUE, -- DAMN - doesnt work in Cedar 5.1 !!! cursor: questionMark, coordSys: top -- to correctly position the cursor menu ] ]; ViewerOps.RegisterViewerClass[$JunoImage, JunoImageClass]; IF debug OR selfDebug THEN {[bugin, bugout] _ ViewerIO.CreateViewerStreams[name: "Juno Bugs"]}; OpenEventStream; CreateImageViewer[$Pencil]; CreateButtonsViewer END; Terminate: PUBLIC PROC = BEGIN IF NOT viewerDead AND imageViewer # NIL THEN {ViewerOps.DestroyViewer[imageViewer]; imageViewer _ NIL; viewerDead _ TRUE}; IF buttonsViewer # NIL THEN {ViewerOps.DestroyViewer[buttonsViewer]; buttonsViewer _ NIL}; CloseEventStream END; END.