A Complete Graphical Application Example

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.

Graphical items

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.

View: displaying items

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.

Win: user interaction

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

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

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.


Copyright 1995 Michel Dagenais, dagenais@vlsi.polymtl.ca, Wed Mar 8 14:41:03 EST 1995