home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D4.DMS / in.adf / Beispiele / Persistent.mod < prev    next >
Encoding:
Text File  |  1993-11-03  |  3.8 KB  |  180 lines
  1. (*
  2.  * Example program for use of persistent Objects using the features
  3.  * provided by Module Objects.
  4.  *
  5.  * (c) 1993 Fridtjof Siebert.
  6.  *)
  7.  
  8. MODULE Persistent;
  9.  
  10. IMPORT O := Objects,
  11.        B := BasicTypes,
  12.        F := FileSystem,
  13.             Out;
  14.  
  15. TYPE
  16.   Figure = POINTER TO FigureDesc;
  17.   Rectangle = POINTER TO RectangleDesc;
  18.   Circle = POINTER TO CircleDesc;
  19.  
  20.   FigureDesc = RECORD (O.ObjectDesc)
  21.     next: Figure;
  22.     color: INTEGER;
  23.   END;
  24.  
  25.   RectangleDesc = RECORD (FigureDesc)
  26.     x,y,w,h: INTEGER;
  27.   END;
  28.  
  29.   CircleDesc = RECORD (FigureDesc)
  30.     mx,my,r: INTEGER;
  31.   END;
  32.  
  33. VAR ok: BOOLEAN; (* to ignore I/O errors, don't do this in your code! *)
  34.  
  35. PROCEDURE (fig: Figure) Store * (VAR f: F.File);
  36. BEGIN
  37.   ok := F.Write(f,fig.color);
  38. END Store;
  39.  
  40. PROCEDURE (rec: Rectangle) Store * (VAR f: F.File);
  41. BEGIN
  42.   rec.Store^(f);
  43.   ok := F.Write(f,rec.x) & F.Write(f,rec.y) & F.Write(f,rec.w) & F.Write(f,rec.h);
  44. END Store;
  45.  
  46. PROCEDURE (cir: Circle) Store * (VAR f: F.File);
  47. BEGIN
  48.   cir.Store^(f);
  49.   ok := F.Write(f,cir.mx) & F.Write(f,cir.my) & F.Write(f,cir.r );
  50. END Store;
  51.  
  52. PROCEDURE (fig: Figure) Load * (VAR f: F.File);
  53. BEGIN
  54.   ok := F.Read(f,fig.color);
  55. END Load;
  56.  
  57. PROCEDURE (rec: Rectangle) Load * (VAR f: F.File);
  58. BEGIN
  59.   rec.Load^(f);
  60.   ok := F.Read(f,rec.x) & F.Read(f,rec.y) & F.Read(f,rec.w) & F.Read(f,rec.h);
  61. END Load;
  62.  
  63. PROCEDURE (cir: Circle) Load * (VAR f: F.File);
  64. BEGIN
  65.   cir.Load^(f);
  66.   ok := F.Read(f,cir.mx) & F.Read(f,cir.my) & F.Read(f,cir.r );
  67. END Load;
  68.  
  69. PROCEDURE (fig: Figure) Draw;
  70. BEGIN
  71.   Out.String("Figure"); Out.Ln;
  72. END Draw;
  73.  
  74. PROCEDURE (rec: Rectangle) Draw;
  75. BEGIN
  76.   Out.String("Rectangle: ");
  77.   Out.Int(rec.x,4); Out.String(",");
  78.   Out.Int(rec.y,4); Out.String(",");
  79.   Out.Int(rec.w,4); Out.String(",");
  80.   Out.Int(rec.h,4); Out.Ln;
  81. END Draw;
  82.  
  83. PROCEDURE (cir: Circle) Draw;
  84. BEGIN
  85.   Out.String("Circle: ");
  86.   Out.Int(cir.mx,4); Out.String(",");
  87.   Out.Int(cir.my,4); Out.String(",");
  88.   Out.Int(cir.r ,4); Out.Ln;
  89. END Draw;
  90.  
  91. PROCEDURE WriteFigure(VAR f: F.File; x: Figure);
  92. VAR
  93.   name: ARRAY 64 OF CHAR;
  94. BEGIN
  95.   IF x=NIL THEN
  96.     ok := F.WriteString(f,"")
  97.   ELSE
  98.     O.ObjToName(x,name);
  99.     ok := F.WriteString(f,name);
  100.     x.Store(f);
  101.   END;
  102. END WriteFigure;
  103.  
  104. PROCEDURE ReadFigure(VAR f: F.File; VAR x: Figure);
  105. VAR
  106.   name: ARRAY 64 OF CHAR;
  107.   o: B.ANY;
  108. BEGIN
  109.   ok := F.ReadString(f,name);
  110.   IF name="" THEN
  111.     x := NIL
  112.   ELSE
  113.     O.NameToObj(name,o);
  114.     x := o(Figure);
  115.     x.Load(f);
  116.   END;
  117. END ReadFigure;
  118.  
  119. PROCEDURE SaveFigure(name: ARRAY OF CHAR; x: Figure);
  120. VAR f: F.File;
  121. BEGIN
  122.   ok := F.Open(f,name,TRUE);
  123.   WHILE x#NIL DO WriteFigure(f,x); x := x.next END;
  124.   WriteFigure(f,NIL);
  125.   ok := F.Close(f);
  126. END SaveFigure;
  127.  
  128. PROCEDURE LoadFigure(name: ARRAY OF CHAR; VAR head: Figure);
  129. VAR
  130.   f: F.File;
  131.   x: Figure;
  132. BEGIN
  133.   ok := F.Open(f,name,FALSE);
  134.   ReadFigure(f,x); head := x;
  135.   WHILE x#NIL DO ReadFigure(f,x.next); x := x.next END;
  136.   ok := F.Close(f);
  137. END LoadFigure;
  138.  
  139. PROCEDURE TestSave;
  140. VAR
  141.   r: Rectangle;
  142.   c: Circle;
  143.   fig: Figure;
  144. BEGIN
  145.   NEW(r); r.x := 10; r.y := 10; r.w := 25; r.h := 30; r.next := fig; fig := r;
  146.   NEW(c); c.mx:= 20; c.my:= 10; c.r := 35;            c.next := fig; fig := c;
  147.   NEW(r); r.x := 12; r.y :=  8; r.w :=  5; r.h := 16; r.next := fig; fig := r;
  148.   SaveFigure("test.fig",fig);
  149. END TestSave;
  150.  
  151. PROCEDURE TestLoad;
  152. VAR fig: Figure;
  153. BEGIN
  154.   LoadFigure("test.fig",fig);
  155.   WHILE fig#NIL DO fig.Draw; fig := fig.next END;
  156. END TestLoad;
  157.  
  158. PROCEDURE InitObjects;
  159. (*
  160.  * inform Objects.mod about our objects!
  161.  * this must be done by every module that works with storeable
  162.  * objects.
  163.  *)
  164. VAR
  165.   r: Rectangle;
  166.   c: Circle;
  167.   f: Figure;
  168. BEGIN
  169.   NEW(r); O.AddObject(r,"Persistent.Rectangle");
  170.   NEW(c); O.AddObject(c,"Persistent.Circle");
  171.   NEW(f); O.AddObject(f,"Persistent.Figure");
  172. END InitObjects;
  173.  
  174. BEGIN
  175.   InitObjects;   (* Tell Module Objects about our Objects *)
  176.   TestSave;      (* Save some objects  *)
  177.   TestLoad;      (* Reload the objects *)
  178. END Persistent.
  179.  
  180.