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