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.