-- WhiteboardNutImpl.mesa
-- Last edited by
-- Maxwell, October 1, 1982 2:01 pm
-- Willie-Sue, February 22, 1983 4:02 pm
-- Cattell, June 6, 1983 4:21 pm
-- Donahue, June 1, 1983 6:38 pm

DIRECTORY
Ascii USING[ CR, SP ],
CedarSnapshot USING[ Register, CheckpointProc, RollbackProc ],
DB,
DBNames,
Cursors USING [CursorArray, CursorType, NewCursor],
Inline USING [LowHalf],
InputFocus USING [CaptureButtons],
IO USING [STREAM, RIS, GetSequence, CharProc],
MBQueue,
Menus,
Nut,
NutOps,
NutViewer,
Process USING [Detach],
Rope USING [Cat, Equal, Flatten, Index, Length, ROPE],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable],
UserExec USING[ CommandProc, RegisterCommand, Confirm ],
UserProfile USING[ Number, Token ],
ViewerBLT USING[ ChangeNumberOfLines ],
ViewerClasses USING [ModifyProc, NotifyProc, PaintProc,
Viewer, ViewerClass, ViewerClassRec, ViewerRec, ViewerFlavor],
ViewerOps USING [
AddProp, CreateViewer, DestroyViewer, FetchProp, FetchViewerClass,
PaintViewer, RegisterViewerClass, SetMenu, EnumProc],
ViewerTools USING [
GetSelectionContents, GetSelectedViewer, GetTiogaContents,
SetContents, SetTiogaContents, TiogaContents, TiogaContentsRec],
VirtualDesktops USING[ EnumerateViewers ],
Whiteboard USING [
AddIcon, AddTextBox, BinaryProperty, GetBinaryProperties, GrowBox, MoveChild,
NearestChild, OpenIcon, PaintIcon, PaintIconic, PaintRelships, RemoveChild,
ShowLines, UpdateRelships, FetchEntity, StoreEntity, readOnly],
WindowManager USING [WaitCursor, UnWaitCursor];

WhiteboardNutImpl: CEDAR PROGRAM
IMPORTS
CedarSnapshot, Cursors, DB, DBNames, Inline, InputFocus, IO,
MBQueue, Menus, Nut, NutOps, NutViewer, Process, Rope, TIPUser, UserExec,
UserProfile, ViewerBLT, ViewerOps, ViewerTools, VirtualDesktops,
Whiteboard, WindowManager
EXPORTS Whiteboard
SHARES ViewerClasses =
BEGIN
OPEN DB, ViewerClasses, Ascii;

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

-- ************************************************************
-- creation and initialization
-- ************************************************************

CreateWhiteboardClass: PROCEDURE =
BEGIN
tipTable: TIPUser.TIPTable ← TIPUser.InstantiateNewTIPTable["Whiteboard.tip"];
whiteboardClass: ViewerClasses.ViewerClass ← NIL;
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;

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: ViewerClasses.ViewerClass ← NIL;
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;

PaintWhiteboard: ViewerClasses.PaintProc =
BEGIN
IF self.iconic THEN {Whiteboard.PaintIconic[self, context, NIL, TRUE]; RETURN};
PaintContainer[self, context, whatChanged, TRUE];
Whiteboard.PaintRelships[self, context, NIL, TRUE];
END;

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[], "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] } };

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
p: TIPUser.TIPScreenCoords;
FOR list: LIST OF REF ANY ← input, list.rest UNTIL list = NIL DO
WITH list.first SELECT FROM
z: ATOM => InterpAtom[self, z, p];
z: TIPUser.TIPScreenCoords => p ← z;
ENDCASE => SIGNAL WBError;
ENDLOOP;
END;

InterpAtom: PROCEDURE[self: Viewer, atom: ATOM, p: TIPUser.TIPScreenCoords] =
-- Central command interpreter for all mouse button presses in whiteboards.
-- We try to catch all the same signals here that are caught in NutViewerMiscImpl's
-- DBNotifier, too bad this can't be handled by it so don't have to duplicate.
BEGIN
OPEN Whiteboard;
ENABLE BEGIN
DB.Aborted =>
{NutViewer.Message[self,
"Transaction aborted, must re-open (using Squirrel) to continue!"]; CONTINUE};
DB.Aborted => TRUSTED {
MBQueue.Flush[NutViewer.DBQueue[]];
Process.Detach[FORK NutOps.TryRestart[trans]];
CONTINUE};
DB.Error =>
IF code=NullifiedArgument THEN
{NutViewer.Message[self, "Sorry, that entity has been nullified!"]; CONTINUE}
ELSE IF code=TransactionNotOpen THEN
{NutViewer.Message[self, "There is no transaction open!"]; CONTINUE}
END;
flushCursor: BOOLEAN;
parent: Viewer ← IF self.parent = NIL THEN self ELSE self.parent;
readOnly: BOOLEAN = DB.V2B[ViewerOps.FetchProp[ parent, $readOnly ]];
flushCursor ← parent.class.cursor # crossHairsCircle;
SELECT atom FROM
$AddSelected =>
[] ← AddIcon[self, ViewerTools.GetSelectedViewer[], NIL, 100, 100];
$Erase =>
{ IF NOT readOnly THEN
{ DB.DestroyEntity[Whiteboard.FetchEntity[self]];
 ViewerOps.DestroyViewer[self] } };
$Expand => Expand[NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon]];
$Grow => IF parent.class.flavor = $Whiteboard THEN
TRUSTED{ Process.Detach[ FORK
GrowBox[parent, NearestChild[self, p.mouseX, p.mouseY, $Text], p.mouseX, p.mouseY]] };
$Instructions => [] ← NewTextBox[self, 100, 100, TRUE];
$Move => {
child: Viewer;
SELECT parent.class.cursor FROM
textBoxCursor => child ← NewTextBox[parent, p.mouseX, p.mouseY, FALSE];
iconCursor => child ←
  AddIcon[parent, NIL, DeclareEntity[WBEntity], p.mouseX, p.mouseY];
ENDCASE => child ← NearestChild[self, p.mouseX, p.mouseY];
TRUSTED{ Process.Detach[FORK MoveChild[child]]} };
$NewBox => {self.class.cursor ← textBoxCursor;
WindowManager.WaitCursor[textBoxCursor]};
$NewWhiteboard => {self.class.cursor ← iconCursor;
WindowManager.WaitCursor[iconCursor]};
$Open => OpenIcon[NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon]];
$Release => InputFocus.CaptureButtons[NIL, NIL]; -- release control
$Remove => { -- remove icon
child: Viewer ← NearestChild[self, p.mouseX, p.mouseY];
  IF child = NIL THEN RETURN;
  Whiteboard.RemoveChild[child.parent, child];
  parent.newVersion ← TRUE;
  ViewerOps.PaintViewer[parent, caption]};
$Freeze => NutViewer.DefaultFreezeProc[ parent: self ];
$Rename => IF NOT readOnly THEN SetWBName[self, ViewerTools.GetSelectionContents[]];
$ShowLines => Whiteboard.ShowLines[self, ViewerOps.FetchProp[self, $ShowLines] = NIL];
ENDCASE => ERROR;
IF flushCursor THEN {
parent.class.cursor ← crossHairsCircle;
WindowManager.UnWaitCursor[]};
END;

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

NewTextBox: PROCEDURE[self: Viewer, x, y: INTEGER, instructions: BOOLEAN]
RETURNS[child: Viewer] =
BEGIN
OPEN Whiteboard;
IF ~instructions
THEN child ← AddTextBox[self, DeclareEntity[Note], x, y, boxW, boxH]
ELSE {child ← AddTextBox[self, DeclareEntity[Note], x, y, 250, 100];
ViewerTools.SetContents[child, "INSTRUCTIONS:\n RED => move entity\n ctrl RED => delete entity\n YELLOW => open icon\n shift YELLOW => expand icon\n BLUE => 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: FALSE, column: column],
       paint: FALSE];
ViewerOps.AddProp[ viewer, $readOnly, NEW[BOOL ← Whiteboard.readOnly] ];
ViewerOps.SetMenu[viewer, menu, FALSE];
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
entity: Entity = Whiteboard.FetchEntity[wb];
wb.child ← NIL; -- flushes old whiteboard
ViewerOps.AddProp[wb, $LineList, NIL];
ViewerOps.PaintViewer[wb, client];
DisplayWhiteboard[entity, wb];
END;

DisplayWhiteboard: Nut.DisplayProc = -- e: Entity, newV: Viewer --
BEGIN
cRS: Relship;
child: Entity;
rs: RelshipSet;
SetWBName[newV, GetName[e]];
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
childName: ROPE = GetFS[cRS, containerOf];
child ← DBNames.NameToEntity[childName];
IF Null[child] THEN LOOP; -- here need something to handle closed segments
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];
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, FALSE];
Whiteboard.StoreEntity[child, note];
END;

DisplayIconEntity: PROCEDURE[wbViewer: Viewer, icon: Entity, cRS: Relship] =
BEGIN
child: Viewer;
x, y: INTEGER;
[x, y, , ] ← GetValues[cRS];
child ← Whiteboard.AddIcon[wbViewer, NIL, icon, x, y];
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
new: Viewer;
entity: Entity;
x, y: INTEGER;
tooMany: ROPE;
width: INTEGER = 150;
depth, position: INTEGER;
even, all: BOOLEAN ← TRUE;
props: LIST OF Whiteboard.BinaryProperty;
IF icon = NIL THEN RETURN;
entity ← Whiteboard.FetchEntity[icon];
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
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;
-- 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
IF DB.Eq[props.first.of, entity]
THEN new ← Whiteboard.AddIcon[icon.parent, NIL, props.first.is, x, y]
ELSE new ← Whiteboard.AddIcon[icon.parent, NIL, props.first.of, x, y];
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, down, 10000];
-- 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;
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];
-- SetP[note, contents, ViewerTools.GetContents[v]];
-- SetP[note, format, NIL];
Whiteboard.StoreEntity[v, note];
END;

StoreIconEntity: PROCEDURE[wb: Entity, icon: Viewer] RETURNS[entity: Entity] =
BEGIN
cRS: Relship;
entity ← ConvertIcon[icon];
IF entity = NIL THEN RETURN;
cRS ← GetContainerRS[wb, entity];
SetValues[cRS, icon.wx, icon.wy, icon.ww, icon.wy];
END;

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];
IF e = NIL THEN RETURN[NIL];
Whiteboard.StoreEntity[icon, e];
END;

-- ************************************************************
-- data base initialization
-- ************************************************************

WBSegment: ROPE;

readOnly: PUBLIC BOOL;

TextViewer: PUBLIC Domain;

ToolViewer: PUBLIC Domain;
comment: PUBLIC Attribute; -- human readable intstuctions
loadError: PUBLIC Attribute; -- load error is set if tool can't be loaded
implementor: PUBLIC Attribute; -- an implementor of a tool is a BCD

BCD: PUBLIC Domain;

WBEntity: Domain;

Note: Entity;
contents: Attribute;
format: Attribute;

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

InitializeSchema: PUBLIC PROC[ segName: ROPE ← NIL, readOnly: BOOL ← TRUE ] =
BEGIN
DB.Initialize[nCachePages: UserProfile.Number["DB.nCachePages", 256] ];
IF segName = NIL THEN
IF WBSegment # NIL THEN segName ← WBSegment
ELSE
segName ← UserProfile.Token[key:"Squirrel.Segment", default: "[Local]Squirrel.segment"];
IF NutOps.AtomFromSegment[segName] # $Squirrel THEN RETURN;
IF NutOps.IsLocalName[segName] THEN readOnly ← FALSE; -- ignore it for local files
IF SquirrelDeclared[] AND DB.TransactionOf[segment: $Squirrel] # NIL
THEN DB.CloseTransaction[trans: DB.TransactionOf[segment: $Squirrel]];
NutOps.SetUpSegment[ segmentFile: segName, seg: $Squirrel, readOnly: readOnly ];
WBSegment ← segName;
Whiteboard.readOnly ← readOnly;
Note ← DeclareDomain["Note", $Squirrel];

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

contents ← DeclareProperty["contents", Note, StringType, $Squirrel];
format ← DeclareProperty["format", Note, StringType, $Squirrel];
-- for whiteboards
showLines ← DeclareProperty["showLines", WBEntity, BoolType, $Squirrel];
container ← DeclareRelation["container", $Squirrel];
containerIs ← DeclareAttribute[container, "is", WBEntity];
containerOf ← DeclareAttribute[container, "of", StringType];
containerX ← DeclareAttribute[container, "x", IntType];
containerY ← DeclareAttribute[container, "y", IntType];
containerW ← DeclareAttribute[container, "w", IntType];
containerH ← DeclareAttribute[container, "h", IntType];
NutViewer.SetIcon[WBEntity, "Nut.icons", 15];

BCD ← DeclareDomain["BCD", $Squirrel]; -- initialize the tool/text part too
comment ← DeclareProperty["comment", ToolViewer, StringType, $Squirrel];
loadError ← DeclareProperty["loadError", ToolViewer, StringType, $Squirrel];
implementor ← DeclareProperty["implementor", ToolViewer, BCD, $Squirrel];

Nut.Register[domain: "Whiteboard", segment: $Squirrel,
   display: DisplayWhiteboard, create: CreateWhiteboard,
   edit: EditWhiteboard, update: Whiteboard.UpdateRelships];

END;

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

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

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

ResetWhiteboards: CedarSnapshot.RollbackProc = {
whiteboardClass: ViewerClasses.ViewerClass = ViewerOps.FetchViewerClass[$Whiteboard];
ResetProc: ViewerOps.EnumProc = {
IF v.class = whiteboardClass THEN Reset[v]; RETURN[TRUE] };
InitializeSchema[ WBSegment, Whiteboard.readOnly];
VirtualDesktops.EnumerateViewers[enum: ResetProc] };

RegisterCommandProcs: PROC[] = {
UserExec.RegisterCommand[name: "Whiteboard", proc: displayIt,
         briefDoc: "displays the named whiteboard"] };
        
displayIt: UserExec.CommandProc = {
nonBlankFound: BOOLEAN ← FALSE;
h: IO.STREAM = IO.RIS[event.commandLine];
name: ROPE = h.GetSequence[noLeadingBlanks];
wb: DB.Entity ← DB.DeclareEntity[WBEntity, name, OldOnly];
noLeadingBlanks: IO.CharProc = CHECKED{
atEnd: BOOLEAN = char = CR;
IF char # SP AND NOT nonBlankFound THEN nonBlankFound ← TRUE;
RETURN[ atEnd, nonBlankFound AND NOT atEnd ] };
IF wb = NIL THEN -- ask whether one should be created
{ okToMakeNew: BOOLEAN =
  UserExec.Confirm[msg: Rope.Cat["Whiteboard ", name, " does not exist; OK to create one"],
       exec: exec];
 IF okToMakeNew THEN wb ← DeclareEntity[WBEntity, name, NewOnly] };
IF wb # NIL THEN
{ v: Viewer = ViewerOps.CreateViewer[ flavor: $Whiteboard,
             info: [name: name, iconic: FALSE ] ];
ViewerOps.SetMenu[v, menu];
ViewerOps.AddProp[v, $readOnly, NEW[BOOL ← Whiteboard.readOnly]];
DisplayWhiteboard[wb, v] } };

OpenSegment: PUBLIC PROC[ fileName: ROPE, readOnly: BOOL ← TRUE ] = {
whiteboardClass: ViewerClasses.ViewerClass = ViewerOps.FetchViewerClass[$Whiteboard];
DestroyProc: ViewerOps.EnumProc = {
IF v.class = whiteboardClass THEN ViewerOps.DestroyViewer[viewer: v]; RETURN[TRUE] };
IF NOT Rope.Equal[fileName, WBSegment] THEN
{ VirtualDesktops.EnumerateViewers[enum: DestroyProc];
  InitializeSchema[fileName, readOnly] } };

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

SetValues: PROCEDURE[cRS: Relship, x, y, w, h: INTEGER] =
INLINE 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] =
INLINE BEGIN
x ← Inline.LowHalf[V2I[GetF[cRS, containerX]]];
y ← Inline.LowHalf[V2I[GetF[cRS, containerY]]];
w ← Inline.LowHalf[V2I[GetF[cRS, containerW]]];
h ← Inline.LowHalf[V2I[GetF[cRS, containerH]]];
END;

CreateWhiteboardClass[]; InitializeSchema[]; RegisterRollBack[]; RegisterCommandProcs[]

END..