-- WhiteboardImpl.mesa
-- last edited by:
-- John Maxwell on: September 22, 1982 12:19 pm
-- Willie-Sue on: February 22, 1983 4:19 pm
-- Cattell on: April 21, 1983 4:02 pm
-- Donahue, June 1, 1983 4:26 pm

DIRECTORY
  DB,
  DBNames,
  Graphics USING [
    black, Box, Color, Context, DrawBox, DrawRope, DrawStroke, DrawTo, 
    FontRef, GetBounds, NewPath, Path, SetCP, Rectangle, RopeBox, Scale, SetColor, SetStipple,
    Translate, white],
  IconManager USING [selectedIcon],
  Icons USING [DrawIcon, IconFlavor],
  InputFocus USING [CaptureButtons],
  Interminal USING [ButtonValue, KeyFields, MousePosition],
  Nut USING [ Display, UpdateProc],
  NutOps USING[ EntityValued, GetRelation ],
  NutViewer USING[GetIcon, ConvertViewerToEntity, FindViewerForEntity],
  Rope USING [Equal, Flatten, Find, Substr, Length, ROPE],
  AMTypes USING [TV],
  SafeStorage USING [NarrowRefFault],
  UserTerminal USING [keyboard, mouse],
  VFonts USING [EstablishFont, GraphicsFont],
  ViewerClasses USING [
     PaintProc, Viewer, ViewerClass, ViewerRec, ViewerFlavor],
  ViewerLocks USING [CallUnderWriteLock],
  ViewerOps USING [
     AddProp, AcquireContext, CreateViewer, DestroyViewer,
     EnumerateChildren, EnumProc, FetchProp, MoveViewer, 
     OpenIcon, PaintViewer, ReleaseContext],
  ViewerTools USING [MakeNewTextViewer],
  VirtualDesktops USING[ EnumerateViewers ],
  Whiteboard; 

WhiteboardImpl: CEDAR PROGRAM 
  IMPORTS 
    DB, DBNames, Graphics, IconManager, Icons, InputFocus, Nut, NutOps, NutViewer, Rope,
    SafeStorage, UserTerminal, VFonts, ViewerOps, ViewerTools, VirtualDesktops, Whiteboard,
    ViewerLocks
  EXPORTS Whiteboard
  SHARES ViewerOps =
  BEGIN
  OPEN DB, ViewerClasses, Whiteboard;

  ROPE: TYPE = Rope.ROPE;
  TV: TYPE = AMTypes.TV;
  WBError: SIGNAL = CODE;

  --************************************************
  -- painting procedures 
  --************************************************

  h: INTEGER _ 620;
  w: INTEGER _ 30;

Line: TYPE = RECORD[of, is: Viewer, name: ROPE];
GetLines: PROC[v: Viewer] RETURNS[LIST OF Line] = INLINE {
     RETURN[NARROW[ViewerOps.FetchProp[v, $LineList]]]};
SetLines: PROC[v: Viewer, lines: LIST OF Line] = INLINE {
     ViewerOps.AddProp[v, $LineList, lines]};

PaintRelships: PUBLIC ViewerClasses.PaintProc =
    BEGIN
    lines: LIST OF Line _ GetLines[self];
    FOR lines _ lines, lines.rest WHILE lines # NIL DO
       IF lines.first.is = NIL OR lines.first.is.destroyed THEN LOOP;
       IF lines.first.of = NIL OR lines.first.of.destroyed THEN LOOP;
       IF lines.first.of = lines.first.is THEN LOOP;
       DrawLine[context, lines.first.of, lines.first.is, lines.first.name];
       ENDLOOP;
    END;

  a: INTEGER _ 8;

DrawLine: PROCEDURE[context: Graphics.Context, from, to: Viewer, name: ROPE] =
    BEGIN
    x1, x2, y1, y2: INTEGER;
    [x1, y1] _ Clip[from.wx+32, from.wy+32, to.wx+32, to.wy+32, 32];
    [x2, y2] _ Clip[to.wx+32, to.wy+32, from.wx+32, from.wy+32, 32]; 
    -- draw line
    Graphics.SetCP[context, x1, y1];
    Graphics.DrawTo[context, x2, y2];
    -- draw arrow
    Graphics.SetCP[context, x2-3, y2-3];
    Graphics.DrawRope[context, "o"]; 
    -- draw label
    Graphics.SetCP[context, (x1 + x2 - 20)/2, (y1 + y2)/2];
    Graphics.Scale[context, 1, -1];
    Graphics.DrawRope[context, name];
    Graphics.Scale[context, 1, -1];
    END;

Clip: PROCEDURE[x1, y1, x2, y2, w: INTEGER] RETURNS[newX, newY: INTEGER] =
    BEGIN
    left: BOOLEAN; -- is (x2, y2) above the left diagonal? (\)
    right: BOOLEAN; -- is (x2, y2) above the right diagonal? (/)
    -- figure out which edge it intersects
    left _ (x2-x1) > -(y2-y1);
    right _ (x2-x1) < (y2-y1);
    IF left = right
       THEN { -- top or bottom edge
          newY _ y1 + (IF left THEN w ELSE -w);
          newX _ x1 + ((x2-x1)*(newY-y1))/(y2-y1)} -- think of it as: x1 + (dx times y%)
       ELSE { -- left or right edge
          newX _ x1 + (IF left THEN w ELSE -w);
          newY _ y1 + ((y2-y1)*(newX-x1))/(x2-x1)};
    END;

PaintIconic: PUBLIC ViewerClasses.PaintProc =
    BEGIN
    name: ROPE;
    box: Graphics.Box;
    selected: BOOLEAN;
    color, background: Graphics.Color;
    IF ~self.newVersion THEN
       FOR child: Viewer _ self.child, child.sibling WHILE child # NIL DO
          IF child.newVersion THEN {self.newVersion _ TRUE; EXIT};
          ENDLOOP;
    IF ~self.iconic THEN SIGNAL WBError;
    selected _ IconManager.selectedIcon = self;
    color _ (IF selected THEN Graphics.white ELSE Graphics.black);
    background _ (IF selected THEN Graphics.black ELSE Graphics.white);
    -- draw box
    box _ Graphics.GetBounds[context];
    IF self.newVersion 
       THEN Graphics.SetStipple[context, 122645B]
       ELSE Graphics.SetColor[context, background];
    Graphics.DrawBox[context, box];
    Graphics.SetColor[context, color];
    DrawRectangle[context, box.xmin, box.ymin + 1, box.xmax - 1, box.ymax];
    -- draw outlines of inner boxes
    Graphics.Scale[context, .1, .1];
    box _ Graphics.GetBounds[context];
    FOR child: Viewer _ self.child, child.sibling WHILE child # NIL DO
       IF child.wx > box.xmax AND child.wy > box.ymax THEN LOOP;
       DrawRectangle[context, w + child.wx, h - child.wy, 
          w + child.wx + child.ww, h - (child.wy + child.wh)];
       -- Graphics.SetCP[context, w + child.wx, h - child.wy];
       -- Graphics.DrawTo[context, w + child.wx + child.ww, h - child.wy];
       -- Graphics.DrawTo[context, w + child.wx + child.ww, h - (child.wy + child.wh)];
       -- Graphics.DrawTo[context, w + child.wx, h - (child.wy + child.wh)];
       -- Graphics.DrawTo[context, w + child.wx, h - child.wy];
       ENDLOOP;
    -- print name
    name _ Strip[self.name];
    [box.xmin, box.ymin, box.xmax, box.ymax] _ Graphics.RopeBox[iconFont, name];
    Graphics.Scale[context, 10, 10];
    Graphics.Translate[context, 2, 40];
    Graphics.SetCP[context, 0, 0];
    Graphics.SetColor[context, background];
    Graphics.DrawBox[context, box];
    Graphics.SetColor[context, color];
    Graphics.DrawRope[self: context, rope: Strip[self.name], font: iconFont];
   END;

DrawRectangle: PROCEDURE[context: Graphics.Context, x1, y1, x2, y2: REAL] =
    BEGIN
    path: Graphics.Path;
    path _ Graphics.NewPath[4];
    Graphics.Rectangle[path, x1, y1, x2, y2];
    Graphics.DrawStroke[self: context, path: path, closed: TRUE];
    END;

Strip: PROCEDURE[name: ROPE] RETURNS[ROPE] = 
    INLINE BEGIN
    pos: INT;
    IF name = NIL THEN RETURN[NIL];
    IF (pos _ name.Find[":"]) > 0 
       THEN RETURN[name.Flatten[pos+2, name.Length[]]] 
       ELSE RETURN[name];
    END;
    
ShortName: PROC[ name: ROPE ] RETURNS[ suffix: ROPE ] = {
-- strip off leading server/directory information
i, j: INT;
IF (i _ Rope.Find[name, "/"]) # -1 THEN 
  { UNTIL (j _ Rope.Find[s1: name, s2: "/", pos1: i + 1]) = -1 DO i _ j ENDLOOP;
    suffix _ Rope.Substr[base: name, start: i + 1] }
ELSE suffix _ name };

PaintIcon: PUBLIC ViewerClasses.PaintProc =
    BEGIN
    name: ROPE;
    viewer: Viewer;
    entity: Entity;
    iconRef: REF Icons.IconFlavor;
    icon: Icons.IconFlavor _ unInit;
    screenGrey: CARDINAL = 104042B;
	viewer _ NARROW[self.data, Viewer];
    IF viewer # NIL AND viewer.destroyed THEN {self.data _ viewer _ NIL};
    entity _ FetchEntity[self];
    IF viewer = NIL AND entity = NIL THEN {
       Graphics.SetStipple[context, screenGrey];
       Graphics.DrawBox[context, [0, 0, 64, 64]];
       RETURN};
    -- determine the name
    IF entity # NIL THEN
    { domain: DB.Domain = DomainOf[entity];
      IF DB.Eq[domain, Whiteboard.TextViewer] THEN
      name _ ShortName[DB.NameOf[entity]]
      ELSE name _ DB.NameOf[entity] };
    IF name = NIL AND viewer # NIL THEN name _ viewer.name;
    self.name _ name; 
    -- determine the icon
    iconRef _ NARROW[ViewerOps.FetchProp[self, $IconFlavor]];
    IF icon = unInit AND iconRef # NIL THEN icon _ iconRef^;
    IF viewer # NIL AND viewer.icon = private THEN icon _ viewer.icon;
    IF icon = unInit THEN icon _ NutViewer.GetIcon[entity];
    IF iconRef = NIL THEN iconRef _ NEW[Icons.IconFlavor _ icon];
    ViewerOps.AddProp[self, $IconFlavor, iconRef];
    -- paint the icon
    SELECT TRUE FROM
       icon = private AND viewer # NIL => { -- private icon
          oldClass: ViewerClasses.ViewerClass = self.class;
          oldIcon: Icons.IconFlavor = self.icon;
          oldIconic: BOOLEAN = self.iconic;
          self.class _ viewer.class;
          self.icon _ viewer.icon;
          self.iconic _ TRUE; -- convince it that it's an icon
          self.class.paint[self, context, NIL, TRUE];
          self.class _ oldClass;
          self.icon _ oldIcon;
          self.iconic _ oldIconic}; -- paint it
       icon = private => {  
		  -- Graphics.Rectangle[context, 1, 1, 63, 63];
		  -- Graphics.DrawPath[context, .1];
		  DrawRectangle[context, 0, 1, 62, 61];
		  Graphics.SetCP[context, 4, 40];
		  IF name # NIL THEN Graphics.DrawRope[self: context, rope: name, font: iconFont]};
	   ENDCASE => Icons.DrawIcon[icon, context, 0, 0, name];
    END;

    --************************************************
    -- child addition/deletion procedures --
    --************************************************

AddTextBox: PUBLIC PROC[wb: Viewer, e: Entity, x, y, w, h: INTEGER] 
        RETURNS[child: Viewer] =
      BEGIN
        MakeChild: PROC[] = {
          child _ ViewerTools.MakeNewTextViewer[paint: FALSE,
         info: [parent: wb, wx: 0, wy: 0, ww: 800, wh: 800]];
        ViewerOps.MoveViewer[child, x, y, w, h, FALSE] };
      child _ FindEntity[wb, e];
      IF child # NIL THEN RETURN; -- already on the whiteboard
      ViewerLocks.CallUnderWriteLock[MakeChild, wb];
      wb.newVersion _ TRUE;
      StoreEntity[child, e];
      AddAllLines[wb, child];
      ViewerOps.PaintViewer[child, caption];
      ViewerOps.PaintViewer[wb, caption];
      END;
          
    AddIcon: PUBLIC PROC[wb, viewer: Viewer, e: Entity, x, y: INTEGER] 
        RETURNS[child: Viewer] =
      BEGIN
      OPEN ViewerOps;
      IF e # NIL THEN child _ FindEntity[wb, e];
      IF child # NIL THEN RETURN; -- already on the whiteboard
      IF viewer = NIL AND e = NIL THEN RETURN[NIL];
      IF viewer # NIL THEN
      		WHILE viewer.parent # NIL DO viewer _ viewer.parent; ENDLOOP;
      IF viewer = NIL THEN viewer _ NutViewer.FindViewerForEntity[e];
      IF e = NIL THEN e _ NutViewer.ConvertViewerToEntity[viewer];
      -- add the icon
      child _ CreateViewer[flavor: $WhiteboardIcon, paint: FALSE, 
         info: [
            parent: wb,
            wx: x, wy: y, 
            wh: 64, ww: 64,
            border: FALSE,
            scrollable: FALSE]];
      child.data _ viewer;
      StoreEntity[child, e];
      wb.newVersion _ TRUE;
      AddAllLines[wb, child];
      -- IF viewer = NIL THEN RETURN;
      ViewerOps.PaintViewer[child, all];
      ViewerOps.PaintViewer[wb, caption];
      END;

FindEntity: PROCEDURE[wb: Viewer, e: Entity] RETURNS[child: Viewer] =
      BEGIN
      Find: ViewerOps.EnumProc = {
        new: Entity;
        new _ FetchEntity[v];
        IF ~Eq[e, new] THEN RETURN[TRUE];
        child _ v; RETURN[FALSE]};
      ViewerOps.EnumerateChildren[wb, Find];
      END;

OpenIcon: PUBLIC PROCEDURE[icon: Viewer] =
      BEGIN
      viewer: Viewer;
      e: Entity;
      IF icon = NIL THEN RETURN;
      viewer _ NARROW[icon.data, Viewer];
      IF viewer # NIL AND viewer.destroyed THEN {icon.data _ viewer _ NIL};
      IF viewer = NIL THEN e _ FetchEntity[icon];
      --! IF e # NIL THEN icon.data _ viewer _ Whiteboard.FindViewer[e];
      SELECT TRUE FROM
         viewer = NIL => { 
            IF e # NIL THEN { icon.data _ Nut.Display[e: e, parent: icon.parent] };
            ViewerOps.PaintViewer[icon, all] };
         viewer.iconic => ViewerOps.OpenIcon[viewer];
         ENDCASE => ViewerOps.PaintViewer[viewer, all];
      END; 

    RemoveChild: PUBLIC PROC[wb, child: Viewer] =
      BEGIN
      relships, last: LIST OF Line;
      relships _ GetLines[wb];
      FOR lines: LIST OF Line _ relships, lines.rest WHILE lines # NIL DO
         IF lines.first.of # child AND lines.first.is # child THEN {last _ lines; LOOP};
         IF last = NIL THEN relships _ relships.rest ELSE last.rest _ lines.rest;
         IF lines.first.of.class.flavor # $Text THEN lines.first.of.border _ FALSE;
         IF lines.first.is.class.flavor # $Text THEN lines.first.is.border _ FALSE;
         ENDLOOP;
      SetLines[wb, relships];
      ViewerOps.DestroyViewer[child];
      END;

   --************************************************
    -- relship addition/deletion 
    --************************************************

Pair: TYPE = RECORD[e: Entity, v: Viewer];

ShowLines: PUBLIC PROCEDURE[wb: Viewer, show: BOOLEAN] =
      BEGIN
      entities: LIST OF Pair;
      entities _ GetEntities[wb];
      -- reset the world
      SetLines[wb, NIL];
      FOR list: LIST OF Pair _ entities, list.rest WHILE list # NIL DO
         IF list.first.v.class.flavor # $Text THEN list.first.v.border _ FALSE;
         ENDLOOP;
      ViewerOps.AddProp[wb, $ShowLines, IF show THEN $Yes ELSE NIL];
      -- reconstruct the lines
      IF show THEN 
         FOR entities _ entities, entities.rest WHILE entities # NIL DO
            AddAllLines[wb, entities.first.v];
            ENDLOOP;
      ViewerOps.PaintViewer[wb, client];
      END;

AddAllLines: PROCEDURE[wb, child: Viewer] =
      BEGIN
      entity: Entity;
      lines: LIST OF Line;
      entities: LIST OF Pair;
      props: LIST OF Whiteboard.BinaryProperty;
      IF ViewerOps.FetchProp[wb, $ShowLines] = NIL THEN RETURN;
      lines _ GetLines[wb];
      entities _ GetEntities[wb];
      entity _ FetchEntity[child];
      props _ GetBinaryProperties[entity];
      child.border _ TRUE;
      FOR props _ props, props.rest WHILE props # NIL DO
         [lines, ] _ AddLine[lines, entities, props.first];
         ENDLOOP;
      SetLines[wb, lines];
      END;

AddLine: PROCEDURE[lines: LIST OF Line, entities: LIST OF Pair, prop: BinaryProperty] 
        RETURNS[LIST OF Line, BOOLEAN]=
      BEGIN
      -- convert property to line
      line: Line _ ConvertProperty[lines, entities, prop];
      IF line.is = NIL OR line.of = NIL THEN {
         IF line.is # NIL THEN line.is.border _ FALSE;
         IF line.of # NIL THEN line.of.border _ FALSE;
         RETURN[lines, FALSE]};
      -- add new line to list
      FOR list: LIST OF Line _ lines, list.rest WHILE list # NIL DO
         IF list.first.of # line.of OR list.first.is # line.is THEN LOOP;
         IF Rope.Equal[list.first.name, line.name] THEN RETURN[lines, TRUE];
         ENDLOOP;
      lines _ CONS[line, lines];
      RETURN[lines, TRUE];
      END;

ConvertProperty: PROC[lines: LIST OF Line, entities: LIST OF Pair, prop: BinaryProperty] 
       RETURNS[line: Line] =
      BEGIN
      line _ [NIL, NIL, prop.name];
      FOR pairs: LIST OF Pair _ entities, pairs.rest WHILE pairs # NIL DO
         IF line.is # NIL AND line.of # NIL THEN EXIT;
         IF Eq[prop.is, pairs.first.e] THEN line.is _ pairs.first.v;
         IF Eq[prop.of, pairs.first.e] THEN line.of _ pairs.first.v;
         ENDLOOP;
      END;

-- relship changes in data base --

UpdateRelships: PUBLIC Nut.UpdateProc = 
      BEGIN
      prop: BinaryProperty;
      UpdateWhiteboard: ViewerOps.EnumProc =
         BEGIN
         found: BOOLEAN;
         lines: LIST OF Line;
         entities: LIST OF Pair;
         IF v = NIL OR v.destroyed THEN RETURN[TRUE];
         IF v.class.flavor # $Whiteboard THEN RETURN[TRUE];
         lines _ GetLines[v];
         entities _ GetEntities[v];
         SELECT updateType FROM
            create => {
               [lines, found] _ AddLine[lines, entities, prop];
               IF ~found THEN RETURN[TRUE]};
            destroy => {
               last: LIST OF Line;
               line: Line _ ConvertProperty[lines, entities, prop];
               IF line.is = NIL OR line.of = NIL THEN RETURN[TRUE];
               -- remove line from list
               FOR list: LIST OF Line _ lines, list.rest WHILE list # NIL DO
                  IF list.first.is # line.is THEN {last _ list; LOOP};
                  IF list.first.of # line.of THEN {last _ list; LOOP};
                  IF ~Rope.Equal[list.first.name, line.name] THEN {last _ list; LOOP};
                  IF last = NIL THEN lines _ lines.rest ELSE last.rest _ list.rest;
                  ENDLOOP};
            ENDCASE => ERROR;
         -- show the change
         SetLines[v, lines];
         ViewerOps.PaintViewer[v, all];
         RETURN[TRUE];
         END;
      prop _ ConvertRelship[tuple];
      IF prop.name = NIL THEN RETURN;
      VirtualDesktops.EnumerateViewers[UpdateWhiteboard];
      END;

ConvertRelship: PROCEDURE[relship: Relship] RETURNS[prop: BinaryProperty] =
      BEGIN
      ENABLE DB.Error, SafeStorage.NarrowRefFault => CHECKED{ CONTINUE };
      of, is: Attribute;
      relation: Relation;
      prop _ [NIL, NIL, NIL];
      relation _ RelationOf[relship];
      of _ DeclareAttribute[r: relation, name: "of", version: OldOnly];
      is _ DeclareAttribute[r: relation, name: "is", version: OldOnly];
      prop.of _ V2E[GetF[relship, of]];
      prop.is _ V2E[GetF[relship, is]];
      prop.name _ GetName[relation];
      END;

-- utility routines --

GetEntities: PROCEDURE[wb: Viewer] RETURNS[entities: LIST OF Pair] =
      BEGIN
      -- make up a list of entities on the whiteboard
      GetEntity2: ViewerOps.EnumProc = {
         entities _ CONS[ [Whiteboard.FetchEntity[v], v], entities ];
         RETURN[TRUE]};
      ViewerOps.EnumerateChildren[wb, GetEntity2];
      END;

GetBinaryProperties: PUBLIC PROC[e: Entity] 
        RETURNS[list: LIST OF Whiteboard.BinaryProperty] =
      BEGIN
      rs: RelshipSet;
      relship: Relship;
      is, of: Attribute;
      flag: BOOLEAN;
      relation: Relation;
      name, relationName: ROPE;
      attributes: LIST OF Attribute;
      -- enumerate all of the neighbors of the child's entity
      attributes _ GetAllRefAttributes[e];
      FOR attributes _ attributes, attributes.rest WHILE attributes # NIL DO
         IF attributes.first = NIL THEN LOOP;
         name _ GetName[attributes.first];
         relation _ NutOps.GetRelation[attributes.first];
         relationName _ GetName[relation];
         IF Rope.Equal[relationName, "container"] THEN LOOP;
         -- find all of the "of-is" relships
         rs _ RelationSubset[relation, LIST[[attributes.first, e]]];
         flag _ FALSE;
         WHILE ~Null[relship _ NextRelship[rs]] DO
            ENABLE SafeStorage.NarrowRefFault => LOOP;
            prop: Whiteboard.BinaryProperty;
            IF NOT flag THEN { 
               flag _ TRUE; 
               [of, is] _ GetOfIsAttributes[relation, attributes.first];
               IF of = NIL OR is = NIL THEN EXIT};
            prop.of _ V2E[GetF[relship, of]];
            prop.is _ V2E[GetF[relship, is]];
            IF prop.of = NIL OR prop.is = NIL THEN LOOP;
            prop.name _ relationName;
            list _ CONS[prop, list];
            ENDLOOP;
         ReleaseRelshipSet[rs];
         ENDLOOP;  
      END;
 
GetOfIsAttributes: PROC[r: Relation, a: Attribute] RETURNS [of, is: Attribute] =
    -- Returns the first entity-valued attribute of r other than a; returns NIL if
    -- there is no other.
    BEGIN 
    other: Attribute;
    AIsFirst, entityValued: BOOLEAN _ FALSE;
    aL: LIST OF Attribute_ VL2EL[GetPList[r, aRelationOf, aRelationIs]];
	 FOR al1: LIST OF Attribute_ aL, al1.rest UNTIL al1=NIL DO
       -- skip non-entityValued attributes
       entityValued _ FALSE;
       entityValued _
       	NutOps.EntityValued[other_ al1.first !
       						 Error => CHECKED{ IF code=IllegalEntity THEN CONTINUE } ];
       IF ~entityValued THEN LOOP;
       IF ~Eq[other, a] THEN EXIT ELSE AIsFirst _ TRUE;
       ENDLOOP;
    IF a = NIL OR other = NIL THEN RETURN[NIL, NIL];
    SELECT TRUE FROM 
       Rope.Equal[GetName[a], "of"] => RETURN[a, other];
       Rope.Equal[GetName[other], "of"] => RETURN[other, a];
       Rope.Equal[GetName[a], "is"] => RETURN[other, a];
       Rope.Equal[GetName[other], "is"] => RETURN[a, other];
       ENDCASE => IF AIsFirst THEN RETURN[a, other] ELSE RETURN[other, a];
    END;

--************************************************
-- child manipulation procedures
--************************************************

keys: LONG POINTER TO Interminal.KeyFields = LOOPHOLE[UserTerminal.keyboard];
mouse: LONG POINTER TO Interminal.MousePosition = LOOPHOLE[UserTerminal.mouse];

MoveChild: PUBLIC PROCEDURE[child: Viewer] =
      BEGIN
      parent: Viewer;
      dx, dy: INTEGER;
      old, new: Interminal.MousePosition;
      IF child # NIL THEN parent _ child.parent ELSE RETURN;
      InputFocus.CaptureButtons[parent.class.notify, parent.tipTable, parent];
      TRUSTED
      {old _ mouse^;
        WHILE LOOPHOLE[keys.buttons, Interminal.ButtonValue] # None DO
         IF mouse^ # old THEN new _ mouse^ ELSE LOOP;
         dx _ new.mouseX - old.mouseX;
         dy _ new.mouseY - old.mouseY;
         IF child.wx + dx < 0 THEN dx _ -child.wx;
         IF child.wy + dy < 0 THEN dy _ -child.wy;
         IF child.wx + child.ww + dx > parent.ww 
            THEN dx _ parent.ww - child.wx - child.ww;
         IF child.wy + child.wh + dy > parent.wh
            THEN dy _ parent.wh - child.wy - child.wh;
         IF dx = 0 AND dy = 0 THEN LOOP;
	     MoveViewer[child, child.wx + dx, child.wy + dy, child.ww, child.wh];
         old _ new;
         ENDLOOP;
        };		-- end TRUSTED
       child.parent.newVersion _ TRUE;
       ViewerOps.PaintViewer[parent, all]; -- repaint everything
       END;

boxW: INTEGER = 128;
boxH: INTEGER = 32;

GrowBox: PUBLIC PROCEDURE[wb: Viewer, box: Viewer, x, y: INTEGER] = TRUSTED
      BEGIN
      dx, dy: INTEGER;
      min, delta: INTEGER;
      corner: {ll, lr, ul, ur} _ ll;
      old, new: Interminal.MousePosition;
      IF box = NIL THEN RETURN;
      InputFocus.CaptureButtons[wb.class.notify, wb.tipTable, wb];
      old _ mouse^;
      -- choose the nearest corner
      min _ delta _ LAST[INTEGER];
      delta _ ABS[x - box.wx] + ABS[y - box.wy];
      IF delta < min THEN {min _ delta; corner _ ul};
      delta _ ABS[x - (box.wx + box.ww)] + ABS[y - box.wy];
      IF delta < min THEN {min _ delta; corner _ ur};
      delta _ ABS[x - box.wx] + ABS[y - (box.wy + box.wh)];
      IF delta < min THEN {min _ delta; corner _ ll};
      delta _ ABS[x - (box.wx + box.ww)] + ABS[y - (box.wy + box.wh)];
      IF delta < min THEN {min _ delta; corner _ lr};
      WHILE LOOPHOLE[keys.buttons, Interminal.ButtonValue] # None DO
         IF mouse^ # old THEN new _ mouse^ ELSE LOOP;
         dx _ new.mouseX - old.mouseX;
         dy _ new.mouseY - old.mouseY;
         -- set limits on where it can end up
         IF (corner = ll OR corner = ul) AND box.wx + dx < 0 THEN dx _ -box.wx;
         IF (corner = ul OR corner = ur) AND box.wy + dy < 0 THEN dy _ -box.wy;
         IF (corner = ur OR corner = lr) AND box.wx + box.ww + dx > wb.ww 
            THEN dx _ wb.ww - box.wx - box.ww;
         IF (corner = ll OR corner = lr) AND box.wy + box.wh + dy > wb.wh 
            THEN dy _ wb.wh - box.wy - box.wh;
         -- set limits on the minimum size
         IF (corner = lr OR corner = ur) AND box.ww + dx < boxW THEN dx _ boxW - box.ww;
         IF (corner = ll OR corner = lr) AND box.wh + dy < boxH THEN dy _ boxH - box.wh;
         IF (corner = ll OR corner = ul) AND box.ww - dx < boxW THEN dx _ box.ww - boxW;
         IF (corner = ul OR corner = ur) AND box.wh - dy < boxH THEN dy _ box.wh - boxH;
         -- move the corner
         IF dx = 0 AND dy = 0 THEN LOOP;
         SELECT corner FROM
            ul => MoveViewer[box, box.wx + dx, box.wy + dy, box.ww - dx, box.wh - dy];
            ur => MoveViewer[box, box.wx, box.wy + dy, box.ww + dx, box.wh - dy];
            ll => MoveViewer[box, box.wx + dx, box.wy, box.ww - dx, box.wh + dy];
            lr => MoveViewer[box, box.wx, box.wy, box.ww + dx, box.wh + dy];
            ENDCASE;
         old _ new;
         ENDLOOP;
      wb.newVersion _ TRUE;
      ViewerOps.PaintViewer[wb, all];
      END;

MoveViewer: PROCEDURE[self: Viewer, x, y, w, h: INTEGER] =
      BEGIN
      EraseViewer[self];
      ViewerOps.MoveViewer[self, x, y, w, h, FALSE]; -- don't repaint
      ViewerOps.PaintViewer[self, all]; -- avoids repainting parent and sibling
      END;

EraseViewer: PROCEDURE[self: Viewer] =
      BEGIN
      context: Graphics.Context;
      IF self = NIL THEN RETURN;
      context _ ViewerOps.AcquireContext[self.parent];
	  Graphics.SetColor[context, Graphics.white];
	  Graphics.DrawBox[context, [self.wx, self.wy, self.wx + self.ww, self.wy + self.wh]];
	  ViewerOps.ReleaseContext[context];
	  END;
      
NearestChild: PUBLIC PROCEDURE[wb: Viewer, x, y: INTEGER, type: ViewerFlavor _ NIL] 
         RETURNS[nearest: Viewer] =
      BEGIN
      min, delta: INTEGER _ LAST[INTEGER];
      IF wb.class.flavor = $WhiteboardIcon THEN {
         IF type = NIL THEN RETURN[wb];
         IF type = $WhiteboardIcon THEN RETURN[wb];
         RETURN[NIL]};
      FOR child: Viewer _ wb.child, child.sibling DO
         IF child = NIL THEN EXIT;
         IF type # NIL AND child.class.flavor # type THEN LOOP;
         IF x < child.wx 
            THEN delta _ child.wx - x 
            ELSE delta _ MAX[0, x - (child.wx + child.ww)];
         IF y < child.wy
            THEN delta _ delta + child.wy - y
            ELSE delta _ delta + MAX[0, y - (child.wy + child.wh)];
         IF delta > min THEN LOOP;
         min _ delta;
         nearest _ child;
         ENDLOOP;
      IF min > 40 THEN nearest _ NIL;
      END;
      
FetchEntity: PUBLIC PROC[ v: ViewerClasses.Viewer ] RETURNS[e: DB.Entity] = {
  handle: DB.Entity;
  name: ROPE;
  IF NOT DB.Null[handle_ DB.V2E[ViewerOps.FetchProp[v, $EntityHandle]]] THEN
    RETURN[handle]
  ELSE IF (name_NARROW[ViewerOps.FetchProp[v, $Entity], ROPE])#NIL THEN
    RETURN[DBNames.NameToEntity[name]]
  ELSE
    RETURN[NIL] };
  
StoreEntity: PUBLIC PROC[ v: ViewerClasses.Viewer, e: DB.Entity ] = {
  ViewerOps.AddProp[v, $EntityHandle, e];
  ViewerOps.AddProp[v, $Entity, DBNames.EntityToName[e]] };

iconFont: Graphics.FontRef _VFonts.GraphicsFont[VFonts.EstablishFont["TimesRoman", 8]];

END..

Change log.

Willie-Sue December 13, 1982: aFooProp => aFooIs, for new system properties  
 

�Êà˜JšÔÏcÍ
œ
Ïk	œžœžœÏ
žœžœ&žœ žœ0žœ"žœ+žœ>žœ(žœ
žœžœžœ"žœžœ0žœPžœ#žœ³
žœ(žœ6žœ
žœžœžœÁ
žœ#žœžœ
žœ žœžœžœžœžœžœ
žœžœ�3œ�œ�3œžœ
žœžœžœžœÏnœžœžœ
žœ
žœ	žœžœ
žœ'Ÿœžœžœ
žœ	žœAžœžœžœ
žœžœžœ	žœ
žœžœžœ
žœžœ
žœ	žœžœ
žœžœ
žœ	žœ!žœ
žœUžœžœžœŸœž	œ4žœžœžœ‘
�
œO�œS�œ®
žœŸœž	œžœžœ
žœžœžœ�,œžœ�-œ�'œBžœžœ�œžœžœžœ9�&œžœ�œžœžœžœ>žœžœžœžœ'žœ-žœžœžœ+žœ	žœ
žœžœžœžœžœ
žœžœžœ
žœGžœ
žœžœ$žœ
žœžœ�œ+žœžœ.žœÄ
� œPžœ+žœ	žœ
žœžœžœžœ
žœƒ
�8œ�Dœ�Qœ�Fœ�9œžœ�œ¦žœŸ
œž	œ,žœžœ£
žœžœŸœž	œžœžœ
žœ	žœ
žœ
žœžœžœ
žœ
žœ
žœžœ$žœ
žœ-žœ
žœžœŸ	œžœžœžœ
žœ�2œžœžœ!žœžœ6žœžœ7žœžœžœžœ7žœHžœžœžœ
žœ
žœžœžœ'žœ
žœ
žœ
žœ
žœmžœ�œžœ
žœ
žœµ
žœžœ
žœ
žœ
žœ0�œžœ.žœžœžœ
žœžœ
žœ
žœž
œ
ž
œžœžœžœ'žœžœ
žœžœR�œžœ
žœ
žœžœ
žœ�œxžœpžœ�!œ*žœžœg�œ!�.œ�#œRžœžœ
žœDžœ3žœ�3œ�(œ�3œ
Ÿ
œžœ
žœ$žœžœžœ	Ÿ	œžœ>žœpžœ,žœ	žœ
žœ
žœ�œKžœš
žœŸœžœ
žœ&žœžœžœžœžœžœ
žœ"žœ	žœ
žœ
žœ�œžœ
žœ
žœžœ
žœ
žœ
žœ	žœ
žœ
žœ	žœžœ
žœžœžœ
žœ
žœ2žœžœ
žœ4�œ;žœwžœžœRžœ&� œYžœŸ
œž	œžœžœ_žœ
žœ
žœ
žœžœ
žœ7žœŸœžœ
ž	œžœ.žœžœ
žœ
žœžœžœ
žœ
žœžœžœ	žœ
žœ
žœ�Cœžœ
žœ
žœžœžœžœ
žœ¨
žœ.žœŸœžœ
žœžœžœ
žœ,žœžœ
žœžœ	žœ
žœ
žœžœžœžœžœžœ
žœžœ"žœ%žœžœžœ%žœžœžœLžœ�3œ�œ�3œžœžœŸ	œžœ
ž	œžœ
žœžœ
žœ/�œžœ	žœžœ
žœžœžœ
žœ
žœ#žœžœžœ*žœžœžœ
žœ	�œžœžœžœ$žœžœ
žœ<žœ1žœŸœž	œžœ$žœ
žœžœ
žœžœ
žœ"žœ'žœ
žœ
žœ£
žœžœžœ	žœ
žœFžœ#žœŸœž	œžœ
žœžœ
žœ&žœ
žœ
žœžœ	žœ�œAžœžœ
žœžœ
žœžœžœ
žœžœžœžœ
žœžœžœžœ
�œžœžœ
žœžœžœ
žœ
žœžœžœ
žœžœ(žœ
žœžœžœžœžœžœ	žœŸœžœžœ
žœžœ
žœ%žœžœžœžœžœžœ
žœžœ	žœ
žœ
žœžœ
žœžœ
žœ
žœžœžœ#žœžœ#žœžœ�"œžœžœSžœžœžœ
žœžœ
žœžœžœ
žœ
žœ
žœ
žœžœžœ
žœ
žœNžœžœhžœžœ
žœ
žœ2žœ
žœZžœžœ
žœžœ
žœ
žœ
žœ�œžœžœ
žœžœžœ
žœžœžœžœžœžœžœžœ)žœžœžœžœ
žœžœ*žœžœžœ�œNžœ
žœžœ,žœ
žœ
žœ
žœBžœŸœž	œžœžœžœ
žœ&žœžœEžœžœžœ´žœ�œŸœž	œ
žœžœ
žœžœ�0œ=žœ7žœ
žœ=žœŸœžœ
žœžœžœ
žœ$žœTžœ6žœžœ
žœ�8œ1žœ*žœžœ
žœ
žœžœ
žœ
žœ›
žœ'žœ
žœ�$œ'žœ*žœžœ"žœ
žœžœ;žœ
žœžœžœ[žœžœ
žœžœ
žœ
žœkžœžœ
žœžœ
žœ
žœ;žœžœ+žœ
žœŸœžœžœ�Oœ�œžœ4žœžœ
žœ
žœ<žœžœ
žœžœžœ
žœ�$œžœ^žœžœžœ
žœ
žœžœ
žœ	žœžœ
žœ
žœžœ	žœžœžœ
žœ	žœ
žœ
žœ
žœžœžœ
žœ
žœ)žœ7žœ3žœ7žœžœžœ
žœ
žœžœ
žœžœ�‡
œžœ
žœ
žœžœ žœ
žœ
žœžœŸ	œžœ
ž	œžœ%žœ2žœ	žœ
žœžœ
žœWžœžœ
žœ.žœ
žœžœžœ
žœYžœžœžœžœžœ3žœ0žœ2žœ0žœžœžœ
žœjžœ�œ"žœ-�œžœ	žœžœŸœžœ
ž	œ žœžœžœžœžœWžœžœ
žœ
žœ_�œžœ
žœžœžœžœ
žœ+žœžœžœ
žœ+žœžœžœ
žœ+žœžœžœ
žœ#žœ
žœ.žœ
žœžœžœ
žœY�%œ	žœžœžœžœžœžœžœžœžœžœžœ+žœ(žœžœžœ+žœ(�"œ	žœžœžœžœžœžœžœžœžœžœžœžœžœžœžœžœ�œ	žœžœžœ
žœžœžœÕžœžœžœ.žœŸ
œž	œžœ
žœGžœ�œ(�(œžœŸœž	œžœ(žœžœ
žœ
žœé
žœ	Ÿœžœ
ž	œžœžœžœžœžœžœ
žœ	žœ#žœžœžœ
žœ
žœžœžœ
žœžœ
žœ
žœ)žœ
žœ	žœ
žœ
žœžœžœ
žœžœ
žœžœžœ#žœ	žœ)žœžœ*žœžœ)žœ
žœ
žœ;žœžœ
žœžœžœ	Ÿœžœ
žœžœžœžœžœžœ
žœ
žœžœ-žœžœžœ
žœžœ"žœžœ
žœžœžœžœ
žœŸœžœ
žœžœÎ
žœa˜ŽÏ
—…—g�vv