JaMIViewerImpl.mesa
Last change by Bill Paxton, October 5, 1982 3:19 pm
Last change by McGregor, June 15, 1982 10:05 am
Last Edited by: Stone, December 22, 1983 1:45 pm
DIRECTORY
Imager,
Rope USING [Concat],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
Menus USING [Menu, MenuProc, CreateEntry, CreateMenu, InsertMenuEntry],
ViewerClasses USING [Viewer, ViewerClass, ViewerClassRec, NotifyProc],
ViewerOps USING [DestroyViewer, RegisterViewerClass, CreateViewer, PaintViewer],
JaMTypeScript USING [GetTypeScript, NotifyBeforeDestroy, SetMouseProc, DoAtom, DoButton],
JaMOps USING [SetAbort, defaultFrame, RegisterExplicit, PushReal],
JaMInternal USING [Frame],
JaMImager,
JaMIPrivate,
JaMImagerContexts,
UserTerminal USING [BlinkDisplay];
JaMIViewerImpl: MONITOR
LOCKS info USING info:JaMIPrivate.Info
IMPORTS Imager, JaMTypeScript, JaMIPrivate, Rope,
UserTerminal, TIPUser, Menus, ViewerOps, JaMOps
EXPORTS JaMImager, JaMIPrivate, JaMImagerContexts =
BEGIN
jamImagerClass: ViewerClasses.ViewerClass ← NEW[ViewerClasses.ViewerClassRec ← [
paint: JaMIPrivate.Paint,
notify: InputNotify,
destroy: AboutToDestroy,
tipTable: TIPUser.InstantiateNewTIPTable["JaMImager.TIP"]
]];
Info: TYPE = JaMIPrivate.Info;
Frame: TYPE = JaMInternal.Frame;
JReloadTIP: PROC [frame: Frame] = { ReloadTIP[] };
ReloadTIP: PUBLIC PROC = {
jamImagerClass.tipTable ← TIPUser.InstantiateNewTIPTable["JaMImager.TIP"] };
JGetViewer: PROC [frame: Frame] = {
tool: ViewerClasses.Viewer ← JaMTypeScript.GetTypeScript[frame];
IF tool=NIL THEN RETURN; -- error
[] ← Create[frame,tool];
};
Create: PUBLIC PROC [
frame: Frame, typescript: ViewerClasses.Viewer, iconic: BOOLEANFALSE]
RETURNS [viewer: ViewerClasses.Viewer] = {
info: Info;
menu: Menus.Menu;
{ -- extra block to make info defined in scope of UNWIND
ENABLE UNWIND => -- something went wrong while creating the viewer
IF viewer#NIL THEN DestroyViewer[viewer]
ELSE IF info#NIL THEN JaMIPrivate.ForgetInfo[frame];
IF (info ← JaMIPrivate.GetInfo[frame]) # NIL THEN RETURN;
info ← JaMIPrivate.CreateInfo[frame];
info.trajectory ← NIL;
info.font ← Imager.MakeFont["Xerox/PressFonts/Tioga/MRR", 10];
info.text ← NIL;
menu ← Menus.CreateMenu[];
Menus.InsertMenuEntry[menu, Menus.CreateEntry["Reset", Reset]];
Menus.InsertMenuEntry[menu, Menus.CreateEntry["Interrupt", InterruptButton]];
viewer ← ViewerOps.CreateViewer[flavor: $JaMImager, info: [data: info,
name: Rope.Concat[typescript.name,"Imager "], menu: menu, iconic: iconic, scrollable: FALSE]];
info.viewer ← viewer;
info.typescript ← typescript;
info.vdc ← Imager.Create[deviceType: $LFDisplay];
info.venabled ← TRUE;
JaMTypeScript.NotifyBeforeDestroy[typescript,JDestroyViewer];
}};
Reset: Menus.MenuProc = TRUSTED {
viewer: ViewerClasses.Viewer ← NARROW[parent];
ViewerOps.PaintViewer[viewer: viewer, hint: client, whatChanged: NIL, clearClient: TRUE];
};
InterruptButton: Menus.MenuProc = TRUSTED {
viewer: ViewerClasses.Viewer ← NARROW[parent];
info: Info ← NARROW[viewer.data];
frame: Frame ← info.frame;
JaMOps.SetAbort[frame,TRUE];
SetPlace[info,0,0];
SetBug[info,0,0] };
JDestroyViewer: PROCEDURE [frame: Frame] = { -- returns true if already have a viewer for this frame
info: Info ← JaMIPrivate.GetInfo[frame];
IF info = NIL THEN RETURN;
DestroyViewer[info.viewer];
};
DestroyViewer: PROC [viewer: ViewerClasses.Viewer] = {
AboutToDestroy[viewer];
ViewerOps.DestroyViewer[viewer];
};
AboutToDestroy: SAFE PROC [self: ViewerClasses.Viewer] = TRUSTED {
info: Info ← NARROW[self.data];
JaMIPrivate.ForgetInfo[info.frame];
};
InitDC: PROCEDURE [frame: Frame] = {
info: Info ← JaMIPrivate.GetInfo[frame];
IF info.venabled THEN {
Imager.Reset[info.vdc];
Imager.ConcatT[info.vdc, Imager.pointsToMeters];
};
FOR l: JaMImagerContexts.DCList ← info.dcList, l.next UNTIL l=NIL DO
IF l.enabled THEN l.dc ← l.init[];
ENDLOOP;
};
EnableViewer: PUBLIC PROC [frame: Frame] = {
info: Info ← JaMIPrivate.GetInfo[frame];
info.venabled ← TRUE;
};
DisableViewer: PUBLIC PROC [frame: Frame] = {
info: Info ← JaMIPrivate.GetInfo[frame];
info.venabled ← FALSE;
};
MouseToUser: PROCEDURE[frame: Frame, x,y:REAL] = {
JaMOps.PushReal[frame.opstk,x]; JaMOps.PushReal[frame.opstk,y];
};
ViewerMouse: PUBLIC PROCEDURE[frame: Frame, click: BOOLEAN] RETURNS[x,y: REAL] = {
info: Info ← JaMIPrivate.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;
};
[self: ViewerClasses.Viewer, input: LIST OF REF ANY]
InputNotify: PUBLIC ViewerClasses.NotifyProc = TRUSTED {
Do: PROC [button: ATOM] = {
JaMTypeScript.DoButton[NARROW[self.data,Info].typescript,button,x,y] };
AdjustCoords: PROC = {
info: Info ← NARROW[self.data];
[x,y] ← JaMIPrivate.ViewToUser[info.vdc, mx,my];
};
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]; 
$Place => Place[];
ENDCASE => JaMTypeScript.DoAtom[NARROW[self.data,Info].typescript,z];
z: TIPUser.TIPScreenCoords => { [mx, ----, my] ← z^; AdjustCoords[] };
ENDCASE => UserTerminal.BlinkDisplay;
ENDLOOP;
};
Init: PROC = {
frame: Frame ← JaMOps.defaultFrame;
[] ← JaMTypeScript.SetMouseProc[MouseToUser];
ViewerOps.RegisterViewerClass[$JaMImager, jamImagerClass];
JaMOps.RegisterExplicit[frame,".initdc"L,InitDC];
JaMOps.RegisterExplicit[frame,".destroyviewer"L,JDestroyViewer];
JaMOps.RegisterExplicit[frame,".getviewer"L,JGetViewer];
JaMOps.RegisterExplicit[frame,".reloadTIP"L,JReloadTIP];
JaMOps.RegisterExplicit[frame,".enableviewer"L,EnableViewer];
JaMOps.RegisterExplicit[frame,".disableviewer"L,DisableViewer];
};
Init;
END...