JunoUserEventsImpl.mesa (ex JunoKeyboardImpl + JunoGerm
+ pieces of JunoTop and JunoGraphicsImpl)
Coded by Greg Nelson & Donna Auguste, December 7, 1982 11:51 am
Last edited by Stolfi June 7, 1984 5:02:12 pm PDT

DIRECTORY

Graphics USING [Box, Context, ClipBox],
ViewerClasses USING [Viewer, ViewerClass, ViewerClassRec,
NotifyProc, DestroyProc, PaintProc],
MessageWindow USING [Append, Blink],
Process USING[Detach],
JunoButtons USING [], -- exports it, and calls VieweInterface on it
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],
IO USING [STREAM, PutRope],
ViewerIO USING [CreateViewerStreams],
JunoUserEvents;

JunoUserEventsImpl: CEDAR MONITOR

IMPORTS

JunoGraphics,
JunoCursorMenu,
Terminal,
ViewerOps,
Graphics,
ViewRec,
Rope,
TIPUser,
IO,
ViewerIO,
Process,
MessageWindow

EXPORTS

JunoUserEvents,
JunoButtons =

BEGIN

OPEN

JunoUserEvents,
Curs: JunoCursorMenu,
Gr: JunoGraphics,
Rope,
IO;

DEBUGGING

- - - - DEBUGGING STREAMS

bugin, bugout: PUBLIC IO.STREAM;

selfDebug: BOOL ← TRUE; -- should be TRUE if this module uses bugin/bugout by itself

THE USER EVENT QUEUE

- - - - DEBUGGING STUFF

bugin, bugout: PUBLIC IO.STREAM;

- - - - QUEUE VARIABLES

qSize: INTEGER = 200;
queue: ARRAY [0..qSize) OF Event;
front, count: INTEGER ← 0;
The active range of the queue is [front..front+count), wrapped.
Entries are added to the back of the queue, and removed from the front.

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] =
Removes the next item from the front end of the queue and returns it.
Used by the Filter only.

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;
IF ev.type # Roll THEN {bugout.PutRope["exit Pop:\n"]}

END;

- - - - STARTUP AND FINALIZATION

OpenEventStream: ENTRY PROC =
Starts the queue and forks the filter process.

BEGIN ENABLE {UNWIND => NULL};

bugout.PutRope["enter OpenEventStream\n"];
IF NOT queueClosed THEN ERROR;
front ← 0; count ← 0;
queueClosed ← FALSE;
TRUSTED {Process.Detach[FORK Filter[]]};
BROADCAST nonFull;
bugout.PutRope["exit OpenEventStream\n"]

END;

CloseEventStream: ENTRY PROC =
Gracefully closes the event stream, if still open.

BEGIN ENABLE {UNWIND => NULL};

bugout.PutRope["enter CloseEventStream\n"];
AppendOne[[type: Quit]];
NOTIFY nonEmpty;
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;
Set when image viewer is destroyed

- - - - VIEWER PROCEDURES

PaintImageViewer: ViewerClasses.PaintProc =
Paints the bitmap on the viewer and resets picChanged.
Also recomputes the Juno-to-Viewer coordinate transformations, to account for the current size of bitmap and viewer.

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

{AppendOne[
[type: Roll,
value: NIL, -- will be set on output
 coords: Gr.ViewerToJuno[self, [coords.mouseX, coords.mouseY]]]]};

ENDCASE => {SIGNAL Unexpected};

NOTIFY nonEmpty}

END;

DestroyImageViewer: ViewerClasses.DestroyProc =
[self: Viewer]

TRUSTED BEGIN
AppendEvents [[type: Quit]];
viewerDead ← TRUE
END;

- - - - SCREEN REFRESHER

RefreshViewer: PROC =
This is an independent process that wakes up every two vertical retraces to paints the image bitmap onto the viewer, if necessary.

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];

cmBox ← [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] =

{AppendCmd[$Hardcopy, [type: Rope, value: filename]]};

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: Face] =

{AppendCmd [$SetFontFace,
[type: Atom, value: SELECT face FROM
plain => $plain,
italic => $italic,
bold => $bold,
boldItalic => $boldItalic,
ENDCASE => ERROR]]};

SetJustification: PUBLIC PROC [justification: Justification] =

{AppendCmd [$SetJustification,
[type: Atom, value: SELECT justification FROM
left => $left,
center => $center,
right => $right,
ENDCASE => ERROR]]};

- - - - MISCELLANEOUS PROCS

AppendCmd: PROC [button: ATOM, arg1, arg2, arg3: Evs.Event ← [type: Null]] =

{Evs.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
May be raised by the filtering process or by the process calling AppendTIPEvent

Deliver: ENTRY PROC [ev: Event] =
Puts the given event into the filter output buffer
Used by the filter only.

BEGIN

WHILE out.type#Null DO WAIT outEmpty ENDLOOP;
out ← ev;
BROADCAST outFull

END;

Next: PUBLIC ENTRY PROC RETURNS [ev: Event] =
Removes and returns the event on the filter output buffer.
Called by clients (JunoTop) only.

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 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",
ENDCASE => "ERROR\n"]}

END;

- - - - THE EVENT FILTER

Filter: PROC =
The event stream filter (runs as independent process)

BEGIN

lastCursor: REF ← $Missing; -- should be ATOM, but why risk a NARROW fault?

ev: Event ← Pop[];

ScreamAndSkip: PROC =
Complains about something that shouldn't happen (TIP table ir internal error)

{ENABLE {ABORTED => CONTINUE}; -- If the user aborts the Unexpected signal
 SIGNAL Unexpected; ev ← Pop[]};

BlinkAndSkip: PROC [rope: ROPE] =
Complains about something funny the user did with mouse or keyboard

{Blink[rope]; ev ← Pop[]};

FilterMouseClick: PROC =
Called with ev undelivered, and ev.type = MouseDown. Filters everything up to a matching MouseUp (may have to fake it) into a proper, complete mouse click sequence. Leaves in ev the event FOLLOWING the MouseUp.

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;

FilterCommandBody: PROC [cmdType: EventType] =
On entry, ev should be the (undelivered) event following a $Cursor or $Button. Filters everything up to a matching End (may have to fake it) into a proper, complete cursor or menu command. Leaves in ev the event FOLLOWING the End.

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

{Deliver[ev]; ev ← Pop[]; RETURN};

Roll =>

{ev ← Pop[]};

MouseUp =>

{BlinkAndSkip["funny mouse click"]};

ENDCASE =>

{ScreamAndSkip[]};

ENDLOOP;

END;

Body of Filter:

FakeCursor: PROC = INLINE {Deliver[[type: Cursor, value: lastCursor]]};

DO

ENABLE {ABORTED => LOOP};
If the user aborts uncaught errors.

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]};

MouseUp, Roll => -- leftover from interrupted roll

{BlinkAndSkip["funny mouse click"]};

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.