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; 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 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. πQuickViewerImpl.mesa Copyright c 1985, 1986 by Xerox Corporation. All rights reserved. Much of this taken from ImagerViewer, thanks to TimDiebert and Mike Plass Last Edited by: Crow, October 1, 1986 11:59:53 am PDT Rick Beach, June 13, 1986 5:06:45 pm PDT Makes viewer (Init) Sets up menu and buttons (BuildViewer) Handles screen updates (PaintProc) Handles graphic input (NotifyProc) QuickView: TYPE ~ RECORD [ 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 ~ RECORD [ count: NAT, condition: CONDITION ]; Start up tool (make icon) -- Tip table (translates mouse events to commands) Constrain graphics area to lie in viewer space left over after menu, etc. are drawn BuildFancyViewer: PUBLIC PROC[ viewerTitle: Rope.ROPE, -- build viewer as prescribed herein menuLabels: LIST OF Rope.ROPE, ReDrawProc: PROC[ctx: Imager.Context, toDo: REF ANY], QuitProc: PROC[], ButtonProc: PROC[bttn, choice: ATOM, x, y: REAL], ] RETURNS [quickView: REF QuickView] ~ { ViewerOps.PaintViewer ControlsOuterImpl.GraphicsViewer PopUpMenusDoc.tioga TestPopUpButtons.mesa PopUpButtons.mesa ViewerClasses.mesa }; PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] PROC [self: Viewer] RETURNS [adjusted: BOOL _ FALSE]; Pass procedure to PaintProc MenuProc ~ PROCEDURE [ parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: MouseButton _ red, shift, control: BOOL _ FALSE ] ForkableProc ~ PROC [data: REF] RETURNS [results: REF _ NIL]; NOTIFY must be buffered through here to avoid monitor lock on NotifyProc which would be caused if NotifyProc had to be an ENTRY proc because of containing a NOTIFY NotifyProc ~ PROC[self: Viewer, input: LIST OF REF ANY] DestroyProc ~ PROC [self: Viewer] - Clean up on exit (viewer destroyed) Κ †˜headšœ™Jšœ Οmœ7™BJ™IJšœ5™5J™(J™Jšœ™Jšœ&™&Jšœ#™#Jšœ#™#—J˜šΟk ˜ Jšœ žœ ˜Jšœžœ*˜=Jšœ žœ/˜@Jšœžœ:˜GJšœ žœ˜-Jšœžœu˜‰Jšœ žœ2˜BJšœ žœ+˜:Jšœ žœ˜Jšœžœžœžœ˜$Jšœ žœ˜$Jšœ ˜ —J˜šΠlnœž ˜JšžœZ˜aJšžœ ˜Jšœž˜—˜šœžœ˜$J˜—šœ žœ˜(šœ žœžœ™Jš&œ(Οcœ$ œ# œ" œžœ,žœgžœžœžœ "œ žœžœžΟiœžœžœ !œ žœ  %œ™θ——šœžœ ˜6Jš œžœžœ žœ ž œ™E—J˜—J˜šΟnœžœ˜Jš ™Jšœ. ˜=šœžœ .˜M˜"šœ =˜RJšœ %˜:Jšœ 8˜MJšœ "˜8Jšœ:™:Jšœ<˜