-- WhiteboardNutImpl.mesa
-- Last edited by
-- Maxwell, June 23, 1983 10:03 am
-- Willie-Sue, February 22, 1983 4:02 pm
-- Cattell, September 1, 1983 10:40 am
-- Donahue, August 9, 1983 8:49 am

DIRECTORY
Booting USING[ RegisterProcs, CheckpointProc, RollbackProc ],
Convert USING[ RopeFromCard ],
DB,
DBNames,
Cursors USING [CursorArray, CursorType, NewCursor],
Graphics USING[ Context ],
Interminal USING[ MousePosition ],
IO,
Menus,
Nut,
NutOps,
NutViewer,
Process USING [Detach],
Rope USING [Cat, Equal, Flatten, Index, Length, ROPE, Replace, Find],
BasicTime USING[ GetClockPulses ],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable],
Commander USING[ CommandProc, Register ],
UserProfile USING[ Number, Token ],
ViewerBLT USING[ ChangeNumberOfLines ],
ViewerClasses USING [ModifyProc, NotifyProc, PaintProc,
Viewer, ViewerClass, ViewerClassRec, ViewerRec, ViewerFlavor],
ViewerOps,
ViewerLocks USING[ CallUnderWriteLock, ReleaseWriteLock ],
ViewerTools USING [
GetSelectionContents, GetSelectedViewer, GetTiogaContents,
SetContents, SetTiogaContents, TiogaContents, TiogaContentsRec],
VirtualDesktops USING[ EnumerateViewers ],
Whiteboard;

WhiteboardNutImpl: CEDAR PROGRAM
IMPORTS
Booting, Cursors, DB, DBNames, IO,
Menus, Nut, NutOps, NutViewer, Process, Rope, TIPUser, Commander,
UserProfile, ViewerBLT, ViewerOps, ViewerTools, VirtualDesktops,
Whiteboard, ViewerLocks, BasicTime, Convert
EXPORTS Whiteboard
SHARES ViewerClasses, ViewerLocks, Menus =
BEGIN
OPEN DB, ViewerClasses;

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

-- ************************************************************
-- Creation and initialization
-- ************************************************************

CreateWhiteboardClass: PROCEDURE =
BEGIN
tipTableName: ROPE = "Whiteboard.tip";
tipTable: TIPUser.TIPTable = TIPUser.InstantiateNewTIPTable[tipTableName];
whiteboardClass ← NEW[ViewerClasses.ViewerClassRec ← []];
whiteboardClass^ ← ViewerOps.FetchViewerClass[$Container]^;
whiteboardClass.flavor ← $Whiteboard;
whiteboardClass.notify ← NotifyMe;
whiteboardClass.modify ← Noop;
whiteboardClass.tipTable ← tipTable;
whiteboardClass.cursor ← crossHairsCircle;
whiteboardClass.coordSys ← top;
PaintContainer ← whiteboardClass.paint;
whiteboardClass.paint ← PaintWhiteboard;
whiteboardClass.icon ← private;
CreateMenu[];
ViewerOps.RegisterViewerClass[$Whiteboard, whiteboardClass];
CreateCursors[];
CreateIconClass[];
END;

iconCursor, textBoxCursor: Cursors.CursorType;

whiteboardClass, iconClass: ViewerClasses.ViewerClass;

CreateCursors: PROCEDURE =
BEGIN
cursor: Cursors.CursorArray;
cursor ← [177777B, 100001B, 100001B, 100001B,
100001B, 100001B, 100001B, 177777B, 0, 0, 0, 0, 0, 0, 0, 0];
textBoxCursor ← Cursors.NewCursor[cursor, 0, 0];
cursor ← ALL[100001B];
cursor[15] ← 177777B;
cursor[0] ← 177777B;
iconCursor ← Cursors.NewCursor[cursor, 0, 0];
END;

CreateIconClass: PROCEDURE =
BEGIN
iconClass ← NEW[ViewerClasses.ViewerClassRec ← []];
iconClass^ ← ViewerOps.FetchViewerClass[$Whiteboard]^;
iconClass.flavor ← $WhiteboardIcon;
iconClass.paint ← Whiteboard.PaintIcon;
iconClass.init ← NIL;
iconClass.coordSys ← bottom;
ViewerOps.RegisterViewerClass[$WhiteboardIcon, iconClass];
END;

PaintContainer: PaintProc;

PaintArg: TYPE = RECORD[ self: ViewerClasses.Viewer, context: Graphics.Context,
         whatChanged: REF ANY, clear: BOOL ];

PaintWhiteboard: ViewerClasses.PaintProc =
BEGIN
IF self.iconic THEN { Whiteboard.PaintIconic[self, context, whatChanged, TRUE]; RETURN };
[]← NutOps.Do[ PaintWB, NEW[ PaintArg ← [self, context, whatChanged, clear] ] ]
END;

PaintWB: PROC[ clientData: REF ANY ] = {
data: PaintArg = NARROW[clientData, REF PaintArg]^;
self: ViewerClasses.Viewer = data.self;
context: Graphics.Context = data.context;
whatChanged: REF ANY = data.whatChanged;
clear: BOOL = data.clear;
PaintContainer[self, context, whatChanged, clear];
Whiteboard.PaintRelships[self, context, whatChanged, clear] };

Noop: ViewerClasses.ModifyProc = {};

menu: Menus.Menu;

CreateMenu: PROCEDURE =
-- All menu items are in the default DB queue, and are protected by catch phrases for errors.
BEGIN OPEN NutViewer;
menu ← Menus.CreateMenu[];
-- Build the first line of the menu
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "Store", Store]];
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "Grid: 1", SetGrid]];
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "ShowLines", ShowLines]];
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "HELP", Instructions]];
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "AddSelected", AddSelected]];
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "NewWB", NewWhiteboard]];
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "NewBox", NewBox]];
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "Freeze", Freeze]];
Menus.InsertMenuEntry[menu, MakeMenuEntry[DBQueue[], "Reset", ResetProc]];
-- Build the second line
Menus.AppendMenuEntry[menu, MakeMenuEntry[DBQueue[], "Save", SaveProc], 1];
Menus.AppendMenuEntry[menu, MakeMenuEntry[DBQueue[], "Erase", Erase], 1];
Menus.AppendMenuEntry[menu, MakeMenuEntry[DBQueue[], "Rename", Rename], 1];
Menus.ChangeNumberOfLines[menu, 1]
END;

SaveProc: Menus.MenuProc =
{ v: Viewer = NARROW[parent];
readOnly: BOOL = DB.V2B[ViewerOps.FetchProp[v, $readOnly] ];
IF NOT readOnly THEN Save[v] };

Store: Menus.MenuProc =
{ v: Viewer = NARROW[parent];
readOnly: BOOL = DB.V2B[ViewerOps.FetchProp[v, $readOnly] ];
count: NAT = Menus.GetNumberOfLines[v.menu];
newCount: NAT = IF count = 2 THEN 1 ELSE 2;
IF NOT readOnly THEN
{ Menus.ChangeNumberOfLines[v.menu, newCount];
ViewerBLT.ChangeNumberOfLines[v, newCount] } };

SetGrid: Menus.MenuProc = {
OPEN IO, Menus, NutViewer;
v: Viewer = NARROW[parent];
oldGrid: NAT = Whiteboard.GetGrid[v];
newGrid: NAT = IF mouseButton = red THEN MIN[oldGrid*2, 32] ELSE MAX[oldGrid/2, 1];
gridEntry: Menus.MenuEntry = NARROW[clientData];
oldName: STREAM = ROS[];
newName: STREAM = ROS[];
Whiteboard.SetGrid[ v, newGrid ];
PutF[newName, "Grid: %2g", int[newGrid]];
PutF[oldName, "Grid: %2g", int[oldGrid]];
ReplaceMenuEntry[ v.menu,
      FindEntry[v.menu, RopeFromROS[oldName]],
      MakeMenuEntry[DBQueue[], RopeFromROS[newName], SetGrid]];
ViewerOps.PaintViewer[v, all];
oldName.Close[]; newName.Close[] };

ResetProc: Menus.MenuProc = { v: Viewer = NARROW[parent]; Reset[v]};

ShowLines: Menus.MenuProc =
{viewer: Viewer = NARROW[parent]; viewer.class.notify[viewer, LIST[$ShowLines]] };

Rename: Menus.MenuProc =
{viewer: Viewer = NARROW[parent]; viewer.class.notify[viewer, LIST[$Rename]] };

NewBox: Menus.MenuProc =
{viewer: Viewer = NARROW[parent]; viewer.class.notify[viewer, LIST[$NewBox]] };

AddSelected: Menus.MenuProc =
{viewer: Viewer = NARROW[parent]; viewer.class.notify[viewer, LIST[$AddSelected]] };

NewWhiteboard: Menus.MenuProc =
{viewer: Viewer = NARROW[parent]; viewer.class.notify[viewer, LIST[$NewWhiteboard]] };

Instructions: Menus.MenuProc =
{viewer: Viewer = NARROW[parent]; viewer.class.notify[viewer, LIST[$Instructions]] };

Erase: Menus.MenuProc =
{viewer: Viewer = NARROW[parent]; viewer.class.notify[viewer, LIST[$Erase]] };

Freeze: Menus.MenuProc =
{viewer: Viewer = NARROW[parent]; viewer.class.notify[viewer, LIST[$Freeze]] };


-- ************************************************************
-- Command interpreter
-- ************************************************************

NotifyMe: NotifyProc =
BEGIN
OPEN Whiteboard;
p: TIPUser.TIPScreenCoords;
FOR list: LIST OF REF ANY ← input, list.rest UNTIL list = NIL DO
WITH list.first SELECT FROM
z: ATOM =>
{ parent: Viewer = IF self.parent = NIL THEN self ELSE self.parent;
 SELECT z FROM
$Expand => Expand[NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon]];
$Grow =>
IF parent.class.flavor = $Whiteboard THEN TRUSTED{
v: Viewer = NearestChild[self, p.mouseX, p.mouseY, $Text];
IF v # NIL THEN
Process.Detach[FORK GrowBox[parent, v, p.mouseX, p.mouseY]] };
$Instructions => {[] ← NewTextBox[self, 100, 100, TRUE]};
$NewBox => { [] ← NewTextBox[parent, 100, 100, FALSE] };
  $NewWhiteboard =>
   { random: LONG CARDINAL = LOOPHOLE[BasicTime.GetClockPulses[]];
   uniqueName: ROPE = Convert.RopeFromCard[random];
   newName: ROPE = DBNames.MakeName[$Squirrel, WBEntity, uniqueName];
   child: Viewer = AddIcon[parent, NIL, newName, 100, 100];
parent.newVersion ← TRUE;
ViewerOps.PaintViewer[child, all];
ViewerOps.PaintViewer[parent, caption] };
 $Open => {
  v: Viewer = NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon];
  IF v # NIL THEN TRUSTED{ Process.Detach[FORK OpenProc1[v]] } };
 $OpenFull => {
  v: Viewer = NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon];
  IF v # NIL THEN TRUSTED{ Process.Detach[FORK OpenFullProc[v]] } };
 $Release => { };
 $Remove => {
  child: Viewer ← NearestChild[self, p.mouseX, p.mouseY];
  parent: Viewer = IF self.parent = NIL THEN self ELSE self.parent;
  IF child = NIL THEN RETURN;
  Whiteboard.RemoveChild[child.parent, child];
  parent.newVersion ← TRUE;
  ViewerOps.PaintViewer[parent, caption] };
 $Freeze => NutViewer.DefaultFreezeProc[ parent: self ];
$AddSelected => NewIcon[self, ViewerTools.GetSelectedViewer[], 100, 100];
$Erase =>
{ IF NOT readOnly THEN
   { DB.DestroyEntity[Whiteboard.FetchEntity[self]];
   DestroyAllWBItems[self];
    ViewerOps.DestroyViewer[self] } };
$Move => {
child: Viewer = NearestChild[self, p.mouseX, p.mouseY];
IF child# NIL THEN TRUSTED{ Process.Detach[FORK MoveChild[child]]} };
$ShowLines =>
 Whiteboard.ShowLines[self, ViewerOps.FetchProp[self, $ShowLines] = NIL];
$Rename =>
IF NOT readOnly THEN
{ oldName: ROPE = GetWBName[self];
newName: ROPE = ViewerTools.GetSelectionContents[];
SetWBName[self, newName];
ChangeAllRefs[from: oldName, to: newName, in: self] };
ENDCASE => SIGNAL WBError };
z: TIPUser.TIPScreenCoords => p ← z;
ENDCASE => SIGNAL WBError;
ENDLOOP;
END;

NewIcon: PROC[wb, viewer: Viewer, x, y: INTEGER] =
{ v: Viewer = Whiteboard.AddIcon[wb, viewer, NIL, x, y];
ViewerOps.PaintViewer[v, all];
ViewerOps.PaintViewer[wb, caption] };

ChangeAllRefs: PROC[from: ROPE, to: ROPE, in: Viewer] = {
WB: Entity = DB.DeclareEntity[d: WBEntity, name: from];
oldName: ROPE = DBNames.EntityToName[e: WB];
newName: ROPE =
   Rope.Replace[base: oldName,
       start: Rope.Find[s1: oldName,
            s2: from,
            pos1: Rope.Length[WBSegment]+11],
       with: to];
rshipSet: RelshipSet = RelationSubset[ NutOps.GetRelation[entityName],
            LIST[ AttributeValue[entityName, S2V[oldName]]] ];
DB.ChangeName[e: WB, name: to !
 DB.Error => IF code = NonUniqueEntityName THEN
     { NutViewer.Message[in, "Can't do it; non-unique name"]; GOTO Quit}
     ELSE REJECT ];
Whiteboard.StoreEntity[v: in, e: WB];
FOR nextR: Relship ← NextRelship[rshipSet], NextRelship[rshipSet] UNTIL nextR = NIL DO
[] ← SetF[ nextR, entityName, S2V[newName] ]
ENDLOOP;
ReleaseRelshipSet[rshipSet];
-- and now make sure that the transaction is commited
DB.MarkTransaction[trans: DB.TransactionOf[$Squirrel]];
-- that has changed the DB; now change all the viewers on the screen
{ FindAllWBs: ViewerOps.EnumProc = {
changed: BOOLEAN ← FALSE;
ChangeTheIcons: ViewerOps.EnumProc = {
locked: BOOLEAN ← FALSE;
{ ENABLE UNWIND => IF locked THEN ViewerLocks.ReleaseWriteLock[v];
DoUpdate: PROC = {
entity: DB.Entity = Whiteboard.FetchEntity[v];
eName: ROPE = IF DB.Null[entity] THEN NIL ELSE DBNames.EntityToName[entity];
locked ← TRUE;
IF Rope.Equal[eName, newName]
THEN { Whiteboard.StoreEntity[v, WB]; v.name ← to; changed ← TRUE } };
IF v.class.flavor # $WhiteboardIcon THEN RETURN[TRUE];
ViewerLocks.CallUnderWriteLock[DoUpdate, v]; locked ← FALSE; RETURN[TRUE] } };
IF v.class.flavor = $Whiteboard THEN
{ ViewerOps.EnumerateChildren[v, ChangeTheIcons];
IF changed THEN TRUSTED
{ Process.Detach[ FORK ViewerOps.PaintViewer[v, client] ] } };
RETURN [TRUE] };
ViewerOps.EnumerateViewers[enum: FindAllWBs] }
EXITS
Quit => NULL };

DestroyAllWBItems: PROC[ v: Viewer ] = {
DestroyChild: ViewerOps.EnumProc = {
e: Entity = WBEntityForViewer[v];
IF NOT DB.Null[e] THEN DB.DestroyEntity[e];
RETURN[TRUE] };
ViewerOps.EnumerateChildren[ v, DestroyChild ] };

OpenProc1: PROC[ clientData: REF ANY ] =
{ []← NutOps.Do[proc: OpenProc2, clientData: clientData] };

OpenFullProc: PROC[ clientData: REF ANY ] =
{ v: Viewer = NARROW[clientData];
success: BOOLEAN = NutOps.Do[proc: OpenProc2, clientData: clientData];
IF success AND v # NIL THEN
{ newV: Viewer = NARROW[v.data];
IF newV#NIL AND NOT newV.iconic THEN ViewerOps.GrowViewer[viewer: newV] } };

OpenProc2: PROC[ clientData: REF ANY ] =
{ Whiteboard.OpenIcon[NARROW[clientData]] };

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

NewTextBox: PROCEDURE[self: Viewer, x, y: INTEGER, instructions: BOOLEAN]
RETURNS[child: Viewer] =
BEGIN
IF ~instructions
THEN child ← Whiteboard.AddTextBox[self, NIL, x, y, boxW, boxH]
ELSE {child ← Whiteboard.AddTextBox[self, NIL, x, y, 250, 100];
ViewerTools.SetContents[child, "INSTRUCTIONS:\n LEFT => move entity\n ctrl LEFT => delete entity\n MIDDLE => open icon\n shift MIDDLE => open icon fullsize\n ctrl MIDDLE => expand icon\n RIGHT => grow text box"]};
ViewerOps.PaintViewer[child, all];
ViewerOps.PaintViewer[self, caption];
END;

SetWBName: PROCEDURE[wb: Viewer, name: ROPE, paint: BOOLEAN ← TRUE] =
BEGIN
name ← Strip[name];
IF name = NIL THEN name ← "NEW";
wb.name ← Rope.Cat["Whiteboard: ", name];
IF paint THEN ViewerOps.PaintViewer[wb, caption];
END;

GetWBName: PROCEDURE[wb: Viewer] RETURNS[name: ROPE] =
BEGIN
pos: INT;
name ← wb.name;
IF (pos ← name.Index[0, ":"]) > 0
THEN RETURN[name.Flatten[pos + 2, name.Length[]]]
ELSE RETURN[name];
END;

Strip: PROCEDURE[name: ROPE] RETURNS[ROPE] =
INLINE BEGIN
pos: INT;
IF name = NIL THEN RETURN[NIL];
IF (pos ← name.Index[0, "."]) > 0
THEN RETURN[name.Flatten[0, pos]]
ELSE RETURN[name];
END;

-- ************************************************************
-- data base operations (reset, save, expand)
-- ************************************************************

CreateWhiteboard: Nut.CreateProc =
BEGIN
viewer: Viewer = ViewerOps.CreateViewer[ flavor: $Whiteboard,
       info: [name: eName, iconic: TRUE, column: column],
       paint: FALSE];
ViewerOps.AddProp[ viewer, $readOnly, NEW[BOOL ← Whiteboard.readOnly] ];
RETURN[viewer];
END;

EditWhiteboard: Nut.EditProc =
BEGIN
entity: Entity = DeclareEntity[d, eName];
DisplayWhiteboard[entity, newV];
END;

-- reading a whiteboard from the data base --

Reset: PUBLIC PROCEDURE[wb: ViewerClasses.Viewer] =
BEGIN
DoReset: PROC[arg: REF ANY ] = {
entity: Entity = Whiteboard.FetchEntity[wb];
IF entity = NIL THEN { ViewerOps.DestroyViewer[wb]; RETURN };
wb.child ← NIL; -- flushes old whiteboard
ViewerOps.AddProp[wb, $LineList, NIL];
ViewerOps.AddProp[wb, $destroyList, NIL];
Whiteboard.SetGrid[wb: wb, grid: 1];
ViewerOps.PaintViewer[wb, client];
DisplayWhiteboard[entity, wb] };
[] ← NutOps.Do[DoReset, NIL]
END;

DisplayWhiteboard: Nut.DisplayProc = -- e: Entity, newV: Viewer --
BEGIN
cRS: Relship;
child: Entity;
rs: RelshipSet;
locked: BOOLEAN ← FALSE;
DoDisplay: PROC = {
locked ← TRUE; -- now we're inside the forbidden region
SetWBName[newV, GetName[e]];
ViewerOps.SetMenu[newV, menu];
newV.newVersion ← TRUE;
ViewerOps.PaintViewer[newV, all]; -- clear everything out
ViewerOps.AddProp[newV, $ShowLines, NIL];
ViewerOps.AddProp[newV, $LineList, NIL]; -- NIL out line cache (see WhiteboardImpl)
Whiteboard.StoreEntity[newV, e];
rs ← RelationSubset[container, LIST[[containerIs, e]]];
WHILE (cRS ← NextRelship[rs]) # NIL DO
child ← V2E[GetF[cRS, containerOf]];
IF Null[child] THEN LOOP;
IF Eq[DomainOf[child], Note]
THEN DisplayNoteEntity[newV, child, cRS]
ELSE DisplayIconEntity[newV, child, cRS];
ENDLOOP;
Whiteboard.ShowLines[newV, V2B[GetP[e, showLines]]];
newV.newVersion ← FALSE;
ViewerOps.PaintViewer[newV, caption] };
{ ENABLE UNWIND =>
{ IF locked THEN ViewerLocks.ReleaseWriteLock[newV] };
IF Null[WBEntity] THEN IF NOT InitializeSchema[WBSegment] THEN RETURN;
ViewerLocks.CallUnderWriteLock[ DoDisplay, newV ];
locked ← FALSE;
IF NOT doingRestart AND newV.iconic THEN ViewerOps.OpenIcon[newV] }
END;

DisplayNoteEntity: PROCEDURE[wbViewer: Viewer, note: Entity, cRS: Relship] =
BEGIN
child: Viewer;
x, y, w, h: INTEGER;
text: ViewerTools.TiogaContents;
[x, y, w, h] ← GetValues[cRS];
child ← Whiteboard.AddTextBox[wbViewer, note, x, y, w, h];
text ← NEW[ViewerTools.TiogaContentsRec ← []];
text.contents ← V2S[GetP[note, contents]];
text.formatting ← V2S[GetP[note, format]];
ViewerTools.SetTiogaContents[child, text];
Whiteboard.StoreEntity[child, note];
END;

DisplayIconEntity: PROCEDURE[wbViewer: Viewer, icon: Entity, cRS: Relship] =
BEGIN
child: Viewer;
iconName: ROPE = V2S[GetP[icon, entityName]];
x, y: INTEGER;
[x, y, , ] ← GetValues[cRS];
child ← Whiteboard.AddIcon[wbViewer, NIL, iconName, x, y];
ViewerOps.AddProp[ child, $IconLabel, DB.GetP[e: icon, aIs: iconLabel] ];
ViewerOps.PaintViewer[viewer: child, hint: client]
END;

-- expanding an existing icon

-- try empty spots in this order: (depth.position; all of one depth first)
-- 2.8 1.4 xx 1.3 2.7
-- 2.6 1.2 1.0 1.1 2.5
-- 2.4 2.2 2.0 2.1 2.3

Expand: PROCEDURE[icon: Viewer] =
BEGIN
entity: Entity;
x, y: INTEGER;
tooMany: ROPE;
width: INTEGER = 150;
depth, position: INTEGER;
even, all: BOOLEAN ← TRUE;
props: LIST OF Whiteboard.BinaryProperty;
entityList: LIST OF Whiteboard.Pair;
IF icon = NIL THEN RETURN;
entity ← Whiteboard.FetchEntity[icon];
entityList ← Whiteboard.GetEntities[icon.parent];
IF Null[entity] THEN RETURN;
props ← Whiteboard.GetBinaryProperties[entity];
depth ← 1; position ← 0;
x ← icon.wx; y ← icon.wy + width;
FOR props ← props, props.rest WHILE props # NIL DO
newEntity: Entity;
newIcon: Viewer;
IF Null[props.first.of] OR Null[props.first.is] THEN LOOP;
IF Rope.Equal[props.first.name, tooMany] THEN LOOP;
IF Count[props, props.first.name] > 10
THEN {tooMany ← props.first.name; all ← FALSE; LOOP}
ELSE tooMany ← NIL;
newEntity ← IF DB.Eq[props.first.of, entity] THEN props.first.is ELSE props.first.of;
-- check to see whether the addition is necessary
FOR el: LIST OF Whiteboard.Pair ← entityList, el.rest UNTIL el = NIL DO
IF DB.Eq[el.first.e, newEntity] THEN {newEntity ← NIL; EXIT}
ENDLOOP;
IF newEntity = NIL THEN LOOP;
-- find an empty spot
WHILE ~Empty[icon.parent, x+10, y+10, 64-20, 64-20] DO
position ← position + 1;
IF position > 4*depth THEN {depth ← depth + 1; position ← 0};
even ← ((position MOD 2) = 0);
SELECT TRUE FROM
position <= 2*depth => { -- bottom row; alternate left and right
x ← width*((position + 1)/2);
IF even THEN x ← -x;
x ← x + icon.wx;
y ← icon.wy + width*depth};
even => { -- left side
offset: INTEGER ← (position - 2*depth)/2;
x ← icon.wx - depth*width;
y ← icon.wy + (depth - offset)*width};
ENDCASE => { -- right side
offset: INTEGER ← (position + 1 - 2*depth)/2;
x ← icon.wx + depth*width;
y ← icon.wy + (depth - offset)*width};
ENDLOOP;
-- add the icon
   newIcon ← Whiteboard.AddIcon[icon.parent, NIL,
     DBNames.EntityToName[newEntity], x, y];
-- make sure that you don't try to add it again
entityList ← CONS[ Whiteboard.Pair[e: newEntity, v: newIcon], entityList ];
ENDLOOP;
icon.border ← all;
ViewerOps.PaintViewer[icon.parent, all];
END;

Count: PROCEDURE[props: LIST OF Whiteboard.BinaryProperty, name: ROPE]
RETURNS[count: INTEGER ← 0] = INLINE
BEGIN
FOR props ← props, props.rest WHILE props # NIL DO
IF ~Rope.Equal[props.first.name, name] THEN EXIT;
count ← count + 1;
ENDLOOP;
END;

Empty: PROCEDURE[wb: Viewer, x, y, w, h: INTEGER] RETURNS[BOOLEAN] =
BEGIN
IF y < 10 THEN RETURN[FALSE];
IF x < 10 OR x + w - 10 > wb.ww THEN RETURN[FALSE];
FOR child: Viewer ← wb.child, child.sibling WHILE child # NIL DO
IF child.wx + child.ww < x OR child.wx > x + w THEN LOOP;
IF child.wy + child.wh < y OR child.wy > y + h THEN LOOP;
RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END;

-- Saving the whiteboard in the data base --

Save: PUBLIC PROCEDURE[v: Viewer] =
BEGIN
cRS: Relship;
rs: RelshipSet;
wb: Entity ← Whiteboard.FetchEntity[v];
IF wb # NIL THEN SetName[wb, GetWBName[v]]
ELSE wb ← DeclareEntity[WBEntity, GetWBName[v]];
[] ← v.class.scroll[v, thumb, 0];
-- eliminate all relations
rs ← RelationSubset[container, LIST[[containerIs, wb]]];
WHILE (cRS ← NextRelship[rs]) # NIL DO
DestroyRelship[cRS];
ENDLOOP;
ReleaseRelshipSet[rs];
-- recreate them
[]← SetP[wb, showLines, B2V[ViewerOps.FetchProp[v, $ShowLines] # NIL]];
FOR child: Viewer ← v.child, child.sibling WHILE child # NIL DO
IF child.class.flavor = $Text
THEN [] ← StoreNoteEntity[wb, child]
ELSE [] ← StoreIconEntity[wb, child];
child.newVersion ← FALSE;
ENDLOOP;
-- now destroy all the entities that have been deleted
{ entityList: LIST OF REF ANY = NARROW[ ViewerOps.FetchProp[v, $destroyList] ];
FOR el: LIST OF REF ANY ← entityList, el.rest UNTIL el = NIL DO
entity: DB.Entity = DB.V2E[el.first];
IF NOT DB.Null[entity] THEN DB.DestroyEntity[entity]
ENDLOOP };
ViewerOps.AddProp[ v, $destroyList, NIL ];
v.newVersion ← FALSE;
ViewerOps.PaintViewer[v, caption];
IF TransactionOf[$Squirrel] # NIL THEN
MarkTransaction[TransactionOf[$Squirrel]];
END;

StoreNoteEntity: PUBLIC PROCEDURE[wb: Entity, v: Viewer] RETURNS[note: Entity] =
BEGIN
cRS: Relship;
text: ViewerTools.TiogaContents;
note ← Whiteboard.FetchEntity[v];
IF note = NIL THEN note ← DeclareEntity[Note];
cRS ← GetContainerRS[wb, note];
SetValues[cRS, v.wx, v.wy, v.ww, v.wh];
text ← ViewerTools.GetTiogaContents[v];
[]← SetP[note, contents, text.contents];
[]← SetP[note, format, text.formatting];
Whiteboard.StoreEntity[v, note];
END;

StoreIconEntity: PROCEDURE[wb: Entity, icon: Viewer] RETURNS[entity: Entity] =
BEGIN
cRS: Relship;
eName: ROPE = DB.V2S[ViewerOps.FetchProp[icon, $Entity]];
iconName: ROPE = DB.V2S[ViewerOps.FetchProp[icon, $IconName]];
iconViewer: Viewer = NARROW[ icon.data, Viewer ];
entity ← DeclareEntity[Icon, iconName];
IF entity = NIL THEN RETURN;
cRS ← GetContainerRS[wb, entity];
SetValues[cRS, icon.wx, icon.wy, icon.ww, icon.wy];
[] ← SetP[entity, entityName, eName];
IF iconViewer # NIL THEN
[] ← SetP[entity, iconLabel, DB.V2S[ViewerOps.FetchProp[iconViewer, $IconLabel]]]
END;

WBEntityForViewer: PUBLIC PROC[v: Viewer] RETURNS[ e: Entity ] = {
IF v.class.flavor = $Text THEN e ← Whiteboard.FetchEntity[v]
ELSE e ← DeclareEntity[Icon, V2S[ViewerOps.FetchProp[v, $IconName]], OldOnly] };

ConvertIcon: PUBLIC PROCEDURE[icon: Viewer] RETURNS[e: Entity] =
BEGIN
v: Viewer;
-- retrieve the cached entity
e ← Whiteboard.FetchEntity[icon];
IF e # NIL THEN RETURN[e];
-- determine the entity and cache it
v ← NARROW[icon.data];
IF v = NIL OR v.destroyed THEN RETURN[NIL];
e ← NutViewer.ConvertViewerToEntity[v].e;
IF e = NIL THEN RETURN[NIL];
Whiteboard.StoreEntity[icon, e];
END;

-- ************************************************************
-- Database initialization
-- ************************************************************

WBSegment: PUBLIC ROPE;

readOnly: PUBLIC BOOL;

doingRestart: BOOLEAN ← FALSE;

TextViewer: PUBLIC Domain;

ToolViewer: PUBLIC Domain;

LoadInstructions: PUBLIC Relation;
viewerPattern: PUBLIC Attribute; -- how to go from the viewer to the tool
instructions: PUBLIC Attribute; -- instructions to be passed to the commander after running
implementor: PUBLIC Attribute; -- an implementor of a tool is a BCD

BCD: PUBLIC Domain;

WBEntity: Domain;

WBItem: Domain; -- the supertype of Icon and Note (what can be put on a whiteboard)

Note: Entity;
contents: Attribute; -- a property of a note
format: Attribute; -- another property of a note

Icon: Entity;
entityName: Attribute; -- a property of an icon (the name of its associated DB entity)
iconLabel: Attribute;

showLines: Attribute;
container: Relation; -- RECORD[is: Whiteboard, of: ANY, x, y, w, h: INTEGER]
containerIs: Attribute;
containerOf: Attribute;
containerX: Attribute;
containerY: Attribute;
containerW: Attribute;
containerH: Attribute;

InitializeSchema: PUBLIC PROC[segName: ROPE ← NIL] RETURNS[ success: BOOL ← TRUE ] =
BEGIN readOnly: BOOLEAN;
DB.Initialize[nCachePages: UserProfile.Number["DB.nCachePages", 256] ];
[success, segName] ← SquirrelDeclared[];
IF success THEN
IF WBSegment # NIL AND NOT Rope.Equal[WBSegment, segName] THEN
{ success ← FALSE; RETURN } -- something messed up here; old WB segment not right
ELSE WBSegment ← segName
ELSE
IF segName = NIL THEN SELECT TRUE FROM
WBSegment # NIL => segName ← WBSegment; -- use the one previously opened
ENDCASE => segName ← UserProfile.Token[key: "Squirrel.Segment",
          default: "[Luther.Alpine]<CedarDoc>Squirrel.segment"];
[success, readOnly] ← NutOps.SetUpSegment[ segmentFile: segName, seg: $Squirrel ];
IF NOT success THEN {NutViewer.Error[NIL, "Can't open transaction!"]; RETURN};
WBSegment ← segName;
Whiteboard.readOnly ← readOnly;

Note ← DeclareDomain["Note", $Squirrel];
Icon ← DeclareDomain["WBIcon", $Squirrel];

WBItem ← DeclareDomain["WBItems", $Squirrel];
DB.DeclareSubType[of: WBItem, is: Note];
DB.DeclareSubType[of: WBItem, is: Icon];

ToolViewer ← DeclareDomain["ToolViewer", $Squirrel];
instructions ← DeclareProperty["instructions", ToolViewer, RopeType, $Squirrel];

TextViewer ← DeclareDomain["TextViewer", $Squirrel];
WBEntity ← DeclareDomain["Whiteboard", $Squirrel];

contents ← DeclareProperty["contents", Note, RopeType, $Squirrel];
format ← DeclareProperty["format", Note, RopeType, $Squirrel];

entityName ← DeclareProperty["entity", Icon, RopeType, $Squirrel];
iconLabel ← DeclareProperty["label", Icon, RopeType, $Squirrel];

-- for whiteboards
showLines ← DeclareProperty["showLines", WBEntity, BoolType, $Squirrel];
container ← DeclareRelation["container", $Squirrel];
containerIs ← DeclareAttribute[container, "is", WBEntity];
containerOf ← DeclareAttribute[container, "of", WBItem];
containerX ← DeclareAttribute[container, "x", IntType];
containerY ← DeclareAttribute[container, "y", IntType];
containerW ← DeclareAttribute[container, "w", IntType];
containerH ← DeclareAttribute[container, "h", IntType];
END;

NullDisplay: Nut.DisplayProc = {};
NullQuery: Nut.QueryProc = {};
NullEdit: Nut.EditProc = {};

SquirrelDeclared: PROC[] RETURNS[ found: BOOL ← FALSE, file: ROPE ← NIL ] = {
FOR sl: LIST OF DB.Segment ← DB.GetSegments[], sl.rest UNTIL sl = NIL DO
IF sl.first = $Squirrel THEN
{ found ← TRUE; file ← DB.GetSegmentInfo[$Squirrel].filePath; RETURN }
ENDLOOP };

ResetTransaction: Nut.TransactionProc =
{ IF type # close THEN
TRUSTED{ WBSegment ← fileName; ResetWhiteboards[NIL] }
ELSE -- take down all the whiteboards
{ DestroyProc: ViewerOps.EnumProc = {
  IF v.class.flavor = $Whiteboard THEN ViewerOps.DestroyViewer[v];
  RETURN[TRUE] };
VirtualDesktops.EnumerateViewers[enum: DestroyProc] } };

RegisterRollBack: PROC[] =
TRUSTED { Booting.RegisterProcs[c: CloseSquirrel, r: ResetWhiteboards] };

CloseSquirrel: Booting.CheckpointProc = {
trans: DB.Transaction = DB.TransactionOf[segment: $Squirrel];
IF trans # NIL THEN DB.CloseTransaction[trans: trans] };

ResetWhiteboards: Booting.RollbackProc = {
opened: BOOL ← FALSE;
InitProc: PROC[ clientData: REF ANY ] = { opened ← InitializeSchema[ ] };
ResetProc: ViewerOps.EnumProc = {
IF v.class.flavor = $Whiteboard THEN
{ IF DB.Null[WBEntity] THEN []← NutOps.Do[InitProc, NIL];
IF opened THEN Reset[v] ELSE ViewerOps.DestroyViewer[v] };
RETURN[TRUE] };
doingRestart ← TRUE;
VirtualDesktops.EnumerateViewers[enum: ResetProc];
doingRestart ← FALSE };

RegisterProcs: PROC[] = {
Commander.Register[
key: "Whiteboard", proc: DisplayIt, doc: "displays the named whiteboard"];
Nut.Register[domain: "Whiteboard", segment: $Squirrel,
   display: DisplayWhiteboard, create: CreateWhiteboard,
   edit: EditWhiteboard, update: Whiteboard.UpdateRelships,
   transaction: ResetTransaction];
  
Nut.Register[domain: NutViewer.TextViewer, segment: $Squirrel,
    create: Whiteboard.CreateTextViewer,
   display: NullDisplay, edit: NullEdit, query: NullQuery];
   
Nut.Register[ domain: NutViewer.ToolViewer, segment: $Squirrel,
     create: Whiteboard.CreateToolViewer, display: NullDisplay,
     edit: NullEdit, query: NullQuery];
};
        
DisplayIt: Commander.CommandProc = {
nonBlankFound: BOOLEAN ← FALSE;
h: IO.STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
displayProc: PROC[ clientData: REF ANY ] = {
name: ROPE = NARROW[clientData];
wb: DB.Entity;
IF DB.Null[WBEntity] THEN IF NOT InitializeSchema[] THEN RETURN;
wb ← DB.DeclareEntity[WBEntity, name, OldOnly];
IF wb = NIL THEN -- Ask whether one should be created
{ okToMakeNew: BOOLEAN = TRUE;
  IF okToMakeNew THEN
  {wb ← DeclareEntity[WBEntity, name, NewOnly];
  msg ← "New Whiteboard created" } };
IF wb # NIL THEN
{v: Viewer = ViewerOps.CreateViewer[ flavor: $Whiteboard, paint: FALSE,
             info: [name: name, iconic: TRUE ] ];
ViewerOps.AddProp[v, $readOnly, NEW[BOOL ← Whiteboard.readOnly]];

DisplayWhiteboard[wb, v] } };
[] ← h.SkipWhitespace[];
name ← h.GetLineRope[];
[]← NutOps.Do[displayProc, name] };

GetContainerRS: PROCEDURE[wb, entity: Entity] RETURNS[cRS: Relship] =
BEGIN
rs: RelshipSet = RelationSubset[container, LIST[[containerOf, entity], [containerIs, wb]]];
cRS ← NextRelship[rs];
IF cRS = NIL THEN {
cRS ← CreateRelship[container];
SetF[cRS, containerIs, wb];
SetF[cRS, containerOf, entity] };
ReleaseRelshipSet[rs];
END;

SetValues: PROCEDURE[cRS: Relship, x, y, w, h: INTEGER] =
BEGIN
SetF[cRS, containerX, I2V[x]];
SetF[cRS, containerY, I2V[y]];
SetF[cRS, containerW, I2V[w]];
SetF[cRS, containerH, I2V[h]];
END;

GetValues: PROCEDURE[cRS: Relship] RETURNS[x, y, w, h: INTEGER] =
BEGIN
x ← V2I[GetF[cRS, containerX]];
y ← V2I[GetF[cRS, containerY]];
w ← V2I[GetF[cRS, containerW]];
h ← V2I[GetF[cRS, containerH]];
END;

CreateWhiteboardClass[]; RegisterRollBack[]; RegisterProcs[]

END..