<> <> <> <> <<>> <> <> <> <> DIRECTORY Graphics USING [Context, Mark, Save, white, GetBounds, SetColor, DrawBox, Restore, Translate], Containers USING [Container, Create, ChildXBound, ChildYBound], Menus USING [Menu, CreateMenu, AppendMenuEntry, CreateEntry, MouseButton], ViewerClasses USING [Viewer, ViewerClass, ViewerClassRec, NotifyProc, PaintProc, DestroyProc, ScrollProc], ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass], TIPUser USING [InstantiateNewTIPTable ,TIPScreenCoords], Atom USING [GetPName], Process USING [Detach], Real USING [FixI], Rope USING [ROPE], QuickViewer USING []; QuickViewerImpl: CEDAR MONITOR IMPORTS Graphics, Containers, Menus, ViewerOps, TIPUser, Real, Atom, Process EXPORTS QuickViewer = BEGIN done: BOOLEAN _ FALSE; inputEvent: ATOM; newEventArrival: CONDITION; gotaNewOne: BOOLEAN _ FALSE; controlPointX, controlPointY: REAL; entryHeight: CARDINAL = 12; -- height of a line of items in a menu entryVSpace: CARDINAL = 3; -- vertical leading between lines entryHSpace: CARDINAL = 8; -- horizontal space between items on a line QuickView: TYPE = REF QuickViewData; QuickViewData: TYPE = RECORD [ outer: Containers.Container _ NIL, -- enclosing container viewer: ViewerClasses.Viewer, -- graphics area within xTranslation, yTranslation: REAL _ 0., xLeft, xRight, yBottom, yTop: REAL, proc: PROC [context: Graphics.Context] ]; quickView: QuickView; -- Keeps useful info around DrawProc: PROC[Graphics.Context]; -- name of procedure for redrawing on window resizing, etc. ButtProc: PROC[ATOM, REAL, REAL]; -- name of procedure for acting on button pushes ExitProc: PROC[]; -- name of procedure for cleaning up on exit BuildViewer: PUBLIC PROC[ menuLabels: LIST OF ATOM, -- build viewer as prescribed herein ReDrawProc: PROC[Graphics.Context], QuitProc: PROC[], ButtonProc: PROC[ATOM, REAL, REAL], viewerTitle: Rope.ROPE ] = { menu: Menus.Menu; quickView _ NEW[QuickViewData]; -- allocate a data object menu _ Menus.CreateMenu[]; -- set up menu DrawProc _ ReDrawProc; -- store away procedure names ButtProc _ ButtonProc; ExitProc _ QuitProc; Menus.AppendMenuEntry[ menu: menu, -- enter "erase" button entry: Menus.CreateEntry[ name: "Erase", proc: Erase, clientData: quickView, documentation: "erase the viewer" ] ]; Menus.AppendMenuEntry[ menu: menu, -- enter "<" button entry: Menus.CreateEntry[ name: "<", proc: RollLeft, clientData: quickView, documentation: "Roll image to left" ] ]; Menus.AppendMenuEntry[ menu: menu, -- enter ">" button entry: Menus.CreateEntry[ name: ">", proc: RollRight, clientData: quickView, documentation: "Roll image to right" ] ]; WHILE menuLabels # NIL DO Menus.AppendMenuEntry[ -- enter menu buttons menu: menu, entry: Menus.CreateEntry[ name: Atom.GetPName[menuLabels.first], proc: MenuProc, clientData: menuLabels.first, documentation: "Roll image to right" ] ]; menuLabels _ menuLabels.rest; ENDLOOP; quickView.outer _ Containers.Create[ [ name: viewerTitle, -- define outer viewer menu: menu, iconic: TRUE, column: left, scrollable: FALSE ] ]; quickView.viewer _ ViewerOps.CreateViewer -- define graphics area [ flavor: $QuickViewer, info: [ parent: quickView.outer, wx: 0, wy: 0, -- position WRT parent ww: quickView.outer.ww, -- CHildXBound below wh: quickView.outer.wh, -- CHildXBound below data: quickView, -- describes the current scene scrollable: TRUE ] ]; << -- constrain graphics area to lie in viewer space left over after menu, etc. are drawn >> Containers.ChildXBound[quickView.outer, quickView.viewer]; Containers.ChildYBound[quickView.outer, quickView.viewer]; ViewerOps.PaintViewer[quickView.outer, all]; -- load up the viewer (paint it) quickView.xTranslation _ quickView.yTranslation _ 0.; quickView.xLeft _ quickView.yBottom _ 0.; quickView.xRight _ quickView.viewer.ww; quickView.yTop _ quickView.viewer.wh; }; PaintProc: ViewerClasses.PaintProc = -- repaint screen for updates <<[self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]>> { x,y: REAL; x _ quickView.xTranslation + quickView.viewer.ww/2.; -- center image on relative origin y _ quickView.yTranslation + quickView.viewer.wh/2.; IF whatChanged = NIL THEN { Graphics.Translate[context, x, y]; DrawProc[context]; -- window resized, redraw } ELSE { Graphics.Translate[context, x, y]; NARROW[whatChanged, REF PROC[Graphics.Context]]^[context]; }; }; DrawInViewer: PUBLIC PROCEDURE [proc: PROC [Graphics.Context]] = -- pass procedure to PaintProc { drawProc: REF PROC[Graphics.Context] _ NIL; TRUSTED { drawProc _ NEW[PROC[Graphics.Context] _ proc]; }; ViewerOps.PaintViewer[viewer: quickView.viewer, -- pass record to viewer painter hint: client, whatChanged: drawProc, clearClient: FALSE]; }; Erase: PROCEDURE [parent: REF ANY, clientData: REF ANY, mouseButton: Menus.MouseButton, shift, control: BOOL] = { -- procedure for screen erasure DoErase: PROC [context: Graphics.Context] = { mark: Graphics.Mark _ Graphics.Save[context]; -- mark stack Graphics.SetColor[context, Graphics.white]; -- set color to white Graphics.DrawBox[context,Graphics.GetBounds[context]]; -- erase by drawing box Graphics.Restore[context,mark]; -- restore stack }; DrawInViewer[DoErase] -- execute by passing name }; RollLeft: PROCEDURE [parent: REF ANY, clientData: REF ANY, mouseButton: Menus.MouseButton, shift, control: BOOL] = { quickView.xTranslation _ quickView.xTranslation - 64; -- Move image to left DrawInViewer[DrawProc]; }; RollRight: PROCEDURE [parent: REF ANY, clientData: REF ANY, mouseButton: Menus.MouseButton, shift, control: BOOL] = { quickView.xTranslation _ quickView.xTranslation + 64; -- Move image to right DrawInViewer[DrawProc]; }; MenuProc: PROCEDURE [parent: REF ANY, clientData: REF ANY, mouseButton: Menus.MouseButton, shift, control: BOOL] = { menuButton: ATOM; menuButton _ NARROW[clientData]; ButtonMonitor[menuButton]; }; ButtonMonitor: ENTRY PROCEDURE [event: ATOM] = -- Store event and notify passing process { inputEvent _ event; gotaNewOne _ TRUE; NOTIFY newEventArrival; }; ButtonPasser: ENTRY PROCEDURE [] = { WHILE ~done DO WAIT newEventArrival; IF gotaNewOne THEN ButtProc[inputEvent, controlPointX, controlPointY]; gotaNewOne _ FALSE; IF done THEN EXIT; ENDLOOP; }; NotifyProc: ViewerClasses.NotifyProc = { -- PROCEDURE [self: Viewer, input: LIST OF REF ANY] IF ISTYPE[input.first, TIPUser.TIPScreenCoords] -- If input is coords from mouse THEN { mousePlace: TIPUser.TIPScreenCoords _ NARROW[input.first]; -- get mouse coordinates, store globally controlPointX _ mousePlace.mouseX - quickView.xTranslation - quickView.viewer.ww/2.; controlPointY _ mousePlace.mouseY - quickView.yTranslation - quickView.viewer.wh/2.; -- expand work area if clicked outside existing bounds IF controlPointX > quickView.xRight THEN quickView.xRight _ controlPointX ELSE IF controlPointX < quickView.xLeft THEN quickView.xLeft _ controlPointX; IF controlPointY > quickView.yTop THEN quickView.yTop _ controlPointY ELSE IF controlPointY < quickView.yBottom THEN quickView.yBottom _ controlPointY; IF ISTYPE[input.rest.first, ATOM] AND (gotaNewOne = FALSE ) THEN ButtonMonitor[NARROW[input.rest.first]]; -- Send button name }; }; DestroyProc: ViewerClasses.DestroyProc = -- clean up on exit (viewer destroyed) { ExitProc[]; }; ScrollProc: ViewerClasses.ScrollProc = -- act on scrollbar mouse hits -- TYPE = PROC[self: Viewer, op: ScrollOp, amount: INTEGER] -- RETURNS[top, bottom: INTEGER _ LAST[INTEGER]]; -- ScrollOp: TYPE = {query, up, down, thumb} { SELECT op FROM up => { quickView.yTranslation _ quickView.yTranslation + amount; DrawInViewer[DrawProc]; }; down => { quickView.yTranslation _ quickView.yTranslation - amount; DrawInViewer[DrawProc]; }; thumb => { quickView.yTranslation _ - (quickView.yBottom + (1. - amount/100.) * (quickView.yTop - quickView.yBottom)); DrawInViewer[DrawProc]; }; query => { OPEN quickView; RETURN[ Real.FixI[100. - (-yTranslation + self.ch - yBottom) * 100. / (yTop - yBottom)], Real.FixI[100. - (-yTranslation - yBottom) * 100. / (yTop - yBottom)] ]; }; ENDCASE; }; Init: PROC = -- Start up tool (make icon) { 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 notify: NotifyProc, -- procedure to respond to input events (from TIP table) destroy: DestroyProc, -- procedure to clean up when done scroll: ScrollProc, -- procedure to respond to scroll bar hits << -- Tip table (translates mouse events to commands) >> tipTable: TIPUser.InstantiateNewTIPTable["QuickViewer.TIP"], icon: document ] ]; ViewerOps.RegisterViewerClass[$QuickViewer, quickPictureClass]; -- Register with viewers TRUSTED { Process.Detach[FORK ButtonPasser]; }; -- Start up button event monitor }; Init[]; END.