-- To do: check locking scheme

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

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;

BEGIN
vData: ViewerData = NARROW [dr.data];
RETURN [vData.alive]
END;

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;

BEGIN
obj ← NEW [ObjectRec ←
[Painter: Painter, parms: parms, order: , pred: NIL, succ: NIL, dr: NIL]]
END;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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

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

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..

END;

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;

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;

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;

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;

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;

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;

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;

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;

-- 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;

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;

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;

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;

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;