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