-- WhiteboardImpl.mesa -- last edited by: -- John Maxwell on: September 22, 1982 12:19 pm -- Willie-Sue on: February 22, 1983 4:19 pm -- Cattell on: April 21, 1983 4:02 pm -- Donahue, August 15, 1983 1:31 pm DIRECTORY Atom, DB, CommandTool USING[ConvertToSlashFormat], DBNames, DBIcons USING[GetIcon], Graphics, Icons USING [DrawIcon, IconFlavor], IconManager USING [selectedIcon], Interminal, InputFocus, Keys, KeyboardFace USING[DownUp], Nut USING [ Display, UpdateProc], NutOps USING[ EntityValued, GetRelation ], NutViewer USING[ConvertViewerToEntity, GetIconFromName, GetNutInfo], Process USING[ Detach ], Rope USING [Equal, Flatten, Find, Substr, Length, ROPE], AMTypes USING [TV], SafeStorage USING [NarrowRefFault], Terminal, VFonts USING [EstablishFont, GraphicsFont], ViewerClasses USING [ PaintProc, Viewer, ViewerClass, ViewerRec, ViewerFlavor], ViewerEvents, ViewerLocks USING [CallUnderWriteLock], ViewerOps, ViewerTools USING [MakeNewTextViewer], VirtualDesktops USING[ EnumerateViewers ], Whiteboard; WhiteboardImpl: CEDAR PROGRAM IMPORTS Atom, CommandTool, DB, DBNames, DBIcons, Graphics, Icons, Nut, NutOps, NutViewer, Rope, SafeStorage, VFonts, ViewerOps, ViewerTools, VirtualDesktops, Whiteboard, ViewerLocks, ViewerEvents, Process, IconManager, Terminal, InputFocus, Interminal EXPORTS Whiteboard SHARES ViewerOps = BEGIN OPEN DB, ViewerClasses, Whiteboard; ROPE: TYPE = Rope.ROPE; TV: TYPE = AMTypes.TV; WBError: SIGNAL = CODE; --************************************************ -- painting procedures --************************************************ h: INTEGER _ 620; w: INTEGER _ 30; Line: TYPE = RECORD[of, is: Viewer, name: ROPE]; GetLines: PROC[v: Viewer] RETURNS[LIST OF Line] = INLINE { RETURN[NARROW[ViewerOps.FetchProp[v, $LineList]]]}; SetLines: PROC[v: Viewer, lines: LIST OF Line] = INLINE { ViewerOps.AddProp[v, $LineList, lines]}; PaintRelships: PUBLIC ViewerClasses.PaintProc = BEGIN lines: LIST OF Line _ GetLines[self]; FOR lines _ lines, lines.rest WHILE lines # NIL DO IF lines.first.is = NIL OR lines.first.is.destroyed THEN LOOP; IF lines.first.of = NIL OR lines.first.of.destroyed THEN LOOP; IF lines.first.of = lines.first.is THEN LOOP; DrawLine[context, lines.first.of, lines.first.is, lines.first.name]; ENDLOOP; END; a: INTEGER _ 8; DrawLine: PROCEDURE[context: Graphics.Context, from, to: Viewer, name: ROPE] = BEGIN x1, x2, y1, y2: INTEGER; [x1, y1] _ Clip[from.wx+32, from.wy+32, to.wx+32, to.wy+32, 32]; [x2, y2] _ Clip[to.wx+32, to.wy+32, from.wx+32, from.wy+32, 32]; -- draw line Graphics.SetCP[context, x1, y1]; Graphics.DrawTo[context, x2, y2]; -- draw arrow Graphics.SetCP[context, x2-3, y2-3]; Graphics.DrawRope[context, "o"]; -- draw label Graphics.SetCP[context, (x1 + x2 - 20)/2, (y1 + y2)/2]; Graphics.Scale[context, 1, -1]; Graphics.DrawRope[context, name]; Graphics.Scale[context, 1, -1]; END; Clip: PROCEDURE[x1, y1, x2, y2, w: INTEGER] RETURNS[newX, newY: INTEGER] = BEGIN left: BOOLEAN; -- is (x2, y2) above the left diagonal? (\) right: BOOLEAN; -- is (x2, y2) above the right diagonal? (/) -- figure out which edge it intersects left _ (x2-x1) > -(y2-y1); right _ (x2-x1) < (y2-y1); IF left = right THEN { -- top or bottom edge newY _ y1 + (IF left THEN w ELSE -w); newX _ x1 + ((x2-x1)*(newY-y1))/(y2-y1)} -- think of it as: x1 + (dx times y%) ELSE { -- left or right edge newX _ x1 + (IF left THEN w ELSE -w); newY _ y1 + ((y2-y1)*(newX-x1))/(x2-x1)}; END; PaintIconic: PUBLIC ViewerClasses.PaintProc = BEGIN mark: Graphics.Mark = Graphics.Save[context]; IF ~self.newVersion THEN FOR child: Viewer _ self.child, child.sibling WHILE child # NIL DO IF child.newVersion THEN {self.newVersion _ TRUE; EXIT}; ENDLOOP; IF ~self.iconic THEN SIGNAL WBError; IF self.newVersion THEN Icons.DrawIcon[DirtyWBicon, context, 0, 0, Strip[self.name]] ELSE Icons.DrawIcon[WBicon, context, 0, 0, Strip[self.name]]; IF IconManager.selectedIcon = self THEN { Graphics.Restore[context, mark]; [] _ Graphics.SetPaintMode[context, invert]; Graphics.DrawBox[context, [0, 0, 64, 64]]; -- now set the context back to it's original value Graphics.Restore[context, mark] } END; DrawRectangle: PROCEDURE[context: Graphics.Context, x1, y1, x2, y2: REAL] = BEGIN path: Graphics.Path; path _ Graphics.NewPath[4]; Graphics.Rectangle[path, x1, y1, x2, y2]; Graphics.DrawStroke[self: context, path: path, closed: TRUE]; END; Strip: PROCEDURE[name: ROPE] RETURNS[ROPE] = INLINE BEGIN pos: INT; IF name = NIL THEN RETURN[NIL]; IF (pos _ name.Find[":"]) > 0 THEN RETURN[name.Flatten[pos+2, name.Length[]]] ELSE RETURN[name]; END; ShortName: PUBLIC PROC[name: ROPE] RETURNS[suffix: ROPE] = { -- strip off leading server/directory information i, j: INT; name _ CommandTool.ConvertToSlashFormat[name]; IF (i _ Rope.Find[name, "/"]) # -1 THEN { UNTIL (j _ Rope.Find[s1: name, s2: "/", pos1: i + 1]) = -1 DO i _ j ENDLOOP; suffix _ Rope.Substr[base: name, start: i + 1] } ELSE suffix _ name }; PaintIcon: PUBLIC ViewerClasses.PaintProc = BEGIN name: ROPE _ self.name; domainName: ROPE; viewer: Viewer; iconRef: REF Icons.IconFlavor _ NARROW[ViewerOps.FetchProp[self, $IconFlavor]]; icon: Icons.IconFlavor _ IF iconRef = NIL THEN unInit ELSE iconRef^; screenGrey: CARDINAL = 104042B; mark: Graphics.Mark = Graphics.Save[context]; viewer _ NARROW[self.data, Viewer]; IF viewer # NIL AND viewer.destroyed THEN {self.data _ viewer _ NIL}; IF viewer = NIL AND iconRef = NIL THEN { -- no hope to Graphics.SetStipple[context, screenGrey]; Graphics.DrawBox[context, [0, 0, 64, 64]]; RETURN}; IF name = NIL THEN -- try to find a nice name to print on the icon { name _ NARROW[ViewerOps.FetchProp[self, $IconLabel]]; -- try it's iconLabel first IF viewer#NIL AND Rope.Equal[name,""] THEN -- try label of Viewer attached name _ NARROW[ViewerOps.FetchProp[viewer, $IconLabel], ROPE]; IF Rope.Equal[name,""] THEN -- still no luck; use the DB entity name { name _ NARROW[ViewerOps.FetchProp[self, $Entity]]; IF name # NIL THEN { segName, entityName, domainName: ROPE; [segName, domainName, entityName] _ DBNames.DecomposeName[name]; IF Rope.Equal[domainName, "TextViewer"] THEN name _ ShortName [entityName] ELSE name _ entityName } } ELSE IF viewer # NIL THEN name _ viewer.name; self.name _ name }; -- paint the icon SELECT TRUE FROM icon = private AND viewer # NIL => { -- private icon oldClass: ViewerClasses.ViewerClass = self.class; oldIcon: Icons.IconFlavor = self.icon; oldIconic: BOOLEAN = self.iconic; oldData: REF ANY = self.data; self.class _ viewer.class; self.icon _ viewer.icon; self.data _ viewer.data; self.iconic _ TRUE; -- convince it that it's an icon self.class.paint[self, context, NIL, TRUE]; -- paint it self.class _ oldClass; self.icon _ oldIcon; self.data _ oldData; self.iconic _ oldIconic}; icon = private AND Rope.Equal[domainName, "Whiteboard"] => Icons.DrawIcon[WBicon, context, 0, 0, name]; icon = private => { DrawRectangle[context, 0, 1, 62, 61]; Graphics.SetCP[context, 4, 40]; IF name # NIL THEN Graphics.DrawRope[self: context, rope: name, font: iconFont] }; ENDCASE => Icons.DrawIcon[icon, context, 0, 0, name]; IF self.spare0 THEN -- this icon has been inverted by OpenIcon; keep it that way { -- reset the context (which may have been changed by DrawIcon) Graphics.Restore[context, mark]; [] _ Graphics.SetPaintMode[context, invert]; Graphics.DrawBox[context, [0, 0, 64, 64]] }; END; --************************************************ -- child addition/deletion procedures -- --************************************************ -- the AddTextBox and AddIcon procedures DO NOT paint the viewers they create AddTextBox: PUBLIC PROC[wb: Viewer, e: Entity, x, y, w, h: INTEGER] RETURNS[child: Viewer] = BEGIN grid: NAT = GetGrid[wb]; MakeChild: PROC[] = { child _ ViewerTools.MakeNewTextViewer[paint: FALSE, info: [parent: wb, wx: 0, wy: 0, ww: 800, wh: 800]]; ViewerOps.MoveViewer[child, x-(x MOD grid), y-(y MOD grid), w-(w MOD grid), h-(h MOD grid), FALSE] }; registration: ViewerEvents.EventRegistration; ViewerLocks.CallUnderWriteLock[MakeChild, wb]; wb.newVersion _ TRUE; IF NOT DB.Null[e] THEN StoreEntity[child, e]; -- if e = NIL, not necessary -- Note: we are assuming that there is no sharing among textBox entities; -- thus, there is no attempt to add lines between textboxes or any check to see -- if the box is already on the whiteboard (it can't be!!) registration _ ViewerEvents.RegisterEventProc[ SetNew, edit, child ]; ViewerOps.AddProp[ child, $registration, registration ] END; SetNew: ViewerEvents.EventProc = { viewer.parent.newVersion _ TRUE; TRUSTED {Process.Detach[FORK ViewerOps.PaintViewer[viewer: viewer.parent, hint: caption]]}}; AddIcon: PUBLIC PROC[wb, viewer: Viewer, name: ROPE, x, y: INTEGER] RETURNS[child: Viewer] = -- AddIcon works just like AddTextBox; it just adds the icon entity to the whiteboard -- (the name is the name of the associated DB entity and is used if the viewer is NIL) BEGIN OPEN ViewerOps; iconEntity: DB.Entity; icon: Icons.IconFlavor _ unInit; seg: DB.Segment; grid: NAT = GetGrid[wb]; IF viewer = NIL THEN iconEntity _ DBNames.NameToEntity[name] ELSE { WHILE viewer.parent # NIL DO viewer _ viewer.parent; ENDLOOP; -- convert the viewer supplied to a DB entity [iconEntity, name] _ NutViewer.ConvertViewerToEntity[viewer]; [seg,,] _ NutViewer.GetNutInfo[viewer] }; -- add the icon IF name = NIL THEN RETURN; -- nothing we can do here child _ CreateViewer[flavor: $WhiteboardIcon, paint: FALSE, info: [ parent: wb, wx: x - (x MOD grid), wy: y - (y MOD grid), wh: 64, ww: 64, border: FALSE, scrollable: FALSE]]; child.data _ viewer; StoreEntity[child, iconEntity, seg, name]; -- now find the icon for the viewer {toolInfo: REF Whiteboard.ToolInfo = IF viewer = NIL THEN NIL ELSE NARROW[ViewerOps.FetchProp[viewer, $ToolInfo]]; iconAtom: ATOM = IF toolInfo = NIL THEN NIL ELSE toolInfo.icon; iconName: ROPE = IF iconAtom = NIL THEN NIL ELSE Atom.GetPName[iconAtom]; IF iconName.Length[] # 0 THEN icon _ DBIcons.GetIcon[iconName, Icons.IconFlavor[tool]] ELSE IF viewer # NIL AND viewer.icon = private THEN icon _ private ELSE icon _ NutViewer.GetIconFromName[name] }; ViewerOps.AddProp[child, $IconFlavor, NEW[Icons.IconFlavor _ icon]]; wb.newVersion _ TRUE; [] _ AddAllLines[wb, child]; END; GetGrid: PUBLIC PROC[ wb: Viewer ] RETURNS[ grid: NAT ] = { gridSize: REF NAT = NARROW[ViewerOps.FetchProp[wb, $gridSize]]; RETURN[ IF gridSize = NIL THEN 1 ELSE gridSize^ ] }; SetGrid: PUBLIC PROC[ wb: Viewer, grid: NAT ] = { gridSize: REF NAT = NARROW[ViewerOps.FetchProp[wb, $gridSize]]; IF gridSize = NIL THEN ViewerOps.AddProp[wb, $gridSize, NEW[NAT _ grid]] ELSE gridSize^ _ grid }; OpenIcon: PUBLIC PROCEDURE[icon: Viewer] = BEGIN ENABLE UNWIND => icon.spare0 _ FALSE; viewer: Viewer; e: Entity; IF icon = NIL THEN RETURN; -- invert the icon first to give information on when display complete ViewerOps.InvertForMenus[icon, 0, icon.wy, icon.ww, icon.wh]; icon.spare0 _ TRUE; -- remember that the viewer is inverted viewer _ NARROW[icon.data, Viewer]; IF viewer # NIL AND viewer.destroyed THEN {icon.data _ viewer _ NIL}; IF viewer = NIL THEN e _ FetchEntity[icon]; --! IF e # NIL THEN icon.data _ viewer _ Whiteboard.FindViewer[e]; SELECT TRUE FROM viewer = NIL => IF e # NIL THEN { dontSpawn: BOOLEAN = DB.Eq[DB.DomainOf[e], Whiteboard.TextViewer] OR DB.Eq[DB.DomainOf[e], Whiteboard.ToolViewer]; icon.data _ Nut.Display[e: e, parent: icon.parent, method: IF dontSpawn THEN oneOnly ELSE spawned] }; viewer.iconic => ViewerOps.OpenIcon[viewer]; ENDCASE => ViewerOps.PaintViewer[viewer, all]; -- now repaint the icon that was inverted when this got started IF NOT icon.destroyed THEN ViewerOps.InvertForMenus[icon, 0, icon.wy, icon.ww, icon.wh]; icon.spare0 _ FALSE -- reset the inverted bit (checked by PaintIconic) END; RemoveChild: PUBLIC PROC[wb, child: Viewer] = BEGIN relships, last: LIST OF Line; destroyList: LIST OF REF ANY _ NARROW[ ViewerOps.FetchProp[wb, $destroyList] ]; entity: Entity = Whiteboard.WBEntityForViewer[child]; relships _ GetLines[wb]; FOR lines: LIST OF Line _ relships, lines.rest WHILE lines # NIL DO IF lines.first.of # child AND lines.first.is # child THEN {last _ lines; LOOP}; IF last = NIL THEN relships _ relships.rest ELSE last.rest _ lines.rest; ENDLOOP; SetLines[wb, relships]; ViewerOps.DestroyViewer[child]; IF NOT DB.Null[entity] THEN IF destroyList = NIL THEN ViewerOps.AddProp[wb, $destroyList, LIST[entity]] ELSE ViewerOps.AddProp[ wb, $destroyList, destroyList _ CONS[entity, destroyList] ] END; --************************************************ -- relship addition/deletion --************************************************ ShowLines: PUBLIC PROCEDURE[wb: Viewer, show: BOOLEAN] = BEGIN entities: LIST OF Whiteboard.Pair; changes: BOOLEAN _ FALSE; entities _ GetEntities[wb]; -- reset the world SetLines[wb, NIL]; ViewerOps.AddProp[wb, $ShowLines, IF show THEN $Yes ELSE NIL]; -- reconstruct the lines IF show THEN FOR entities _ entities, entities.rest WHILE entities # NIL DO changes _ AddAllLines[wb, entities.first.v] OR changes ENDLOOP; IF changes THEN ViewerOps.PaintViewer[wb, client] END; AddAllLines: PROCEDURE[wb, child: Viewer] RETURNS[ changed: BOOLEAN ] = BEGIN entity: Entity; lines: LIST OF Line; entities: LIST OF Whiteboard.Pair; props: LIST OF Whiteboard.BinaryProperty; IF ViewerOps.FetchProp[wb, $ShowLines] = NIL THEN RETURN[FALSE]; changed _ FALSE; lines _ GetLines[wb]; entities _ GetEntities[wb, FALSE]; entity _ FetchEntity[child]; props _ GetBinaryProperties[entity]; FOR props _ props, props.rest WHILE props # NIL DO new: BOOLEAN; [lines, new] _ AddLine[lines, entities, props.first]; changed _ changed OR new; ENDLOOP; SetLines[wb, lines]; END; AddLine: PROCEDURE[lines: LIST OF Line, entities: LIST OF Whiteboard.Pair, prop: BinaryProperty] RETURNS[LIST OF Line, BOOLEAN]= BEGIN -- convert property to line line: Line _ ConvertProperty[lines, entities, prop]; IF line.is = NIL OR line.of = NIL THEN { RETURN[lines, FALSE] }; -- add new line to list FOR list: LIST OF Line _ lines, list.rest WHILE list # NIL DO IF list.first.of # line.of OR list.first.is # line.is THEN LOOP; IF Rope.Equal[list.first.name, line.name] THEN RETURN[lines, TRUE]; ENDLOOP; lines _ CONS[line, lines]; RETURN[lines, TRUE]; END; ConvertProperty: PROC[lines: LIST OF Line, entities: LIST OF Whiteboard.Pair, prop: BinaryProperty] RETURNS[line: Line] = BEGIN line _ [NIL, NIL, prop.name]; FOR pairs: LIST OF Whiteboard.Pair _ entities, pairs.rest WHILE pairs # NIL DO IF line.is # NIL AND line.of # NIL THEN EXIT; IF Eq[prop.is, pairs.first.e] THEN line.is _ pairs.first.v; IF Eq[prop.of, pairs.first.e] THEN line.of _ pairs.first.v; ENDLOOP; END; -- relship changes in data base -- UpdateRelships: PUBLIC Nut.UpdateProc = BEGIN prop: BinaryProperty; UpdateWhiteboard: ViewerOps.EnumProc = BEGIN found: BOOLEAN; lines: LIST OF Line; entities: LIST OF Whiteboard.Pair; IF v = NIL OR v.destroyed THEN RETURN[TRUE]; IF v.class.flavor # $Whiteboard THEN RETURN[TRUE]; lines _ GetLines[v]; entities _ GetEntities[v]; SELECT updateType FROM create => { [lines, found] _ AddLine[lines, entities, prop]; IF ~found THEN RETURN[TRUE]}; destroy => { last: LIST OF Line; line: Line _ ConvertProperty[lines, entities, prop]; IF line.is = NIL OR line.of = NIL THEN RETURN[TRUE]; -- remove line from list FOR list: LIST OF Line _ lines, list.rest WHILE list # NIL DO IF list.first.is # line.is THEN {last _ list; LOOP}; IF list.first.of # line.of THEN {last _ list; LOOP}; IF ~Rope.Equal[list.first.name, line.name] THEN {last _ list; LOOP}; IF last = NIL THEN lines _ lines.rest ELSE last.rest _ list.rest; ENDLOOP}; ENDCASE => ERROR; -- show the change SetLines[v, lines]; ViewerOps.PaintViewer[v, all]; RETURN[TRUE]; END; prop _ ConvertRelship[tuple]; IF prop.name = NIL THEN RETURN; VirtualDesktops.EnumerateViewers[UpdateWhiteboard]; END; ConvertRelship: PROCEDURE[relship: Relship] RETURNS[prop: BinaryProperty] = BEGIN ENABLE DB.Error, SafeStorage.NarrowRefFault => CHECKED{ CONTINUE }; of, is: Attribute; relation: Relation; prop _ [NIL, NIL, NIL]; relation _ RelationOf[relship]; of _ DeclareAttribute[r: relation, name: "of", version: OldOnly]; is _ DeclareAttribute[r: relation, name: "is", version: OldOnly]; prop.of _ V2E[GetF[relship, of]]; prop.is _ V2E[GetF[relship, is]]; prop.name _ GetName[relation]; END; -- utility routines -- GetEntities: PUBLIC PROCEDURE[wb: Viewer, text: BOOL _ TRUE] RETURNS[entities: LIST OF Whiteboard.Pair] = BEGIN -- make up a list of entities on the whiteboard GetEntity2: ViewerOps.EnumProc = { iconEntity: DB.Entity; IF v.class.flavor = $Text AND NOT text THEN RETURN[TRUE]; iconEntity _ Whiteboard.FetchEntity[v]; IF iconEntity # NIL THEN entities _ CONS[ [iconEntity, v], entities ]; RETURN[TRUE]}; ViewerOps.EnumerateChildren[wb, GetEntity2]; END; GetBinaryProperties: PUBLIC PROC[e: Entity] RETURNS[list: LIST OF Whiteboard.BinaryProperty] = BEGIN rs: RelshipSet; relship: Relship; is, of: Attribute; flag: BOOLEAN; relation: Relation; name, relationName: ROPE; attributes: LIST OF Attribute; -- enumerate all of the neighbors of the child's entity attributes _ GetAllRefAttributes[e]; FOR attributes _ attributes, attributes.rest WHILE attributes # NIL DO IF attributes.first = NIL THEN LOOP; name _ GetName[attributes.first]; relation _ NutOps.GetRelation[attributes.first]; relationName _ GetName[relation]; IF Rope.Equal[relationName, "container"] THEN LOOP; -- find all of the "of-is" relships rs _ RelationSubset[relation, LIST[[attributes.first, e]]]; flag _ FALSE; WHILE ~Null[relship _ NextRelship[rs]] DO ENABLE SafeStorage.NarrowRefFault => LOOP; prop: Whiteboard.BinaryProperty; IF NOT flag THEN { flag _ TRUE; [of, is] _ GetOfIsAttributes[relation, attributes.first]; IF of = NIL OR is = NIL THEN EXIT}; prop.of _ V2E[GetF[relship, of]]; prop.is _ V2E[GetF[relship, is]]; IF prop.of = NIL OR prop.is = NIL THEN LOOP; prop.name _ relationName; list _ CONS[prop, list]; ENDLOOP; ReleaseRelshipSet[rs]; ENDLOOP; END; GetOfIsAttributes: PROC[r: Relation, a: Attribute] RETURNS [of, is: Attribute] = -- Returns the first entity-valued attribute of r other than a; returns NIL if -- there is no other. BEGIN other: Attribute; AIsFirst, entityValued: BOOLEAN _ FALSE; aL: LIST OF Attribute_ VL2EL[GetPList[r, aRelationOf, aRelationIs]]; FOR al1: LIST OF Attribute_ aL, al1.rest UNTIL al1=NIL DO -- skip non-entityValued attributes entityValued _ FALSE; entityValued _ NutOps.EntityValued[other_ al1.first ! Error => CHECKED{ IF code=IllegalEntity THEN CONTINUE } ]; IF ~entityValued THEN LOOP; IF ~Eq[other, a] THEN EXIT ELSE AIsFirst _ TRUE; ENDLOOP; IF a = NIL OR other = NIL THEN RETURN[NIL, NIL]; SELECT TRUE FROM Rope.Equal[GetName[a], "of"] => RETURN[a, other]; Rope.Equal[GetName[other], "of"] => RETURN[other, a]; Rope.Equal[GetName[a], "is"] => RETURN[other, a]; Rope.Equal[GetName[other], "is"] => RETURN[a, other]; ENDCASE => IF AIsFirst THEN RETURN[a, other] ELSE RETURN[other, a]; END; --************************************************ -- child manipulation procedures --************************************************ keys: REF Keys.KeyBits = NEW[Keys.KeyBits _ Terminal.GetKeys[Interminal.terminal]]; mouse: Terminal.Position; MoveChild: PUBLIC PROCEDURE[child: Viewer] = BEGIN parent: Viewer; dx, dy: INTEGER; grid: NAT; old, new: Terminal.Position; IF child # NIL THEN parent _ child.parent ELSE RETURN; grid _ GetGrid[parent]; InputFocus.CaptureButtons[parent.class.notify, parent.tipTable, parent]; old _ Terminal.GetMousePosition[Interminal.terminal]; TRUSTED { DO mouse _ Terminal.GetMousePosition[Interminal.terminal]; Terminal.GetKeysRef[Interminal.terminal, keys]; IF keys[Keys.KeyName[Red]] = KeyboardFace.DownUp[up] THEN EXIT; IF mouse # old THEN new _ mouse ELSE LOOP; dx _ new.x - old.x; dy _ new.y - old.y; IF child.wx + dx < 0 THEN dx _ -child.wx; IF child.wy + dy < 0 THEN dy _ -child.wy; IF child.wx + child.ww + dx > parent.ww THEN dx _ parent.ww - child.wx - child.ww; IF child.wy + child.wh + dy > parent.wh THEN dy _ parent.wh - child.wy - child.wh; IF dx = 0 AND dy = 0 THEN LOOP; MoveViewer[child, child.wx + dx, child.wy + dy, child.ww, child.wh]; old _ new; ENDLOOP; }; -- end TRUSTED child.parent.newVersion _ TRUE; IF grid # 1 THEN ViewerOps.MoveViewer[child, child.wx-(child.wx MOD grid), child.wy-(child.wy MOD grid), child.ww, child.wh, FALSE]; InputFocus.ReleaseButtons[]; ViewerOps.PaintViewer[parent, all]; -- repaint everything END; boxW: INTEGER = 128; boxH: INTEGER = 32; corner: {ll, lr, ul, ur}; GrowBox: PUBLIC PROCEDURE[wb: Viewer, box: Viewer, x, y: INTEGER] = TRUSTED BEGIN dx, dy: INTEGER; min, delta: INTEGER; grid: NAT = GetGrid[wb]; corner: {ll, lr, ul, ur} _ ll; old, new: Terminal.Position; 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}; InputFocus.CaptureButtons[wb.class.notify, wb.tipTable, wb]; old _ Terminal.GetMousePosition[Interminal.terminal]; DO mouse _ Terminal.GetMousePosition[Interminal.terminal]; Terminal.GetKeysRef[Interminal.terminal, keys]; IF keys[Keys.KeyName[Blue]] = KeyboardFace.DownUp[up] THEN EXIT; IF mouse # old THEN new _ mouse ELSE LOOP; dx _ new.x - old.x; dy _ new.y - old.y; -- 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; InputFocus.ReleaseButtons[]; IF grid # 1 THEN ViewerOps.MoveViewer[box, box.wx-(box.wx MOD grid), box.wy-(box.wy MOD grid), box.ww-(box.ww MOD grid), box.wh-(box.wh MOD grid), FALSE]; ViewerOps.PaintViewer[wb, all]; END; MoveViewer: PROCEDURE[self: Viewer, x, y, w, h: INTEGER] = BEGIN parent: Viewer = self.parent; EraseViewer[self]; ViewerOps.MoveViewer[self, x, y, w, h, FALSE]; -- don't repaint ViewerOps.PaintViewer[self, all]; -- avoids repainting parent and sibling END; EraseViewer: PROCEDURE[self: Viewer] = BEGIN context: Graphics.Context; IF self = NIL THEN RETURN; context _ ViewerOps.AcquireContext[self.parent]; Graphics.SetColor[context, Graphics.white]; Graphics.DrawBox[context, [self.wx, self.wy, self.wx + self.ww, self.wy + self.wh]]; ViewerOps.ReleaseContext[context]; END; NearestChild: PUBLIC PROCEDURE[wb: Viewer, x, y: INTEGER, type: ViewerFlavor _ NIL] RETURNS[nearest: Viewer] = BEGIN min, delta: INTEGER _ LAST[INTEGER]; IF wb.class.flavor = $WhiteboardIcon THEN { IF type = NIL THEN RETURN[wb]; IF type = $WhiteboardIcon THEN RETURN[wb]; RETURN[NIL]}; FOR child: Viewer _ wb.child, child.sibling DO IF child = NIL THEN EXIT; IF type # NIL AND child.class.flavor # type THEN LOOP; IF x < child.wx THEN delta _ child.wx - x ELSE delta _ MAX[0, x - (child.wx + child.ww)]; IF y < child.wy THEN delta _ delta + child.wy - y ELSE delta _ delta + MAX[0, y - (child.wy + child.wh)]; IF delta > min THEN LOOP; min _ delta; nearest _ child; ENDLOOP; IF min > 40 THEN {nearest _ NIL; RETURN}; -- if you're looking for a text box, set the corner too min _ delta _ LAST[INTEGER]; delta _ ABS[x - nearest.wx] + ABS[y - nearest.wy]; IF delta < min THEN {min _ delta; corner _ ul}; delta _ ABS[x - (nearest.wx + nearest.ww)] + ABS[y - nearest.wy]; IF delta < min THEN {min _ delta; corner _ ur}; delta _ ABS[x - nearest.wx] + ABS[y - (nearest.wy + nearest.wh)]; IF delta < min THEN {min _ delta; corner _ ll}; delta _ ABS[x - (nearest.wx + nearest.ww)] + ABS[y - (nearest.wy + nearest.wh)]; IF delta < min THEN {min _ delta; corner _ lr}; END; FetchEntity: PUBLIC PROC[ v: ViewerClasses.Viewer ] RETURNS[e: DB.Entity] = { handle: DB.Entity; name: ROPE; IF NOT DB.Null[handle_ DB.V2E[ViewerOps.FetchProp[v, $EntityHandle]]] THEN RETURN[handle] ELSE IF (name_NARROW[ViewerOps.FetchProp[v, $Entity], ROPE])#NIL THEN RETURN[DBNames.NameToEntity[name, NOT Whiteboard.readOnly]] ELSE RETURN[NIL] }; StoreEntity: PUBLIC PROC[ v: ViewerClasses.Viewer, e: DB.Entity, seg: DB.Segment _ NIL, name: ROPE _ NIL ] = { ViewerOps.AddProp[v, $EntityHandle, e]; IF DB.Null[e] THEN ViewerOps.AddProp[v, $Entity, name] ELSE ViewerOps.AddProp[v, $Entity, DBNames.EntityToName[e, seg]] }; DoDeregister: ViewerOps.EnumProc = { registration: ViewerEvents.EventRegistration = NARROW[ViewerOps.FetchProp[v, $registration]]; IF registration # NIL THEN ViewerEvents.UnRegisterEventProc[registration, edit] }; DeRegister: ViewerEvents.EventProc = TRUSTED { Process.Detach[ FORK ViewerOps.EnumerateChildren[viewer, DoDeregister] ] }; iconFont: Graphics.FontRef _VFonts.GraphicsFont[VFonts.EstablishFont["TimesRoman", 8]]; WBicon: Icons.IconFlavor _ DBIcons.GetIcon["Whiteboard"]; DirtyWBicon: Icons.IconFlavor _ DBIcons.GetIcon["DirtyWhiteboard"]; [] _ ViewerEvents.RegisterEventProc[ proc: DeRegister, event: destroy, filter: $Whiteboard ]; END.. Change log. Willie-Sue December 13, 1982: aFooProp => aFooIs, for new system properties