<> <> <> <> <> <<>> <> <> <> <> DIRECTORY Imager USING [Context], CedarProcess USING [Abort, CheckAbort, Fork, ForkableProc], Containers USING [Container, Create, ChildXBound, ChildYBound], Menus USING [AppendMenuEntry, CreateMenu, Menu, MenuEntry, MenuProc], ActionQueue USING [Create, CreateMenuEntry], ViewerClasses USING [AdjustProc, Viewer, ViewerRec, ViewerClass, ViewerClassRec, NotifyProc, PaintProc, DestroyProc, ScrollProc], ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass], TIPUser USING [InstantiateNewTIPTable ,TIPScreenCoords], Convert USING [AtomFromRope], Rope USING [Find, Replace, ROPE], Terminal USING [Virtual, Current], QuickViewer; QuickViewerImpl: CEDAR MONITOR IMPORTS CedarProcess, Containers, Convert, ActionQueue, Menus, Rope, Terminal, TIPUser, ViewerOps EXPORTS QuickViewer ~ BEGIN Viewer: TYPE ~ ViewerClasses.Viewer; QuickView: TYPE ~ QuickViewer.QuickView; <> <<[ outer: ViewerClasses.Viewer, -- enclosing container viewer: ViewerClasses.Viewer, -- graphics area within terminal: Terminal.Virtual, -- virtual terminal imagerCtx: Imager.Context, -- associated graphics context newEvent: CountedCondition, -- prevents pile-up of actions eventProcess: CedarProcess.Process, -- event action process inputEvent: ATOM, -- Action from tip table choice: ATOM, -- from pop-up menu or ctrl-shift x, y: REAL _ 0, -- mouse coordinates drawProc: PROC[Imager.Context, REF ANY], -- procedure for redrawing window buttProc: PROC[ATOM, ATOM, REAL, REAL], -- procedure for button actions exitProc: PROC[] -- procedure for cleaning up on exit ];>> CountedCondition: TYPE ~ QuickViewer.CountedCondition; <> Init: PROC ~ { <> quickPictureClass: ViewerClasses.ViewerClass; -- Declare type quickPictureClass _ NEW -- Get record and fill it with procedure names [ ViewerClasses.ViewerClassRec _ [ paint: PaintProc, -- procedure called when viewer contents must be repainted adjust: AdjustProc, -- called when viewer size is changed notify: NotifyProc, -- procedure to respond to input events (from TIP table) destroy: DestroyProc, -- procedure to clean up when done << -- Tip table (translates mouse events to commands) >> tipTable: TIPUser.InstantiateNewTIPTable["QuickViewer.TIP"], icon: document ] ]; ViewerOps.RegisterViewerClass[$QuickViewer, quickPictureClass]; -- Register with viewers }; BuildViewer: PUBLIC PROC[ viewerTitle: Rope.ROPE, -- build viewer as prescribed herein menuLabels: LIST OF Rope.ROPE, reDrawProc: PROC[imagerCtx: Imager.Context, toDo: REF ANY], buttonProc: PROC[bttn, choice: ATOM, x, y: REAL], quitProc: PROC[] ] RETURNS [quickView: REF QuickView] ~ { menu: Menus.Menu _ Menus.CreateMenu[]; quickView _ NEW[QuickViewer.QuickView]; -- allocate space and fill it quickView.terminal _ Terminal.Current[]; quickView.menuQueue _ ActionQueue.Create[]; quickView.drawProc _ reDrawProc; quickView.buttProc _ buttonProc; quickView.exitProc _ quitProc; FOR labels: LIST OF Rope.ROPE _ menuLabels, labels.rest UNTIL labels = NIL DO pos: INTEGER _ Rope.Find[labels.first, "!"]; IF pos >= 0 THEN labels.first _ Rope.Replace[labels.first, pos, 1]; Menus.AppendMenuEntry[ -- enter menu buttons menu: menu, entry: ActionQueue.CreateMenuEntry[ q: quickView.menuQueue, name: labels.first, proc: MenuProc, clientData: Convert.AtomFromRope[labels.first], panic: pos >= 0 ] ] ENDLOOP; quickView.outer _ Containers.Create[ [ name: viewerTitle, menu: menu, scrollable: FALSE ] ]; quickView.viewer _ ViewerOps.CreateViewer[ -- define graphics area flavor: $QuickViewer, info: [ parent: quickView.outer, ww: quickView.outer.ww, -- CHildXBound below wh: quickView.outer.wh, -- CHildXBound below scrollable: FALSE, data: quickView ] ]; <> Containers.ChildXBound[quickView.outer, quickView.viewer]; Containers.ChildYBound[quickView.outer, quickView.viewer]; quickView.eventProcess _ CedarProcess.Fork[ActOnButton, quickView]; -- Start event monitor ViewerOps.PaintViewer[quickView.outer, all]; -- load up the viewer (paint it) }; <> <> <> <> <> <> <> <<}; >> PaintProc: ViewerClasses.PaintProc ~ { -- repaint screen for updates <> view: REF QuickView _ NARROW[self.data]; IF whatChanged = NIL THEN view.drawProc[context, NIL] -- if whatChanged = NIL THEN window resized ELSE NARROW[ whatChanged, REF PROC[Imager.Context] ]^[context]; -- call back passed proc }; AdjustProc: ViewerClasses.AdjustProc ~ { -- repaint screen for updates <> view: REF QuickView _ NARROW[self.data]; view.changed _ TRUE; }; DrawInViewer: PUBLIC PROCEDURE [view: REF QuickView, proc: PROC[Imager.Context]] ~ { <> drawProc: REF PROC[Imager.Context] _ NEW[PROC[Imager.Context] _ proc]; IF view # NIL THEN ViewerOps.PaintViewer[ viewer: view.viewer, -- pass record to viewer painter hint: client, whatChanged: drawProc, clearClient: FALSE ]; }; MenuProc: Menus.MenuProc ~ { <> menuButton: ATOM _ NARROW[clientData]; view: REF QuickView _ NIL; viewer: Viewer _ NARROW[parent, Viewer].child; -- get first child of container WHILE viewer # NIL AND viewer.class.flavor # $QuickViewer DO -- get quickViewer viewer _ viewer.sibling; ENDLOOP; view _ NARROW[viewer.data]; -- narrow fault here means screwed up viewer structure view.inputEvent _ NARROW[clientData]; -- load menu button name view.x _ view.y _ 0; -- load mouse coordinates view.choice _ IF shift AND control THEN $ControlShift -- load ctrl and shift key state ELSE IF shift THEN $Shift ELSE IF control THEN $Control ELSE NIL; view.newEvent.count _ view.newEvent.count + 1; view.buttProc[ view.inputEvent, view.choice, view.x, view.y ! ABORTED => CONTINUE ]; view.newEvent.count _ view.newEvent.count - 1; }; ActOnButton: ENTRY CedarProcess.ForkableProc ~ { -- does action while NotifyProc continues <> view: REF QuickView _ NARROW[data]; WHILE TRUE DO ENABLE UNWIND => view.newEvent.count _ MAX[0, INTEGER[view.newEvent.count] - 1]; WAIT view.newEvent.condition; -- initial condition waits until notified CedarProcess.CheckAbort[]; -- exit if aborted view.buttProc[ view.inputEvent, view.choice, view.x, view.y ! ABORTED => CONTINUE ]; view.newEvent.count _ view.newEvent.count - 1; -- decrement queue ENDLOOP; }; ReleaseButton: ENTRY PROC[view: REF QuickView] ~ { <> NOTIFY view.newEvent.condition; }; NotifyProc: ViewerClasses.NotifyProc ~ { -- collect inputs and act on them <> ENABLE UNWIND => NULL; IF ISTYPE[input.first, TIPUser.TIPScreenCoords] THEN { -- If input is coords from mouse mousePlace: TIPUser.TIPScreenCoords _ NARROW[input.first]; -- get mouse coordinates view: REF QuickView _ NARROW[self.data]; IF ISTYPE[input.rest.first, ATOM] AND view.newEvent.count = 0 THEN { buttonName: ATOM _ NARROW[input.rest.first]; shft, ctrl: BOOLEAN _ FALSE; restOfInput: LIST OF REF ANY _ input.rest.rest; WHILE restOfInput # NIL DO SELECT NARROW[restOfInput.first, ATOM] FROM $Shift => shft _ TRUE; $Ctrl => ctrl _ TRUE; ENDCASE; -- ignore anything else restOfInput _ restOfInput.rest; ENDLOOP; view.newEvent.count _ view.newEvent.count + 1; -- discard events until count = 0 view.inputEvent _ buttonName; -- load action name view.x _ mousePlace.mouseX; -- load mouse coordinates view.y _ mousePlace.mouseY; view.choice _ IF shft AND ctrl THEN $ControlShift -- load ctrl and shift key state ELSE IF shft THEN $Shift ELSE IF ctrl THEN $Control ELSE NIL; ReleaseButton[ view ]; -- release ActOnButton from WAIT }; }; }; DestroyProc: ENTRY ViewerClasses.DestroyProc ~ { <> ENABLE UNWIND => NULL; view: REF QuickView _ NARROW[self.data]; CedarProcess.Abort[ view.eventProcess ]; -- abort event monitor NOTIFY view.newEvent.condition; -- wake it up so it can die view.exitProc[]; }; Init[]; END.