<> <> <> <> 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: BOOLEAN _ FALSE] 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...