-- 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, August 15, 1983 1:31 pm

DIRECTORY
DB,
DBNames,
DBIcons USING[ GetIcon ],
Graphics,
Icons USING [DrawIcon, IconFlavor],
IconManager USING [selectedIcon],
InputFocus USING [CaptureButtons],
Interminal USING [ButtonValue, KeyFields, MousePosition],
Nut USING [ Display, UpdateProc],
NutOps USING[ EntityValued, GetRelation ],
NutViewer USING[ConvertViewerToEntity, GetIconFromName, GetNutInfo],
Process USING[ Detach ],
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],
ViewerEvents,
ViewerLocks USING [CallUnderWriteLock],
ViewerOps,
ViewerTools USING [MakeNewTextViewer],
VirtualDesktops USING[ EnumerateViewers ],
Whiteboard;

WhiteboardImpl: CEDAR PROGRAM
IMPORTS
DB, DBNames, DBIcons, Graphics, Icons, InputFocus, Nut, NutOps, NutViewer, Rope,
SafeStorage, UserTerminal, VFonts, ViewerOps, ViewerTools, VirtualDesktops, Whiteboard,
ViewerLocks, ViewerEvents, Process, IconManager
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
mark: Graphics.Mark = Graphics.Save[context];
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;
IF self.newVersion THEN
Icons.DrawIcon[DirtyWBicon, context, 0, 0, Strip[self.name]]
  ELSE Icons.DrawIcon[WBicon, context, 0, 0, Strip[self.name]];
  IF IconManager.selectedIcon = self THEN
  { Graphics.Restore[context, mark];
  [] ← Graphics.SetPaintMode[context, invert];
  Graphics.DrawBox[context, [0, 0, 64, 64]];
  -- now set the context back to it's original value
  Graphics.Restore[context, mark] }
  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 ← self.name;
domainName: ROPE;
viewer: Viewer;
iconRef: REF Icons.IconFlavor ← NARROW[ViewerOps.FetchProp[self, $IconFlavor]];
icon: Icons.IconFlavor ← IF iconRef = NIL THEN unInit ELSE iconRef^;
screenGrey: CARDINAL = 104042B;
mark: Graphics.Mark = Graphics.Save[context];
  viewer ← NARROW[self.data, Viewer];
IF viewer # NIL AND viewer.destroyed THEN {self.data ← viewer ← NIL};
IF viewer = NIL AND iconRef = NIL THEN { -- no hope to
Graphics.SetStipple[context, screenGrey];
Graphics.DrawBox[context, [0, 0, 64, 64]];
RETURN};
IF name = NIL THEN -- try to find a nice name to print on the icon
{ name ← NARROW[ViewerOps.FetchProp[self, $IconLabel]]; -- try it's iconLabel first
IF viewer#NIL AND Rope.Equal[name,""] THEN -- try label of Viewer attached
name ← NARROW[ViewerOps.FetchProp[viewer, $IconLabel], ROPE];
IF Rope.Equal[name,""] THEN -- still no luck; use the DB entity name
{ name ← NARROW[ViewerOps.FetchProp[self, $Entity]];
IF name # NIL THEN
{ segName, entityName, domainName: ROPE;
[segName, domainName, entityName] ← DBNames.DecomposeName[name];
IF Rope.Equal[domainName, "TextViewer"] THEN
name ← ShortName [entityName]
ELSE name ← entityName } }
ELSE IF viewer # NIL THEN name ← viewer.name;
self.name ← name };
-- 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;
oldData: REF ANY = self.data;
self.class ← viewer.class;
self.icon ← viewer.icon;
self.data ← viewer.data;
self.iconic ← TRUE; -- convince it that it's an icon
self.class.paint[self, context, NIL, TRUE]; -- paint it
self.class ← oldClass;
self.icon ← oldIcon;
self.data ← oldData;
self.iconic ← oldIconic};
icon = private AND Rope.Equal[domainName, "Whiteboard"] =>
Icons.DrawIcon[WBicon, context, 0, 0, name];
icon = private => {
   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];
  IF self.spare0 THEN -- this icon has been inverted by OpenIcon; keep it that way
  { -- reset the context (which may have been changed by DrawIcon)
  Graphics.Restore[context, mark];
  [] ← Graphics.SetPaintMode[context, invert];
  Graphics.DrawBox[context, [0, 0, 64, 64]] };
END;

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

  -- the AddTextBox and AddIcon procedures DO NOT paint the viewers they create
 
AddTextBox: PUBLIC PROC[wb: Viewer, e: Entity, x, y, w, h: INTEGER]
RETURNS[child: Viewer] =
BEGIN
grid: NAT = GetGrid[wb];
MakeChild: PROC[] = {
child ← ViewerTools.MakeNewTextViewer[paint: FALSE,
info: [parent: wb, wx: 0, wy: 0, ww: 800, wh: 800]];
   ViewerOps.MoveViewer[child, x-(x MOD grid), y-(y MOD grid),
        w-(w MOD grid), h-(h MOD grid), FALSE] };
registration: ViewerEvents.EventRegistration;
ViewerLocks.CallUnderWriteLock[MakeChild, wb];
wb.newVersion ← TRUE;
IF NOT DB.Null[e] THEN StoreEntity[child, e]; -- if e = NIL, not necessary
-- Note: we are assuming that there is no sharing among textBox entities;
-- thus, there is no attempt to add lines between textboxes or any check to see
-- if the box is already on the whiteboard (it can't be!!)
registration ← ViewerEvents.RegisterEventProc[ SetNew, edit, child ];
ViewerOps.AddProp[ child, $registration, registration ]
END;

SetNew: ViewerEvents.EventProc =
{ viewer.parent.newVersion ← TRUE;
TRUSTED
{Process.Detach[FORK ViewerOps.PaintViewer[viewer: viewer.parent, hint: caption]]}};

AddIcon: PUBLIC PROC[wb, viewer: Viewer, name: ROPE, x, y: INTEGER]
RETURNS[child: Viewer] =
-- AddIcon works just like AddTextBox; it just adds the icon entity to the whiteboard
-- (the name is the name of the associated DB entity and is used if the viewer is NIL)
BEGIN
OPEN ViewerOps;
iconEntity: DB.Entity;
icon: Icons.IconFlavor ← unInit;
seg: DB.Segment;
grid: NAT = GetGrid[wb];
IF viewer = NIL THEN iconEntity ← DBNames.NameToEntity[name]
ELSE
{ WHILE viewer.parent # NIL DO viewer ← viewer.parent; ENDLOOP;
-- convert the viewer supplied to a DB entity
[iconEntity, name] ← NutViewer.ConvertViewerToEntity[viewer];
[seg,,] ← NutViewer.GetNutInfo[viewer] };
-- add the icon
IF name = NIL THEN RETURN; -- nothing we can do here
child ← CreateViewer[flavor: $WhiteboardIcon, paint: FALSE,
info: [
parent: wb,
wx: x - (x MOD grid), wy: y - (y MOD grid),
wh: 64, ww: 64,
border: FALSE,
scrollable: FALSE]];
child.data ← viewer;
StoreEntity[child, iconEntity, seg, name];
-- now find the icon for the viewer
IF viewer # NIL AND viewer.icon = private
THEN icon ← private ELSE icon ← NutViewer.GetIconFromName[name];
ViewerOps.AddProp[child, $IconFlavor, NEW[Icons.IconFlavor ← icon]];
wb.newVersion ← TRUE;
[] ← AddAllLines[wb, child];
END;

GetGrid: PUBLIC PROC[ wb: Viewer ] RETURNS[ grid: NAT ] = {
gridSize: REF NAT = NARROW[ViewerOps.FetchProp[wb, $gridSize]];
RETURN[ IF gridSize = NIL THEN 1 ELSE gridSize^ ] };

SetGrid: PUBLIC PROC[ wb: Viewer, grid: NAT ] = {
gridSize: REF NAT = NARROW[ViewerOps.FetchProp[wb, $gridSize]];
IF gridSize = NIL THEN ViewerOps.AddProp[wb, $gridSize, NEW[ NAT ← grid ] ]
ELSE gridSize^ ← grid };

OpenIcon: PUBLIC PROCEDURE[icon: Viewer] =
BEGIN
ENABLE UNWIND => icon.spare0 ← FALSE;
viewer: Viewer;
e: Entity;
IF icon = NIL THEN RETURN;
-- invert the icon first to give information on when display complete
ViewerOps.InvertForMenus[icon, 0, icon.wy, icon.ww, icon.wh];
icon.spare0 ← TRUE; -- remember that the viewer is inverted
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
{ dontSpawn: BOOLEAN =
DB.Eq[DB.DomainOf[e], Whiteboard.TextViewer] OR
DB.Eq[DB.DomainOf[e], Whiteboard.ToolViewer];
icon.data ← Nut.Display[e: e, parent: icon.parent,
       method: IF dontSpawn THEN oneOnly ELSE spawned] };
viewer.iconic => ViewerOps.OpenIcon[viewer];
ENDCASE => ViewerOps.PaintViewer[viewer, all];
-- now repaint the icon that was inverted when this got started
IF NOT icon.destroyed THEN
ViewerOps.InvertForMenus[icon, 0, icon.wy, icon.ww, icon.wh];
icon.spare0 ← FALSE -- reset the inverted bit (checked by PaintIconic)
END;

RemoveChild: PUBLIC PROC[wb, child: Viewer] =
BEGIN
relships, last: LIST OF Line;
destroyList: LIST OF Entity ← NARROW[ ViewerOps.FetchProp[wb, $destroyList] ];
entity: Entity = Whiteboard.WBEntityForViewer[child];
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;
ENDLOOP;
SetLines[wb, relships];
ViewerOps.DestroyViewer[child];
IF NOT DB.Null[entity] THEN
IF destroyList = NIL THEN ViewerOps.AddProp[wb, $destroyList, LIST[entity]]
ELSE ViewerOps.AddProp[ wb, $destroyList, destroyList ← CONS[entity, destroyList] ]
END;

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

ShowLines: PUBLIC PROCEDURE[wb: Viewer, show: BOOLEAN] =
BEGIN
entities: LIST OF Whiteboard.Pair;
changes: BOOLEAN ← FALSE;
entities ← GetEntities[wb];
-- reset the world
SetLines[wb, NIL];
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
changes ← AddAllLines[wb, entities.first.v] OR changes
ENDLOOP;
IF changes THEN ViewerOps.PaintViewer[wb, client]
END;

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

AddLine: PROCEDURE[lines: LIST OF Line, entities: LIST OF Whiteboard.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 { 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 Whiteboard.Pair,
        prop: BinaryProperty]
RETURNS[line: Line] =
BEGIN
line ← [NIL, NIL, prop.name];
FOR pairs: LIST OF Whiteboard.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 Whiteboard.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: PUBLIC PROCEDURE[wb: Viewer, text: BOOL ← TRUE]
      RETURNS[entities: LIST OF Whiteboard.Pair] =
BEGIN
-- make up a list of entities on the whiteboard
GetEntity2: ViewerOps.EnumProc = {
iconEntity: DB.Entity;
IF v.class.flavor = $Text AND NOT text THEN RETURN[TRUE];
iconEntity ← Whiteboard.FetchEntity[v];
IF iconEntity # NIL THEN entities ← CONS[ [iconEntity, 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;
grid: NAT;
old, new: Interminal.MousePosition;
IF child # NIL THEN parent ← child.parent ELSE RETURN;
grid ← GetGrid[parent];
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;
IF grid # 1 THEN
ViewerOps.MoveViewer[child, child.wx-(child.wx MOD grid),
          child.wy-(child.wy MOD grid),
          child.ww, child.wh, FALSE];
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;
grid: NAT = GetGrid[wb];
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;
IF grid # 1 THEN
ViewerOps.MoveViewer[box, box.wx-(box.wx MOD grid), box.wy-(box.wy MOD grid),
         box.ww-(box.ww MOD grid), box.wh-(box.wh MOD grid),
         FALSE];
ViewerOps.PaintViewer[wb, all];
END;

MoveViewer: PROCEDURE[self: Viewer, x, y, w, h: INTEGER] =
BEGIN
parent: Viewer = self.parent;
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, NOT Whiteboard.readOnly]]
ELSE
RETURN[NIL] };

StoreEntity: PUBLIC PROC[ v: ViewerClasses.Viewer, e: DB.Entity,
         seg: DB.Segment ← NIL, name: ROPE ← NIL ] = {
ViewerOps.AddProp[v, $EntityHandle, e];
IF DB.Null[e] THEN ViewerOps.AddProp[v, $Entity, name]
ELSE ViewerOps.AddProp[v, $Entity, DBNames.EntityToName[e, seg]] };

DoDeregister: ViewerOps.EnumProc = {
registration: ViewerEvents.EventRegistration = NARROW[ViewerOps.FetchProp[v, $registration]];
IF registration # NIL THEN ViewerEvents.UnRegisterEventProc[registration, edit] };

DeRegister: ViewerEvents.EventProc =
TRUSTED { Process.Detach[ FORK ViewerOps.EnumerateChildren[viewer, DoDeregister] ] };

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

WBicon: Icons.IconFlavor ← DBIcons.GetIcon["Whiteboard"];

DirtyWBicon: Icons.IconFlavor ← DBIcons.GetIcon["DirtyWhiteboard"];

[] ← ViewerEvents.RegisterEventProc[ proc: DeRegister,
            event: destroy, filter: $Whiteboard ];

END..

Change log.

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