[Cyan]<PreISLCedar>Stolfi>COG>COGDrawingImpl.mesa!1

-- COGDrawingImpl.mesa: Viewers for geometrical drawings

-- last modified by Stolfi - October 16, 1982 6:52 pm

-- To do: check locking scheme

-- To do: implement recursive objects, and use them in lieu of layers!!!.

-- To do: try using the RefTab interface for managing property lists, mouse/menu actions, etc.

-- To do: check whether the AddProp and FetchProp procs in ViewerOps are usable

-- To do: make interlocking mechanism more efficient and elegant - it is lousy!

DIRECTORY
COGDebug USING [out, in],
Graphics USING
[Box, Color, Path, Context, GetBounds, DrawTo, MoveTo, LineTo,
DrawBox, SetColor, SetCP, NewPath, DrawStroke],
IO USING [PutF, GetChar],
List USING [Assoc, AList, DotCons, Zone],
Atom USING [GetPName],
Process USING
[GetPriority, Priority, priorityBackground, priorityForeground, SetPriority, GetCurrent],
ViewerClasses,
TIPTables USING [TIPScreenCoords],
Rope USING [ROPE],
TIPUser USING [InstantiateNewTIPTable, TIPTable],
ViewerOps USING
[RegisterViewerClass, CreateViewer, PaintViewer],
Menus USING
[Menu, MenuProc, CreateMenu, AppendMenuEntry, CreateEntry,
MenuEntry, MenuLine],
WindowManager USING [StartColorViewers],
Real USING [Float],
COGCart USING [Point, UnScalePoint, Box, ScaleFactors, BoxToBoxScale],
COGHomo USING [Point, FinPt, ScalePoint, ScaleSeg],
COGDrawing;

COGDrawingImpl: CEDAR MONITOR
LOCKS
vData^ USING vData: ViewerData
IMPORTS
Graphics, Process, ViewerOps, IO, List, Atom, COGDebug,
Menus, COGHomo, TIPUser, Real, COGDrawing, COGCart, WindowManager
EXPORTS
COGDrawing
SHARES
COGDrawing, List =
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: ARRAY [0..maxHold) OF PROCESS ← ALL[NIL], -- processes with read or write access
nHolders: NAT[0..maxHold] ← 0, -- no. of non-NIL holders
owner: [0..maxHold] ← maxHold, -- the one which has write access, if any
empty: [0..maxHold] ← 0, -- first empty slot
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
grid: NAT ← 0 -- grid size (in user coords) for rounding mouse coordinates; 0 = no grid
];

maxHold: NAT = 4; -- max no of simultaneous processes that can have rights to a drawing

MouseActionEntry: TYPE = RECORD
[event: MouseEvent,
Proc: MouseProc,
eventData: REF,
needs: Access -- to be acquired before calling the Proc
];

MenuActionEntry: TYPE = RECORD
[name: ROPE,
Proc: MenuProc,
menuData: REF,
needs: 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
vData: ViewerData ← NEW [ViewerDataRec ←
[pList: NIL,
box: box]];
Bug.out.PutF["\nCreating Viewer..."];
dr ← ViewerOps.CreateViewer
[flavor: $Drawing,
info:
[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 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Change: PUBLIC TYPE = RECORD [ix: NAT [0..maxHold], kind: ChangeKind]; -- Change in rights.

ChangeKind: TYPE = {null, noneToRead, noneToWrite, readToWrite};

noChange: PUBLIC Change ← [maxHold, null]; -- none to none, read to read, or write to write.

FindProcess: INTERNAL PROC [vData: ViewerData, me: PROCESS]
RETURNS [ix: INTEGER [0..maxHold] ← 0] = INLINE

BEGIN OPEN vData;
-- returns maxHold if not found
IF nHolders = 0 THEN ix ← maxHold
ELSE WHILE ix < maxHold AND holders[ix] # me DO ix ← ix + 1 ENDLOOP
END;

InsertProcess: INTERNAL PROC [vData: ViewerData, me: PROCESS]
RETURNS [ix: INTEGER [0..maxHold]] = INLINE

BEGIN OPEN vData;
-- assumes empty < maxHold
ix ← empty; holders[ix] ← me; nHolders ← nHolders + 1;
WHILE empty < maxHold AND holders[empty] # NIL DO empty ← empty + 1 ENDLOOP
END;

DeleteProcess: INTERNAL PROC [vData: ViewerData, ix: INTEGER [0..maxHold)] = INLINE

BEGIN OPEN vData;
holders[ix] ← NIL; empty ← ix; nHolders ← nHolders-1
END;

GetReadRights: PUBLIC PROC [dr: Drawing] RETURNS [c: Change] = TRUSTED

BEGIN
me: PROCESS = LOOPHOLE [Process.GetCurrent[]];

DoGetReadRights: ENTRY PROC [vData: ViewerData] RETURNS [c: Change] = TRUSTED INLINE
BEGIN OPEN vData;
ix: NAT[0..maxHold] ← FindProcess[vData, me];
IF ix < maxHold THEN RETURN [noChange];
-- has to insert it
WHILE vData.owner # maxHold OR nHolders = maxHold DO WAIT released ENDLOOP;
RETURN [[InsertProcess [vData, me], noneToRead]]
END;

c ← DoGetReadRights [NARROW [dr.data]]
END;

GetWriteRights: PUBLIC PROC [dr: Drawing] RETURNS [c: Change] = TRUSTED

BEGIN
me: PROCESS = LOOPHOLE[Process.GetCurrent[]];

DoGetWriteRights: ENTRY PROC [vData: ViewerData] RETURNS [c: Change] = TRUSTED INLINE
BEGIN OPEN vData;
ix: NAT[0..maxHold] ← FindProcess[vData, me];
IF ix >= maxHold THEN
{-- has to insert it
WHILE nHolders # 0 DO WAIT released ENDLOOP;
ix ← InsertProcess [vData, me];
c ← [ix, noneToWrite]}
ELSE IF ix = owner THEN
{RETURN [noChange]}
ELSE
{-- upgrades Hold to Lock
WHILE nHolders # 1 DO WAIT released ENDLOOP;
c ← [ix, readToWrite]};
vData.owner ← ix;
RETURN
END;

c ← DoGetWriteRights [NARROW [dr.data]]
END;

Release: PUBLIC PROC [dr: Drawing, c: Change] =

BEGIN
DoRelease: ENTRY PROC [vData: ViewerData] = TRUSTED INLINE
BEGIN OPEN vData;
-- c.kind is not null
IF c.kind # noneToRead THEN owner ← maxHold;
IF c.kind # readToWrite THEN DeleteProcess [vData, c.ix];
BROADCAST vData.released
END;

IF c.kind # null THEN DoRelease [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] =

BEGIN

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;

c: Change;
IF obj.dr = dr THEN RETURN;
IF obj.dr # NIL THEN ERROR DrawingError ["Object in another Drawing!"];
c ← GetWriteRights[dr];
BEGIN ENABLE UNWIND => {Release[dr, c]};
DoAddObject [NARROW [dr.data]];
DoPaint [dr, obj];
Release[dr, c]
END
END;

Remove: PUBLIC PROC [obj: Object] =

BEGIN

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;

dr: Drawing = obj.dr;
c: Change;
IF dr = NIL THEN RETURN;
c ← GetWriteRights[dr];
BEGIN ENABLE UNWIND => {Release[dr, c]};
color: Color = obj.parms.color;
obj.parms.color ← white;
DoPaint [dr, obj];
obj.parms.color ← color;
DoRemoveObject [NARROW [dr.data]];
Release[dr, c]
END
END;

RemoveLayers: PUBLIC PROC [dr: Drawing, minOrder, maxOrder: PaintOrder] =

BEGIN

DoRemoveTheObjects: PROC [vData: ViewerData] =
BEGIN OPEN vData;
oba, obj: Object;
color: Color;
remAll: BOOL ← TRUE;
FOR order: PaintOrder IN PaintOrder WHILE remAll DO
IF NOT order IN [minOrder..maxOrder] AND vData.fobj[order] # NIL THEN
remAll ← FALSE
ENDLOOP;
FOR order: PaintOrder IN [minOrder..maxOrder] DO
obj ← vData.fobj[order];
WHILE obj # NIL DO
color ← obj.parms.color;
obj.parms.color ← white;
DoPaint [dr, obj]; -- erase object from screen
obj.parms.color ← color;
oba ← obj.succ;
obj.succ ← obj.pred ← NIL;
obj.dr ← NIL;
obj ← oba
ENDLOOP;
lobj[order] ← fobj[order] ← NIL
ENDLOOP;
IF remAll THEN DoPaintAll [dr]
END;

c: Change ← GetWriteRights[dr];
BEGIN ENABLE UNWIND => {Release[dr, c]};
DoRemoveTheObjects [NARROW [dr.data]];
Release[dr, c]
END
END;

RepaintAll: PUBLIC PROC [dr: Drawing] =

BEGIN
c: Change ← GetReadRights[dr];
DoPaintAll [dr ! UNWIND => {Release[dr, c]}];
Release[dr, c]
END;

SetStyle: PUBLIC PROC [obj: Object, color: Color ← black, size: Size ← 1, style: Style ← 0] =

BEGIN
c: Change ← GetWriteRights[obj.dr];
BEGIN ENABLE UNWIND => {Release[obj.dr, c]};
obj.parms.color ← white;
DoPaint [obj.dr, obj];
obj.parms.color ← color; obj.parms.size ← size; obj.parms.style ← style;
DoPaint [obj.dr, obj];
Release[obj.dr, c]
END
END;

Modify: PUBLIC PROC
[obj: Object, Action: ObjectAction, actionData: REF ← NIL,
erase, repaint: BOOL ← TRUE] RETURNS [actionResult: REF] =

BEGIN
color: Color;
c: Change ← GetWriteRights[obj.dr];
BEGIN ENABLE UNWIND => {Release[obj.dr, c]};
IF erase THEN
{color ← obj.parms.color; obj.parms.color ← white;
DoPaint [obj.dr, obj]; -- erase object
obj.parms.color ← color};
actionResult ← Action [obj, actionData];
IF repaint THEN
{DoPaint [obj.dr, obj]};
Release[obj.dr, c]
END
END;

ModifyAll: PUBLIC PROC
[dr: Drawing, Action: ObjectAction, actionData: REF ← NIL, erase, repaint: BOOL ← TRUE]
RETURNS [actionResult: REF] =

BEGIN
color: Color;
obj: Object;
c: Change ← GetWriteRights[dr];
BEGIN ENABLE UNWIND => {Release[dr, c]};
vData: ViewerData = NARROW [dr.data];
actionResult ← actionData;
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 [obj, actionResult];
IF repaint THEN
{DoPaint [dr, obj]};
obj ← obj.succ
ENDLOOP
ENDLOOP;
Release[dr, c]
END
END;

Enumerate: PUBLIC PROC [dr: Drawing, Action: ObjectAction, actionData: REF ← NIL]
RETURNS [actionResult: REF] =

BEGIN
obj: Object;
c: Change ← GetReadRights[dr];
BEGIN ENABLE UNWIND => {Release[dr, c]};
vData: ViewerData = NARROW [dr.data];
actionResult ← actionData;
FOR order: PaintOrder IN PaintOrder DO
obj ← vData.fobj[order];
WHILE obj # NIL DO
actionResult ← Action [obj, actionResult];
obj ← obj.succ
ENDLOOP
ENDLOOP;
Release[dr, c]
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)
so, sd: Cart.Point;
[so, sd] ← Homo.ScaleSeg [org, dest, sf];
Graphics.SetColor[context, color];
IF width # 0 THEN
{path: Graphics.Path = Graphics.NewPath[2];
Graphics.MoveTo[path, so.x, so.y];
Graphics.LineTo[path, sd.x, sd.y];
Graphics.DrawStroke[context, path, Float [width]]}
ELSE
{Graphics.SetCP[context, so.x, so.y];
Graphics.DrawTo[context, sd.x, sd.y]}
END;

SetCP: PUBLIC PROC
[context: Graphics.Context, sf: Cart.ScaleFactors, pt: Homo.Point] = TRUSTED

BEGIN
cp: Cart.Point = Homo.ScalePoint [pt, sf];
Graphics.SetCP[context, cp.x, cp.y]
END;

DrawTo: PUBLIC PROC
[context: Graphics.Context, sf: Cart.ScaleFactors, pt: Homo.Point] = TRUSTED

BEGIN
cp: Cart.Point = Homo.ScalePoint [pt, sf];
Graphics.DrawTo[context, cp.x, cp.y]
END;

MoveTo: PUBLIC PROC
[path: Graphics.Path, sf: Cart.ScaleFactors, pt: Homo.Point] = TRUSTED

BEGIN
cp: Cart.Point = Homo.ScalePoint [pt, sf];
Graphics.MoveTo[path, cp.x, cp.y]
END;

LineTo: PUBLIC PROC
[path: Graphics.Path, sf: Cart.ScaleFactors, pt: Homo.Point] = TRUSTED

BEGIN
cp: Cart.Point = Homo.ScalePoint [pt, sf];
Graphics.LineTo[path, 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];

c: Change;

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;

c ← GetReadRights [self];

BEGIN OPEN vData;
ENABLE UNWIND => {Release[self, c]};
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
Release[self, c]
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, needs: Access] =

BEGIN
vData: ViewerData = NARROW [dr.data];
me: REF MouseActionEntry ← NEW [MouseActionEntry ←
[event: event,
Proc: Proc,
eventData: eventData,
needs: needs]];
c: Change ← GetWriteRights[dr];
vData.mouseActions ← CONS [me, vData.mouseActions]; -- hope for no UNWINDs here
Release [dr, c]
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;

BEGIN
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;
c: Change; -- access rights currently held by this process
IF NOT vData.alive THEN RETURN;
SELECT input.first FROM
$LeftDown => {event.button ← red};
$CenterDown => {event.button ← yellow};
$RightDown => {event.button ← blue};
$LeftMove => {event.button ← red; event.kind ← move};
$CenterMove => {event.button ← yellow; event.kind ← move};
$RightMove => {event.button ← blue; 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
c ← GetReadRights[self];
BEGIN ENABLE UNWIND => {Release [self, c]};
maList: LIST OF REF MouseActionEntry ← vData.mouseActions;
gr: NAT = vData.grid;
IF gr # 0 THEN
{coords.mouseX ← (coords.mouseX + gr/2)/gr*gr;
coords.mouseY ← (coords.mouseY + gr/2)/gr*gr};
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
me ← maList.first;
Release [self, c]
END;
-- CAUTION - there is a chance that some other process will sneak in here, perhaps
-- removing this mouse action from the list. It is possible to check for that case, but let's
-- think about that if and when the problem occurs...
IF me # NIL THEN
{c ← GetRights[self, me.needs];
me.Proc [self, me.eventData, pt.x, pt.y, event ! UNWIND => {Release [self, c]} ];
Release [self, c]}
END

END;

-- MENU PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

AddMenuAction: PUBLIC PROC
[dr: Drawing, name: ROPE, Proc: MenuProc, menuData: REF ← NIL,
needs: Access, line: Menus.MenuLine ← 1] = TRUSTED

BEGIN
vData: ViewerData = NARROW [dr.data];
me: REF MenuActionEntry ← NEW [MenuActionEntry ←
[name: name,
Proc: Proc,
menuData: menuData,
needs: needs]];
entry: Menus.MenuEntry = Menus.CreateEntry
[name: name, proc: MenuDispatcher, clientData: me];
Menus.AppendMenuEntry [menu: dr.menu, entry: entry, line: line];
ViewerOps.PaintViewer [viewer: dr, hint: menu, clearClient: FALSE, whatChanged: NIL]
END;

MenuDispatcher: Menus.MenuProc = TRUSTED

BEGIN

-- parameters parent: REF ANY, clientData: REF ANY, mouseButton]
-- Called by the system for all client-generated menu entries; clientData will be a REF MenuActionEntry.

viewer: ViewerClasses.Viewer = NARROW [parent];
vData: ViewerData = NARROW[viewer.data];
me: REF MenuActionEntry ← NARROW[clientData];
-- call corresponding client procedure
c: Change;
IF NOT vData.alive THEN RETURN;
Process.SetPriority[Process.priorityForeground];
c ← GetRights[viewer, me.needs];
me.Proc [viewer, me.menuData, mouseButton ! UNWIND => {Release[viewer, c]}];
Release[viewer, c]
END;

AddPropertyButton: PUBLIC PROC
[dr: Drawing, key: ATOM, line: Menus.MenuLine ← 1] = TRUSTED

BEGIN
vData: ViewerData = NARROW [dr.data];
entry: Menus.MenuEntry = Menus.CreateEntry
[name: Atom.GetPName[key], proc: PropertyButtonHandler, clientData: key];
Menus.AppendMenuEntry [menu: dr.menu, entry: entry, line: line];
ViewerOps.PaintViewer [viewer: dr, hint: menu, clearClient: FALSE, whatChanged: NIL]
END;

PropertyButtonHandler: Menus.MenuProc = TRUSTED

BEGIN

-- parameters [parent: REF ANY, clientData: REF ANY, mouseButton]
-- Called by the system when the "Repaint" menu entry is activated.

viewer: ViewerClasses.Viewer = NARROW [parent];
vData: ViewerData = NARROW[viewer.data];
key: ATOM = NARROW [clientData];
IF NOT vData.alive THEN RETURN;
PutProp [viewer, key, IF mouseButton = red THEN $TRUE ELSE NIL];
Process.SetPriority[Process.priorityForeground];
RepaintAll [viewer]
END;

MenuRepaintAll: Menus.MenuProc = TRUSTED

BEGIN

-- parameters: [parent: REF ANY, clientData: REF ANY, mouseButton]
-- Called by the system when the "Repaint" menu entry is activated.

viewer: ViewerClasses.Viewer = NARROW [parent];
vData: ViewerData = NARROW[viewer.data];
IF NOT vData.alive THEN RETURN;
Process.SetPriority[Process.priorityForeground];
RepaintAll [viewer]
END;

MenuSetGrid: Menus.MenuProc = TRUSTED

BEGIN

-- parameters: [parent: REF ANY, clientData: REF ANY, mouseButton]
-- Called with write access when the "Grid" menu entry is activated.

viewer: ViewerClasses.Viewer = NARROW [parent];
vData: ViewerData = NARROW[viewer.data];
c: Change = GetRights[viewer, write];
vData.grid ← SELECT mouseButton FROM
red => (IF vData.grid = 0 THEN 4 ELSE vData.grid * 2),
blue => (IF vData.grid <= 1 THEN 0 ELSE vData.grid / 2),
yellow => 0
ENDCASE => 0;
RepaintAll[viewer];
Release[viewer, c]
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] RETURNS [value: REF] =

BEGIN
vData: ViewerData = NARROW [dr.data];
c: Change = GetReadRights[dr];
value ← List.Assoc [key, vData.pList ! UNWIND => {Release[dr, c]} ];
Release[dr, c]
END;

PutProp: PUBLIC PROC [dr: Drawing, key: ATOM, value: REF] =

BEGIN
vData: ViewerData = NARROW [dr.data];
c: Change = GetWriteRights[dr];
vData.pList ← MyPutAssoc [key, value, vData.pList ! UNWIND => {Release[dr, c]} ];
Release[dr, c]
END;

MakeBasicMenu: PROC RETURNS [m: Menus.Menu] = TRUSTED

BEGIN
DoAppendEntry: PROC [name: ROPE, proc: Menus.MenuProc] = TRUSTED
{entry: Menus.MenuEntry = Menus.CreateEntry
[name: name, proc: proc, clientData: NIL, fork: TRUE, guarded: FALSE];
Menus.AppendMenuEntry [menu: m, entry: entry, line: 0]};
-- Creates the initial menu
m ← Menus.CreateMenu[2];

DoAppendEntry[name: "Repaint", proc: MenuRepaintAll];
DoAppendEntry[name: "Grid", proc: MenuSetGrid]
END;

Initialize: PROC = TRUSTED

BEGIN
-- registers viewer class
DoStartColorViewers: PROC = TRUSTED INLINE
{WindowManager.StartColorViewers [left, 8]};
tipTable: TIPUser.TIPTable ← TIPUser.InstantiateNewTIPTable["COGDraw.tip"];
menu: Menus.Menu ← MakeBasicMenu[];
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
menu: menu, -- default menu
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.