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],
  COGScene;
SceneImpl: CEDAR MONITOR
  IMPORTS
    Graphics, Process, ViewerOps, IO, List, Atom, COGDebug,
    Menus, TIPUser, Real, Scene, ScenePrivate, WindowManager
  EXPORTS
    Scene
  SHARES
    ScenePrivate =
BEGIN
  OPEN Sc: Scene, SPr: ScenePrivate, Real, Rope, Bug: COGDebug, IO;

SceneDataRec: TYPE = RECORD
 [alive: BOOL _ TRUE, -- reset to FALSE when scene is killed. Unprotected.
  -- The entries below are protected by the SceneImpl monitor lock
  --  and the scene viewer's paintlock. Both locks must be acquired for write
  --  (in that order) to modify any of these fields or the object tree.
  tree: ObjectTree _ NIL, -- The object to be shown. 
  viewer: ViewerClasses.Viewer, -- Where to display the scene.
  mouseActions: LIST OF REF ClickTableEntry _ NIL, -- Enabled mouse events. 
  -- The entries below are protected by the COGSceneQueueImpl lock
  repaintQueue: BoundingBox, -- For now, just a single box to be repainted
  repaintAll: BOOL _ FALSE, -- Global repaint request indicator. Unprotected.
  ClickQueue: LIST OF REF ClickQueueEntry -- queued menu and mouse actions.
   ];
SceneData: TYPE = REF SceneDataRec;
ClickTableEntry: TYPE = RECORD
  [name: ROPE, -- NIL for mouse table entries
   clickType: ClickType, -- 
   Proc: MouseProc, 
   eventData: REF,
   needs: Access, -- to be acquired before calling the Proc
   needsContext: BOOL  -- true if the Proc needs the viewer's context.
   ];

DrawingError: ERROR [descr: ROPE] = CODE;

CreateScene: PUBLIC PROC [info: ViewerClasses.ViewerRec] RETURNS [sc: Scene] =
BEGIN
  sData: SceneData _ NEW [SceneDataRec];
  Bug.out.PutF["\nCreating Scene..."];
  info.data _ sData;
  sc _ ViewerOps.CreateViewer
      [flavor: $Scene,
       info: info]
   sData.viewer _ sc;
   Process.Detach[FORK[Server[sc]]]
END;
KillScene: PUBLIC PROC [sc: Scene];
BEGIN
  sData: SceneData = NARROW [sc.data];
  sData.alive _ FALSE;  -- redundant, but better safe than sorry
  ViewerOps.DestroyViewer[sc]
END;
Alive: PUBLIC PROC [sc: Scene] RETURNS [BOOL] =
BEGIN
  sData: SceneData = NARROW [sc.data];
  RETURN [sData.alive]
END;
RepaintAll: PUBLIC PROC [sc: Scene];
BEGIN
  SP.ScheduleRepaint [sc, infiniteBox]
END;
inf: REAL = Real.LargestNumber;
emptyBox: BoundingBox =
 [client: [xmin: inf, ymin: inf, xmax: -inf, ymax: -inf],
  extraX: 0.0, extraY: 0.0,
  unbounded: FALSE];
infiniteBox: BoundingBox =
 [client: [xmin: -inf, ymin: -inf, xmax: inf, ymax: inf],
  extraX: defaultLineWidth, extraY:  defaultLineWidth,
  unbounded: TRUE];

MakeThing: PUBLIC PROC [class: ObjectClass, parms: REF] RETURNS [thing: Thing] =
BEGIN
  thing _ NEW [thing ObjectRec _ [var: [class: class, parms: parms]]]
END;
MakeGroup: PUBLIC PROC RETURNS [group: Group] =
BEGIN
  group _ NEW [group ObjectRec _ [var: [child: NIL]]]
END;
RemoveAndRepaintObject: PUBLIC PROC [obj: Object] RETURNS [oldParent: REF, oldNext: Object] =
BEGIN
    IF obj.parent # NIL THEN
    BEGIN
      dad: Object; -- parent object, if any
      sc: Scene; -- attached scene, if any

      WITH obj.parent SELECT FROM
        scenePar: Scene =>
          BEGIN
             oldParent _ sc _ scenePar; oldNext _ dad _ NIL;
             UnS.RemoveTree[sc]
           END;
        objectPar: Object =>
            BEGIN
              sc _ UnS.GetScene[obj]; dad _ objectPar;
              IF dad.class # GroupClass OR dad.parms # obj THEN
                SceneError["Invalid parent/child links"];
              [oldPArent, oldNext] _ UnS.RemoveChild[obj]
            END; 
       ENDCASE => ERROR SceneError["Invalid parent link"];
      IF sc # NIL THEN
       {[] _ Uns.RecomputeAncestorBoxes[dad];
        UnS.ScheduleRepaint[sc, obj.box]}
    END
  ELSE
   {oldParent _ oldNext _ NIL;
    IF obj.next # NIL THEN
      ERROR SceneError["root's next should be NIL"]}
END;
InsertAndRepaintObject: PUBLIC PROC
 [obj: Object, newParent: REF, newNext: Object _ NIL] =
BEGIN

  IF obj.parent # NIL OR obj.next # NIL THEN
    ERROR SceneError["New object must be detached root"];

  IF newParent # NIL THEN
    BEGIN
      dad: Object; -- new parent object, if any
      sc: Scene; -- new attached scene, if any

      IF newNext# NIL AND newNext.parent # newParent THEN
        ERROR SceneError["newNext not child of newParent"];
      WITH  newParent SELECT FROM
        scenePar: Scene =>
            BEGIN
              sc _ scenePar; dad _ NIL;
              UnS.SetTree[sc, obj]
           END;
        objectPar: Object =>
            BEGIN
              sc _ UnS.GetScene[obj]; dad _ objectPar;
              UnS.InsertChild [obj: obj, newParent: dad, newNext: newNext]
            END;
         ENDCASE => ERROR SceneError["Invalid new parent"];
       IF sc # NIL THEN
        {boxChanged: BOOL = UnS.RecomputeLineWidthsAndBoxes[obj];
         IF boxChanged THEN UnS.RecomputeAncestorBoxes[dad];
         UnS.ScheduleRepaint[sc, obj.box]}
     END
  ELSE
   {IF newNext # NIL THEN
      ERROR SceneError["spurious sibling -- should be NIL"]}
END;
RemoveObject: PUBLIC PROC [obj: Object] RETURNS [oldParent: REF, oldNext: Object] =
BEGIN

DoRemoveObject: TreeAction =
  BEGIN
    [oldParent, oldNext] _ RemoveAndRepaintObject[obj];
  END;

  DoWithWriteAccess[obj, DoRemoveObject];
END;
InsertObject: PUBLIC PROC [obj: Object, newParent: REF, newNext: Object _ NIL] =
BEGIN

DoInsertObject: TreeAction =
  BEGIN
    InsertAndRepaintObject[obj, newParent, newNext]
  END;

  DoWithWriteAccess[obj, DoInsertObject];
END;
MoveObject: PUBLIC PROC [obj: Object, newParent: REF, newNext: Object _ NIL]
 RETURNS [oldParent: REF, oldNext: Object] =
BEGIN

DoMoveObject: DoubleTreeAction =
  BEGIN
    -- remove object from current tree
    [oldParent, oldNext] _ RemoveAndRepaintObject[obj];
    -- insert it in new place
    InsertAndRepaintObject[obj, newParent, newNext]
  END;

  DoWithDoubleWriteAccess[obj, newParent, DoMoveObject];
END;
RemoveTree: PUBLIC PROC [sc: Scene] RETURNS [tree: ObjectTree] =
BEGIN
  sData: SceneData = NARROW [sc.data];
  tree _ sData.tree;
  IF tree.parent # sc OR tree.next # NIL THEN
    ERROR SceneError["Invalid tree-scene connection"];
  tree.parent _ NIL;
  sData.tree _ NIL
END;
SetTree: PUBLIC PROC [sc: Scene, tree: ObjectTree] =
BEGIN
  sData: SceneData = NARROW [sc.data];
  IF sData.tree # NIL THEN
    ERROR SceneError["Scene should have empty tree"];
  IF tree.parent # NIL OR tree.next # NIL THEN
    ERROR SceneError["Tree should be detached"];
  sData.tree _ tree;
  tree.parent _ sc
END;
RemoveChild: PUBLIC PROC [obj: Object]
 RETURNS [oldParent: Object, oldNext: Object] =
BEGIN
  oldParent _ NARROW[obj.parent];
  oldPrev: Object _ NARROW [oldParent.parms];
  oldNext _ IF obj = oldParent.parms THEN NIL ELSE obj.next;
  DO
    IF oldPrev = NIL THEN ERROR SceneError["Inconsistent next/last links"];
    IF oldPrev.next = obj THEN EXIT;
    IF oldPrev = oldParent.parms THEN
      ERROR SceneError["Inconsistent parent/next links"];
    oldPrev _ oldPrev.next
   ENDLOOP;
  IF oldPrev = obj THEN
   {oldParent.parms _ NIL} -- only child
  ELSE
   {oldNext _ oldPrev.next _ obj.next;
    IF oldParent.parms = obj THEN
     {oldParent.parms _ oldPrev; oldNext _ NIL} -- topmost child
    };
  obj.parent _ NIL; obj.next _ NIL
END;
InsertChild: PUBLIC PROC [obj: Object, newParent: Object, newNext: Object _ NIL] =
BEGIN
  newPrev: Object _ NARROW [newParent.parms];

  -- consistency check to avoid cycles
  temp: Object _ newParent;
  DO
    IF temp = obj THEN ERROR SceneError ["Attempt to create cycle"];
    IF temp.parent IS Object THEN
      temp _ NARROW [temp.parent]
    ELSE EXIT
   ENDLOOP;

  IF obj.parent # NIL OR obj.next # NIL THEN
    ERROR SceneError["Object must be detached root"];

  -- locate current child newPrev just below newNext
  --   (or topmost child if newNext is bottommost)
  IF newNext # NIL THEN
    BEGIN
      IF newNext.parent # newParent THEN
        ERROR SceneError["newNext not child of newParent"];
      DO
        IF newPrev.next = newNext THEN EXIT;
        IF newPrev = newParent.parms THEN
          ERROR SceneError["Inconsistent child/next links"];
        newPrev _ newPrev.next
       ENDLOOP
    END;

  IF newPrev.parent # newParent THEN
    ERROR SceneError["newPrev not child of newParent"];
  obj.parent _ newParent;
  obj.next _ newPrev.next;
  newPrev.next _ obj;
  IF newNext = NIL THEN
   {newParent.parms _ obj}
END;
RecomputeAncestorBoxes: PUBLIC PROC [dad: Group] =
BEGIN
  changed: BOOL;
  child: Object;
  WHILE dad # NIL DO
    changed _ RecomputeBox[dad];
    IF NOT changed THEN EXIT;
    dad _ IF dad.parent IS Object THEN NARROW [dad.parent] ELSE NIL
   ENDLOOP;
END;
RecomputeLineWidthsAndBoxes: PUBLIC PROC [obj: ObjectTree]
 RETURNS [boxChanged: BOOL] =
BEGIN
  -- recompute default line width
  UnS.RecomputeLineWidth[obj];
  -- recompute bounding boxes of descendants
  IF obj IS Group THEN
    BEGIN
      child: object _ NARROW[obj.parms];
      IF child # NIL THEN
        DO
          RecomputeLineWidthsAndBoxes [child];
          IF child.parent # obj THEN 
            ERROR SceneError ["Inconsistent parent/child/next links"];
          child _ child.next;
          IF child = obj.last THEN EXIT
        ENDLOOP
    END;
  boxChanged _ RecomputeBox[obj]
END;
RecomputeBox: PUBLIC PROC [obj: Object] RETURNS [changed: BOOL] =
BEGIN
  newBox: BoundingBox;
  -- join bounding boxes of descendants and join them
  IF obj IS Group THEN
    BEGIN
      child: object _ NARROW[obj.parms];
      newBox _ emptyBox;
      IF child # NIL THEN
        DO
          IF child.parent # obj THEN 
            ERROR SceneError ["Inconsistent parent/child/next links"];
          newBox _ UnS.JoinBoxes[newBox, child.box];
          child _ child.next;
          IF child = obj.last THEN EXIT
        ENDLOOP
    END
  ELSE
    BEGIN
      newBox _ obj.class.Bounder[obj];
    END;
  newBox.oscX _ MAX[newBox.oscX, obj.lineWidth];
  newBox.oscY _ MAX[newBox.oscY, obj.lineWidth];
  IF newBox # obj.box THEN
   {obj.box _ newBox; RETURN[TRUE]}
  ELSE
   {RETURN[FALSE]}
END;
GetLineWidth: PUBLIC PROC [node: REF] RETURNS [width: REAL] =
BEGIN
  WITH node SELECT FROM
    scene: Scene =>
      BEGIN
        sData: SceneData = NARROW[scene.data];
        RETURN [sData.lineWidth]
      END;
    object: Object => RETURN [object.lineWidth];
    nil: NIL => RETURN [defaultLineWidth];
   ENDCASE => ERROR SceneError["Invalid parent link"]
END;
RecomputeLineWidth: PUBLIC PROC [node: REF] =
BEGIN
  width: REAL _ defaultLineWidth;
  w: REF RealRec _ UnS.GetProp[node, $LineWidth, local];
  WITH node SELECT FROM
    object: Object =>
      BEGIN
        w _ List.GetProp[object.props, $LineWidth];
        IF w = NIL AND object.class # NIL THEN
          w _ List.GetProp[object.class.props, $LineWidth];
        object.lineWidth _ IF w = NIL THEN GetLineWidth[object.parent] ELSE w.value
      END;
    scene: Scene =>
      BEGIN
        sData: SceneData = NARROW[scene.data];
        w _ List.GetProp[sData.props, $LineWidth];
        sData.lineWidth _ IF w = NIL THEN defaultLineWidth ELSE w.value
      END
   ENDCASE => ERROR SceneError["Node is NIL"]
END;
JoinBoxes: PUBLIC PROC [box1, box2: BoundingBoxes] RETURNS [box: BoundingBox] =
BEGIN
  RETURN[
   [client:
     [xmin: MIN[box1.client.xmin, box2.client.xmin],
      ymin: MIN[box1.client.ymin, box2.client.ymin],
      xmax: MAX[box1.client.xmax, box2.client.xmax],
      ymax: MAX[box1.client.ymax, box2.client.ymax]],
    oscX: MAX[box1.oscX, box2.oscX],
    oscY: MAX[box1.oscY, box2.oscY],
    unbounded: box1.unbounded OR box2.unbounded]]
END;
GetScene: PUBLIC PROC [node: REF]  RETURNS [sc: Scene] =
BEGIN
  DO
     WITH node DO
       obj: Object => node _ obj.parent;
       scene: Scene => RETURN[scene];
       nil: NIL => RETURN[NIL];
      ENDCASE => ERROR SceneError ["Invalid node type"]
    ENDLOOP
END;
ModifyAndRepaintObjects: PUBLIC PROC
  [node: Node, Action: ModifyProc, option: TraversalOption _ single,
   context: Gr.context _ NIL, repaint: BOOL _ TRUE] =
BEGIN
  sc: Scene = UnS.GetScene[node];
  rootBoxChanged: BOOL;
  rootObj: Object = -- root of subtree to modify
      WITH node SELECT FROM
        scene: Scene  => NARROW[scene.data, SceneData].tree,
        object: Object => object,
        nil: NIL => NIL,
       ENDCASE ERROR SceneError["Invalid node"];

  ModifyRootObjectOnly: PROC [obj: Object]
   RETURNS [boxChanged: BOOL _ FALSE] =
BEGIN
  -- apply action to obj.
  changed: BOOL _ Action[obj, context];
  IF changed AND sc # NIL THEN 
    BEGIN
      UnS.ScheduleRepaint[sc, obj.box]; -- repaint old box
      boxChanged _ UnS.RecomputeLineWidthsAndBoxes[obj];
      IF boxChanged THEN
        {UnS.ScheduleRepaint[sc, box]} -- repaint new box too
    END
END;
  ModifyAllObjects: PROC [obj: Object, someAncestorChanged: BOOL]
    RETURNS [boxChanged: BOOL _ FALSE] =
BEGIN
  -- apply action to obj. Assumes its lineWidth is OK.
  objChanged: BOOL;
  someChildBoxChanged: BOOL _ FALSE;
  IF someAncestorChanged AND sc # NIL THEN 
   {UnS.RecomputeLineWidth[obj]}; -- propagate ancestor's changes
  objChanged _ Action[obj, context];
  IF objChanged AND sc # NIL THEN 
    BEGIN
      UnS.RecomputeLineWidth[obj]; -- Action may have changed $LineWidth
    END;
  IF ISTYPE [obj, Group] THEN
    BEGIN
      group: Group _ NARROW[obj];
      child: object _ group.child;
      IF child # NIL THEN
        BEGIN
            DO
            child _ child.next;
            someChildBoxChanged _
              someChildBoxChanged OR ModifyAllObjects
                [child, someAncestorChanged OR objChanged];
            IF child = group.last THEN EXIT
           ENDLOOP
        END
    END;
  IF (someAncestorChanged OR objChanged OR someChildBoxChanged)
   AND sc # NIL THEN
    BEGIN
      IF repaint AND objChanged THEN
       {UnS.ScheduleRepaint[sc, obj.box]}; -- repaint old box
      boxChanged _ UnS.RecomputeBox[group]
      IF repaint AND objChanged AND NOT someAncestorChanged
        AND boxChanged THEN
       {UnS.ScheduleRepaint[sc, obj.box]} -- repaint new box
    END
END;
  ModifyAllThings: PROC [obj: Object]
   RETURNS [boxChanged: BOOL _ FALSE] =
BEGIN
  objChanged: BOOL;
  WITH obj SELECT FROM
    group: Group =>
      BEGIN
        child: object _ group.child;
        someChildBoxChanged: BOOL _ FALSE;
          IF child # NIL THEN
          BEGIN
            DO
            child _ child.next;
            someChildBoxChanged _
              someChildBoxChanged OR ModifyAllThings [child];
            IF child = group.last THEN EXIT
           ENDLOOP
          END;
        IF someChildBoxChanged AND sc # NIL THEN
         {boxChanged _ UnS.RecomputeBox[group]};
      END;
    thing: THING =>
      BEGIN
        objChanged: BOOL _ Action[thing, context];
        IF objChanged AND sc # NIL THEN 
          BEGIN
            UnS.RecomputeLineWidth[thing]; -- Action may change $LineWidth
            IF repaint THEN
              UnS.ScheduleRepaint [sc, thing.box];
            boxChanged _ UnS.RecomputeBox[thing];
            IF repaint AND boxChanged THEN
              UnS.ScheduleRepaint [sc, thing.box]
          END
      END;
    nil: NIL => {};
   ENDCASE => ERROR SceneError["Invalid object"]
END;

    rootBoxChanged _
      SELECT option FROM
        root => ModifyRootObjectOnly [rootObj],
        all => ModifyAllObjects [rootObj, FALSE],
        things => ModifyAllThings [rootObj],
       ENDCASE;
    IF rootBoxChanged AND sc # NIL AND rootObj.parent IS Group THEN
      UnS.RecomputeAncestorBoxes[NARROW[rootObj.parent]]
  END;
ModifyObjects: PUBLIC PROC
  [node: REF, Action: ModifyProc, option: TraversalOption _ root,
   getContext: BOOL _ FALSE, repaint: BOOL _ TRUE] =
BEGIN
DoModifyObjects: TreeAction =
  BEGIN
    ModifyAndRepaintObjects [node: node, Action: Action, option: option,
      context: context, repaint: repaint];
  END;

  DoWithWriteAccess[thing, DoModifyThing, getContext];
END;
ModifyAllThings: PUBLIC PROC
  [node: REF, Action: ThingAction, getContext: BOOL _ FALSE] =
BEGIN
DoModifyThing: TreeAction =
  BEGIN
    sc: Scene = UnS.GetScene[node];
    rootBoxChanged: BOOL;
    rootObj: Object = -- root of subtree to modify
      IF node IS Scene THEN
        NARROW[NARROW[node, Scene].data], SceneData].tree
      ELSE IF node IS Object THEN NARROW[node, Object]
      ELSE NIL;

    RecursiveModifyAllThings: PROC [obj: Object]
      RETURNS [boxChanged: BOOL _ FALSE] =
  BEGIN
    WITH obj SELECT FROM
      thing: Thing =>
        BEGIN
          [thing.parms, changed] _ Action[thing, context];
          IF changed AND sc # NIL THEN 
            BEGIN
              UnS.ScheduleRepaint[sc, thing.box]; -- repaint old box
              boxChanged _ UnS.RecomputeBox[thing];
              IF boxChanged THEN
               {UnS.ScheduleRepaint[sc, box]} -- repaint new box too
            END
        END;
      group: Group =>
        BEGIN
          someChildBoxChanged: BOOL _ FALSE
          child: object _ group.last;
          IF child = NIL then RETURN;
          DO
            child _ child.next;
            someChildBoxChanged _
              someChildBoxChanged OR RecursiveModifyAllThings [child];
            IF child = group.last THEN EXIT
           ENDLOOP;
          IF someChildBoxChanged AND sc # NIL THEN
            {boxChanged _ UnS.RecomputeBox[group]}
        END;
     ENDCASE => ERROR SceneError["This couldn't happen!"]
  END;
    rootBoxChanged _ RecursiveModifyAllThings[rootObj];
    IF rootBoxChanged AND sc # NIL AND rootObj.parent IS Group THEN
      UnS.RecomputeAncestorBoxes[NARROW[rootObj.parent]]
  END;
  DoWithWriteAccess[node, DoModifyAllThings, getContext];
END;
EnumerateAllThings: PUBLIC PROC
  [node: REF, Examine: ThingAction, getContext: BOOL _ FALSE] =
BEGIN
DoEnumerateAllThing: TreeAction =
  BEGIN
    rootObj: Object = -- root of subtree to enumerate
      IF node IS Scene THEN
        NARROW[NARROW[node, Scene].data], SceneData].tree
      ELSE IF node IS Object THEN NARROW[node, Object]
      ELSE NIL;
    RecursiveEnumerateAllThings: PROC [obj: Object] =
  BEGIN
    WITH obj SELECT FROM
      thing: Thing =>
        BEGIN
          Examine[thing, context]
        END;
      group: Group =>
        BEGIN
          child: object _ group.last;
          IF child = NIL then RETURN;
          DO
            RecursiveEnumerateAllThings [child];
            child _ child.next;
            IF child = group.last THEN EXIT
           ENDLOOP;
        END;
     ENDCASE => {}
  END;
    RecursiveEnumerateAll[rootObj]
  END;
  DoWithReadAccess[node, DoEnumerateAllThings, getContext];
END;
AddMouseAction: PUBLIC PROC
  [sc: Scene, event: MouseEvent, Proc: MouseProc,
   eventData: REF _ NIL, needs: Access, needsContext: BOOL _ FALSE] =
BEGIN
  sData: SceneData = NARROW [sc.data];
  me: REF MouseActionEntry _ NEW [MouseActionEntry _
    [event: event,
     Proc: Proc,
     eventData: eventData,
     needs: needs,
     needsContext: needsContext]];
  DoAddMouseAction: TreeAction =
    BEGIN
      sData.mouseActions _ CONS [me, sData.mouseActions]
    END;
  DoWithWriteRights[sc, DoAddMouseAction]
END;
QueuedClick: TYPE = REF QueuedClickRec;
QueuedClickRec: TYPE = RECORD
 [me: REF; -- MouseEvent or MenuEvent
 
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];
  sData: SceneData = NARROW[self.data];
  coords: TIPTables.TIPScreenCoords _
    NARROW[input.rest.first, TIPTables.TIPScreenCoords];
  clientContext: Gr.context _ UnS.ComputeClientContext[sc, self.context];
  xc, yc: REAL; -- mouse coordinates in client's coordinate system
  IF NOT sData.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 client coordinates and locate MouseActionEntry for this event
  -- since we have the viewer's lock for read, we know no one is
  --   changing the object tree of the scene.
  BEGIN
    maList: LIST OF REF MouseActionEntry _ sData.mouseActions;
    UNTIL maList = NIL OR maList.first.event = event DO
      maList _ maList.rest
     ENDLOOP;
    IF maList # NIL THEN
      me _ maList.first
    END;
    clientContext _ Grgr: 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];
    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
  --Called with read access to the viewer 
  sData: SceneData = NARROW [sc.data];
  me: REF MenuActionEntry _ NEW [MenuActionEntry _
    [name: name,
     Proc: Proc,
     menuData: menuData,
     needs: needs,
     needsContext: needsContext]];
  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;
  SHOULD ENQUEUE MENU ACTION
  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;
DoWithReadRights: PUBLIC PROC
  [Action: TreeAction, obj: Object] =
BEGIN
  sc: Scene _ NIL;
  myself: PROCESS = Process.GetCurrent[];
  GetReadRights: ENTRY PROC RETURNS [success: BOOL] =
BEGIN
  p: Object _ obj;
  WHILE p.parent IS Object DO p _ p.parent ENDLOOP;
  IF p.parent = NIL THEN RETURN[TRUE]
  ELSE IF p.parent IS Scene THEN
    BEGIN
      IF p.next NEQ NIL THEN ERROR InvalidTreeStructure
      sc _ NARROW [p.parent];
      IF p
      IF sc.writer = NIL OR sc.writer=myself THEN
        {-- wops! no writers; grab it!
         sc.readers _ sc.readers+1; RETURN [TRUE]}
      ELSE
        {-- sorry, scene is in use...
         sc _ NIL; RETURN [FALSE]}
    END
  ELSE ERROR InvalidTreeStructure
END;
  ReleaseReadRights: ENTRY PROC =
BEGIN
  sc.readers _ sc.readers - 1;
  IF sc.readers = 0 THEN BROADCAST TreesAvailable
END;
  WHILE NOT GetReadRights[] DO
    WAIT TreesAvailable
   ENDLOOP
  Action[sc, NIL];
  IF sc NEQ NIL THEN ReleaseReadRights[];
END;
      
DoWithWriteRights: PUBLIC PROC
  [Action: SceneAction, obj: Object, withContext: BOOL _ FALSE] =
BEGIN
  sc: Scene _ NIL;
  myself: PROCESS = Process.GetCurrent[];
  wasHoldingIt: BOOL _ FALSE -- TRUE if current process was already holding the scene to write.
  GetWriteRights: ENTRY PROC RETURNS [success: BOOL] =
BEGIN
  p: Object _ obj;
  WHILE p.parent IS Object DO p _ p.parent ENDLOOP;
  IF p.parent = NIL THEN RETURN[TRUE]
  ELSE IF p.parent IS Scene THEN
    BEGIN
      IF p.next NEQ NIL THEN ERROR InvalidTreeStructure
      sc _ NARROW [p.parent];
      IF (sc.writer = NIL OR (wasHolding _ sc.writer=myself))
        AND sc.readers=0 THEN
        {-- wops! no readers or writers; grab it!
         sc.writer _ myself; RETURN [TRUE]}
      ELSE
        {-- sorry, scene is in use...
         sc _ NIL; RETURN [FALSE]}
    END
  ELSE ERROR InvalidTreeStructure
END;
  ReleaseWriteRights: ENTRY PROC =
BEGIN
  sc.writer _ NIL;
  BROADCAST TreesAvailable
END;
  WHILE NOT GetWriteRights[] DO
    WAIT TreesAvailable
   ENDLOOP;
   
  Action[sc];
  IF sc NEQ NIL AND NOT wasHoldingIt THEN ReleaseWriteRights[];
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;
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;
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; 
PaintServer: PROC [sc: Scene] =
BEGIN
  Loops servicing the scene's paint requests until the scene is destroyed.
END;
ViewerPainter: PUBLIC PROC [sc: Scene] RETURNS [BOOL] =
{RETURN [sc.alive]};
 
  Initialize[]
END.


Š-- SceneImpl.mesa: Viewers for geometrical drawings
-- last modified by Stolfi - September 13, 1983 10:47 am
-- To do: declare all node parameters as Node (= Object or Scene OR NIL; for doc purposes only) . 
-- To do: worry about sc.data being NIL (means scene was killed). 
-- To do: clip contexts before passing them to painter procs and client modify procs?. 
-- To do: change root convention: root.next=root. 
-- To do: Add (not just MAXize) the object's lineWidth to the extra margins of Bounder-computed boxes. MAXize the two for group objects. 
-- To do: If $Border = TRUE or $Backgroung # NIL, and object's box changes, must repaint it even if the object itself has not changed. Descendants then need not be painted?.  Perhaps have an invisible flag to teel whether the object is just the superposition of its children, or is something more.
-- To do: Account for $Border property in bounding box computation. 
-- To do: use variant records to distinguish things and groups. 
-- To do: Every process that acquires an attached tree for write must acquire the viewer for write too, to prevent the mouse dispatcher from getting an out-of-date object tree bounding box (and thus computing the wrong scale conversion).   
-- SCENE VIEWER'S DATA RECORD - - - - - - - - - - - - - - - - - - - - - - - - -
-- Whenever a scene is created, a new server process is spawned, whose function is to periodically process the painting requests and mouse/menu actions put in the scene's queues by other processes.
-- Besides the client-visible attributes, a  Scene viewer has also the following ones:
-- a queue of pending painting requests, consisting of boxes whose interior has to be repainted by the server process. 
-- a queue of pending click actions to be performed by the server process as soon as the scene becomes available. 
-- DEBUGGING TOOLS - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- SCENE CREATION - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

-- OBJECT TREE MANIPULATION - - - - - - - - - - - - - - - - - - - - - - - -
-- Every process that modifies the trees must first acquire write access to them and to the scene's viewer (if the tree is attached), and must make sure that the fields above are consistent before releasing the locks. However, the line widths and bounding boxes of detached trees may be left inconsistent. 

-- Unsynchronized; requires write rights to the scene containing the object obj.
-- Unsynchronized; requires write rights to the scene of the newParent.
-- Synchronized
-- Synchronized
-- Synchronized
-- Unsynchronized. Requires write access to the scene sc.
-- Unsynchronized. Requires write access to the scene sc.
-- Unsynchronized. Requires write access to the object's scene.
-- Unsynchronized. Requires write access to the new parent's scene.
-- Unsynchronized. Requires write access to the object's scene.
-- Unsynchronized. Requires write access to the object's scene.
-- Unsynchronized. Requires write access to the object's scene.
-- Unsynchronized. Requires read access to the node's scene.
-- Unsynchronized. Requires write access to the node's scene.
-- Unsynchronized. Requires read access to the node's scene.
-- Unsynchronized. Requires write access to the object's scene.
-- Synchronized
-- Synchronized.
-- Modifies all things in the tree rooted at node, updates the bounding boxes, schedules repaint as needed. Node may be a scene.
-- Synchronized.
-- Enumerates all things in the tree rooted at node, applying the given Action to them.

-- MOUSE PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- This procedure is called with the viewer locked for read (I hope). Any process that modifies an attached  object tree must first lock its viewer for write, and must update its bounding boxes before releasing the lock. Therefore, inside this procedure the bounding box of the object tree and the viewer's context are stable. We can search the mouse action table and convert the mouse coordinates from the the viewer's to the client's coordinate system.
-- However, we cannot call the mouse action; to do so properly we should acquire access to it, and this may get us into a deadlock. All we can do is to enqueue the action and the transformed coordinates for the server process to call later on.  

-- MENU PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- PROCESS SYNCHRONIZATION - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Locates the scene sc to which the object belongs. If the scene is not being written, acquires read access to it, and returns success=TRUE. If the scene is in use, returns success=FALSE and sets sc to NIL.
If the object is in a detached tree, returns success=TRUE with sc = NIL. 
-- sc must be non-NIL
-- Locates the scene sc to which the object belongs. If the scene is not being read or written, acquires write access to it, and returns success=TRUE. If the scene is in use, returns success=FALSE and sets sc to NIL. 
-- If the object is in a detached tree, returns success=TRUE with sc = NIL. 
-- NOTE: deadlocks if a process with read access tries to get write access too. Could prevent the deadlock by attaching to the current process a stack of scenes to which it holds access.
-- sc must be non-NIL

-- "INTERNAL" PROCEDURES - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

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

-- PROPERTY LIST - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Similar to List.PutAssoc, but deletes the entry if val = NIL
Edited on August 11, 1983 11:35 pm, by Stolfi

changes to: SceneDataRec, ClickTableEntry, MenuActionEntry, CreateScene, KillScene, Alive, RepaintAll, ObjectRec, groupClass, BoundingBox, inf, emptyBox, infiniteBox, MakeObject, MakeGroup, RemoveAndRepaintObject, InsertAndRepaintObject, RemoveObject, DoRemoveObject, InsertObject, DoInsertObject, MoveObject, DoMoveObject, RemoveTree, SetTree, RemoveChild, InsertChild, RecomputeAncestorBoxes, RecomputeLineWidthsAndBoxes, RecomputeBox, GetLineWidth, RecomputeLineWidth, JoinBoxes, ScheduleRepaint, GetScene, ModifyObject, DoModifyThing, ModifyAllThings, DoModifyThing, EnumerateAllThings, DoEnumerateAllThing, AddMouseAction, QueuedClick, QueuedClickRec, MouseWatcher, AddMenuAction, MenuDispatcher, AddPropertyButton, DoWithReadRights, DoWithWriteRights, FindProcess, InsertProcess, DeleteProcess, GetReadRights, GetWriteRights, Release, DoErase, DoPaint, DoPaintAll, DrawDot, DrawSegment, SetCP, DrawTo, MoveTo, LineTo, ViewerPainter, MyPutAssoc, GetProp, PutProp, MakeBasicMenu, Initialize, PaintServer, ViewerPainter, ClickTableEntry, CreateScene, RepaintAll, emptyBox, infiniteBox, MakeThing, MakeGroup, RemoveAndRepaintObject, InsertAndRepaintObject, MoveObject, DoMoveObject, RemoveTree, SetTree, RemoveChild, InsertChild, RecomputeAncestorBoxes, RecomputeLineWidthsAndBoxes, RecomputeBox, GetLineWidth, RecomputeLineWidth, JoinBoxes, GetScene, ModifyAndRepaintObject, ModifyObject, DoModifyThing

Edited on September 13, 1983 10:47 am, by Stolfi
changes to: SceneImpl, SceneDataRec

�ʖ
"mesa" style˜IprocšÏcÏb	Ðbc�"™3š
�8™8KšœžœZ™bKšœžœ:™BKšœžœO™WKšœžœ*™2Kšœžœ�
™‰
Kšœžœ·
ž	œa™©Kšœžœ<™DKšœžœ8™@Kšœžœè
™ð
—Kš$Ïk	œ œ œ{ œ
 œ œ' œ œ| œ œ œ
 œ1 œ? œk œ œ œD œ2˜øKšž	œ œ
 œ œ# œW œ
 œ œ œ: œ
˜•K˜š
�O™OKšœ&žœ‘
™Å
šœ-žœ$™VKšœžœP™wKšœž
œO™r——Kš#žœ œ œ
 œ �7œî
 �œ�!œ œ
 œ
 œ œ�œb�.œ œ �3œ+�"œ˜¯Kšž	œ œ œ˜#Kšžœ œ œ
 œ�œ�œ# œ�%Ÿ�
œ œ�Ÿ�œ˜šK˜Kš
�R™RKšžœ œ	 œ œ
˜)K˜Kš
�Q™QšÏnœ œ
 œ! œ˜NKš œ œ½
 œ œ
˜ñ
—š¡	œ œ
 œ
˜#Kš
 œ œ œ�)œ œ
˜�
—š
¡œ œ
 œ
 œ œ˜/Kš œ œ œ œ
˜H—š¡
œ œ
 œ
˜$Kš œ( œ
˜1—K™š
�K™KKš
œ²™²—K™Kšœ œ˜Kšœ{ œ˜‚
Kšœ™
 œ˜Ÿ
K˜š
¡	œ œ
 œ œ œ˜PKš œ œ9 œ
˜P—š¡	œ œ
 œ
 œ˜/Kš œ œ" œ œ
˜@—š
¡œ œ
 œ œ
 œ˜]KšœLžœ
™PKš> œ œ œ
 œ œ�œ�œ œ œ
 œ& œ9 œ- œ+ œF œ œ œ�
 œ
 œ œ* œ œ
 œ] œ œ œ œ œ
 œ œ* œ
˜——š
¡œ œ
 œ œ œ˜[Kšœ=ž	œ
™GKšR œ œ œ
 œ œ
 œ œ4 œ
 œ
 œ œ�œ�œ œ
 œ
 œ œ	 œ5 œ œ
 œ( œ$ œ0 œ+ œ�
 œ œ œ* œ œ
 œ œ2 œ œR œ œ œ œ
 œ œ2 œ
˜¾—š
¡œ œ
 œ œ
 œ˜SKš
œ™š œ
˜Kšœ œ; œ
˜c—Kšœ+ œ
˜/—š
¡œ œ
 œ œ œ˜PKš
œ™š œ
˜Kšœ œ7 œ
˜_—Kšœ+ œ
˜/—š¡
œ œ
 œ œ œ œ˜yKš
œ™š œ
˜Kš	œ# œ�#œ<�œ6 œ
˜à
—Kšœ: œ
˜>—š¡
œ œ
 œ
 œ˜@Kšœ6žœ
™9Kš œ œ# œ œ
 œ
 œ œ> œ œ
 œ
˜Ó
—š¡œ œ
 œ ˜4Kšœ6žœ
™9Kš œ œ œ œ
 œ œ/ œ œ
 œ
 œ
 œ œP œ
˜Š—š¡œ œ
 œ œ'˜VKš
œ?™?Kš> œ œ" œ  œ œ
 œ
 œ
 œ œ œ
 œ
 œ1 œ œ
 œ œ œ œM œ œ œ œ�œ œ, œ œ, œ�œ œ
 œ
 œ
˜�—š¡œ œ
 œ4 œ˜RKš
œC™CKš` œ œ�%œ œ œ œ
 œ- œ
 œ œ œ œ
 œ œ œ œ
 œ œ
 œ œ0�Ÿ�Ÿ�
œ�Ÿ�œ œ œ
 œ œ œ œ	 œ5 œ	 œ œ
 œ
 œ œ œT œ œ œ œ œ| œ œ
 œ œ
˜¨—š¡œ œ
 œ˜2Kš
œ?™?Kš" œ œ œ œ
 œ& œ
 œ	 œ
 œ œ œ œ
 œ œ
 œ œ œ
˜Ð
—š
¡œ œ
 œ œ œ˜XKš
œ?™?Kš* œ� œ!�+œ œ œ œ œ œ œ	 œ
 œ	 œ: œ œ œ^ œ œ
 œ	 œ œ# œ
˜ƒ—š
¡œ œ
 œ œ œ˜AKš
œ?™?Kš@ œ�4œ œ œ œ œ œ, œ	 œ
 œ	 œ œ œ œ“
 œ œ
 œ	 œ œ œ œ, œ œ. œ  œ œ œ
 œ œ œ
 œ œ
˜Û—šÐbnœ œ
 œ œ œ	 œ˜=Kš
œ<™<Kš œ œ œ
 œ œ œ œ œ œ œ œ œ œ# œ
˜¯—š	¡	¢	œ œ
 œ œ˜-Kš
œ=™=Kš6 œ
 œ œ3 œ œ
 œ œ= œ œ
 œ œ
 œX œ œ
 œ œ œ œ œ[ œ œ
 œ œ œ œ œ œ
˜Ÿ—š¡	œ œ
 œ œ˜OKš œ œ œ2 œ2 œ2 œ1 œ" œ6 œ œ
˜ñ—š
¡œ œ
 œ œ œ˜8Kš
œ<™<Kš œ œ œ œA œ œ œ
 œ	 œ œ& œ
 œ
˜Ô
—š
¡œ œ
 œm œ œ˜Ÿ
Kš
œ?™?Kš œ5 œ�œ œ œ
 œ œM œ œ	 œ
 œ˜¶šœ¡œ œ œ œ œ˜RKš œ�œ+ œ	 œ œ
 œ œ)�œ? œ œ(�œ œ
 œ
˜É—šœ¡œ œ. œ œ œ˜jKšj œ�œ
ž	œ œ œ œ œ œ œ
 œ$�œ( œ œ œ
 œ œ$�&œ œ œ 
œ œ œ œ0 œ	 œ
 œ œe œ> œ œ œ
 œ œ œ œ œ œ œ œ
 œ œ œ	 œ œ,�œ1 œ	 œ œ
 œ, œ+�œ œ
 œ
˜Â	—šœ¡œ œ œ œ œ˜MKš8 œ œ3 œC œ œ 
œ	 œ
 œ œ
 œe œ& œ œ
 œ œ œj œ
 œ
 œ< œ œ œ
 œ œ,�{œ$�œ
�8œ
 œV˜±—KšœÑ
 œ œ œ
 œ œ œ" œ œ
˜Ð—š¡
œ œ
 œR œ œ œ œ˜‘
Kš
œ™š
 ˜Kšž¡œ œ¡œ_˜ 
K˜—Kšœ7 œ
˜;—š¡œ œ
 œ
 œ# œ œ˜[Kš
œ™Kšœ-žœO™€
š
 ˜Kš ž
œ œ9 œ�œ œ œ œ	 œ
 œ+ œ
 œ œ œ
 œ œ
 œ˜²šœ¡œ œ œ œ œ˜[KšIœ œ œ œ
 œ œF œ	 œ œ
 œ œ3�œB œ œ/�œ œ	 œ  œ  œ œ1 œ	 œ œ œe œ/ œ œ
 œ œ œ œ œ
 œ< œ œ œ' œ
˜Û—Kšœ< œ œ œ
 œ œ œ" œ œ
˜»
—Kšœ: œ
˜>—š¡œ œ
 œ
 œ$ œ œ˜_Kš
œ™Kš
œW™Wš
 ˜Kšœ$ œ� œ œ œ œ	 œ
 œ+ œ
 œ œ œ
 œ œ
 œ
˜ü
šœ¡œ œ˜5Kš%œ œ œ œ
 œ œ+ œ  œ1 œ	 œ œ œ^ œ œ
 œ œ
 œ œ	 œ
˜¨—Kšœ% œ
˜)—Kšœ< œ
˜@—K™Kš
�Q™Qš¡œ œ
 œA œ œ œ œ˜“
Kš œ œ œ œ¯
 œ œ œ, œ
˜ò—Kšžœ œ œ˜'Kš
žœ œ œ œ�œ
˜Ešžœ˜(Kš
 ˜š�xœ
�/Ÿ�Š
œ œ	 œ
 œ œ
 œ
 œ
˜éKš
œÆ™ÆKš
ϛ
™õ
Kšm œ œ œ* œ œ$ œ7 œƒ
 œ�3œ œ
 œ
 œ
 œ œ
 œµ œ œ œ	 œ
 œ œ œ œ	 œ
 œ œ œ�Mœ�?œ�,œ œ
 œ
 œ
 œ, œ
 œ
 œ œ! œ œ
 œ
 œ œ œ œ œÖ
 œ�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š
�P™Pš¢œ œ
 œ&˜Cš œ œ œ¡
œ œ
 œ
 œ œ˜xKš
œÏ
™Ï
Kš
œI™IKšL œ œ
 œ œ œ œ œ
 œ
 œ
 œ œ
 œ
 œ œ œ œ œ
 œ
 œ
 œ! œ œ	 œ
 œ
 œ œ
�œ$ œ œ	 œ
�œ œ œ œ œ œ
 œ œ
˜�—šœ¡œ œ
 œ˜!Kš
œ™Kš
 œ" œ œ
 	œ œ
˜[—Kšœ œ
 œ œ œ œ œ œ œ
 œ
 œ œ˜Š
—š
¢œ œ
 œ3 œ œ˜`š œ œ œ) œ œ
�Cœ¡œ œ
 œ
 œ œ˜Ù
Kš
œÙ
™Ù
Kš
œL™LKš
ϼ
™º
KšL œ œ
 œ œ œ œ œ
 œ
 œ
 œ œ
 œ
 œ œ œ œ œ
 œ
 œ
 œ! œ œ œ
 œ* œ œ
�)œ œ œ	 œ
�œ œ œ œ œ œ
 œ œ
˜°—šœ¡œ œ
 œ˜"Kš
œ™Kš œ œ 	œ œ
˜8—Kšœ œ
 œ œ œ œ œ œ
 œ
 œ
 œ œ œ˜¡
—Kšžœ œ
 œ œ œ"�˜[Kšž
œ œ0˜@Kšžœ œ�2˜]š
¡œ œ
 œ œ œ œ ˜lKš œ
 œ
� œ œ œ œ
 œ œ œ
 œ
 œ
˜¢
—š
¡
œ œ
 œ œ œ œ ˜jKš œ
 œ
�œ; œ œ œ
 œ œ
 œ
˜º
—š	¡
œ œ
 œ œ ˜SKš œ
 œ œ$ œ
˜M—š	¢
œ œ
 œ œ ˜FKš3 œ œ œ¡¢
œ œ
 œ œ œ
 œ œ
 œ œ- œ œ
 œ�œ œ œ œ
 œ
 œ œ/ œ œ œ
˜á—š	¢œ œ
 œ œ ˜GKšC œ œ œ¡¢œ œ
 œ œ œ
 œ œ
 œ œ- œ œ
�œ	 œ œ
 œ
 œQ œ
 œ œ
 œ œ
�œ	 œ œ
 œ
 œA œ œ œ œ
˜­—š¡œ œ
 œ˜/Kš( œ¡	œ œ
 œ œ
 œ œ
 œ�Ÿ�
œ œ œ œ œ$ 	œ œ œ œ œ œ
˜Ë—K™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š
�f™fš¡
œ œ œ
 œ œ
 œ œ˜WKš
�?™?Kš: œ
 œ œ œ œ
 œ œ œ œ œ
 œ œ œ
 œ( œ3 œ& œ( œ�œ œ œ
 œ œ œ œ
 œ œ  œ	 œ
˜“—š¡œ œ
 œ œ œ	 œ˜DKš œ œV œ) œ
˜«
—š
¡œ œ
 œ œ	 œ˜;Kš œ œd œ) œ
˜¹
—š¡
œ œ
 œ ˜5Kš œ¡
œ œ œ œ] œ œ œA�œˆ
 œ˜®—š¡
œ œ ˜Kš> œ
�œ¡œ œ œ
 œÑ
 œF�.œ"�œ œ�,œ�8œ œ�œ
 œ�œ
 œ�œ œ�,œ œ�-œ�œ œ	�œ�!œ�2œ!�+œ·
 œ œ œ˜——š¡œ œ˜Kš œL œ
˜U—š
¡
œ œ
 œ
 œ œ˜7Kšœ
 œ
˜—Kšœ œ˜™-J™JšœÏrñ
™ý
—J™™0Jšœ£™#—J™—…—–Р