home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 July / Chip_2004-07_cd1.bin / tema / aos / files / Oberon.exe / Oberon / Docu.exe / Docu / Examples1.Mod (.txt) < prev    next >
Oberon Text  |  2000-02-29  |  3KB  |  87 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. MODULE Examples1; (** portable *)    (* jm 24.2.93 File: Examples1.Mod*)
  6.     Version management/storing/loading example. This example illustrates how pointers are saved to and
  7.     restored from disk, how objects can be given version numbers, how to bind objects to libraries, and
  8.     how to copy objects correctly.
  9. IMPORT Gadgets, Objects, Files, Texts, Oberon;
  10. CONST
  11.     ModName = "Examples1"; VersionNo = 2;
  12.     Frame* = POINTER TO FrameDesc;
  13.     FrameDesc* = RECORD (Gadgets.FrameDesc)
  14.         x: INTEGER;
  15.         ptr0, ptr1: Gadgets.Frame; (* Two pointers to frames *)
  16.     END;
  17. VAR W: Texts.Writer;
  18. (* Write a version number *)
  19. PROCEDURE WriteVersion(VAR R: Files.Rider);
  20. BEGIN Files.WriteNum(R, VersionNo);
  21. END WriteVersion;
  22. (* Check the version number *)
  23. PROCEDURE ReadVersion(VAR R: Files.Rider);
  24. VAR x: LONGINT;
  25. BEGIN Files.ReadNum(R, x);
  26.     IF x # VersionNo THEN
  27.         Texts.WriteString(W, "Version "); Texts.WriteInt(W, VersionNo, 3); Texts.WriteString(W, " of ");
  28.         Texts.WriteString(W, ModName); Texts.WriteString(W, " cannot read version "); Texts.WriteInt(W, x, 3);
  29.         Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
  30.         HALT(99)
  31.     END;
  32. END ReadVersion;
  33. PROCEDURE CopyFrame*(VAR M: Objects.CopyMsg; from, to: Frame);
  34. VAR obj: Objects.Object;
  35. BEGIN
  36.     Gadgets.CopyFrame(M, from, to);
  37.     to.x := from.x;
  38.     (* Copy pointers *)
  39.     obj := Gadgets.CopyPtr(M, from.ptr0); IF obj # NIL THEN to.ptr0 := obj(Gadgets.Frame) END;
  40.     obj := Gadgets.CopyPtr(M, from.ptr1); IF obj # NIL THEN to.ptr1 := obj(Gadgets.Frame) END;
  41. END CopyFrame;
  42. PROCEDURE Handler*(obj: Objects.Object; VAR M: Objects.ObjMsg);
  43. VAR obj0: Objects.Object; obj2: Frame;
  44. BEGIN
  45.     WITH obj: Frame DO
  46.         IF M IS Objects.FileMsg THEN
  47.             WITH M: Objects.FileMsg DO
  48.                 IF M.id = Objects.store THEN
  49.                     WriteVersion(M.R);
  50.                     Files.WriteInt(M.R, obj.x);
  51.                     
  52.                     (* Write pointers *)
  53.                     Gadgets.WriteRef(M.R, obj.lib, obj.ptr0); 
  54.                     Gadgets.WriteRef(M.R, obj.lib, obj.ptr1);
  55.                     Gadgets.framehandle(obj, M)
  56.                 ELSIF M.id = Objects.load THEN
  57.                     ReadVersion(M.R);
  58.                     Files.ReadInt(M.R, obj.x);
  59.                     
  60.                     (* Read pointers back, checking their type. Dummies are discarded *)
  61.                     Gadgets.ReadRef(M.R, obj.lib, obj0);
  62.                     IF (obj0 # NIL) & (obj0 IS Gadgets.Frame) THEN obj.ptr0 := obj0(Gadgets.Frame) END;
  63.                     
  64.                     Gadgets.ReadRef(M.R, obj.lib, obj0);
  65.                     IF (obj0 # NIL) & (obj0 IS Gadgets.Frame) THEN obj.ptr1 := obj0(Gadgets.Frame) END;
  66.                     Gadgets.framehandle(obj, M);
  67.                 END
  68.             END
  69.         ELSIF M IS Objects.BindMsg THEN
  70.             WITH M: Objects.BindMsg DO
  71.                 (* Bind objects known by pointers *)
  72.                 IF obj.ptr0 # NIL THEN obj.ptr0.handle(obj.ptr0, M) END;
  73.                 IF obj.ptr1 # NIL THEN obj.ptr1.handle(obj.ptr1, M) END;
  74.                 Gadgets.framehandle(obj, M);
  75.             END
  76.         ELSIF M IS Objects.CopyMsg THEN
  77.             WITH M: Objects.CopyMsg DO
  78.                 IF M.stamp = obj.stamp THEN
  79.                     M.obj := obj.dlink
  80.                 ELSE
  81.                     NEW(obj2); obj.stamp := M.stamp; obj.dlink := obj2; CopyFrame(M, obj, obj2); M.obj := obj2
  82.                 END
  83.             END
  84.         END
  85. END Handler;
  86. END Examples1.
  87.