-- TJaMGraphicsViewer.mesa
-- Last change by Bill Paxton, July 8, 1982 8:43 am
-- Last change by McGregor, June 15, 1982 10:05 am

DIRECTORY
JaMGraphics,
Graphics,
InputFocus USING [CaptureButtons, ReleaseButtons],
Real USING [RoundI],
TJaMGraphics,
TJaMGraphicsPrivate,
JaMOps USING [defaultFrame],
JaMTypeScript USING [DoAtom, DoButton],
TIPUser USING [TIPScreenCoords],
UserTerminal USING [BlinkDisplay],
ViewerClasses USING [Viewer];

TJaMGraphicsViewer: MONITOR
LOCKS info USING info:TJaMGraphicsPrivate.Info
IMPORTS Graphics, Real, JaMTypeScript, JaMOps, TJaMGraphicsPrivate,
 UserTerminal, InputFocus
EXPORTS JaMGraphics, TJaMGraphics, TJaMGraphicsPrivate =
BEGIN OPEN TJaMGraphicsPrivate;

Update: PUBLIC PROCEDURE[] = {
SIGNAL NotImplemented;
};

NotImplemented: PUBLIC SIGNAL = CODE;

ViewerMouse: PUBLIC PROCEDURE[frame: Frame, click: BOOLEAN] RETURNS[x,y: INTEGER] = {
rx, ry: REAL;
[rx, ry] ← RealViewerMouse[frame, click];
x ← Real.RoundI[x]; y ← Real.RoundI[y] };

RealViewerMouse: PUBLIC PROCEDURE[frame: Frame, click: BOOLEAN] RETURNS[x,y: REAL] = {
info: Info ← GetInfo[frame];
IF info=NIL THEN RETURN [0,0];
IF click THEN [x,y] ← GetBug[info] ELSE [x,y] ← GetPlace[info];
};

GetBug: ENTRY PROC [info: Info] RETURNS[x,y: REAL] = { OPEN info;
ENABLE UNWIND => NULL;
bugflag ← FALSE;
UNTIL viewer.destroyed OR bugflag DO WAIT bugged ENDLOOP;
IF viewer.destroyed THEN x ← y ← 0
ELSE { x ← bugX; y ← bugY; bugflag ← FALSE };
};

SetBug: PUBLIC ENTRY PROC [info: Info, x,y: REAL] = { OPEN info;
ENABLE UNWIND => NULL;
bugflag ← TRUE; bugX ← x; bugY ← y;
NOTIFY bugged };

GetPlace: ENTRY PROC [info: Info] RETURNS[x,y: REAL] = { OPEN info;
ENABLE UNWIND => NULL;
mouseflag ← FALSE;
UNTIL viewer.destroyed OR mouseflag DO WAIT mouse ENDLOOP;
IF viewer.destroyed THEN x ← y ← 0
ELSE { x ← mouseX; y ← mouseY; mouseflag ← FALSE };
};

SetPlace: PUBLIC ENTRY PROC [info: Info, x,y: REAL] = { OPEN info;
ENABLE UNWIND => NULL;
mouseflag ← TRUE; mouseX ← x; mouseY ← y; NOTIFY mouse;
};

Mouse: PUBLIC PROCEDURE[click: BOOLEAN] RETURNS[x,y: INTEGER] = {
[x,y] ← ViewerMouse[JaMOps.defaultFrame,click];
};

InputNotify: PUBLIC PROCEDURE [self: ViewerClasses.Viewer, input: LIST OF REF ANY] = {
Do: PROC [button: ATOM] = {
JaMTypeScript.DoButton[NARROW[self.data,Info].typescript,button,mx,my] };
ReleaseButtons: PROC = {
 info: Info ← NARROW[self.data];
 IF ~info.capturedButtons THEN RETURN;
 InputFocus.ReleaseButtons[];
info.capturedButtons ← FALSE };
AdjustCoords: PROC = {
 info: Info ← NARROW[self.data];
 IF ~info.capturedButtons THEN -- get screen coordinates
  [x, y] ← Graphics.UserToWorld[info.initdc, mx, my]
 ELSE { x ← mx; y ← my }; -- already in screen coordinates
 [x, y] ← Graphics.WorldToUser[info.dc, x, y] -- convert using current dc
 };
mx, my: INTEGER;
x, y: REAL;
Place: PROC = { SetPlace[NARROW[self.data,Info],x,y] };
FOR l: LIST OF REF ANY ← input, l.rest UNTIL l = NIL DO
WITH l.first SELECT FROM
z: ATOM => SELECT z FROM
  $RedDown, $CtrlRedDown, $ShiftRedDown, $CtrlShiftRedDown => {
   SetBug[NARROW[self.data,Info],x,y]; Place[]; Do[z] };
  $YellowDown, $CtrlYellowDown, $ShiftYellowDown, $CtrlShiftYellowDown,
   $BlueDown, $CtrlBlueDown, $ShiftBlueDown, $CtrlShiftBlueDown,
   $Track, $CtrlTrack, $ShiftTrack, $CtrlShiftTrack => Do[z];
  $RedUp, $CtrlRedUp, $ShiftRedUp, $CtrlShiftRedUp,
   $YellowUp, $CtrlYellowUp, $ShiftYellowUp, $CtrlShiftYellowUp,
   $BlueUp, $CtrlBlueUp, $ShiftBlueUp, $CtrlShiftBlueUp => { Do[z]; ReleaseButtons[] }; 
  $Place => Place[];
  ENDCASE => JaMTypeScript.DoAtom[NARROW[self.data,Info].typescript,z];
z: TIPUser.TIPScreenCoords => { [mx, ----, my] ← z^; AdjustCoords[] };
ENDCASE => UserTerminal.BlinkDisplay;
ENDLOOP;
};

END...