[Cyan]<PreISLCedar>Stolfi>JunoX>JunoUserEventsImpl.mesa!1

JunoUserEventsImpl.mesa (ex JunoKeyboardImpl + JunoGerm
+ pieces of JunoTop and JunoGraphicsImpl)

First coded by Greg Nelson & Donna Auguste, December 7, 1982 11:51 am

Last edited by Stolfi June 15, 1984 7:50:43 am PDT

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;

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

END;

- - - - STARTUP AND FINALIZATION

OpenEventStream: ENTRY PROC =

Starts the queue and forks the filter process.

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 =

Gracefully closes the event stream, if still open.

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;

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

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

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

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

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

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

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

On entry, ev should be an (undelivered) event following a $Cursor or $Button. Filters everything up to next Cursor, Button, or Quit (which is left in ev) into a sequence of one or more proper, complete cursor or menu commands. The number of commands is the number of End events found, plus one (the last End is always faked).

BEGIN

FakeEnd: PROC = INLINE {Deliver[[type: End, value: $None]]};

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:

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

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.