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;

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

DrawingError: ERROR [descr: ROPE] = CODE;

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

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;
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;
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;
MyPutAssoc:  PROC [key: REF ANY, val: REF ANY, aList: List.AList] RETURNS[List.AList] =
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.



L-- 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!


-- VIEWER DATA RECORD  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- DEBUGGING TOOLS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- VIEWER CREATION - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-- PROCESS SYNCHRONIZATION - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-- GRAPHIC OBJECTS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- "INTERNAL" PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-- PREDEFINED OBJECTS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- VIEWER PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-- MOUSE PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-- MENU PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- PROPERTY LIST - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Similar to List.PutAssoc, but deletes the entry if val = NIL
�ʖ
"Mesa" style˜IprocšÏcÐbcÏbž�"™8š
�5™5KšœŸœ™KšœŸœA™IKšœŸœV™^Kš	œŸœŸœŸ	œ
Ÿ	œ™OKšœŸœG™O—Kš
�
™
Kš$Ïk	œ œ œ{ œ
 œ œ' œ œ| œ œ œ
 œ1 œ? œk œ œ œD œ4˜úKšŸœ œ
 œ œ œ œ# œ` œ œ œ œF œ
˜ãK˜Kš
�`™`KšŸ
œ œ œ˜%KšPŸ
œ œ 	œ
 œ œ œ�ž�œ�9œ œ œ
 œ œ
 œ�ž�ž�œ
 œ�œ"�ž�œ�œ
 	œ�$œ�Vœ œ œ
 œ œ�&œ�œ œ
 œ
 œ œ�œ�+œ4�!œ	 œ�Jœ˜—K˜KšŸœ œ�E˜WKšŸœ œ œ: œ�%ž�
œ˜ž
KšŸœ œ œ
 œ# œ�%ž�
œ˜”
K˜Kš
�b™bKšŸœ œ	 œ œ
˜)K˜Kš
�\™\šÏnœ œ
 œ
 œ œ ˜WKš œ œ œÃ
 œ) œ œ
˜¼—š
¡œ œ
 œ œ œ˜1Kš œ œ œ œ
˜I—K™Kš
�^™^KšŸœ œ
 œ œ œ"�˜[KšŸ
œ œ0˜@KšŸœ œ�2˜]š
¡œ œ
 œ œ œ œ ˜lKš œ
 œ
� œ œ œ œ
 œ œ œ
 œ
 œ
˜¢
—š
¡
œ œ
 œ œ œ œ ˜jKš œ
 œ
�œ; œ œ œ
 œ œ
 œ
˜º
—š	¡
œ œ
 œ œ ˜SKš œ
 œ œ$ œ
˜M—š	Ðbn
œ œ
 œ œ ˜FKš3 œ œ œ¡¢
œ œ
 œ œ œ
 œ œ
 œ œ- œ œ
 œ�œ œ œ œ
 œ
 œ œ/ œ œ œ
˜á—š	¢œ œ
 œ œ ˜GKšC œ œ œ¡¢œ œ
 œ œ œ
 œ œ
 œ œ- œ œ
�œ	 œ œ
 œ
 œQ œ
 œ œ
 œ œ
�œ	 œ œ
 œ
 œA œ œ œ œ
˜­—š¡œ œ
 œ˜/Kš( œ¡	œ œ
 œ œ
 œ œ
 œ�ž�
œ œ œ œ œ$ 	œ œ œ œ œ œ
˜Ë—K™Kš
�^™^š¡œ œ
 œ, œ˜TKš œ	 œB œ œ œ œ
˜q—š¡œ œ
 œ4˜Dš œ
˜Kš¡œ œ œ
 œ# œ œ
 œF œ œk œ œ
˜Ê—Kšœ œ
 œ
 œ œ
 œ
 œ
 œJ œ
 œ
 œ' œ9 œ
 œ
˜“—š¡œ œ
 œ˜#š
 ˜Kš*¡œ œ œ
 œF œ œ
 œ8 œ= œ œ
 œ/ œ œ
 œ8 œ= œ œ
 œ9 œ œ œ
˜Ý—Kšœ( œ œ
 œ
 œ œ
 œ
 œŸ
 œ" œ
 œ
˜¿—š¢œ œ
 œ0˜Iš
 ˜KšB¡œ œ œ
 œ< œ œ œ œ œ œ œ
 œ œ œ œ
 œ œ œ œ œ œ& œ œ
 œ^�œW œ œ œ$ œ œ œ œ œ
˜„—Kš
œ% œ
 œ
 œ. œ" œ
 œ
˜–
—š¡
œ œ
 œ˜'Kš œ5 œ( œ˜m—š¡œ œ
 œH˜]Kš œ) œ
 œ
 œÓ
 œ
 œ
˜œ—š¡œ œ
 œ3 œ œ œ œ œ œ˜�
Kš œ9 œ
 œ
 œ œ œX�œR œ	 œ9 œ
 œ
˜†—š¡	œ œ
 œ3 œ œ œ œ œ œ˜�
Kš( œD œ
 œ
 œ. œ/ œ œ œ& œ œ
 œ	 œ œ\�œ` œ	 œ> œ œ œ
 œ
˜ÿ—š¡	œ œ
 œ1 œ œ œ œ˜pKš œ3 œ
 œ
 œ. œ/ œ œ œ& œ œ
 œR œ œ œ
 œ
˜‘—Kš
�^™^š¡œ œ
 œ ˜9Kš
 œ�ž�(œ} œ/ œ
˜‚—š¡œ œ
 œ ˜9Kš
 œ�!ž�(œ@ œ œ
˜²
—š¡
œ œ
 œ ˜/Kš
 œ�!ž�(œ@ œ œ
˜²
—K™Kš
�a™aš¢œ œ
 œs ˜Ž
Kš œ œ œ: œ œ
 œ œ†
 œ
˜ƒ—š¢œ œ
 œ{ ˜š
Kš œ�Bœi œ œ»
 œV œ
˜Ý—š¢œ œ
 œI ˜bKš œT œ
˜]—š¢œ œ
 œI ˜cKš œU œ
˜^—š¢œ œ
 œC ˜]Kš œR œ
˜[—š¢œ œ
 œC ˜]Kš œR œ
˜[—K˜Kš
�`™`šŸ
œ ˜0š œ�¥
ž�
ž
�	ž	�
ž�œ
�ž�	ž�Jž
�ž� ž�	ž�ž�)ž�!ž
�˜ËKšœ œ˜&Kš
œ
˜
š¡œ œ œ
 ˜6Kš
œ6˜6—š¢œ œ œ
˜"Kš œ�œ œ œ œ  œ œ
 œ4 œ œ& œ
˜æ—Kš	œ
 œ
 œ
 œ
 œ˜;Kšœ
 œ
 œ
 œ
 œ´
 œ œ
 œ œ�7œ œ�œ œ0�%œ œ
˜‰—Kš œ
˜—šŸœ˜%Kš
 œ
�_œ œ œ
 œ
˜©
—K™Kš
�_™_š
¡œ œ
 œC œ œ˜yKš œ œ œ œ¢
 œ�œ œ
˜Á—šŸœ˜(š œ�xœ
�/ž�Š
œ œ	 œ
 œ œ
 œ
 œ
˜ðKši œ œ œ* œ œ% œ3 œN�0œ œ
 œ
 œ
 œ œ
 œµ œ œ œ	 œ
 œ œ œ œ	 œ
 œ œ œ�Kœ œ
 œ
 œ% œ
 œ
 œ, 
œ
 œ œÁ
 œ
 œ
 œ œ! œ œ
 œ
 œ3 œ�Sœ�aœ�9œ œ œ
 œ[ œ3 ˜ž—Kš œ
˜—K™Kš
�^™^š
¡
œ œ
 œ œ œ œ0 ˜‘
Kš œ œ œ œÊ œ œ œ
˜´—šŸœ ˜(Kš" œ�Aœ�?ž
�ž�
ž�œ" œ! œ œ œ�'œ œ
 œ
 œ
 œ†
 œ0 œ
˜Ù—š	¡œ œ
 œ œ ˜]Kš
 œ œˆ œ œ œ
˜Ç—šŸœ ˜/Kš  œ�Bœ�Dœ" œ! œ œ œ œ
 œ
 œ
 œ œ œ œ
 œL œ
˜Ä—šŸœ ˜(Kš œ�Cœ�Dœ" œ! œ œ
 œ
 œ
 œK œ
˜ß—šŸœ ˜%Kš  œ�Cœ�ž�1œ" œ! œF œ
 œ œ œ œ! œ œ œ) œ2 œ
˜�—Kš
�f™fš¡
œ œ œ
 œ œ
 œ œ˜WKš
�?™?Kš: œ
 œ œ œ œ
 œ œ œ œ œ
 œ œ œ
 œ( œ3 œ& œ( œ�œ œ œ
 œ œ œ œ
 œ œ  œ	 œ
˜“—š¡œ œ
 œ œ œ	 œ˜DKš œ œV œ) œ
˜«
—š
¡œ œ
 œ œ	 œ˜;Kš œ œd œ) œ
˜¹
—š¡
œ œ
 œ ˜5Kš œ¡
œ œ œ œ] œ œ œA�œˆ
 œ˜®—š¡
œ œ ˜Kš> œ
�œ¡œ œ œ
 œÑ
 œF�.œ"�œ œ�,œ�8œ œ�œ
 œ�œ
 œ�œ œ�,œ œ�-œ�œ œ	�œ�!œ�2œ!�+œ·
 œ œ œ˜——Kšœ œ˜J˜—…—`°x