In this section, a complete graphical example SharedBoard is examined. The SharedBoard package is available from the DEC Systems Research Center in the SRC Modula-3 3.5 release. It is in large part reproduced and annotated in this book. Some peripheral modules were left out and very minor modifications inserted for simplicity and brevity. SharedBoard is copyrighted material and is the property of Digital Equipment Corporation. Fortunately, as the other tools and libraries discussed in this book, it is available under generous licensing terms (see in appendix) which grants royalty free right to use, modify, reproduce and distribute it.
It is a simple diagram editor but an excellent example of complete user interface. It exercises mouse, keyboard and painting operations from the Trestle windowing library and higher level user interaction operations (menus and dialogs) from the FormsVBT library. It also uses network and persistent objects in an interesting way but this will be examined in a later chapter.
The diagram editor is built in a number of layers. Lower level layers could easily be reused in the context of a different graphical application. The lowest level is a collection of items which know how to paint themselves on a Trestle window. The next level is a View maintaining and displaying a list of items in a window. The following level Win adds basic user interaction functions such as typing a text item, dragging, panning... The top level is the Client diagram editor, with menus surrounding the editing window. Each of these levels is studied below.
The simple graphical editor handles two types of items: rectangle (RuleItem) and text (TextItem). Items have an identifier and a bounding box as well as methods for painting and moving themselves on a window. The Item.i3 interface defines items.
INTERFACE Item;
IMPORT Word, RectR;
TYPE T <: Public;
Public = OBJECT
id: ID;
box: RectR.T;
END;
ID = Word.T;
TYPE TArray = REF ARRAY OF T;
IDArray = REF ARRAY OF ID;
CONST Brand = "Item";
PROCEDURE Equal (i1, i2: T): BOOLEAN;
(* Two items are equal if they have the same ID. *)
END Item.
The methods associated with items are revealed in a separate interface since they are only used by the View painting the items.
INTERFACE ItemClass;
IMPORT VBT,
PointR, Item, Focus;
REVEAL Item.T = Item.Public BRANDED "Item" OBJECT
METHODS
paint (v: VBT.T; focus: Focus.T);
hilite (v: VBT.T; focus: Focus.T);
unhilite (v: VBT.T; focus: Focus.T);
move (delta: PointR.T);
END;
END ItemClass.
Text and Rule items implement these methods to paint, highlight and move themselves in a View. They are defined in files TextItem.i3, TextItem.m3, RuleItem.i3 and RuleItem.m3.
INTERFACE TextItem;
IMPORT Color,
Item, PointR, ItemFont;
TYPE T <: Public;
Public = Item.T OBJECT
text: TEXT;
rp: PointR.T;
font: ItemFont.T;
color := Color.Black;
END;
CONST Brand = "TextItem";
END TextItem.
MODULE TextItem EXPORTS TextItem;
IMPORT VBT, Rect, PaintOp,
PointR, RectR, Trans, Focus, ItemClass,
ItemFont;
REVEAL T = Public BRANDED "TextItem" OBJECT
OVERRIDES
paint := Paint;
hilite := Hilite;
unhilite := Paint;
move := Move;
END;
PROCEDURE Paint (it: T; wn: VBT.T; focus: Focus.T) =
BEGIN
ColorPaint (it, wn, focus, Trans.Color2Op (it.color));
END Paint;
PROCEDURE Hilite (it: T; wn: VBT.T; focus: Focus.T) =
BEGIN
ColorPaint (it, wn, focus, PaintOp.FromRGB (0.5, 0.5, 0.5));
END Hilite;
PROCEDURE ColorPaint (it: T; wn: VBT.T; focus: Focus.T; color: PaintOp.T) =
VAR rect := Trans.RectB2W (it.box, focus);
BEGIN
IF NOT Rect.Overlap (VBT.Domain (wn), rect) THEN
RETURN
END;
VBT.PaintText (wn, rect, Trans.PointB2W (it.rp, focus),
ItemFont.ToFont (it.font, focus.scale),
it.text, color);
END ColorPaint;
PROCEDURE Move (it: T; delta: PointR.T) =
BEGIN
it.box := RectR.Add (it.box, delta);
it.rp := PointR.Add (it.rp, delta);
END Move;
BEGIN
END TextItem.
INTERFACE RuleItem;
IMPORT Color,
Item;
TYPE T <: Public;
Public = Item.T OBJECT
color := Color.Black;
END;
END RuleItem.
MODULE RuleItem;
IMPORT VBT, Rect, PaintOp,
PointR, RectR, Trans, Focus, ItemClass;
REVEAL T = Public BRANDED "RuleItem" OBJECT
OVERRIDES
paint := Paint;
hilite := Hilite;
unhilite := Paint;
move := Move;
END;
PROCEDURE Paint (it: T; wn: VBT.T; focus: Focus.T) =
VAR rect := Trans.RectB2W (it.box, focus);
BEGIN
IF NOT Rect.Overlap (VBT.Domain (wn), rect)
THEN RETURN
END;
VBT.PaintTint (wn, rect, Trans.Color2Op (it.color));
END Paint;
PROCEDURE Hilite (it: T; wn: VBT.T; focus: Focus.T) =
VAR rect := Trans.RectB2W (it.box, focus);
BEGIN
IF NOT Rect.Overlap (VBT.Domain (wn), rect)
THEN RETURN
END;
VBT.PaintTint (wn, rect, PaintOp.FromRGB (0.5, 0.5, 0.5));
END Hilite;
PROCEDURE Move (it: T; delta: PointR.T) =
BEGIN
it.box := RectR.Add (it.box, delta);
END Move;
BEGIN
END RuleItem.
The view stores and displays a list of items, some of which are selected and must be highlighted. It refreshes the display when receiving commands to add, remove or modify items or when the corresponding window is refreshed or reshaped. The View focus determines the portion of the drawing board shown in the window, and thus the board to window coordinates transformation. The View module is as follows.
INTERFACE View;
IMPORT VBT, Rect, Point,
NetObj,
Board, Item, ItemList, Focus, RectR, PointR;
TYPE T <: Public;
Public = VBT.Leaf OBJECT
reportFocus: PROCEDURE (READONLY focus: Focus.T) := NIL;
reportError: PROCEDURE (msg: TEXT) := NIL;
METHODS
init (bd: Board.T): VBT.T RAISES {NetObj.Error};
refresh (READONLY rect: Rect.T);
quit ();
END;
PROCEDURE GetFocus (v: T): Focus.T;
(* Returns the attributes of the focus of the view. *)
PROCEDURE ChangeFocus (v: T; focus: Focus.T);
(* Sets the attributes of the focus of the view. *)
PROCEDURE ChangeOffset (v: T; offset: PointR.T);
(* Sets the attributes of the focus of the view. *)
PROCEDURE GetSelection (v: T): ItemList.T;
(* Returns the list of selected items. The list is read-only: it must
not be modified. *)
PROCEDURE SelectItems (v: T; its: ItemList.T);
(* Causes the items "its" to be selected. Items selected
earlier are unselected first.
*)
PROCEDURE SelectOne (v: T; pt: Point.T);
(* Causes an item whose bounding box covers point "pt" to be selected,
if any. Items selected earlier are unselected first.
*)
PROCEDURE SetSelectionBox (v: T; box: Rect.T);
(* Causes items whose bouding boxes lie within "box" to be selected.
The "box" is specified in the window coordinates. Items selected
earlier are unselected first.
*)
PROCEDURE CreateItems (v: T; its: Item.TArray);
(* The view installs "its" in its display list, and updates the display.
*)
PROCEDURE ModifyItems (v: T; its: Item.TArray; additive: BOOLEAN;
oldBox: RectR.T);
(* The view updates its display.
*)
PROCEDURE DeleteItems (v: T; ids: Item.IDArray);
(* The view removes the items from its display list, and updates the display.
*)
END View.
MODULE View;
IMPORT VBT, Region, Rect, PaintOp, Point, DblBufferVBT,
Thread, Atom, NetObj,
Item, ItemClass, ItemTbl, ItemList,
Board, ClientInfo, CallbackX,
Trans, Focus, RectR, PointR;
REVEAL T = Public BRANDED OBJECT
mu: MUTEX;
board: Board.T;
ci: ClientInfo.T;
focus: Focus.T;
display: ItemTbl.T;
selected: ItemList.T := NIL;
OVERRIDES
init := Init;
repaint := Repaint;
reshape := Reshape;
refresh := Refresh;
quit := Quit;
END;
(* The "focus" gives the position of the window's focus in board
coordinates: the offset of the top-left corner and the scale.
The field "display" is the display list of items in "board" that are
cached at the client;
"selected" gives the list of items selected.
*)
PROCEDURE Init (v: T; board: Board.T): VBT.T
RAISES {NetObj.Error} =
BEGIN
v.mu := NEW (MUTEX);
v.board := board;
v.ci := v.board.register (NEW (CallbackX.T).init (v));
v.focus := NEW (Focus.T, offset := PointR.Origin, scale := 1.0);
v.board.setScope (v.ci, RectR.Full);
v.display := NEW (ItemTbl.Default).init ();
RETURN NEW (DblBufferVBT.T).init (v);
END Init;
PROCEDURE Error (v: T; text: TEXT) =
BEGIN
IF v.reportError # NIL THEN v.reportError (text) END;
END Error;
PROCEDURE Repaint (v: T; READONLY rgn: Region.T) =
BEGIN
LOCK v.mu DO
v.refresh (rgn.r);
VBT.Sync (v);
END;
END Repaint;
PROCEDURE Reshape (v: T; <*UNUSED *> READONLY cd: VBT.ReshapeRec) =
BEGIN
LOCK v.mu DO
v.refresh (Rect.Full);
VBT.Sync (v);
END;
END Reshape;
PROCEDURE Refresh (v: T; READONLY r: Rect.T) =
BEGIN
VAR ir := v.display.iterate ();
id: Item.ID;
it: Item.T;
rect := Rect.Meet (r, VBT.Domain (v));
rectR := Trans.RectW2B (rect, v.focus);
BEGIN
(* Paint the background and then each item inside the focus *)
IF Rect.IsEmpty (rect) THEN RETURN END;
VBT.PaintTint (v, rect, op := PaintOp.Bg);
WHILE ir.next (id, it) DO
IF RectR.Overlap (it.box, rectR) THEN
it.paint (v, v.focus);
END;
END;
(* Highlight the currently selected items *)
HiliteList (v, v.selected);
END;
END Refresh;
PROCEDURE HiliteList (v: T; il: ItemList.T) =
BEGIN
WHILE il # NIL DO
il.head.hilite (v, v.focus);
il := il.tail;
END;
END HiliteList;
PROCEDURE UnhiliteList (v: T; il: ItemList.T) =
BEGIN
WHILE il # NIL DO
il.head.unhilite (v, v.focus);
il := il.tail;
END;
END UnhiliteList;
PROCEDURE GetFocus (v: T): Focus.T =
BEGIN
RETURN v.focus;
END GetFocus;
PROCEDURE ChangeFocus (v: T; focus: Focus.T) =
BEGIN
IF focus.scale = v.focus.scale THEN
ChangeOffset (v, focus.offset);
RETURN;
END;
LOCK v.mu DO
v.focus.offset := focus.offset;
v.focus.scale := focus.scale;
v.refresh (Rect.Full);
IF v.reportFocus # NIL THEN v.reportFocus (v.focus) END;
VBT.Sync (v);
END;
END ChangeFocus;
PROCEDURE ChangeOffset (v: T; offset: PointR.T) =
VAR delta := Trans.PointB2W (offset, v.focus);
domain := VBT.Domain (v);
overlap := Rect.Meet (domain, Rect.Sub (domain, delta));
extra: Rect.Partition;
BEGIN
LOCK v.mu DO
v.focus.offset := offset;
VBT.Scroll (v, overlap, Point.Minus (delta));
Rect.Factor (domain, overlap, extra, 0, 0);
extra[2] := extra[4];
FOR i := 0 TO 3 DO
v.refresh (extra[i]);
END;
IF v.reportFocus # NIL THEN v.reportFocus (v.focus) END;
VBT.Sync (v);
END;
END ChangeOffset;
PROCEDURE GetSelection (v: T): ItemList.T =
BEGIN
RETURN v.selected;
END GetSelection;
PROCEDURE SelectItems (v: T; newSel: ItemList.T) =
BEGIN
LOCK v.mu DO
VAR list1 := newSel;
list2 := v.selected;
BEGIN
(* Skip items that were already selected in the old list *)
WHILE list1 # NIL AND list2 # NIL AND list1.head = list2.head DO
list1 := list1.tail;
list2 := list2.tail;
END;
UnhiliteList (v, list2);
HiliteList (v, list1);
END;
v.selected := newSel;
VBT.Sync (v);
END;
END SelectItems;
PROCEDURE SelectOne (v: T; pt: Point.T) =
BEGIN
(* Select the item intersecting with the specified point *)
LOCK v.mu DO
UnhiliteList (v, v.selected);
v.selected := NIL;
VAR ir := v.display.iterate ();
id: Item.ID;
it: Item.T;
pp := Trans.PointW2B (pt, v.focus);
BEGIN
WHILE ir.next (id, it) DO
IF RectR.Member (pp, it.box) THEN
v.selected := ItemList.List1 (it);
EXIT;
END;
END;
END;
HiliteList (v, v.selected);
VBT.Sync (v);
END;
END SelectOne;
PROCEDURE SetSelectionBox (v: T; box: Rect.T) =
VAR newSel: ItemList.T := NIL;
BEGIN
(* Select the items intersecting with the specified box *)
LOCK v.mu DO
IF NOT Rect.IsEmpty (box) THEN
VAR ir := v.display.iterate ();
id: Item.ID;
it: Item.T;
rr := Trans.RectW2B (box, v.focus);
BEGIN
WHILE ir.next (id, it) DO
IF RectR.Subset (it.box, rr) THEN
newSel := ItemList.Cons (it, newSel);
END;
END;
END;
END;
VAR list1 := newSel;
list2 := v.selected;
BEGIN
WHILE list1 # NIL AND list2 # NIL AND list1.head = list2.head DO
list1 := list1.tail;
list2 := list2.tail;
END;
UnhiliteList (v, list2);
HiliteList (v, list1);
END;
v.selected := newSel;
VBT.Sync (v);
END;
END SetSelectionBox;
PROCEDURE CreateItems (v: T; its: Item.TArray) =
BEGIN
IF its = NIL THEN RETURN END;
LOCK v.mu DO
FOR i := FIRST (its^) TO LAST (its^) DO
EVAL v.display.put (its[i].id, its[i]);
its[i].paint (v, v.focus);
END;
VBT.Sync (v);
END;
END CreateItems;
PROCEDURE ModifyItems (v: T; its: Item.TArray; additive: BOOLEAN) =
VAR oldBox := RectR.Empty;
BEGIN
IF its = NIL THEN RETURN END;
LOCK v.mu DO
IF NOT additive THEN
FOR i := FIRST (its^) TO LAST (its^) DO
VAR old: Item.T; BEGIN
IF its[i] = NIL OR NOT v.display.get (its[i].id, old) THEN
its[i] := NIL;
ELSE
oldBox := RectR.Join (oldBox, old.box);
END;
END;
END;
END;
FOR i := FIRST (its^) TO LAST (its^) DO
IF its[i] # NIL THEN
EVAL v.display.put (its[i].id, its[i]);
IF (additive OR NOT RectR.Overlap (its[i].box, oldBox)) THEN
IF ItemList.Member (v.selected, its[i]) THEN
its[i].hilite (v, v.focus);
ELSE
its[i].paint (v, v.focus);
END;
END;
END;
END;
IF NOT additive THEN
v.refresh (Trans.RectB2W (oldBox, v.focus));
END;
VBT.Sync (v);
END;
END ModifyItems;
PROCEDURE DeleteItems (v: T; ids: Item.IDArray) =
VAR oldBox := RectR.Empty;
BEGIN
IF ids = NIL THEN RETURN END;
LOCK v.mu DO
FOR i := FIRST (ids^) TO LAST (ids^) DO
VAR old: Item.T; BEGIN
IF v.display.delete (ids[i], old) THEN
RemoveFromSelection (v, old);
oldBox := RectR.Join (oldBox, old.box);
END;
END;
END;
v.refresh (Trans.RectB2W (oldBox, v.focus));
VBT.Sync (v);
END;
END DeleteItems;
PROCEDURE RemoveFromSelection (v: T; it: Item.T) =
BEGIN
(* Remove deleted items from the selected list *)
IF NOT ItemList.Member (v.selected, it) THEN RETURN END;
IF v.selected.head.id = it.id THEN
v.selected := v.selected.tail;
ELSE
VAR list := v.selected; BEGIN
WHILE list.tail.head.id # it.id DO
list := list.tail;
END;
list.tail := list.tail.tail;
END;
END;
END RemoveFromSelection;
PROCEDURE Quit (v: T) =
BEGIN
v.board.unregister (v.ci);
END Quit;
BEGIN
END View.
The Win object adds basic user interaction functions on top of the View. These functions include typing a new text item, entering a new rule item, selecting items, moving items, and dragging, panning, reducing or magnifying the window's focus on the drawing board. To achieve this, the keyboard entries and the mouse position are monitored. Mouse clicks are not handled at this level; they are used at a higher level to initiate actions for which the corresponding Win procedures are called. This way, the Win object may be reused in editors with quite different menu structures.
The Win.i3 interface exports a number of procedures used to initiate actions.
INTERFACE Win;
IMPORT VBT, Color,
View;
TYPE T <: Public;
Public = View.T;
TYPE Status = {Nothing, Selecting, Moving, Typing, Ruling,
Dragging, Magnifying, Reducing};
PROCEDURE GetStatus (wn: T): Status;
(* Returns the status of the window. *)
PROCEDURE Nothing (wn: T);
(* Terminates current action. *)
PROCEDURE Typing (wn: T; READONLY cd: VBT.MouseRec);
(* Invites the user to type text into the window. *)
PROCEDURE Ruling (wn: T; READONLY cd: VBT.MouseRec);
(* Invites the user to draw a rule. *)
PROCEDURE Selecting (wn: T; READONLY cd: VBT.MouseRec);
(* Invites the user to select items. *)
PROCEDURE Dragging (wn: T; READONLY cd: VBT.MouseRec);
(* Shifts the window's focus on the board. *)
PROCEDURE Moving (wn: T; READONLY cd: VBT.MouseRec);
(* Moves the selected Items. *)
PROCEDURE Magnifying (wn: T; READONLY cd: VBT.MouseRec);
(* Magnifies the window's focus on the board. *)
PROCEDURE Reducing (wn: T; READONLY cd: VBT.MouseRec);
(* Reduces the window's focus on the board. *)
(* \subsection{Events} *)
PROCEDURE ChangeFont (wn: T; fontName: TEXT);
(* Changes the current font assocaited with the window. *)
PROCEDURE ChangeColor (wn: T; op: Color.T);
(* Changes the current color assocaited with the window. *)
PROCEDURE DiscardSelection (wn: T);
(* Unselects the selected items. *)
PROCEDURE DeleteSelection (wn: T);
(* Deletes the selected items. *)
PROCEDURE ChangeZoomRate (wn: T; rate: REAL);
(* Sets the zoom factor to "factor".*)
PROCEDURE SelectItem (wn: T; READONLY cd: VBT.MouseRec);
(* Selects the item under the pointer, if any. *)
PROCEDURE Undo (wn: T);
(* Undoes the effect of last action that created or deleted items. *)
END Win.
The Win.m3 module implements these procedures.
MODULE Win;
IMPORT VBT, Rect, Font, Point, HighlightVBT, Color,
KeyboardKey, Latin1Key, Text, TextSeq, Thread, NetObj, Time,
Item, ItemList, ItemClass, TextItem, RuleItem, Do,
View, Board, Trans, RectR, PointR, Focus,
ItemFont, FontCache;
REVEAL T = Public BRANDED OBJECT
parent: VBT.T; (* Double buffer parent window *)
status := Status.Nothing;
color := Color.Black;
kbCount := 0;
curText: TextItem.T;
cursor: Point.T; (* Current position of the text cursor *)
itemFont: ItemFont.T;
font: Font.T;
lmargin: INTEGER;
curStart: INTEGER; (* curText start point x coordinate *)
pointer: Point.T;
pointer2: Point.T;
zoomRate := 0.5;
lastZoom: Time.T;
zoomIndex := 0;
moveBox: Rect.T;
do: Do.T;
OVERRIDES
init := Init;
key := Key;
position := Position;
misc := Misc;
END;
(* Initialize a new window *)
PROCEDURE Init (wn: T; board: Board.T): VBT.T
RAISES {NetObj.Error} =
VAR fontName := "-*-times-medium-r-*-*-*-100-*";
BEGIN
wn.parent := View.T.init (wn, board);
wn.itemFont := ItemFont.FromName (fontName);
wn.font := FontCache.Get (fontName);
wn.do := NEW (Do.T).init (wn);
RETURN (wn.parent);
END Init;
PROCEDURE PaintCursor (wn: T) =
VAR rect := Rect.Add (VBT.BoundingBox (wn, "x", wn.font),
Point.Add (wn.cursor, ParentDelta (wn)));
BEGIN
IF wn.kbCount > 0 THEN
HighlightVBT.SetRect (wn, rect, 100);
ELSE
HighlightVBT.SetRect (wn, rect, 2);
END;
END PaintCursor;
PROCEDURE UnpaintCursor (wn: T) =
BEGIN
HighlightVBT.SetRect (wn, Rect.Empty);
END UnpaintCursor;
PROCEDURE GetStatus (wn: T): Status =
BEGIN RETURN wn.status END GetStatus;
(* Quit the current state for state Nothing *)
PROCEDURE Nothing (wn: T) =
BEGIN
CASE wn.status OF
| Status.Typing => EndTyping (wn);
| Status.Ruling => EndRuling (wn);
| Status.Selecting => EndSelecting (wn);
| Status.Moving => EndMoving (wn);
ELSE (*SKIP*)
END;
wn.status := Status.Nothing;
VBT.SetCage (wn, VBT.EverywhereCage);
END Nothing;
(* Start entering a text item where the mouse was clicked *)
PROCEDURE Typing (wn: T; READONLY cd: VBT.MouseRec) =
BEGIN
Nothing (wn);
TRY
VBT.Acquire (wn, VBT.KBFocus, cd.time);
INC (wn.kbCount);
wn.status := Status.Typing;
wn.curText := NIL;
wn.cursor := cd.cp.pt;
wn.lmargin := wn.cursor.h;
wn.curStart := wn.cursor.h;
PaintCursor (wn);
EXCEPT
VBT.Error => RETURN;
END;
END Typing;
PROCEDURE EndTyping (wn: T) =
BEGIN
wn.status := Status.Nothing;
(* above ensures that "Misc" works correctly *)
UnpaintCursor (wn);
(* VBT.Release (wn, VBT.KBFocus); *)
END EndTyping;
(* Start rubber banding a box from the start point
to define a Rule item *)
PROCEDURE Ruling (wn: T; READONLY cd: VBT.MouseRec) =
BEGIN
Nothing (wn);
wn.status := Status.Ruling;
wn.pointer := cd.cp.pt;
wn.pointer2 := cd.cp.pt;
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
END Ruling;
(* Create the rule item between the start point and the end point *)
PROCEDURE EndRuling (wn: T) =
VAR rect := Rect.FromCorners (wn.pointer, wn.pointer2);
it := NEW (RuleItem.T, box := Trans.RectW2B (rect, View.GetFocus (wn)),
color := wn.color);
its := NEW (Item.TArray, 1);
BEGIN
HighlightVBT.SetRect (wn, Rect.Empty);
its[0] := it;
wn.do.createItems (its);
END EndRuling;
(* Track the mouse to drag the board in the window focus *)
PROCEDURE Dragging (wn: T; READONLY cd: VBT.MouseRec) =
BEGIN
Nothing (wn);
wn.status := Status.Dragging;
wn.pointer := cd.cp.pt;
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
END Dragging;
(* Track the mouse to drag the bounding box of the selected items
to move *)
PROCEDURE Moving (wn: T; READONLY cd: VBT.MouseRec) =
VAR il := View.GetSelection (wn);
box := RectR.Empty;
BEGIN
Nothing (wn);
wn.status := Status.Moving;
wn.pointer := cd.cp.pt;
wn.pointer2 := cd.cp.pt;
WHILE il # NIL DO
box := RectR.Join (box, il.head.box);
il := il.tail;
END;
wn.moveBox := Trans.RectB2W (box, View.GetFocus (wn));
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
END Moving;
(* Now that the displacement is known, move the selected items *)
PROCEDURE EndMoving (wn: T) =
VAR il := View.GetSelection (wn);
its := NEW (Item.TArray, ItemList.Length (il));
i := 0;
focus := View.GetFocus (wn);
delta := Point.Sub (wn.pointer2, wn.pointer);
displ := PointR.T{h := FLOAT (delta.h)/focus.scale,
v := FLOAT (delta.v)/focus.scale};
oldBox := RectR.Empty;
BEGIN
WHILE il # NIL DO
oldBox := RectR.Join (oldBox, il.head.box);
il.head.move (displ);
(* Ideally the items should be copied and then modified.
Otherwise: weird effects if the item is being painted. *)
its [i] := il.head;
INC (i);
il := il.tail;
END;
View.ModifyItems (wn, its, FALSE, oldBox);
HighlightVBT.SetRect (wn, Rect.Empty);
END EndMoving;
(* Track the mouse to rubber band a selection rectangle *)
PROCEDURE Selecting (wn: T; READONLY cd: VBT.MouseRec) =
BEGIN
Nothing (wn);
wn.status := Status.Selecting;
wn.pointer := cd.cp.pt;
View.SetSelectionBox (wn, Rect.Empty);
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
END Selecting;
PROCEDURE EndSelecting (wn: T) =
BEGIN
HighlightVBT.SetRect (wn, Rect.Empty);
END EndSelecting;
(* Select a single item based on its position *)
PROCEDURE SelectItem (wn: T; READONLY cd: VBT.MouseRec) =
BEGIN
View.SelectOne (wn, cd.cp.pt);
END SelectItem;
PROCEDURE DiscardSelection (wn: T) =
BEGIN
Nothing (wn);
View.SetSelectionBox (wn, Rect.Empty);
END DiscardSelection;
(* Delete the selected items *)
PROCEDURE DeleteSelection (wn: T) =
BEGIN
Nothing (wn);
VAR il := View.GetSelection (wn);
its := NEW (Item.TArray, ItemList.Length (il));
j := 0;
BEGIN
WHILE il # NIL DO
its [j] := il.head;
il := il.tail;
INC (j);
END;
wn.do.deleteItems (its);
END;
END DeleteSelection;
(* Compute the bounding box of a text item *)
PROCEDURE AdjustTextBox (wn: T; it: TextItem.T) =
<* FATAL ItemFont.TooSmall, ItemFont.TooBig, ItemFont.Invisible *>
VAR scale := 10.0/ItemFont.Size (it.font);
font := ItemFont.ToFont (it.font, scale);
bb := VBT.BoundingBox (wn, it.text, font);
width := FLOAT (bb.east-bb.west)*1.1;
BEGIN
it.box := RectR.Add (RectR.T{west := FLOAT (bb.west)/scale,
east := (FLOAT (bb.west)+width)/scale,
north := FLOAT (bb.north)/scale,
south := FLOAT (bb.south)/scale},
it.rp);
END AdjustTextBox;
(* Change the current font *)
PROCEDURE ChangeFont (wn: T; fontName: TEXT) =
BEGIN
wn.itemFont := ItemFont.FromName (fontName);
wn.font := FontCache.Get (fontName);
IF wn.status = Status.Typing THEN
wn.curText := NIL;
wn.curStart := wn.cursor.h;
PaintCursor (wn);
END;
END ChangeFont;
(* Change the current color *)
PROCEDURE ChangeColor (wn: T; color: Color.T) =
BEGIN
IF wn.status = Status.Typing THEN
wn.curText := NIL;
wn.curStart := wn.cursor.h;
END;
wn.color := color;
END ChangeColor;
(* While the mouse is being tracked and moves, some visual feedback
is required in some cases *)
PROCEDURE Position (wn: T; READONLY cd: VBT.PositionRec) =
BEGIN
CASE wn.status OF
(* Change the focus as the mouse moves. Track the mouse *)
| Status.Dragging =>
VAR delta := Point.Sub (wn.pointer, cd.cp.pt);
BEGIN
wn.pointer := cd.cp.pt;
View.ChangeOffset (wn, Trans.PointW2B (delta, View.GetFocus (wn)));
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
END;
(* Track the mouse and update pointer2, another thread reads pointer2 *)
| Status.Magnifying, Status.Reducing =>
BEGIN
wn.pointer2 := cd.cp.pt;
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
END;
(* As the mouse moves, rubber band the selection rectangle *)
| Status.Selecting =>
VAR rect1 := Rect.FromCorners (wn.pointer, cd.cp.pt);
rect2 := Rect.Add (rect1, ParentDelta (wn));
BEGIN
HighlightVBT.SetRect (wn, rect2);
View.SetSelectionBox (wn, rect1);
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
END;
(* As the mouse moves, rubber band the rectangle for the new
RuleItem being drawn. *)
| Status.Ruling =>
VAR rect := Rect.Add (Rect.FromCorners (wn.pointer, cd.cp.pt),
ParentDelta (wn));
BEGIN
HighlightVBT.SetRect (wn, rect);
wn.pointer2 := cd.cp.pt;
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
END;
(* Move the selection rectangle with the mouse to show where the
moved items will go. *)
| Status.Moving =>
VAR displ := Point.Sub (cd.cp.pt, wn.pointer);
rect := Rect.Add (wn.moveBox, Point.Add (displ, ParentDelta (wn)));
BEGIN
HighlightVBT.SetRect (wn, rect);
wn.pointer2 := cd.cp.pt;
END;
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
ELSE
VBT.SetCage (wn, VBT.EverywhereCage);
END;
END Position;
(* Keyboard input is of interest only when typing a new TextItem. *)
PROCEDURE Key (wn: T; READONLY cd: VBT.KeyRec) =
VAR code := cd.whatChanged;
focus := View.GetFocus (wn);
BEGIN
IF NOT wn.status = Status.Typing OR
NOT cd.wentDown OR
VBT.Modifier.Control IN cd.modifiers THEN
RETURN;
END;
CASE code OF
(* <Return> key, go down to enter a new text item *)
| KeyboardKey.Return =>
VAR bb := VBT.BoundingBox (wn, "|", wn.font); BEGIN
wn.curText := NIL;
INC (wn.cursor.v, bb.south - bb.north);
wn.cursor.h := wn.lmargin;
PaintCursor (wn);
wn.curStart := wn.cursor.h;
END;
(* Backspace or Delete, remove the preceeding character. *)
| KeyboardKey.BackSpace, KeyboardKey.Delete =>
IF wn.curText # NIL THEN
VAR oldBox := wn.curText.box; BEGIN
wn.curText.text := Text.Sub (wn.curText.text, 0,
MAX (0, Text.Length(wn.curText.text)-1));
AdjustTextBox (wn, wn.curText);
wn.cursor.h := wn.curStart +
VBT.TextWidth (wn, wn.curText.text, wn.font);
PaintCursor (wn);
VAR its := NEW (Item.TArray, 1); BEGIN
its[0] := wn.curText;
View.ModifyItems (wn, its, FALSE, oldBox);
IF its[0] = NIL THEN
wn.curText := NIL;
wn.curStart := wn.cursor.h;
END;
END;
END;
END;
ELSE
IF code >= 0 AND code <= Latin1Key.ydiaeresis THEN
VAR text := Text.FromChar(VAL(code, CHAR));
its := NEW (Item.TArray, 1);
BEGIN
(* It is the first character, a new TextItem is created. *)
IF wn.curText = NIL THEN
wn.curText := NEW (TextItem.T, text := text,
rp := Trans.PointW2B (wn.cursor, focus),
font := ItemFont.Scale (wn.itemFont, focus.scale),
color := wn.color);
AdjustTextBox (wn, wn.curText);
its[0] := wn.curText;
wn.cursor.h := wn.curStart +
VBT.TextWidth (wn, wn.curText.text, wn.font);
PaintCursor (wn);
wn.do.createItems (its);
(* it looks better to paint the cursor BEFORE the text *)
(* Additional characters are added to the existing TextItem *)
ELSE
wn.curText.text := wn.curText.text & text;
AdjustTextBox (wn, wn.curText);
its[0] := wn.curText;
wn.cursor.h := wn.curStart +
VBT.TextWidth (wn, wn.curText.text, wn.font);
PaintCursor (wn);
View.ModifyItems (wn, its, TRUE, RectR.Empty);
IF its[0] = NIL THEN (* the old text item was deleted *)
wn.curText := NEW (TextItem.T, text := text,
rp := Trans.PointW2B (wn.cursor, focus),
font := ItemFont.Scale (wn.itemFont, focus.scale),
color := wn.color);
AdjustTextBox (wn, wn.curText);
its[0] := wn.curText;
wn.curStart := wn.cursor.h;
PaintCursor (wn);
wn.do.createItems (its);
END;
END;
END;
END;
END;
END Key;
(* Misc is called when receiving or loosing the keyboard focus.
A cursor is painted when the keyboard focus is held and
in Typing mode. *)
PROCEDURE Misc (wn: T; READONLY cd: VBT.MiscRec) =
BEGIN
IF cd.type = VBT.TakeSelection THEN
IF cd.selection = VBT.KBFocus AND wn.status = Status.Typing THEN
TRY
VBT.Acquire (wn, cd.selection, cd.time);
INC (wn.kbCount);
PaintCursor (wn);
EXCEPT
VBT.Error => (*SKIP*)
END;
ELSE (* SKIP *)
END;
ELSIF cd.type = VBT.Lost THEN
IF cd.selection = VBT.KBFocus THEN
DEC (wn.kbCount);
IF wn.status = Status.Typing THEN
PaintCursor (wn);
END;
END;
END;
END Misc;
(* The zooming is based on the elapsed time. Thus, a thread is forked and
each second the mouse position stored in wn.pointer2 by the
usual Trestle thread is examined by this new thread and the
zoom factor computed accordingly. The thread exits when the
Magnifying state is left. *)
TYPE ZoomClosure = Thread.Closure OBJECT
wn: T;
zoomIndex: INTEGER;
OVERRIDES
apply := Zoom;
END;
PROCEDURE Zoom (cl: ZoomClosure): REFANY =
VAR wn := cl.wn;
newFocus := NEW (Focus.T);
BEGIN
WHILE wn.status = Status.Magnifying OR wn.status = Status.Reducing DO
IF NOT (wn.status = Status.Magnifying OR wn.status = Status.Reducing)
OR cl.zoomIndex # wn.zoomIndex THEN
RETURN NIL;
END;
VAR focus := View.GetFocus (wn);
delta := Point.Sub (wn.pointer, wn.pointer2);
offset := Trans.PointW2B (delta, focus);
f: REAL;
now := Time.Now ();
interval := MAX (0.1, MIN (1.0, FLOAT(now-wn.lastZoom)));
zoomFactor := 1.0 + interval*wn.zoomRate;
BEGIN
wn.pointer := wn.pointer2;
IF wn.status = Status.Magnifying THEN
newFocus.scale := focus.scale * zoomFactor;
ELSE
newFocus.scale := focus.scale / zoomFactor;
END;
f := 1.0/focus.scale - 1.0/newFocus.scale;
newFocus.offset := PointR.T {
h := offset.h + FLOAT(wn.pointer.h) * f,
v := offset.v + FLOAT(wn.pointer.v) * f};
View.ChangeFocus (wn, newFocus);
wn.lastZoom := now;
END;
END;
RETURN NIL;
END Zoom;
(* Start a thread to update the zooming factor based on elapsed time *)
PROCEDURE Magnifying (wn: T; READONLY cd: VBT.MouseRec) =
BEGIN
Nothing (wn);
INC (wn.zoomIndex);
wn.status := Status.Magnifying;
wn.pointer := cd.cp.pt;
wn.pointer2 := cd.cp.pt;
wn.lastZoom := Time.Now ();
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
EVAL Thread.Fork (NEW (ZoomClosure, wn := wn, zoomIndex := wn.zoomIndex));
END Magnifying;
(* Same as magnifying but for redicing the zooming factor *)
PROCEDURE Reducing (wn: T; READONLY cd: VBT.MouseRec) =
BEGIN
Nothing (wn);
INC (wn.zoomIndex);
wn.status := Status.Reducing;
wn.pointer := cd.cp.pt;
wn.pointer2 := cd.cp.pt;
wn.lastZoom := Time.Now ();
VBT.SetCage (wn, VBT.CageFromPosition (cd.cp));
EVAL Thread.Fork (NEW (ZoomClosure, wn := wn, zoomIndex := wn.zoomIndex));
END Reducing;
(* Update the zoom rate stored in the window *)
PROCEDURE ChangeZoomRate (wn: T; rate: REAL) =
BEGIN
wn.zoomRate := rate;
END ChangeZoomRate;
<*INLINE*> PROCEDURE ParentDelta (wn: T): Point.T =
BEGIN
RETURN Point.Sub (Rect.NorthWest (VBT.Domain (wn.parent)),
Rect.NorthWest (VBT.Domain (wn)));
END ParentDelta;
PROCEDURE Undo (wn: T) =
BEGIN
TRY
wn.do.undo ();
EXCEPT
| Do.NoInfo =>
IF wn.reportError # NIL THEN
wn.reportError ("No more undo information");
END;
END;
END Undo;
BEGIN
END Win.
The Window and view objects are responsible for painting the contained items and for interacting with the mouse and keyboard to define new items, select items or change the window focus. The diagram editor uses a Window (which inherits a View) and adds menus that call the relevant procedures and methods of the Window object.
The user interface appearance is described using FormsVBT. A symbolic expression describes and names the elements (menus, scroll bars, typein...) contained in the user interface. The Client.m3 module then associates procedures to events on those named user interface elements.
The formsVBT description of the user interface is as follows.
% A ZSplit allows pop-up menus
(ZSplit
% Select nice default fonts
(LabelFont (Family "helvetica") (WeightName "bold") (PointSize 140))
(Font (Family "courier") (WeightName "bold") (Slant "r") (Width "normal")
(PointSize 140))
% Define childs with shape: Flexible, Fixed, Fixed height or Fixed width
(Macro Flexible BOA (child) `(Shape (Width + Inf) (Height + Inf) ,child))
(Macro Fixed BOA (child) `(Shape (Width + 0) (Height + 0) ,child))
(Macro FixedHt BOA (ht child) `(Shape (Height ,ht) ,child))
(Macro FixedWt BOA (wt child) `(Shape (Width ,wt) ,child))
(Macro Label BOA (text) `(Text LeftAlign ,text))
% Board Viewer logo
(Macro Logo ()
`(FixedWt 80 (VBox
(Fill)
(Fixed (Text "BOARD"))
(Glue 3)
(Fixed (Text "VIEWER"))
(Fill)
)))
% Where to post information
(Macro InfoBar ()
`(Shape (Height + 0) (Rim (Pen 5)
(HBox
(Fill)
(Text RightAlign %info "Not Connected")
))))
% Menu for File related operations
(Macro FileMenu ()
`(Menu
(FixedWt 50 "File")
(VBox
(PopMButton %create (For contact) (Label "Create"))
(PopMButton %open (For contact) (Label "Open"))
(MButton %save (Label "Save"))
(MButton %close (Label "Close"))
(PopMButton %remove (For contact) (Label "Remove"))
(MButton %quit (Label "Quit"))
)))
% Menu for font selection
(Macro FontMenu ()
`(Menu %font
(FixedWt 50 "Font")
(VBox
(LabelFont (Family "times"))
(VBox (LabelFont (Slant "r"))
(MButton %f_1 (LabelFont (WeightName "medium")) "times-r-medium")
(MButton %f_2 (LabelFont (WeightName "bold")) "times-r-bold"))
(VBox (LabelFont (Slant "i"))
(MButton %f_3 (LabelFont (WeightName "medium")) "times-i-medium")
(MButton %f_4 (LabelFont (WeightName "bold")) "times-i-bold"))
(VBox
(LabelFont (Family "helvetica") (Slant "r"))
(MButton %f_5 (LabelFont (WeightName "medium")) "helvetica-r-medium")
(MButton %f_6 (LabelFont (WeightName "bold")) "helvetica-r-bold"))
(VBox
(LabelFont (Family "courier") (Slant "r"))
(MButton %f_7 (LabelFont (WeightName "medium")) "courier-r-medium")
(MButton %f_8 (LabelFont (WeightName "bold")) "courier-r-bold"))
)))
% Menu for font size selection
(Macro FontSizeMenu ()
`(Menu %fontsize
(FixedWt 50 "Size")
(VBox
(LabelFont (Family "times"))
(MButton %fs_7 (LabelFont (PointSize 60)) "6")
(MButton %fs_1 (LabelFont (PointSize 100)) "10")
(MButton %fs_2 (LabelFont (PointSize 140)) "14")
(MButton %fs_3 (LabelFont (PointSize 180)) "18")
(MButton %fs_4 (LabelFont (PointSize 240)) "24")
(MButton %fs_5 (LabelFont (PointSize 480)) "48")
(MButton %fs_6 (LabelFont (PointSize 640)) "64")
)))
% Menu for color selection
(Macro ColorMenu ()
`(Menu %color
(FixedWt 50 "Color")
(FixedWt 50 (VBox
(MButton %c_1 (BgColor "Black") "")
(MButton %c_2 (BgColor "DarkRed") "")
(MButton %c_3 (BgColor "DarkBlue") "")
(MButton %c_4 (BgColor "Green4") "")
(MButton %c_5 (BgColor "Yellow") "")
(MButton %c_6 (BgColor "Cyan") "")
(MButton %c_7 (BgColor "Magenta") "")
(MButton %c_8 (BgColor "White") "")
))))
% The menu bar offers the File, Font, Size and Color menus
(Macro MenuBar ()
`(Rim (Pen 5)
(HBox
(Glue 10)
(FileMenu)
(Glue 10)
(FontMenu)
(FontSizeMenu)
(Glue 10)
(ColorMenu)
(Fill)
(Glue 10)
(PopButton (For help) (FixedWt 50 "Help")))))
% Display, for the current state, what each mouse button does.
(Macro MouseKeys ()
`(Rim (Pen 3)
(Color "Black")
(Fixed (VBox
(Text "MouseKey")
(Glue 3)
(Text %mousel LeftAlign "L:")
(Glue 3)
(Text %mousem LeftAlign "M:")
(Glue 3)
(Text %mouser LeftAlign "R:")
))))
% Select the zoom rate
(Macro Zoomer ()
`(VBox
(Fixed (Text LeftAlign "ZoomRate"))
(Glue 3)
(Frame Lowered
(VBox
(Fixed (Text LeftAlign %zoomrate_feedback "0.5"))
(Glue 3)
(Scroller %zoomrate =5 (Min 0) (Max 25))
))))
% Select the window focus on the board
(Macro Focus ()
`(Rim (Pen 3) (VBox
(Color "DarkBlue")
(Choice %focus (Label "Focus"))
(Glue 7)
(Zoomer)
(Glue 10)
(Button %reset (Label "Reset"))
(Glue 5)
(Fixed (Label "Offset.h"))
(Frame Lowered
(TypeIn %off_h =""
(TabTo off_v)))
(Glue 5)
(Fixed (Label "Offset.v"))
(Frame Lowered
(TypeIn %off_v =""
(TabTo scale)))
(Glue 5)
(Fixed (Label "Scale"))
(Frame Lowered
(TypeIn %scale =""
(TabTo off_h)))
)))
% Vertical menu for selecting the operation
(Macro Edit ()
`(Rim (Pen 3) (VBox
(Color "DarkRed")
(Choice %text (Label "Text"))
(Glue 5)
(Choice %draw (Label "Draw"))
(Glue 5)
(Choice %select (Label "Select"))
(Glue 10)
(Button %unselect (Label "Unselect"))
(Glue 10)
(Button %delete (Label "Delete"))
(Glue 10)
(TrillButton %undo (Label "Undo"))
(Glue 10)
(Button %refresh (Label "Refresh"))
)))
% The side bar contains the operation menu, information about mouse
% keys and the focus.
(Macro SideBar ()
`(FixedWt 80
(Radio %state =focus (VBox
(Glue 10)
(Edit)
(Glue 10)
(Chisel 3.0)
(Glue 10)
(MouseKeys)
(Glue 10)
(Chisel 3.0)
(Glue 10)
(Focus)
(Glue 10)
(Fill)
))))
% Place holder to put the board view.
(Macro Win ()
`(Flexible (Generic %win)))
% The application contains the menu bar on top, the side bar on the
% left and a big window for viewing the board.
(ZBackground %zbg
(Shape (Width 500 + Inf - 200) (Height 630 + Inf - 300)
(VBox
(HBox
(Logo)
(Chisel 3.0)
(VBox
(InfoBar)
(Chisel 3.0)
(MenuBar)))
(Chisel 3.0)
(HBox
(SideBar)
(Chisel 3.0)
(Win))
)))
% A popup window to query the server to contact and board to view
(ZChassis %contact
(Title (Text %jobname ""))
(Font (Family "helvetica") (WeightName "bold") (PointSize 140))
(Shape (Width 375 + Inf - 100) (Rim (Pen 5)
(VBox
(HBox
(FixedWt 115 "Server Machine:")
(Frame Lowered
(TypeIn %server ="castle"
(TabTo board))))
(Glue 10)
(HBox
(FixedWt 115 "Board Name:")
(Frame Lowered
(TypeIn %board ="/udir/chaiken/testbd"
(TabTo server))))
(Glue 10)
(HBox
(Button %contactserver (FixedWt 60 "Do It"))
(Glue 10)
(Fill)
(CloseButton %cancelconnect (FixedWt 60 "Cancel")))
))))
% A popup window to show the Help text
(ZChassis %help
(Title "Help")
(LabelFont (Family "times") (WeightName "medium") (PointSize 100))
(Font (Family "times") (WeightName "medium") (Slant "r") (Width "normal")
(PointSize 100))
(Shape (Width 375 + Inf) (Height 100 + Inf)
(TextEdit ReadOnly (From "Help.txt"))))
% A popup window to show error messages. The user must click "seen" to
% make it disappear
(ZChassis %error
(Title "Error Message")
(Font (Family "helvetica") (WeightName "bold") (PointSize 140))
(At 0.7 0.99 SE)
(Rim (Pen 5)
(VBox
(Text %errmsg "")
(Glue 10)
(HBox
(Fill)
(CloseButton (FixedWt 50 "Seen"))
(Fill)))))
)
The diagram editor installs the user interface and connects procedures to named components in it. When these named components are activated, the associated procedures are called.
MODULE Client EXPORTS Main;
IMPORT VBT, Trestle, FormsVBT, NetObj, Atom, AtomList, Err, Thread,
TrestleComm, HighlightVBT, Pixmap, TextureVBT, Color, Rect, PaintOp,
Rd, Rsrc, Fmt, Text, Scan,
View, Win, WinUIBundle, Board, BoardServer,
ItemFont, Focus, PointR,
FloatMode, Lex;
TYPE WinMouse = Win.T OBJECT
OVERRIDES
mouse := Mouse;
END;
VAR wn: WinMouse := NIL;
TYPE State = {Disconnected, Focus, Text, Draw, Select};
VAR state := State.Disconnected;
(* The "state" is "Disconnected" when there is no "Win.T" installed.
All other states imply that a "Win.T" is installed.
*)
(* Upon mouse clicks, the state may change *)
PROCEDURE Mouse (wn: WinMouse; READONLY cd: VBT.MouseRec) =
BEGIN
IF cd.clickType = VBT.ClickType.FirstDown THEN
CASE state OF
(* When setting the focus, the left button initiates magnification
while the middle button starts dragging and right button reducing. *)
| State.Focus =>
CASE cd.whatChanged OF
| VBT.Modifier.MouseL =>
Win.Magnifying (wn, cd);
| VBT.Modifier.MouseM =>
Win.Dragging (wn, cd);
| VBT.Modifier.MouseR =>
Win.Reducing (wn, cd);
ELSE (*SKIP*)
END;
(* In text mode, the left button defines the insertion point *)
| State.Text =>
CASE cd.whatChanged OF
| VBT.Modifier.MouseL =>
Win.Typing (wn, cd);
| VBT.Modifier.MouseR =>
(*SKIP*)
ELSE (*SKIP*)
END;
(* In drawing mode, the left button defines the RuleItem start point *)
| State.Draw =>
CASE cd.whatChanged OF
| VBT.Modifier.MouseL =>
Win.Ruling (wn, cd);
| VBT.Modifier.MouseM =>
(*SKIP*)
| VBT.Modifier.MouseR =>
(*SKIP*)
ELSE (*SKIP*)
END;
(* In select mode, the left mouse button selects a region while the
middle button selects a single item and the right button moves
items *)
| State.Select =>
CASE cd.whatChanged OF
| VBT.Modifier.MouseL =>
Win.Selecting (wn, cd);
| VBT.Modifier.MouseM =>
Win.SelectItem (wn, cd);
| VBT.Modifier.MouseR =>
Win.Moving (wn, cd);
ELSE (*SKIP*)
END;
ELSE (*SKIP*)
END;
(* Releasing the mouse button ends most modes except typing *)
ELSIF
cd.clickType = VBT.ClickType.LastUp THEN
CASE Win.GetStatus (wn) OF
| Win.Status.Ruling => Win.Nothing (wn);
| Win.Status.Selecting => Win.Nothing (wn);
| Win.Status.Panning => Win.Nothing (wn);
| Win.Status.Dragging => Win.Nothing (wn);
| Win.Status.Magnifying => Win.Nothing (wn);
| Win.Status.Reducing => Win.Nothing (wn);
| Win.Status.Moving => Win.Nothing (wn);
ELSE (*SKIP: true of Status.Typing *)
END;
END;
END Mouse;
CONST
FormFile = "WinUI.fv";
(* The user interface is read from a file and shown. Procedures
are connected to the named components in the FormsVBT user interface *)
PROCEDURE NewForm (): FormsVBT.T RAISES {FormsVBT.Error} =
<* FATAL Thread.Alerted *>
VAR fv: FormsVBT.T;
BEGIN
TRY
fv := NEW(FormsVBT.T).initFromRsrc(
FormFile, Rsrc.BuildPath("$WinUIPath", WinUIBundle.Get()));
EXCEPT
| Rd.Failure =>
Err.Print ("Rd.Failure -- cannot read " & FormFile);
| Rsrc.NotFound =>
Err.Print ("Rsrc.NotFound -- cannot find resource " & FormFile);
END;
(* on the menu bar *)
FormsVBT.AttachProc(fv, "create", Create);
FormsVBT.AttachProc(fv, "open", Open);
FormsVBT.AttachProc(fv, "save", Save);
FormsVBT.AttachProc(fv, "close", Close);
FormsVBT.AttachProc(fv, "remove", Remove);
FormsVBT.AttachProc(fv, "quit", Quit);
FormsVBT.AttachProc(fv, "contactserver", ContactServer);
FormsVBT.AttachProc(fv, "board", BoardInput);
FormsVBT.AttachProc(fv, "server", ServerInput);
FormsVBT.AttachProc(fv, "f_1", ChangeFont);
FormsVBT.AttachProc(fv, "f_2", ChangeFont);
FormsVBT.AttachProc(fv, "f_3", ChangeFont);
FormsVBT.AttachProc(fv, "f_4", ChangeFont);
FormsVBT.AttachProc(fv, "f_5", ChangeFont);
FormsVBT.AttachProc(fv, "f_6", ChangeFont);
FormsVBT.AttachProc(fv, "f_7", ChangeFont);
FormsVBT.AttachProc(fv, "f_8", ChangeFont);
FormsVBT.AttachProc(fv, "fs_1", ChangeFontSize);
FormsVBT.AttachProc(fv, "fs_2", ChangeFontSize);
FormsVBT.AttachProc(fv, "fs_3", ChangeFontSize);
FormsVBT.AttachProc(fv, "fs_4", ChangeFontSize);
FormsVBT.AttachProc(fv, "fs_5", ChangeFontSize);
FormsVBT.AttachProc(fv, "fs_6", ChangeFontSize);
FormsVBT.AttachProc(fv, "fs_7", ChangeFontSize);
FormsVBT.AttachProc(fv, "c_1", ChangeColor);
FormsVBT.AttachProc(fv, "c_2", ChangeColor);
FormsVBT.AttachProc(fv, "c_3", ChangeColor);
FormsVBT.AttachProc(fv, "c_4", ChangeColor);
FormsVBT.AttachProc(fv, "c_5", ChangeColor);
FormsVBT.AttachProc(fv, "c_6", ChangeColor);
FormsVBT.AttachProc(fv, "c_7", ChangeColor);
FormsVBT.AttachProc(fv, "c_8", ChangeColor);
(* on the side bar *)
FormsVBT.AttachProc(fv, "state", ChangeState);
FormsVBT.AttachProc(fv, "off_h", ChangeFocus);
FormsVBT.AttachProc(fv, "off_v", ChangeFocus);
FormsVBT.AttachProc(fv, "scale", ChangeFocus);
FormsVBT.AttachProc(fv, "zoomrate", ChangeZoomRate);
FormsVBT.AttachProc(fv, "reset", ResetFocus);
FormsVBT.AttachProc(fv, "unselect", Unselect);
FormsVBT.AttachProc(fv, "delete", Delete);
FormsVBT.AttachProc(fv, "undo", Undo);
FormsVBT.AttachProc(fv, "refresh", Refresh);
RETURN fv;
END NewForm;
VAR jobName: TEXT;
serverName, boardName: TEXT;
server: BoardServer.T;
(* Open or create the specified board on the desired server *)
PROCEDURE ContactServer (fv : FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
TRY
VAR
newServerName := FormsVBT.GetText (fv, "server");
newBoardName := FormsVBT.GetText (fv, "board");
newBoard: Board.T;
newServer: BoardServer.T;
serverDaemon: NetObj.Address;
BEGIN
IF Text.Equal (newServerName, "") THEN
serverDaemon := NIL;
ELSE
TRY
serverDaemon := NetObj.Locate (newServerName);
EXCEPT
| NetObj.Invalid => Error (fv, "Invalid server name");
| NetObj.Error =>
Error (fv, "Could not locate NetObj daemon at server");
END;
END;
TRY
newServer := NetObj.Import ("BoardServer", serverDaemon);
EXCEPT
| NetObj.Error =>
Error (fv, "Could not import server object from NetObj daemon");
END;
IF newServer = NIL THEN
Error (fv, Fmt.F ("BoardServer not running on %s", newServerName));
RETURN;
END;
TRY
IF Text.Equal (jobName, "create") THEN
newBoard := newServer.create (newBoardName);
ELSIF Text.Equal (jobName, "open") THEN
newBoard := newServer.open (newBoardName);
ELSIF Text.Equal (jobName, "remove") THEN
newServer.remove (newBoardName);
FormsVBT.PopDown (fv, "contact");
RETURN;
END;
EXCEPT
| BoardServer.Failed (text) =>
Error (fv, text);
RETURN;
END;
IF state # State.Disconnected THEN
Close (fv, "close", NIL, 0);
END;
(* The board content is obtained and displayed in the window
with selected values for focus, zoom rate... *)
boardName := newBoardName;
serverName := newServerName;
server := newServer;
wn := NEW (WinMouse);
FormsVBT.PutGeneric (fv, "win", wn.init (newBoard));
wn.reportFocus := DisplayFocus;
wn.reportError := DisplayError;
Win.ChangeFont (wn, font);
Win.ChangeColor (wn, color);
Win.ChangeZoomRate (wn, zoomrate);
View.ChangeFocus (wn, focus);
HighlightVBT.SetTexture (wn, Pixmap.Gray,
op := PaintOp.Pair (PaintOp.Transparent,
PaintOp.SwapPair (PaintOp.FromRGB (1.0, 0.0, 0.0),
PaintOp.Bg)));
HighlightVBT.SetRect (wn, Rect.Empty);
(* The popup menu shown to enter the server/board is removed *)
FormsVBT.PutText (fv, "info", serverName & ":" & boardName);
FormsVBT.PopDown (fv, "contact");
SetState (fv);
END;
EXCEPT
| NetObj.Error (atom) => Error (fv, AtomList2Text (atom));
| Thread.Alerted => Error (fv, "Thread.Alerted");
END;
END ContactServer;
(* Cease to display the board in the window *)
PROCEDURE Disconnect (fv : FormsVBT.T) =
BEGIN
wn.quit ();
FormsVBT.PutGeneric (fv, "win",
TextureVBT.New (txt := Pixmap.Gray));
FormsVBT.PutText (fv, "mousel", "L:");
FormsVBT.PutText (fv, "mousem", "M:");
FormsVBT.PutText (fv, "mouser", "R:");
FormsVBT.PutText (fv, "info", "Nothing open");
ChangeFocus (fv, "", NIL, 0);
state := State.Disconnected;
END Disconnect;
(* Remember if we want to Create, Open or Remove and popup the menu to enter
the board and server name, triggered by setting the "jobname" *)
PROCEDURE Create (fv : FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
jobName := "create";
FormsVBT.PutText (fv, "jobname", "Create Board");
END Create;
PROCEDURE Open (fv : FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
jobName := "open";
FormsVBT.PutText (fv, "jobname", "Open Board");
END Open;
PROCEDURE Remove (fv : FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
jobName := "remove";
FormsVBT.PutText (fv, "jobname", "Remove Board");
END Remove;
(* Save the board content on disk *)
PROCEDURE Save (fv : FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
IF state = State.Disconnected THEN
Error (fv, "Nothing open");
RETURN;
END;
TRY
server.save (boardName);
EXCEPT
| BoardServer.Failed (text) =>
Error (fv, text);
| NetObj.Error (atom) => Error (fv, AtomList2Text (atom));
| Thread.Alerted => Error (fv, "Thread.Alerted");
END;
END Save;
(* Cease to display the board in the window *)
PROCEDURE Close (fv : FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
IF state = State.Disconnected THEN
Error (fv, "Nothing open");
RETURN;
END;
Disconnect (fv);
TRY
server.close (boardName);
EXCEPT
| BoardServer.Failed (text) =>
Error (fv, text);
| NetObj.Error (atom) => Error (fv, AtomList2Text (atom));
| Thread.Alerted => Error (fv, "Thread.Alerted");
END;
END Close;
(* Close the user interface *)
PROCEDURE Quit (fv : FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
IF state # State.Disconnected THEN
Close (fv, "close", NIL, 0);
END;
Trestle.Delete(fv);
END Quit;
(* When the server/board name popup menu appears, set the keyboard
focus to the board name typein, and after to the server name *)
PROCEDURE BoardInput (fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; ts: VBT.TimeStamp) =
BEGIN
FormsVBT.TakeFocus (fv, "server", ts);
END BoardInput;
PROCEDURE ServerInput (fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; ts: VBT.TimeStamp) =
BEGIN
FormsVBT.TakeFocus (fv, "board", ts);
END ServerInput;
(* Set the current state from the value stored in the "state"
named component. Show the function of each mouse button
for that state. *)
PROCEDURE ChangeState (fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
IF state # State.Disconnected THEN SetState (fv) END;
END ChangeState;
PROCEDURE SetState (fv: FormsVBT.T) =
BEGIN
Win.Nothing (wn);
VAR stateName := FormsVBT.GetChoice (fv, "state");
BEGIN
IF Text.Equal (stateName, "focus") THEN
state := State.Focus;
FormsVBT.PutText (fv, "mousel", "L: magnify");
FormsVBT.PutText (fv, "mousem", "M: pan");
FormsVBT.PutText (fv, "mouser", "R: reduce");
ELSIF Text.Equal (stateName, "text") THEN
state := State.Text;
FormsVBT.PutText (fv, "mousel", "L: type");
FormsVBT.PutText (fv, "mousem", "M: paste");
FormsVBT.PutText (fv, "mouser", "R:");
ELSIF Text.Equal (stateName, "draw") THEN
state := State.Draw;
FormsVBT.PutText (fv, "mousel", "L: rule");
FormsVBT.PutText (fv, "mousem", "M:");
FormsVBT.PutText (fv, "mouser", "R:");
ELSIF Text.Equal (stateName, "select") THEN
state := State.Select;
FormsVBT.PutText (fv, "mousel", "L: many");
FormsVBT.PutText (fv, "mousem", "M: one");
FormsVBT.PutText (fv, "mouser", "R: move");
ELSE (*SKIP*)
END;
END;
END SetState;
VAR font: TEXT;
(* Change the default font for adding text items to the window *)
PROCEDURE ChangeFont (fv: FormsVBT.T; event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
font := FormsVBT.GetTextProperty (fv, event, "LabelFont");
SetFontSize ();
FormsVBT.PutTextProperty (fv, "info", "LabelFont", font);
IF state # State.Disconnected THEN
Win.ChangeFont (wn, font);
END;
END ChangeFont;
VAR fontSize: TEXT;
(* Change the default font size for text items added to the window *)
PROCEDURE ChangeFontSize (fv: FormsVBT.T; event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
fontSize := FormsVBT.GetTextProperty (fv, event, "LabelFont");
SetFontSize ();
FormsVBT.PutTextProperty (fv, "info", "LabelFont", font);
IF state # State.Disconnected THEN
Win.ChangeFont (wn, font);
END;
END ChangeFontSize;
PROCEDURE SetFontSize () =
(* Sets the point size in "font" to that in "fontSize".
This uses knowledge of the X font naming scheme. The size component
follows the 8th hyphen in the name.
*)
VAR pre1, size1, post1: TEXT;
pre2, size2, post2: TEXT;
BEGIN
ItemFont.SplitName (font, pre1, size1, post1);
ItemFont.SplitName (fontSize, pre2, size2, post2);
font := pre1 & size2 & post1;
END SetFontSize;
VAR color := Color.Black;
(* Change the default color for items added to the window *)
PROCEDURE ChangeColor (fv: FormsVBT.T; event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
color := FormsVBT.GetColorProperty (fv, event, "BgColor");
FormsVBT.PutColorProperty (fv, "info", "Color", color);
IF state # State.Disconnected THEN
Win.ChangeColor (wn, color);
END;
END ChangeColor;
VAR zoomrate := 0.5;
(* Change the zoom rate for Magnifying and Reducing operations *)
PROCEDURE ChangeZoomRate (fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
zoomrate := FLOAT (FormsVBT.GetInteger (fv, "zoomrate")) / 10.0;
FormsVBT.PutText (fv, "zoomrate_feedback",
Fmt.Real (zoomrate, Fmt.Style.Auto, 1));
IF state # State.Disconnected THEN
Win.ChangeZoomRate (wn, zoomrate);
END;
END ChangeZoomRate;
VAR focus := NEW (Focus.T, offset := PointR.T {0.0, 0.0}, scale := 1.0);
(* Change the focus of the window on the board shown *)
PROCEDURE ChangeFocus (fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
TRY
focus.offset.h := Scan.Real (FormsVBT.GetText (fv, "off_h"));
focus.offset.v := Scan.Real (FormsVBT.GetText (fv, "off_v"));
focus.scale := Scan.Real (FormsVBT.GetText (fv, "scale"));
IF state # State.Disconnected THEN
View.ChangeFocus (wn, focus);
END;
EXCEPT
| FloatMode.Trap, Lex.Error => Error (fv, "Bad format for a number");
DisplayFocus (View.GetFocus (wn));
END;
END ChangeFocus;
(* Reset the focus to its default value *)
PROCEDURE ResetFocus (<*UNUSED*> fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
focus.offset.h := 0.0;
focus.offset.v := 0.0;
focus.scale := 1.0;
IF state # State.Disconnected THEN
View.ChangeFocus (wn, focus);
END;
DisplayFocus (focus);
END ResetFocus;
(* Display the current focus to the user *)
PROCEDURE DisplayFocus (READONLY focus: Focus.T) =
(* makes use of the global variable "fv". *)
BEGIN
FormsVBT.PutText (fv, "off_h", Fmt.Real (focus.offset.h, Fmt.Style.Sci, 3));
FormsVBT.PutText (fv, "off_v", Fmt.Real (focus.offset.v, Fmt.Style.Sci, 3));
FormsVBT.PutText (fv, "scale", Fmt.Real (focus.scale, Fmt.Style.Sci, 3));
END DisplayFocus;
(* Remove all items from the selection list *)
PROCEDURE Unselect (<*UNUSED*> fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
IF state # State.Disconnected THEN
Win.DiscardSelection (wn);
END;
END Unselect;
(* Delete the currently selected items *)
PROCEDURE Delete (<*UNUSED*> fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
IF state # State.Disconnected THEN
Win.DeleteSelection (wn);
END;
END Delete;
(* An undo log is kept to undo the previous commands *)
PROCEDURE Undo (<*UNUSED*> fv: FormsVBT.T; <*UNUSED*> event: TEXT;
<*UNUSED*> data: REFANY; <*UNUSED*> ts: VBT.TimeStamp) =
BEGIN
IF state # State.Disconnected THEN
Win.Undo (wn);
END;
END Undo;
(* Popup the error window with an error message for the user *)
PROCEDURE Error (fv: FormsVBT.T; msg: TEXT) =
BEGIN
FormsVBT.PutText (fv, "errmsg", msg);
FormsVBT.PopUp (fv, "error");
END Error;
PROCEDURE DisplayError (msg: TEXT) =
(* makes use of the global variable "fv". *)
BEGIN
Error (fv, msg);
END DisplayError;
(* The user interface is installed. All further activity will be
triggered from the user interface and procedures associated to
named user interface components will be called *)
VAR fv := NewForm ();
BEGIN
Trestle.Install (fv);
fontSize := FormsVBT.GetTextProperty (fv, "fs_4", "LabelFont");
ChangeFont (fv, "f_2", NIL, 0);
Trestle.AwaitDelete (fv);
END Client.