-- 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 = { locked _ TRUE; IF Rope.Equal[DBNames.EntityToName[Whiteboard.FetchEntity[v]], 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 Entity = NARROW[ ViewerOps.FetchProp[v, $destroyList] ]; FOR el: LIST OF Entity _ entityList, el.rest UNTIL el = NIL DO IF NOT DB.Null[el.first] THEN DB.DestroyEntity[el.first] 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]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.. <<>> <<>>