home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 July / Chip_2004-07_cd1.bin / tema / aos / files / Oberon.exe / Oberon / Docu.exe / Docu / OpenDemo2.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  2000-02-29  |  3.7 KB  |  99 lines
  1. Oberon10.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. (* ETH Oberon, Copyright 2000 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
  4. Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
  5.     OpenDemo2.Mod, jm 03.11.93
  6.     This more extensive example shows how a new document type is created.
  7.     In this case a panel is the primary document type. It modifies the menu
  8.     bar and its icon.
  9. MODULE OpenDemo2; (** portable *)
  10. IMPORT Out, Files, Objects, Gadgets, Panels, Documents, Desktops;
  11. PROCEDURE LoadPanel*(D: Documents.Document);
  12. VAR obj: Objects.Object; main: Gadgets.Frame;
  13.     F: Files.File; R: Files.Rider; name: ARRAY 64 OF CHAR; ch: CHAR;
  14.     tag: INTEGER; len: LONGINT; lib: Objects.Library;
  15. BEGIN
  16.     main := NIL; D.W := 300; D.H := 200;
  17.     F := Files.Old(D.name);
  18.     IF F # NIL THEN
  19.         Files.Set(R, F, 0); Files.ReadInt(R, tag);
  20.         IF tag = Documents.Id THEN
  21.             Files.ReadString(R, name); (* skip over tag *)
  22.             Files.ReadInt(R, D.X); Files.ReadInt(R, D.Y); Files.ReadInt(R, D.W); Files.ReadInt(R, D.H);
  23.             Files.Read(R, ch);
  24.             IF ch = Objects.LibBlockId THEN
  25.                 NEW(lib); Objects.OpenLibrary(lib); Objects.LoadLibrary(lib, F, Files.Pos(R), len);
  26.                 lib.GetObj(lib, 0, obj); (* by default *)
  27.                 IF (obj # NIL) & (obj IS Objects.Dummy) THEN
  28.                     Out.String("Discarding "); Out.String(obj(Objects.Dummy).GName); Out.Ln
  29.                 ELSIF (obj # NIL) & (obj IS Gadgets.Frame) THEN main := obj(Gadgets.Frame)
  30.                 END
  31.             END
  32.         END
  33.     END;
  34.     IF main = NIL THEN Panels.NewPanel; main := Objects.NewObj(Gadgets.Frame) END;
  35.     Documents.Init(D, main)
  36. END LoadPanel;
  37. PROCEDURE StorePanel*(D: Documents.Document);
  38. VAR F: Files.File; len: LONGINT; B: Objects.BindMsg; R: Files.Rider; obj: Objects.Object;
  39. BEGIN
  40.     IF D.name # "" THEN
  41.         obj := D.dsc;
  42.         IF obj # NIL THEN 
  43.             NEW(B.lib); Objects.OpenLibrary(B.lib); obj.handle(obj, B);
  44.             F := Files.New(D.name);
  45.             Files.Set(R, F, 0); Files.WriteInt(R, Documents.Id); Files.WriteString(R, "OpenDemo2.NewDoc");
  46.             Files.WriteInt(R, D.X); Files.WriteInt(R, D.H); Files.WriteInt(R, D.W); Files.WriteInt(R, D.H);
  47.             Objects.StoreLibrary(B.lib, F, Files.Pos(R), len);
  48.             Files.Register(F);
  49.         END
  50. END StorePanel;
  51. PROCEDURE DocHandle*(D: Objects.Object; VAR M: Objects.ObjMsg);
  52. BEGIN
  53.     WITH D: Documents.Document DO
  54.         IF M IS Objects.AttrMsg THEN
  55.             WITH M: Objects.AttrMsg DO
  56.                 IF M.id = Objects.get THEN
  57.                     IF M.name = "Gen" THEN M.class := Objects.String; M.s := "OpenDemo2.NewDoc"; M.res := 0
  58.                     ELSIF M.name = "Adaptive" THEN M.class := Objects.Bool; M.b := FALSE; M.res := 0
  59.                     ELSIF M.name = "Icon" THEN M.class := Objects.String; M.s := "Icons.Panel"; M.res := 0
  60.                     ELSE Documents.Handler(D, M)
  61.                     END
  62.                 ELSE Documents.Handler(D, M)
  63.                 END
  64.             END
  65.         ELSIF M IS Objects.LinkMsg THEN
  66.             WITH M: Objects.LinkMsg DO
  67.                 IF M.id = Objects.get THEN
  68.                     IF (M.name = "SystemMenu") OR (M.name = "UserMenu") OR (M.name = "DeskMenu") THEN
  69.                         M.obj := Desktops.NewMenu("Desktops.StoreDoc[Store] System.Time[Time]");
  70.                         M.res := 0
  71.                     ELSE Documents.Handler(D, M)
  72.                     END
  73.                 ELSE Documents.Handler(D, M)
  74.                 END
  75.             END
  76.         ELSE Documents.Handler(D, M)
  77.         END
  78. END DocHandle;
  79. PROCEDURE NewDoc*;
  80. VAR D: Documents.Document;
  81. BEGIN NEW(D); D.Load := LoadPanel; D.Store := StorePanel; D.handle := DocHandle;
  82.     D.W := 250; D.H := 200;
  83.     Objects.NewObj := D
  84. END NewDoc;
  85. (* Opening under program control *)
  86. PROCEDURE ShowGadget(name: ARRAY OF CHAR);
  87. VAR D: Documents.Document;
  88. BEGIN
  89.     NewDoc; (* create a new document *)
  90.     D := Objects.NewObj(Documents.Document);
  91.     COPY(name, D.name);
  92.     D.Load(D);
  93.     Desktops.ShowDoc(D)
  94. END ShowGadget;
  95. PROCEDURE Do*;
  96. BEGIN ShowGadget("Test.Panel");
  97. END Do;
  98. END OpenDemo2.Do
  99.