home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / graphics.mod (.txt) < prev    next >
Oberon Text  |  1994-10-17  |  21KB  |  569 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Graphics;   (*NW 21.12.89 / 3.2.92*)
  3.     IMPORT Files, Modules, Display, Fonts, Printer, Texts, Oberon;
  4.     CONST NameLen* = 16; GraphFileId = 0F9X; LibFileId = 0FDX;
  5.     TYPE
  6.         Graph* = POINTER TO GraphDesc;
  7.         Object* = POINTER TO ObjectDesc;
  8.         Method* = POINTER TO MethodDesc;
  9.         Line* = POINTER TO LineDesc;
  10.         Caption* = POINTER TO CaptionDesc;
  11.         Macro* = POINTER TO MacroDesc;
  12.         ObjectDesc* = RECORD
  13.                 x*, y*, w*, h*, col*: INTEGER;
  14.                 selected*, marked*: BOOLEAN;
  15.                 do*: Method;
  16.                 next, dmy: Object
  17.             END ;
  18.         Msg* = RECORD END ;
  19.         WidMsg* = RECORD (Msg) w*: INTEGER END ;
  20.         ColorMsg* = RECORD (Msg) col*: INTEGER END ;
  21.         FontMsg* = RECORD (Msg) fnt*: Fonts.Font END ;
  22.         Name* = ARRAY NameLen OF CHAR;
  23.         GraphDesc* = RECORD
  24.                 time*: LONGINT;
  25.                 sel*, first: Object
  26.             END ;
  27.         MacHead* = POINTER TO MacHeadDesc;
  28.         MacExt* = POINTER TO MacExtDesc;
  29.         Library* = POINTER TO LibraryDesc;
  30.         MacHeadDesc* = RECORD
  31.                 name*: Name;
  32.                 w*, h*: INTEGER;
  33.                 ext*: MacExt;
  34.                 lib*: Library;
  35.                 first: Object;
  36.                 next: MacHead
  37.             END ;
  38.         LibraryDesc* = RECORD
  39.                 name*: Name;
  40.                 first: MacHead;
  41.                 next: Library
  42.             END ;
  43.         MacExtDesc* = RECORD END ;
  44.         Context* = RECORD
  45.                 nofonts, noflibs, nofclasses: INTEGER;
  46.                 font: ARRAY 10 OF Fonts.Font;
  47.                 lib: ARRAY 4 OF Library;
  48.                 class: ARRAY 10 OF Modules.Command
  49.             END;
  50.         MethodDesc* = RECORD
  51.                 module*, allocator*: Name;
  52.                 new*: Modules.Command;
  53.                 copy*: PROCEDURE (from, to: Object);
  54.                 draw*, handle*: PROCEDURE (obj: Object; VAR msg: Msg);
  55.                 selectable*: PROCEDURE (obj: Object; x, y: INTEGER): BOOLEAN;
  56.                 read*: PROCEDURE (obj: Object; VAR R: Files.Rider; VAR C: Context);
  57.                 write*: PROCEDURE (obj: Object; cno: SHORTINT; VAR R: Files.Rider; VAR C: Context);
  58.                 print*: PROCEDURE (obj: Object; x, y: INTEGER)
  59.             END ;
  60.         LineDesc* = RECORD (ObjectDesc)
  61.             END ;
  62.         CaptionDesc* = RECORD (ObjectDesc)
  63.                 pos*, len*: INTEGER
  64.             END ;
  65.         MacroDesc* = RECORD (ObjectDesc)
  66.                 mac*: MacHead
  67.             END ;
  68.     VAR new*: Object;
  69.         width*, res*: INTEGER;
  70.         T*: Texts.Text;  (*captions*)
  71.         LineMethod*, CapMethod*, MacMethod* : Method;
  72.         FirstLib: Library;
  73.         W, TW: Texts.Writer;
  74.     PROCEDURE Add*(G: Graph; obj: Object);
  75.     BEGIN obj.marked := FALSE; obj.selected := TRUE; obj.next := G.first;
  76.         G.first := obj; G.sel := obj; G.time := Oberon.Time()
  77.     END Add;
  78.     PROCEDURE Draw*(G: Graph; VAR M: Msg);
  79.         VAR obj: Object;
  80.     BEGIN obj := G.first;
  81.         WHILE obj # NIL DO obj.do.draw(obj, M); obj := obj.next END
  82.     END Draw;
  83.     PROCEDURE ThisObj*(G: Graph; x, y: INTEGER): Object;
  84.         VAR obj: Object;
  85.     BEGIN obj := G.first;
  86.         WHILE (obj # NIL) & ~obj.do.selectable(obj, x ,y) DO obj := obj.next END ;
  87.         RETURN obj
  88.     END ThisObj;
  89.     PROCEDURE SelectObj*(G: Graph; obj: Object);
  90.     BEGIN
  91.         IF obj # NIL THEN obj.selected := TRUE; G.sel := obj; G.time := Oberon.Time() END
  92.     END SelectObj;
  93.     PROCEDURE SelectArea*(G: Graph; x0, y0, x1, y1: INTEGER);
  94.         VAR obj: Object; t: INTEGER;
  95.     BEGIN obj := G.first;
  96.         IF x1 < x0 THEN t := x0; x0 := x1; x1 := t END ;
  97.         IF y1 < y0 THEN t := y0; y0 := y1; y1 := t END ;
  98.         WHILE obj # NIL DO
  99.             IF (x0 <= obj.x) & (obj.x + obj.w <= x1) & (y0 <= obj.y) & (obj.y + obj.h <= y1) THEN
  100.                 obj.selected := TRUE; G.sel := obj
  101.             END ;
  102.             obj := obj.next
  103.         END ;
  104.         IF G.sel # NIL THEN G.time := Oberon.Time() END
  105.     END SelectArea;
  106.     PROCEDURE Enumerate*(G: Graph; handle: PROCEDURE (obj: Object; VAR done: BOOLEAN));
  107.         VAR obj: Object; done: BOOLEAN;
  108.     BEGIN done := FALSE; obj := G.first;
  109.         WHILE (obj # NIL) & ~done DO handle(obj, done); obj := obj.next END
  110.     END Enumerate;
  111.     (*----------------procedures operating on selection -------------------*)
  112.     PROCEDURE Deselect*(G: Graph);
  113.         VAR obj: Object;
  114.     BEGIN obj := G.first; G.sel := NIL; G.time := 0;
  115.         WHILE obj # NIL DO obj.selected := FALSE; obj := obj.next END
  116.     END Deselect;
  117.     PROCEDURE DrawSel*(G: Graph; VAR M: Msg);
  118.         VAR obj: Object;
  119.     BEGIN obj := G.first;
  120.         WHILE obj # NIL DO
  121.             IF obj.selected THEN obj.do.draw(obj, M) END ;
  122.             obj := obj.next
  123.         END
  124.     END DrawSel;
  125.     PROCEDURE Handle*(G: Graph; VAR M: Msg);
  126.         VAR obj: Object;
  127.     BEGIN obj := G.first;
  128.         WHILE obj # NIL DO
  129.             IF obj.selected THEN obj.do.handle(obj, M) END ;
  130.             obj := obj.next
  131.         END
  132.     END Handle;
  133.     PROCEDURE Move*(G: Graph; dx, dy: INTEGER);
  134.         VAR obj, ob0: Object; x0, x1, y0, y1: INTEGER;
  135.     BEGIN obj := G.first;
  136.         WHILE obj # NIL DO
  137.             IF obj.selected & ~(obj IS Caption) THEN
  138.                 x0 := obj.x; x1 := obj.w + x0; y0 := obj.y; y1 := obj.h + y0;
  139.                 IF dx = 0 THEN (*vertical move*)
  140.                     ob0 := G.first;
  141.                     WHILE ob0 # NIL DO
  142.                         IF ~ob0.selected & (ob0 IS Line) & (x0 <= ob0.x) & (ob0.x <= x1) & (ob0.w < ob0.h) THEN
  143.                             IF (y0 <= ob0.y) & (ob0.y <= y1) THEN
  144.                                 INC(ob0.y, dy); DEC(ob0.h, dy); ob0.marked := TRUE
  145.                             ELSIF (y0 <= ob0.y + ob0.h) & (ob0.y + ob0.h <= y1) THEN
  146.                                 INC(ob0.h, dy); ob0.marked := TRUE
  147.                             END
  148.                         END ;
  149.                         ob0 := ob0.next
  150.                     END
  151.                 ELSIF dy = 0 THEN (*horizontal move*)
  152.                     ob0 := G.first;
  153.                     WHILE ob0 # NIL DO
  154.                         IF ~ob0.selected & (ob0 IS Line) & (y0 <= ob0.y) & (ob0.y <= y1) & (ob0.h < ob0.w) THEN
  155.                             IF (x0 <= ob0.x) & (ob0.x <= x1) THEN
  156.                                 INC(ob0.x, dx); DEC(ob0.w, dx); ob0.marked := TRUE
  157.                             ELSIF (x0 <= ob0.x + ob0.w) & (ob0.x + ob0.w <= x1) THEN
  158.                                 INC(ob0.w, dx); ob0.marked := TRUE
  159.                             END
  160.                         END ;
  161.                         ob0 := ob0.next
  162.                     END
  163.                 END
  164.             END ;
  165.             obj := obj.next
  166.         END ;
  167.         obj := G.first; (*now move*)
  168.         WHILE obj # NIL DO
  169.             IF obj.selected THEN INC(obj.x, dx); INC(obj.y, dy) END ;
  170.             obj.marked := FALSE; obj := obj.next
  171.         END
  172.     END Move;
  173.     PROCEDURE Copy*(Gs, Gd: Graph; dx, dy: INTEGER);
  174.         VAR obj: Object;
  175.     BEGIN obj := Gs.first;
  176.         WHILE obj # NIL DO
  177.             IF obj.selected THEN
  178.                 obj.do.new; obj.do.copy(obj, new); INC(new.x, dx); INC(new.y, dy);
  179.                 obj.selected := FALSE; Add(Gd, new)
  180.             END ;
  181.             obj := obj.next
  182.         END ;
  183.         new := NIL
  184.     END Copy;
  185.     PROCEDURE Delete*(G: Graph);
  186.         VAR obj, pred: Object;
  187.     BEGIN G.sel := NIL; obj := G.first;
  188.         WHILE (obj # NIL) & obj.selected DO obj := obj.next END ;
  189.         G.first := obj;
  190.         IF obj # NIL THEN
  191.             pred := obj; obj := obj.next;
  192.             WHILE obj # NIL DO
  193.                 IF obj.selected THEN pred.next := obj.next ELSE pred := obj END ;
  194.                 obj := obj.next
  195.             END
  196.         END
  197.     END Delete;
  198.     (* ---------------------- Storing ----------------------- *)
  199.     PROCEDURE WMsg(s0, s1: ARRAY OF CHAR);
  200.     BEGIN Texts.WriteString(W, s0); Texts.WriteString(W, s1);
  201.         Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  202.     END WMsg;
  203.     PROCEDURE InitContext(VAR C: Context);
  204.     BEGIN C.nofonts := 0; C.noflibs := 0; C.nofclasses := 4;
  205.         C.class[1] := LineMethod.new; C.class[2] := CapMethod.new; C.class[3] := MacMethod.new
  206.     END InitContext;
  207.     PROCEDURE FontNo*(VAR W: Files.Rider; VAR C: Context; fnt: Fonts.Font): SHORTINT;
  208.         VAR fno: SHORTINT;
  209.     BEGIN fno := 0;
  210.         WHILE (fno < C.nofonts) & (C.font[fno] # fnt) DO INC(fno) END ;
  211.         IF fno = C.nofonts THEN
  212.             Files.Write(W, 0); Files.Write(W, 0); Files.Write(W, fno);
  213.             Files.WriteString(W, fnt.name); C.font[fno] := fnt; INC(C.nofonts)
  214.         END ;
  215.         RETURN fno
  216.     END FontNo;
  217.     PROCEDURE StoreElems(VAR W: Files.Rider; VAR C: Context; obj: Object);
  218.         VAR cno: INTEGER;
  219.     BEGIN
  220.         WHILE obj # NIL DO
  221.             cno := 1;
  222.             WHILE (cno < C.nofclasses) & (obj.do.new # C.class[cno]) DO INC(cno) END ;
  223.             IF cno = C.nofclasses THEN
  224.                 Files.Write(W, 0); Files.Write(W, 2); Files.Write(W, SHORT(cno));
  225.                 Files.WriteString(W, obj.do.module); Files.WriteString(W, obj.do.allocator);
  226.                 C.class[cno] := obj.do.new; INC(C.nofclasses)
  227.             END ;
  228.             obj.do.write(obj, SHORT(cno), W, C); obj := obj.next
  229.         END ;
  230.         Files.Write(W, -1)
  231.     END StoreElems;
  232.     PROCEDURE Store*(G: Graph; VAR W: Files.Rider);
  233.         VAR C: Context;
  234.     BEGIN InitContext(C); StoreElems(W, C, G.first)
  235.     END Store;
  236.     PROCEDURE WriteObj*(VAR W: Files.Rider; cno: SHORTINT; obj: Object);
  237.     BEGIN Files.Write(W, cno); Files.WriteInt(W, obj.x); Files.WriteInt(W, obj.y);
  238.         Files.WriteInt(W, obj.w); Files.WriteInt(W, obj.h); Files.WriteInt(W, obj.col)
  239.     END WriteObj;
  240.     PROCEDURE WriteFile*(G: Graph; name: ARRAY OF CHAR);
  241.         VAR F: Files.File; W: Files.Rider; C: Context;
  242.     BEGIN F := Files.New(name); Files.Set(W, F, 0); Files.Write(W, GraphFileId);
  243.         InitContext(C); StoreElems(W, C, G.first); Files.Register(