QuickViewerImpl.mesa
Copyright © 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)
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;
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 ~ QuickViewer.CountedCondition;
CountedCondition: TYPE ~ RECORD [ count: NAT, condition: CONDITION ];
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
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
]
];
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];
quickView.eventProcess ← CedarProcess.Fork[ActOnButton, quickView]; -- Start event monitor
ViewerOps.PaintViewer[quickView.outer, all]; -- load up the viewer (paint it)
};
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
};
PaintProc: ViewerClasses.PaintProc ~ {
-- repaint screen for updates
PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL]
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
PROC [self: Viewer] RETURNS [adjusted: BOOL ← FALSE];
view: REF QuickView ← NARROW[self.data];
view.changed ← TRUE;
};
DrawInViewer:
PUBLIC
PROCEDURE [view:
REF QuickView, proc:
PROC[Imager.Context]] ~ {
Pass procedure to PaintProc
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 ~ {
MenuProc ~ PROCEDURE [ parent: REF ANY, clientData: REF ANY ← NIL,
mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE ]
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
ForkableProc ~ PROC [data: REF] RETURNS [results: REF ← NIL];
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 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
NOTIFY view.newEvent.condition;
};
NotifyProc: ViewerClasses.NotifyProc ~ {
-- collect inputs and act on them
NotifyProc ~ PROC[self: Viewer, input: LIST OF REF ANY]
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 ~ {
DestroyProc ~ PROC [self: Viewer] - Clean up on exit (viewer destroyed)
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.