<<-- COGDrawingImpl.mesa: Viewers for geometrical drawings>> <<-- last modified by Stolfi - September 24, 1982 9:39 pm>> <<-- To do: check locking scheme>> <<-- To do: try using the RefTab interface for managing property lists, mouse/menu actions, etc.>> << >> DIRECTORY COGDebug USING [out, in], Graphics USING [Box, Color, Context, DrawArea, GetBounds, DrawTo, MoveTo, LineTo, DrawBox, SetColor], IO USING [PutF, GetChar], List USING [Assoc, AList, DotCons, Zone], Atom USING [GetPName], Process USING [GetPriority, Priority, priorityBackground, priorityForeground, SetPriority], ViewerClasses, TIPTables USING [TIPScreenCoords], Rope USING [ROPE], TIPUser USING [InstantiateNewTIPTable, TIPTable], ViewerOps USING [RegisterViewerClass, CreateViewer, PaintViewer], Menus USING [Menu, MenuProc, CreateMenu, AppendMenuEntry], ViewerMenus USING [Close, Grow, Destroy, Move], WindowManager USING [StartColorViewers], Real USING [SqRt, Float], COGCart USING [Point, Vector, Sub, Length, UnScalePoint, Box, ScaleFactors, BoxToBoxScale], COGHomo USING [Point, FinPt, ScalePoint, ScaleSeg], COGDrawing; COGDrawingImpl: CEDAR MONITOR LOCKS vData^ USING vData: ViewerData IMPORTS Graphics, Process, ViewerOps, IO, ViewerMenus, List, Atom, COGDebug, Menus, COGHomo, TIPUser, Real, COGDrawing, COGCart, WindowManager EXPORTS COGDrawing SHARES COGDrawing = BEGIN OPEN COGDrawing, Homo: COGHomo, Cart: COGCart, Real, Rope, Bug: COGDebug, IO; <<-- VIEWER DATA RECORD - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> ViewerData: TYPE = REF ViewerDataRec; ViewerDataRec: TYPE = MONITORED RECORD [alive: BOOLEAN _ TRUE, -- so Mother can know when to exit -- the following fields are protected by the record lock holders: NAT _ 0, -- number of processes that have acquired the objects or the viewer state owned: BOOL _ FALSE, -- TRUE if some process acquired objects or state to modify them released: CONDITION, -- raised when objects are released -- the following fields are protected by the software lock (the holders/owned fields) fobj, lobj: ARRAY PaintOrder OF Object _ ALL [NIL], -- first and last objs by paint order pList: List.AList, -- Drawing's property list mouseActions: LIST OF REF MouseActionEntry _ NIL, -- enabled mouse events box: Cart.Box, -- client-defined bounding box for objects scale: Cart.ScaleFactors _ [1.0, 1.0, 0.0, 0.0] -- curr scale conversion factors ]; MouseActionEntry: TYPE = RECORD [event: MouseEvent, Proc: MouseProc, eventData: REF, rights: Access -- to be acquired before calling the Proc ]; MenuActionEntry: TYPE = RECORD [name: ROPE, Proc: MenuProc, menuData: REF, rights: Access -- to be acquired before calling the Proc ]; <<-- DEBUGGING TOOLS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> DrawingError: ERROR [descr: ROPE] = CODE; <<-- VIEWER CREATION - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> MakeDrawing: PUBLIC PROC [name: ROPE, box: Cart.Box] RETURNS [dr: Drawing] = TRUSTED BEGIN menu: Menus.Menu _ MakeBasicMenu[]; vData: ViewerData _ NEW [ViewerDataRec _ [pList: NIL, box: box]]; Bug.out.PutF["\nCreating Viewer..."]; dr _ ViewerOps.CreateViewer [flavor: $Drawing, info: [menu: menu, name: name, column: left, iconic: FALSE, data: vData], paint: TRUE] END; Alive: PUBLIC PROC [dr: Drawing] RETURNS [BOOL] = BEGIN vData: ViewerData = NARROW [dr.data]; RETURN [vData.alive] END; <<>> <<-- PROCESS SYNCHRONIZATION - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> Acquire: PUBLIC PROC [dr: Drawing, wants: Access, hasSome: BOOL] = BEGIN SwitchAccessRights: ENTRY PROC [vData: ViewerData] = {curr: Access = IF vData.owned THEN write ELSE read; IF curr = wants THEN RETURN; IF curr = write OR (curr = read AND wants = none) THEN {-- reduced rights: write -> none, read -> none, write -> read IF curr = write THEN vData.owned _ FALSE; IF wants = none THEN vData.holders _ vData.holders - 1; BROADCAST vData.released} ELSE {-- increased rights: none -> read, none -> write, read -> write WHILE vData.owned OR (wants = write AND vData.holders > (IF curr = none THEN 0 ELSE 1)) DO WAIT vData.released ENDLOOP; IF curr = none THEN vData.holders _ vData.holders + 1; IF wants = write THEN vData.owned _ TRUE}}; SwitchAccessRights [NARROW [dr.data]] END; <<>> <<-- GRAPHIC OBJECTS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> Make: PUBLIC PROC [Painter: PainterProc, parms: ObjectParms] RETURNS [obj: Object] = BEGIN obj _ NEW [ObjectRec _ [Painter: Painter, parms: parms, order: , pred: NIL, succ: NIL, dr: NIL]] END; Add: PUBLIC PROC [dr: Drawing, obj: Object, order: PaintOrder _ 3, hasSome: BOOL] = BEGIN ENABLE UNWIND => {Acquire [dr, hasSome, write]}; DoAddObject: PROC [vData: ViewerData] = BEGIN OPEN vData; obj.order _ order; IF fobj[order] = NIL THEN {fobj[order] _ lobj[order] _ obj; obj.pred _ obj.succ _ NIL} ELSE {obj.pred _ lobj[order]; lobj[order].succ _ obj; lobj[order] _ obj; obj.succ _ NIL}; obj.dr _ dr END; IF obj.dr = dr THEN RETURN; IF obj.dr # NIL THEN ERROR DrawingError ["Object in another Drawing!"]; Acquire[dr, write, hasSome]; BEGIN ENABLE UNWIND => {Acquire [dr, hasSome, write]}; DoAddObject [NARROW [dr.data]]; DoPaint [dr, obj]; Acquire[dr, hasSome, write] END END; Remove: PUBLIC PROC [obj: Object, hasSome: BOOL] = BEGIN dr: Drawing = obj.dr; DoRemoveObject: PROC [vData: ViewerData] = BEGIN OPEN vData; order: PaintOrder = obj.order; test: Object; IF obj.succ = NIL THEN {test _ lobj[order]; lobj[order] _ obj.pred} ELSE {test _ obj.succ.pred; obj.succ.pred _ obj.pred}; IF test # obj THEN ERROR DrawingError ["Smashed object list (I)"]; IF obj.pred = NIL THEN {test _ fobj[order]; fobj[order] _ obj.succ} ELSE {test _ obj.pred.succ; obj.pred.succ _ obj.succ}; IF test # obj THEN ERROR DrawingError ["Smashed object list (II)"]; obj.dr _ NIL; obj.succ _ obj.pred _ NIL END; IF dr = NIL THEN RETURN; Acquire[dr, write, hasSome]; BEGIN ENABLE UNWIND => {Acquire [dr, hasSome, write]}; color: Color = obj.parms.color; obj.parms.color _ white; DoPaint [dr, obj]; obj.parms.color _ color; DoRemoveObject [NARROW [dr.data]]; Acquire[dr, hasSome, write] END END; RemoveAll: PUBLIC PROC [dr: Drawing, hasSome: BOOL] = BEGIN DoRemoveAllObjects: PROC [vData: ViewerData] = BEGIN OPEN vData; oba, obj: Object; FOR order: PaintOrder IN PaintOrder DO obj _ vData.fobj[order]; WHILE obj # NIL DO oba _ obj.succ; obj.succ _ obj.pred _ NIL; obj.dr _ NIL; obj _ oba ENDLOOP; lobj[order] _ fobj[order] _ NIL ENDLOOP END; Acquire[dr, write, hasSome]; BEGIN ENABLE UNWIND => {Acquire [dr, hasSome, write]}; DoRemoveAllObjects [NARROW [dr.data]]; DoPaintAll [dr]; Acquire[dr, hasSome, write] END END; RepaintAll: PUBLIC PROC [dr: Drawing, hasSome: BOOL] = BEGIN rights: Access _ IF hasSome = write THEN write ELSE read; Acquire[dr, rights, hasSome]; DoPaintAll [dr ! UNWIND => {Acquire [dr, hasSome, rights]}]; Acquire[dr, hasSome, rights] END; SetStyle: PUBLIC PROC [obj: Object, color: Color _ black, size: Size _ 1, style: Style _ 0, hasSome: BOOL] = BEGIN Acquire[obj.dr, write, hasSome]; BEGIN ENABLE UNWIND => {Acquire [obj.dr, hasSome, write]}; obj.parms.color _ white; DoPaint [obj.dr, obj]; obj.parms.color _ color; obj.parms.size _ size; obj.parms.style _ style; DoPaint [obj.dr, obj]; Acquire[obj.dr, hasSome, write] END END; Modify: PUBLIC PROC [obj: Object, Action: ObjectAction, actionData: REF _ NIL, erase, repaint: BOOL _ TRUE, hasSome: BOOL] RETURNS [actionResult: REF] = BEGIN color: Color; Acquire[obj.dr, write, hasSome]; BEGIN ENABLE UNWIND => {Acquire [obj.dr, hasSome, write]}; IF erase THEN {color _ obj.parms.color; obj.parms.color _ white; DoPaint [obj.dr, obj]; -- erase object obj.parms.color _ color}; actionResult _ Action [obj.dr, obj, actionData]; IF repaint THEN {DoPaint [obj.dr, obj]}; Acquire[obj.dr, hasSome, write] END END; ModifyAll: PUBLIC PROC [dr: Drawing, Action: ObjectAction, actionData: REF _ NIL, erase, repaint: BOOL _ TRUE, hasSome: BOOL] RETURNS [actionResult: REF] = BEGIN color: Color; obj: Object; actionResult _ actionData; Acquire[dr, write, hasSome]; BEGIN ENABLE UNWIND => {Acquire [dr, hasSome, write]}; vData: ViewerData = NARROW [dr.data]; FOR order: PaintOrder IN PaintOrder DO obj _ vData.fobj[order]; WHILE obj # NIL DO IF erase THEN {color _ obj.parms.color; obj.parms.color _ white; DoPaint [dr, obj]; -- erase object obj.parms.color _ color}; actionResult _ Action [dr, obj, actionResult]; IF repaint THEN {DoPaint [dr, obj]}; obj _ obj.succ ENDLOOP ENDLOOP; Acquire[dr, hasSome, write] END END; Enumerate: PUBLIC PROC [dr: Drawing, Action: ObjectAction, actionData: REF _ NIL, hasSome: BOOL] RETURNS [actionResult: REF] = BEGIN obj: Object; rights: Access _ IF hasSome = write THEN write ELSE read; actionResult _ actionData; Acquire[dr, rights, hasSome]; BEGIN ENABLE UNWIND => {Acquire [dr, hasSome, rights]}; vData: ViewerData = NARROW [dr.data]; FOR order: PaintOrder IN PaintOrder DO obj _ vData.fobj[order]; WHILE obj # NIL DO actionResult _ Action [dr, obj, actionResult]; obj _ obj.succ ENDLOOP ENDLOOP; Acquire[dr, hasSome, rights] END END; <<-- "INTERNAL" PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> DoErase: PUBLIC PROC [dr: Drawing, obj: Object] = TRUSTED BEGIN -- The caller must have write rights in order to call this procedure color: Color _ obj.parms.color; obj.parms.color _ white; ViewerOps.PaintViewer [viewer: dr, hint: client, clearClient: FALSE, whatChanged: obj]; obj.parms.color _ color END; DoPaint: PUBLIC PROC [dr: Drawing, obj: Object] = TRUSTED BEGIN -- The caller must have at least read rights in order to call this procedure ViewerOps.PaintViewer [viewer: dr, hint: client, clearClient: FALSE, whatChanged: obj] END; DoPaintAll: PUBLIC PROC [dr: Drawing] = TRUSTED BEGIN -- The caller must have at least read rights in order to call this procedure ViewerOps.PaintViewer [viewer: dr, hint: client, clearClient: TRUE, whatChanged: $All] END; <<>> <<-- PREDEFINED OBJECTS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> DrawDot: PUBLIC PROC [context: Graphics.Context, sf: Cart.ScaleFactors, pt: Homo.Point, side: Size _ 0, color: Color _ black] = TRUSTED BEGIN IF Homo.FinPt [pt] THEN {cp: Cart.Point = Homo.ScalePoint [pt, sf]; sz: REAL = IF side = 0 THEN 1.0 ELSE Float[side]/2.0 + 0.1; Graphics.SetColor[context, color]; Graphics.DrawBox[context, [cp.x-sz, cp.y-sz, cp.x+sz, cp.y+sz]]} END; DrawSegment: PUBLIC PROC [context: Graphics.Context, sf: Cart.ScaleFactors, org, dest: Homo.Point, width: Size _ 1, color: Color _ black] = TRUSTED BEGIN -- note: size = 0 means standard line size (as defined by DrawTo) wd: REAL = Float [width]/2.0; so, sd: Cart.Point; [so, sd] _ Homo.ScaleSeg [org, dest, sf]; Graphics.SetColor[context, color]; IF width # 0 THEN {d: Cart.Vector _ Cart.Sub [sd, so]; tx,ty: REAL; ds: REAL _ Cart.Length[d]; IF ds > 0.1 THEN {tx _ -wd*d.y/ds; ty _ wd*d.x/ds}; Graphics.MoveTo[context, so.x+tx, so.y+ty]; Graphics.LineTo[context, sd.x+tx, sd.y+ty]; Graphics.LineTo[context, sd.x-tx, sd.y-ty]; Graphics.LineTo[context, so.x-tx, so.y-ty]; Graphics.DrawArea[context]} ELSE {Graphics.MoveTo[context, so.x, so.y]; Graphics.DrawTo[context, sd.x, sd.y]} END; MoveTo: PUBLIC PROC [context: Graphics.Context, sf: Cart.ScaleFactors, pt: Homo.Point] = TRUSTED BEGIN cp: Cart.Point = Homo.ScalePoint [pt, sf]; Graphics.MoveTo[context, cp.x, cp.y] END; LineTo: PUBLIC PROC [context: Graphics.Context, sf: Cart.ScaleFactors, pt: Homo.Point] = TRUSTED BEGIN cp: Cart.Point = Homo.ScalePoint [pt, sf]; Graphics.LineTo[context, cp.x, cp.y] END; <<-- VIEWER PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> ViewerPainter: ViewerClasses.PaintProc = TRUSTED BEGIN -- Parameters: [self: Viewer, context: Graphics.Context, whatChanged: REF ANY] -- Called either by the system because of viewer rearrangement or creation, or by the DoPaint/DoPaintAll through ViewerOps.PaintViewer. -- In the first case, whatChanged will be NIL. The caller will hold no access rights to the viewer data, and therefore ViewerPainter will acquire read access. -- In the second case, whatChanged will be $All for full repaint, or a single Object. The caller is assumed to have at least read access rights to the viewer, so ViewerPainter will not try to acquire it.. vData: ViewerData _ NARROW[self.data]; hadAccess: BOOL; PaintSingleObject: PROC [obj: Object] = TRUSTED INLINE {obj.Painter [self, context, vData.scale, obj.parms]}; RePaintEverything: PROC = TRUSTED BEGIN p: Object; oldPriority: Process.Priority _ Process.GetPriority[]; Process.SetPriority[Process.priorityBackground]; -- paint objects in order FOR order: PaintOrder IN PaintOrder DO p _ vData.fobj[order]; WHILE p # NIL DO PaintSingleObject [p]; p _ p.succ ENDLOOP ENDLOOP; Process.SetPriority[oldPriority] END; IF NOT vData.alive THEN RETURN; IF whatChanged = NIL THEN {-- acquire reading rights hadAccess _ FALSE; Acquire [self, read, none]} ELSE {-- should have them already hadAccess _ TRUE}; BEGIN OPEN vData; ENABLE UNWIND => {IF NOT hadAccess THEN Release[self, read]}; cBox: Graphics.Box = Graphics.GetBounds[context]; vData.scale _ Cart.BoxToBoxScale [vData.box, [[cBox.xmin, cBox.ymin], [cBox.xmax, cBox.ymax]]]; IF whatChanged = NIL OR whatChanged = $All THEN {-- repaint everything - assume the background is clear RePaintEverything []} ELSE {-- repaint the given thing obj: Object = NARROW [whatChanged]; PaintSingleObject[obj]}; -- relinquish acquired access rights IF NOT hadAccess THEN Release[self, read] END; END; LastWish: ViewerClasses.DestroyProc = BEGIN -- parameters: [self: Viewer] -- Called by the system when the viewer is going to be destroyed vData: ViewerData _ NARROW[self.data]; vData.alive _ FALSE END; <<>> <<-- MOUSE PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> AddMouseAction: PUBLIC PROC [dr: Drawing, event: MouseEvent, Proc: MouseProc, eventData: REF _ NIL, rights: Access] = BEGIN -- Should be called with no access rights held! vData: ViewerData = NARROW [dr.data]; me: REF MouseActionEntry _ NEW [MouseActionEntry _ [event: event, Proc: Proc, eventData: eventData, rights: rights]]; Acquire [dr, write, none]; vData.mouseActions _ CONS [me, vData.mouseActions]; -- hope for no UNWINDs here Release [dr, write] END; MouseWatcher: ViewerClasses.NotifyProc = BEGIN -- parameters [self: Viewer, input: LIST OF REF ANY] -- Called by the system to process mouse events in the viewer area -- Accordind to COG.tip, the first item in the input list is the button name ($LeftDown, etc), followed by the mouse coordinates, followed by $Shift and/or $Ctrl (in that order) or nothing. IF input = NIL OR input.rest = NIL THEN RETURN ELSE {me: REF MouseActionEntry _ NIL; event: MouseEvent _ [button: , shift: FALSE, ctrl: FALSE, kind: down]; vData: ViewerData = NARROW[self.data]; coords: TIPTables.TIPScreenCoords = NARROW[input.rest.first, TIPTables.TIPScreenCoords]; pt: Cart.Point; acc: Access _ none; -- access rights currently held by this process IF NOT vData.alive THEN RETURN; SELECT input.first FROM $LeftDown => {event.button _ left}; $CenterDown => {event.button _ center}; $RightDown => {event.button _ right}; $LeftMove => {event.button _ left; event.kind _ move}; $CenterMove => {event.button _ center; event.kind _ move}; $RightMove => {event.button _ right; event.kind _ move}; ENDCASE => RETURN; input _ input.rest.rest; IF input # NIL AND input.first = $Shift THEN {event.shift _ TRUE; input _ input.rest}; IF input # NIL AND input.first = $Ctrl THEN {event.ctrl _ TRUE; input _ input.rest}; -- map x, y to user coordinates and locate MouseActionEntry for this event Acquire [self, write, none]; acc _ write; BEGIN ENABLE UNWIND => {Release [self, acc]}; maList: LIST OF REF MouseActionEntry _ vData.mouseActions; pt _ Cart.UnScalePoint [[x: coords.mouseX, y: coords.mouseY], vData.scale]; UNTIL maList = NIL OR maList.first.event = event DO maList _ maList.rest ENDLOOP; IF maList # NIL THEN {-- call corresponding client procedure me _ maList.first; Acquire[self, me.rights, acc]; acc _ me.rights; me.Proc [self, me.eventData, pt.x, pt.y, event] }; Release [self, acc]; END } END; <<>> <<-- MENU PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> AddMenuAction: PUBLIC PROC [dr: Drawing, name: ROPE, Proc: MenuProc, menuData: REF _ NIL, rights: Access] = TRUSTED BEGIN -- should acquire write rights, but... vData: ViewerData = NARROW [dr.data]; me: REF MenuActionEntry _ NEW [MenuActionEntry _ [name: name, Proc: Proc, menuData: menuData, rights: rights]]; Menus.AppendMenuEntry [menu: dr.menu, name: name, proc: MenuDispatcher, fork: TRUE, clientData: me]; ViewerOps.PaintViewer [viewer: dr, hint: header, clearClient: FALSE, whatChanged: NIL] END; MenuDispatcher: Menus.MenuProc = TRUSTED BEGIN -- parameters viewer: Viewer, clientData: REF ANY, redButton: BOOL] -- Called by the system for all client-generated menu entries; clientData will be a REF MenuActionEntry. vData: ViewerData = NARROW[viewer.data]; me: REF MenuActionEntry _ NARROW[clientData]; button: MouseButton _ IF redButton THEN left ELSE right; -- call corresponding client procedure IF NOT vData.alive THEN RETURN; Process.SetPriority[Process.priorityForeground]; Acquire[viewer, me.rights, none]; me.Proc [viewer, me.menuData, button ! UNWIND => {Release[viewer, me.rights]}]; Release[viewer, me.rights] END; AddPropertyButton: PUBLIC PROC [dr: Drawing, key: ATOM] = TRUSTED BEGIN -- should acquire write rights, but... vData: ViewerData = NARROW [dr.data]; Menus.AppendMenuEntry [menu: dr.menu, name: Atom.GetPName[key], proc: PropertyButtonHandler, fork: TRUE, clientData: key]; ViewerOps.PaintViewer [viewer: dr, hint: header, clearClient: FALSE, whatChanged: NIL] END; PropertyButtonHandler: Menus.MenuProc = TRUSTED BEGIN -- parameters viewer: Viewer, clientData: REF ANY, redButton: BOOL] -- Called by the system when the "Repaint" menu entry is activated. vData: ViewerData = NARROW[viewer.data]; key: ATOM = NARROW [clientData]; IF NOT vData.alive THEN RETURN; PutProp [viewer, key, IF redButton THEN $TRUE ELSE NIL, none]; Process.SetPriority[Process.priorityForeground]; RepaintAll [viewer, none] END; MenuRepaintAll: Menus.MenuProc = TRUSTED BEGIN -- parameters viewer: Viewer, clientData: REF ANY, redButton: BOOL] -- Called by the system when the "Repaint" menu entry is activated. vData: ViewerData = NARROW[viewer.data]; IF NOT vData.alive THEN RETURN; Process.SetPriority[Process.priorityForeground]; RepaintAll [viewer, none] END; <<-- PROPERTY LIST - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->> MyPutAssoc: PROC [key: REF ANY, val: REF ANY, aList: List.AList] RETURNS[List.AList] = <<-- Similar to List.PutAssoc, but deletes the entry if val = NIL>> BEGIN OPEN List; x, x1: AList _ NIL; x _ aList; UNTIL x = NIL DO IF x.first.key = key THEN {IF val = NIL THEN {IF x1 = NIL THEN {aList _ x.rest} ELSE {x1.rest _ x.rest} } ELSE {x.first.val _ val}; RETURN[aList] }; x1_x; x _ x.rest; ENDLOOP; -- key not found on x IF val # NIL THEN {x _ Zone.CONS[DotCons[key, val], x]; IF x1 = NIL THEN {aList _ x} ELSE {x1.rest _ x} }; RETURN[aList]; END; GetProp: PUBLIC PROC [dr: Drawing, key: ATOM, hasSome: BOOL] RETURNS [value: REF] = BEGIN acq: Access = IF hasSome = write THEN write ELSE read; vData: ViewerData = NARROW [dr.data]; Acquire [dr, acq, hasSome]; BEGIN ENABLE UNWIND => {Acquire [dr, hasSome, acq]}; value _ List.Assoc [key, vData.pList]; Acquire [dr, hasSome, acq] END END; PutProp: PUBLIC PROC [dr: Drawing, key: ATOM, value: REF, hasSome: BOOL] = BEGIN vData: ViewerData = NARROW [dr.data]; Acquire [dr, write, hasSome]; BEGIN ENABLE UNWIND => {Acquire [dr, hasSome, write]}; vData.pList _ MyPutAssoc [key, value, vData.pList]; Acquire [dr, hasSome, write] END END; MakeBasicMenu: PROC RETURNS [m: Menus.Menu] = TRUSTED BEGIN -- Creates the initial menu m _ Menus.CreateMenu[]; Menus.AppendMenuEntry[menu: m, name: "Close", proc: ViewerMenus.Close]; Menus.AppendMenuEntry[menu: m, name: "Grow", proc: ViewerMenus.Grow]; Menus.AppendMenuEntry[menu: m, name: "<-->", proc: ViewerMenus.Move]; Menus.AppendMenuEntry [menu: m, name: "Destroy", proc: ViewerMenus.Destroy, fork: TRUE]; Menus.AppendMenuEntry [menu: m, name: "Repaint", proc: MenuRepaintAll, fork: TRUE]; END; Initialize: PROC = TRUSTED BEGIN -- registers viewer class DoStartColorViewers: PROC = TRUSTED INLINE {WindowManager.StartColorViewers [left, 8]}; tipTable: TIPUser.TIPTable _ TIPUser.InstantiateNewTIPTable["COGDraw.tip"]; viewerClass: ViewerClasses.ViewerClass _ NEW [ViewerClasses.ViewerClassRec _ [paint: ViewerPainter, -- called whenever the Drawing should repaint notify: MouseWatcher, -- TIP input events modify: NIL, -- InputFocus changes reported through here destroy: LastWish, -- called before Drawing structures freed on destroy op copy: NIL, -- copy data to new Drawing set: NIL, -- set the viewer contents get: NIL, -- get the viewer contents init: NIL, -- called on creation or reset to init data save: NIL, -- requests client to write contents to disk scroll: NIL, -- document scrolling icon: document, -- picture to display when small tipTable: tipTable, -- could be moved into Drawing instance if needed cursor: crossHairsCircle -- standard cursor when mouse is in viewer ]]; Bug.out.PutF["\nRegistering Drawing Class..."]; ViewerOps.RegisterViewerClass[$Drawing, viewerClass]; Bug.out.PutF["\nDrawingImpl: Should start color viewers? "]; IF Bug.in.GetChar [] = 'y THEN DoStartColorViewers[]; END; Initialize[] END.