Oberon - Programming new gadgets

Objective

Estimated time: 90 minutes.

Introduction

Programming a new gadget type

-    Skeleton.Mod is an example of how to program a visual gadget. It implements a small colored block that can be moved, resized, copied, printed and colored.

-    Complex.Mod is an example of how to program a model gadget. It implements a model gadget for complex numbers.

-    DocumentSkeleton.Mod is an example of how to program a document gadget. It implements a document that consists of a panel, only the color of which is stored.

Each of these three examples can be used as a basis for creating a new, custom and application oriented gadget type: a visual, a model and a document gadget.

When programming a new gadget, you will need the following:

1 -    A new type for the new gadget, usually created by extending a existing "base" type. Here is a skeleton for such an extended type declaration:

    TYPE
        MyGadget* = POINTER TO MyGadgetDesc;
        MyGadgetDesc* = RECORD (BaseType)
            (* additional (private) fields *)
    END;

The base type might be for example
    Gadgets.FrameDesc for a visual gadget
    Gadgets.ObjDesc for a model gadget
    Documents.DocumentDesc for a document gadget.

When extending an existing gadget the record type of that gadget is taken as base type. To ensure that the gadget is extensible, both the record and pointer types should be exported.

2 -    A message handler.

3 -    A New procedure.

The New procedure

The following is a typical New procedure:

   PROCEDURE New*;
      VAR F: MyGadget;
   BEGIN
      NEW(F);
      (* assign message handler *)
      F.handle := MyHandler;
      (* initialize private and inherited fields of F,
         e.g. F.W, F.H for a visual gadget*)
      ...
      (* "export" the newly created gadget *)
      Objects.NewObj := F
   END New;

The message handler

Handler = PROCEDURE (obj: Objects.Object; VAR M: Objects.ObjMsg);

In a realistic object-oriented environment, messages are rarely handled completely by the first recipient. Usually, they are passed through a complex network of objects. Thus a handler for a given gadget only handles messages which should be handled differently than in the base type. It passes all other messages on to the handler of the base type (e.g. Gadgets.framehandle for a visual gadget).

There are two important message classes in Gadgets:

-    Messages derived from Display.FrameMsg: The frame messages in the Display module play a central role in interframe communication. These build a communications protocol allowing frames to communicate with each other without knowing about each other's internal working. The latter is crucial if foreign or yet unknown objects are to be integrated into the system and applications need to exchange objects with each other. The FrameMsg is defined as follows:

   FrameMsg = RECORD (Objects.ObjMsg)
      F: Frame; (* target frame *)
      x, y, res: INTEGER
   END;

- Messages not derived from Display.FrameMsg: These messages typically can be sent directly to the receiver object, by calling its handler (obj.handle(obj, msg)). E.g. Objects.AttrMsg

A typical message handler looks like the following:

   PROCEDURE MyHandler*(F: Objects.Object; VAR M: Objects.ObjMsg);
   BEGIN
      WITH F: MyGadget DO
         IF M IS Display.FrameMsg THEN
         (* only for visual gadgets - not for model gadgets *)
            WITH M: Display.FrameMsg DO
               IF (M.F = NIL) OR (M.F = F) THEN
                  (* handle messages derived from Display.FrameMsg here:
                     Display.DisplayMsg, Display.ModifyMsg, Display.PrintMsg,
                     Display.SelectMsg, Display.ConsumMsg,
                     Oberon.InputMsg, Oberon.ControlMsg, ... *)
               END
            END
         ELSIF Objects.AttrMsg THEN
            (* get, set and enumerate attributes *)
         ELSIF Objects.FileMsg THEN
            (* load and store of the gadget *)
         ELSIF Objects.CopyMsg THEN
            (* making a copy of the gadget *)
         ELSE (* unknown msg, framehandler might know it *)
            Gadgets.framehandle(F, M)
         END
      END
   END MyHandler;

- When a message is handled only partially or is not handled at all, then the handler of the base type should be called.
- To ensure that the gadget can later be extended the FrameHandler should be exported.
- Model gadgets should ignore messages of the Display.FrameMsg family.

Messages derived from Display.FrameMsg

Display.DisplayMsg

   DisplayMsg = RECORD (Display.FrameMsg)
      id: INTEGER; (* frame, area *)
      u, v, w, h: INTEGER
   END;

    A special display mask data structure (Display3.Mask) is used to indicate which areas of a gadget are visible. It is specified as a set of non-overlapping rectangles. Drawing primitives are issued through this mask, which has the effect of clipping them to only the visible areas of the gadget.

Handling the Display.DisplayMsg therefore might look as follows:

   IF (M.F = NIL) OR (M.F = F) THEN (* message addressed to this frame *)
      (* calculate display coordinates *)
      x := M.x + F.X; y := M.y + F.Y; w := F.W; h := F.H;
      IF M IS Display.DisplayMsg THEN
         WITH M: Display.DisplayMsg DO
            IF (M.id = Display.frame) OR (M.F = NIL) THEN
               Gadgets.MakeMask(F, x, y, M.dlink, R);
               RestoreFrame(F, R, x, y, w, h)
            ELSIF M.id = Display.area THEN
               Gadgets.MakeMask(F, x, y, M.dlink, R);
               Display3.AdjustMask(R, x + M.u, y + h - 1 + M.v, M.w, M.h);
               RestoreFrame(F, R, x, y, w, h)
            END
         END
      ELSIF ...

- Gadgets are usually rectangular, their size being described by F.W and F.H. x, y are the coordinates of the lower-left corner of the rectangle.
- Normally the drawing routines of the Display3 module are used to draw a gadget.

Display.PrintMsg

   PrintMsg = RECORD (Display.FrameMsg)
      id: INTEGER; (* contents, view *)
      pageno: INTEGER
   END;

Printing can also be done with clipping masks. All the primitives available for display masks (Display3), are also available for printing (Printer3). One major difference is that printing masks are stored using printer coordinates. Just like for display masks, a special routine is provided to calculate the print mask of a gadget (Gadgets.MakePrinterMask).

Oberon.InputMsg

   InputMsg = RECORD (Display.FrameMsg)
      id: INTEGER; (* track, consume *)
      keys: SET;
      X, Y: INTEGER;
      ch: CHAR;
      fnt: Fonts.Font;
      col, voff: SHORTINT
   END;

Tracking the mouse

Normally, gadgets have a control border in which the gadgets respond to mouse combinations for resize, move, delete and copy. These mouse combinations are handled by Gadgets.framehandle, so the mouse has to be tracked only inside the working area of the gadgets. Gadgets.InActiveArea checks whether or not the mouse is inside the working area.

Mouse clicks are normally recorded in a tracking loop. In this loop, the mouse driver is read directly and interclicks are recorded. The loop terminates when all three buttons are up again.

Thus mouse tracking may be programmed as follows:

   PROCEDURE MyHandler*(F: Objects.Object; VAR M: Objects.ObjMsg);
      ...
      ELSIF M IS Oberon.InputMsg THEN
         WITH M: Oberon.InputMsg DO
            IF (M.id = Oberon.Track) & Gadgets.InActiveArea(F, M) THEN
               TrackMouse(F, M.X, M.Y, M.keys)
      ...
   END MyHandler;

   PROCEDURE TrackMouse(F: MyGadget; VAR X, Y: INTEGER; VAR keysum: SET);
      VAR keys: SET;
   BEGIN
      keys := keysum;
      WHILE keys # {} DO
         Effects.TrackMouse(keys, X, Y, Effects.Arrow);
         keysum := keysum+keys
      END;
      IF keysum = Effects.middle THEN
         (* execute F *)
      ELSIF ...
   END TrackMouse;

Programming a caret

A gadget implementing a caret typically has a BOOLEAN field indicating whether or not the caret is set. Thus the definition for MyGadgetDesc may look as follows:

   MyGadgetDesc* = RECORD (Gadgets.Frame)
      caret: BOOLEAN;
      (* other data *)
   END

   PROCEDURE MyHandler*(F: Objects.Object; VAR M: Objects.ObjMsg);
      VAR x, y, w, h: INTEGER;
   BEGIN
      WITH F: MyGadget DO
         IF M IS Display.FrameMsg THEN
         (* Display.FrameMsg messages *)
            WITH M: Display.FrameMsg DO
               IF (M.F = NIL) OR (M.F = F) THEN
                  (* calculate display coordinates *)
                  x := M.x + F.X; y := M.y + F.Y; w := F.W; h := F.H;
                  IF M IS Display.DisplayMsg THEN
                  ...
                  ELSIF M IS Oberon.InputMsg THEN
                     WITH M: Oberon.InputMsg DO
                        IF M.id = Oberon.track THEN
                           IF (M.keys = {Effects.left}) & Gadgets.InActiveArea(F, M) THEN
                              IF ~F.caret THEN
                                 Oberon.Defocus();
                                 F.caret := TRUE
                              END;
                              SetCaret(F, x, y)
                           ...
                           END
                        ELSIF (M.id = Oberon.consume) & F.caret THEN
                           ConsumeChar(F, M.ch);
                           M.res := 0
                        ...
                        END
                     END
                  ELSIF M IS Oberon.ControlMsg THEN
                     WITH M: Oberon.ControlMsg DO
                        IF M.id IN {Oberon.defocus, Oberon.neutralize} THEN
                           IF F.caret THEN
                              F.caret := FALSE;
                              RemoveCaret(F)
                           END
                        ...
                        END
                     END
                  ...
                  END
               END (* IF (M.F = NIL) OR (M.F = F) *)
            END (* WITH M: Display.FrameMsg *)
         (* other messages *)
         END
      END
   END MyHandler;

Oberon.ControlMsg

   ControlMsg = RECORD (Display.FrameMsg)
      id: INTEGER; (* defocus, neutralize, mark *)
      X, Y: INTEGER
   END;

Objects messages

Objects.AttrMsg

Typically, for our case study example, you would handle these messages as follows:

   PROCEDURE MyHandler*(F: Objects.Object; VAR M: Objects.ObjMsg);
      ...
      ELSIF M IS Objects.AttrMsg THEN THEN
         WITH M: Objects.AttrMsg DO
            IF M.id = Objects.get THEN
            
               IF M.name = "Gen" THEN
                  M.class := Objects.String;
                  M.s := "MyGadget.New");
                  M.res := 0
               ELSIF M.name = "Color" THEN
                  M.class := Objects.Int;
                  M.i := F.mycol;
                  M.res := 0
               ELSE Gadgets.framehandle(F, M)
               END
            ELSIF M.id = Objects.set THEN
               IF M.name = "Color" THEN
               
                  IF M.class = Objects.Int THEN
                     F.mycol := SHORT(M.i);
                     M.res := 0
                  ELSIF M.class = Objects.String THEN   (2a)
                     Attributes.StrToInt(M.s, M.i);
                     F.mycol := SHORT(M.i);
                     M.res := 0
                  (*   ELSE   ignore *)                     (2b)
                  END
               ELSE Gadgets.framehandle(F, M)
               END
            ELSIF M.id = Objects.enum THEN      (3)
               M.Enum("Color");
               Gadgets.framehandle(F, M)
            END
         END
      ...
   END MyHandler;

The object must only handle the attributes that have been added to the base type. The other attributes are processed by the base type handler.

(1) id=Objects.get, return the value of a named attribute. Each object should as a minimum handle the "Gen" attribute, i.e. return the New procedure string.

(2) id=Objects.set, change the value of a named attribute.

(3) id=Objects.enum, enumerate each attribute by calling M.Enum(extended attribute) repeatedly.

Objects.FileMsg

   FileMsg = RECORD (ObjMsg)
    id: INTEGER; (* id = load, store *)
    len: LONGINT;
    R: Files.Rider
   END;

   PROCEDURE MyHandler*(F: Objects.Object; VAR M: Objects.ObjMsg);
      ...
      ELSIF M IS Objects.FileMsg THEN
         WITH M: Objects.FileMsg DO
            IF M.id = Objects.store THEN         (1)
               Files.WriteInt(M.R, F.mycol)
            ELSIF M.id = Objects.load THEN      (2)
               Files.ReadInt(M.R, F.mycol)
            END;
            Gadgets.framehandle(F, M)
         END
      ...
   END MyHandler;

The object must only handle the attributes that have been added to the base type. The other attributes are processed by the base type handler.

(1) id=Objects.load, the object is requested to store its data to the file specified by the rider M.R.
(2) id=Objects.store, then the object is requested to load its data from the file specified by the rider M.R.

To keep loading and storing of objects portable among the different Oberon platforms, use the procedures of the Files module which read and write the different Oberon basic types (e.g. WriteInt, WriteString, ...).

Objects.CopyMsg

   CopyMsg = RECORD (ObjMsg)
      id: INTEGER; (* id = shallow | deep *)
      obj: Object
   END;

Objects.CopyMsg:

   PROCEDURE MyHandler*(F: Objects.Object; VAR M: Objects.ObjMsg);
      VAR F1: Frame;
      ...
      ELSIF M IS Objects.CopyMsg THEN
         WITH M: Objects.CopyMsg DO
            IF M.stamp = F.stamp THEN M.obj := F.dlink
               (* Copy message arrives again *)
            ELSE
               (* First time copy message arrives *)
               NEW(F1);
               F.stamp := M.stamp;   (1)
               F.dlink := F1;
               (* Copy private data *)
               F1.mycol := F.mycol;
               ...
               (* Copy data of base type *)
               Gadgets.CopyFrame(M, F, F1);
               M.obj := F1
            END
         END
      ...
   END MyHandler;

(1) The same copy message may arrive more then once. The time stamp field is thus used to detect if a copy of the object has already been made.

Programming a new document type

Load and store a document

   PROCEDURE NewDoc*;
      VAR D: Documents.Document;
   BEGIN
      NEW(D);
      (* assign procedures *)
      D.Load := Load;
      D.Store := Store;
      D.handle := DocHandler;
      D.W := 250; D.H := 200;
      Objects.NewObj := D
   END NewDoc;

   PROCEDURE Load(D: Documents.Document);
      VAR
         obj: Objects.Object;
         tag, x, y, w, h: INTEGER;
         name: ARRAY 64 OF CHAR;
         F: Files.File; R: Files.Rider;
   BEGIN
      (* create a child gadget for the document *)
      obj := Gadgets.CreateObject("Panels.NewPanel");
      WITH obj: Gadgets.Frame DO
         x := 0; y := 0; w := 250; h := 200;
         F := Files.Old(D.name);
         IF F # NIL THEN
            Files.Set(R, F, 0);
            Files.ReadInt(R, tag);
            IF tag = Documents.Id THEN
               Files.ReadString(R, name);
               Files.ReadInt(R, x); Files.ReadInt(R, y);
               Files.ReadInt(R, w); Files.ReadInt(R, h);
               (* read data specific to this document type *)
               ...
            ELSE
               (* not a document header,
               create an empty child (obj), D.name := <new doc> *)
            END
         ELSE
            (* create an empty child (obj), D.name := <new doc> *) 
         END;
         D.X := x; D.Y := y; D.W := w; D.H := h;
         Documents.Init(D, obj)
      END
   END Load;

- All document files have a header consisting of tag, name, x, y, w and h.
- The child gadget needs not to be a panel, any gadget can be used.

Where Store is defined as follows:

   PROCEDURE Store(D: Documents.Document);
      VAR
         obj: Gadgets.Frame;
         F: Files.File;
         R: Files.Rider;
   BEGIN
      (* get the child gadget *)
      obj := D.dsc(Gadgets.Frame);
      F := Files.New(D.name);
      Files.Set(R, F, 0);
      (* write the document header *)
      Files.WriteInt(R, Documents.Id);
      Files.WriteString(R, <gen string of this document type>);
      Files.WriteInt(R, D.X); Files.WriteInt(R, D.Y);
      Files.WriteInt(R, D.W); Files.WriteInt(R, D.H);
      (* write data specific to this document type *)
      ...
      Files.Register(F)
   END Store;

Special attributes of a document

-    Menu: String attribute which specifies the contents of the menu bar. The syntax for this string is:

   menu = { command [ "[" caption "]" ] " " }.
   command = moduleName "." commandName.
   caption = string.

-    Adaptive: Boolean attribute which specifies whether a document should dynamically change its size, when opened as Oberon viewer.

   PROCEDURE DocHandler(D: Objects.Object; VAR M: Objects.ObjMsg);
   BEGIN
      WITH D: Documents.Document DO
         IF M IS Objects.AttrMsg THEN
            WITH M: Objects.AttrMsg DO
               IF M.id = Objects.get THEN
                  IF M.name = "Gen" THEN
                     M.class := Objects.String;
                     M.s := <gen string of this document type>; M.res := 0
                  ELSIF M.name = "Adaptive" THEN
                     M.class := Objects.Bool; M.b := TRUE; M.res := 0
                  ELSIF M.name = "Icon" THEN
                     M.class := Objects.String; M.s := "Icons.Tool"; M.res := 0
                  ELSIF M.name = "Menu" THEN
                     M.class := Objects.String;
                     M.s := "Desktops.StoreDoc[Store]"; M.res := 0
                  ELSE Documents.Handler(D, M)
                  END
               ELSE Documents.Handler(D, M)
               END
            END
         ...
         ELSE Documents.Handler(D, M)
         END
      END
   END DocHandler;

Displaying a document