home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / graphics.mod (.txt) < prev    next >
Oberon Text  |  2012-04-20  |  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(F)
  244.     END WriteFile;
  245.     PROCEDURE Print*(G: Graph; x0, y0: INTEGER);
  246.         VAR obj: Object;
  247.     BEGIN obj := G.first;
  248.         WHILE obj # NIL DO obj.do.print(obj, x0, y0); obj := obj.next END
  249.     END Print;
  250.     (* ---------------------- Loading ------------------------ *)
  251.     PROCEDURE ThisClass*(VAR module, allocator: ARRAY OF CHAR): Modules.Command;
  252.         VAR mod: Modules.Module; com: Modules.Command;
  253.     BEGIN mod := Modules.ThisMod(module);
  254.         IF mod # NIL THEN
  255.             com := Modules.ThisCommand(mod, allocator);
  256.             IF com = NIL THEN WMsg(allocator, " unknown") END
  257.         ELSE WMsg(module, " not available"); com := NIL
  258.         END ;
  259.         RETURN com
  260.     END ThisClass;
  261.     PROCEDURE Font*(VAR R: Files.Rider; VAR C: Context): Fonts.Font;
  262.         VAR fno: SHORTINT;
  263.     BEGIN Files.Read(R, fno); RETURN C.font[fno]
  264.     END Font;
  265.     PROCEDURE ReadObj(VAR R: Files.Rider; obj: Object);
  266.     BEGIN Files.ReadInt(R, obj.x); Files.ReadInt(R, obj.y);
  267.         Files.ReadInt(R, obj.w); Files.ReadInt(R, obj.h); Files.ReadInt(R, obj.col)
  268.     END ReadObj;
  269.     PROCEDURE^ ThisLib*(VAR name: ARRAY OF CHAR; replace: BOOLEAN): Library;
  270.     PROCEDURE LoadElems(VAR R: Files.Rider; VAR C: Context; VAR obj: Object);
  271.         VAR cno, k: SHORTINT; len: INTEGER;
  272.             name, name1: ARRAY 32 OF CHAR;
  273.     BEGIN obj := NIL; Files.Read(R, cno);
  274.         WHILE ~R.eof & (cno >= 0) DO
  275.             IF cno = 0 THEN
  276.                 Files.Read(R, cno); Files.Read(R, k); Files.ReadString(R, name);
  277.                 IF cno = 0 THEN C.font[k] := Fonts.This(name)
  278.                 ELSIF cno = 1 THEN C.lib[k] := ThisLib(name, FALSE)
  279.                 ELSE Files.ReadString(R, name1); C.class[k] := ThisClass(name, name1)
  280.                 END
  281.             ELSIF C.class[cno] # NIL THEN
  282.                 C.class[cno]; ReadObj(R, new);
  283.                 new.selected := FALSE; new.marked := FALSE; new.next := obj; obj := new;
  284.                 new.do.read(new, R, C)
  285.             ELSE Files.Set(R, Files.Base(R), Files.Pos(R) + 10);
  286.                 Files.ReadInt(R, len); Files.Set(R, Files.Base(R), Files.Pos(R) + len)
  287.             END ;
  288.             Files.Read(R, cno)
  289.         END ;
  290.         new := NIL
  291.     END LoadElems;
  292.     PROCEDURE Load*(G: Graph; VAR R: Files.Rider);
  293.         VAR C: Context;
  294.     BEGIN G.sel := NIL; InitContext(C); LoadElems(R, C, G.first)
  295.     END Load;
  296.     PROCEDURE Open*(G: Graph; name: ARRAY OF CHAR);
  297.         VAR tag: CHAR;
  298.             F: Files.File; R: Files.Rider; C: Context;
  299.     BEGIN G.first := NIL; G.sel := NIL; G.time := 0; F := Files.Old(name);
  300.         IF F # NIL THEN
  301.             Files.Set(R, F, 0); Files.Read(R, tag);
  302.             IF tag = GraphFileId THEN InitContext(C); LoadElems(R, C, G.first); res := 0 ELSE res := 1 END
  303.         ELSE res := 2
  304.         END
  305.     END Open;
  306.     (* --------------------- Macros / Libraries ----------------------- *)
  307.     PROCEDURE ThisLib*(VAR name: ARRAY OF CHAR; replace: BOOLEAN): Library;
  308.         VAR i, j: INTEGER; ch: CHAR;
  309.             L: Library; mh: MacHead; obj: Object;
  310.             F: Files.File; R: Files.Rider; C: Context;
  311.             Lname, Fname: ARRAY 32 OF CHAR;
  312.     BEGIN L := FirstLib; i := 0;
  313.         WHILE name[i] >= "0" DO Lname[i] := name[i]; INC(i) END ;
  314.         Lname[i] := 0X;
  315.         WHILE (L # NIL) & (L.name # Lname) DO L := L.next END ;
  316.         IF (L = NIL) OR replace THEN
  317.             (*load library*) j := 0;
  318.             WHILE name[j] > 0X DO Fname[j] := name[j]; INC(j) END ;
  319.             IF i = j THEN
  320.                 Fname[j] := "."; Fname[j+1] := "L"; Fname[j+2] := "i"; Fname[j+3] := "b"; INC(j, 4)
  321.             END ;
  322.             Fname[j] := 0X; F := Files.Old(Fname);
  323.             IF F # NIL THEN
  324.                 WMsg("loading ", name); Files.Set(R, F, 0); Files.Read(R, ch);
  325.                 IF ch = LibFileId THEN
  326.                     IF L = NIL THEN
  327.                         NEW(L); COPY(Lname, L.name); L.next := FirstLib; FirstLib := L
  328.                     END ;
  329.                     L.first := NIL; InitContext(C); LoadElems(R, C, obj);
  330.                     WHILE obj # NIL DO
  331.                         NEW(mh); mh.first := obj;
  332.                         Files.ReadInt(R, mh.w); Files.ReadInt(R, mh.h); Files.ReadString(R, mh.name);
  333.                         mh.lib := L; mh.next := L.first; L.first := mh; LoadElems(R, C, obj)
  334.                     END
  335.                 ELSE L := NIL; WMsg(name, " bad library")
  336.                 END
  337.             ELSE WMsg(name, " not found")
  338.             END
  339.         END ;
  340.         RETURN L
  341.     END ThisLib;
  342.     PROCEDURE NewLib*(VAR Lname: ARRAY OF CHAR): Library;
  343.         VAR L: Library;
  344.     BEGIN NEW(L); COPY(Lname, L.name); L.first := NIL;
  345.         L.next := FirstLib; FirstLib := L; RETURN L
  346.     END NewLib;
  347.     PROCEDURE StoreLib*(L: Library; VAR Fname: ARRAY OF CHAR);
  348.         VAR mh: MacHead;
  349.             F: Files.File; W: Files.Rider;
  350.             C: Context;
  351.     BEGIN F := Files.New(Fname); Files.Set(W, F, 0); Files.Write(W, LibFileId);
  352.         InitContext(C); mh := L.first;
  353.         WHILE mh # NIL DO
  354.             StoreElems(W, C, mh.first); Files.WriteInt(W, mh.w); Files.WriteInt(W, mh.h);
  355.             Files.WriteString(W, mh.name); mh := mh.next
  356.         END ;
  357.         Files.Register(F)
  358.     END StoreLib;
  359.     PROCEDURE RemoveLibraries*;
  360.     BEGIN FirstLib := NIL
  361.     END RemoveLibraries;
  362.     PROCEDURE ThisMac*(L: Library; VAR Mname: ARRAY OF CHAR): MacHead;
  363.         VAR mh: MacHead;
  364.     BEGIN mh := L.first;
  365.         WHILE (mh # NIL) & (mh.name # Mname) DO mh := mh.next END ;
  366.         RETURN mh
  367.     END ThisMac;
  368.     PROCEDURE OpenMac*(mh: MacHead; G: Graph; x, y: INTEGER);
  369.         VAR obj: Object;
  370.     BEGIN obj := mh.first;
  371.         WHILE obj # NIL DO
  372.             obj.do.new; obj.do.copy(obj, new); INC(new.x, x); INC(new.y, y); new.selected := TRUE;
  373.             Add(G, new); obj := obj.next
  374.         END ;
  375.         new := NIL
  376.     END OpenMac;
  377.     PROCEDURE DrawMac*(mh: MacHead; VAR M: Msg);
  378.         VAR elem: Object;
  379.     BEGIN elem := mh.first;
  380.         WHILE elem # NIL DO elem.do.draw(elem, M); elem := elem.next END
  381.     END DrawMac;
  382.     PROCEDURE MakeMac*(G: Graph; x, y, w, h: INTEGER; VAR Mname: ARRAY OF CHAR): MacHead;
  383.         VAR obj, last: Object; mh: MacHead;
  384.     BEGIN obj := G.first; last := NIL;
  385.         WHILE obj # NIL DO
  386.             IF obj.selected THEN
  387.                 obj.do.new; obj.do.copy(obj, new); new.next := last; new.selected := FALSE;
  388.                 DEC(new.x, x); DEC(new.y, y); last := new
  389.             END ;
  390.             obj := obj.next
  391.         END ;
  392.         NEW(mh); mh.w := w; mh.h := h; mh.first := last; mh.ext := NIL; COPY(Mname, mh.name);
  393.         new := NIL; RETURN mh
  394.     END MakeMac;
  395.     PROCEDURE InsertMac*(mh: MacHead; L: Library; VAR new: BOOLEAN);
  396.         VAR mh1: MacHead;
  397.     BEGIN mh.lib := L; mh1 := L.first;
  398.         WHILE (mh1 # NIL) & (mh1.name # mh.name) DO mh1 := mh1.next END ;
  399.         IF mh1 = NIL THEN
  400.             new := TRUE; mh.next := L.first; L.first := mh
  401.         ELSE
  402.             new := FALSE; mh1.w := mh.w; mh1.h := mh.h; mh1.first := mh.first
  403.         END
  404.     END InsertMac;
  405.     (* ---------------------------- Line Methods -----------------------------*)
  406.     PROCEDURE NewLine;
  407.         VAR line: Line;
  408.     BEGIN NEW(line); new := line; line.do := LineMethod
  409.     END NewLine;
  410.     PROCEDURE CopyLine(src, dst: Object);
  411.     BEGIN dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col
  412.     END CopyLine;
  413.     PROCEDURE HandleLine(obj: Object; VAR M: Msg);
  414.     BEGIN
  415.         IF M IS WidMsg THEN
  416.             IF obj.w < obj.h THEN
  417.                 IF obj.w <= 7 THEN obj.w := M(WidMsg).w END
  418.             ELSIF obj.h <= 7 THEN obj.h := M(WidMsg).w
  419.             END
  420.         ELSIF M IS ColorMsg THEN obj.col := M(ColorMsg).col
  421.         END
  422.     END HandleLine;
  423.     PROCEDURE LineSelectable(obj: Object; x, y: INTEGER): BOOLEAN;
  424.     BEGIN
  425.         RETURN (obj.x <= x) & (x < obj.x + obj.w) & (obj.y <= y) & (y < obj.y + obj.h)
  426.     END LineSelectable;
  427.     PROCEDURE ReadLine(obj: Object; VAR R: Files.Rider; VAR C: Context);
  428.     BEGIN
  429.     END ReadLine;
  430.     PROCEDURE WriteLine(obj: Object; cno: SHORTINT; VAR W: Files.Rider; VAR C: Context);
  431.     BEGIN WriteObj(W, cno, obj)
  432.     END WriteLine;
  433.     PROCEDURE PrintLine(obj: Object; x, y: INTEGER);
  434.         VAR w, h: INTEGER;
  435.     BEGIN w := obj.w * 2; h := obj.h * 2;
  436.         IF w < h THEN h := 2*h ELSE w := 2*w END ;
  437.         Printer.ReplConst(obj.x * 4 + x, obj.y *4 + y, w, h)
  438.     END PrintLine;
  439.     (* ---------------------- Caption Methods ------------------------ *)
  440.     PROCEDURE NewCaption;
  441.         VAR cap: Caption;
  442.     BEGIN NEW(cap); new := cap; cap.do := CapMethod
  443.     END NewCaption;
  444.     PROCEDURE CopyCaption(src, dst: Object);
  445.         VAR ch: CHAR; R: Texts.Reader;
  446.     BEGIN
  447.         WITH src: Caption DO
  448.             WITH dst: Caption DO
  449.                 dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col;
  450.                 dst.pos := SHORT(T.len + 1); dst.len := src.len;
  451.                 Texts.Write(TW, 0DX); Texts.OpenReader(R, T, src.pos);
  452.                 Texts.Read(R, ch); TW.fnt := R.fnt;
  453.                 WHILE ch > 0DX DO Texts.Write(TW, ch); Texts.Read(R, ch) END
  454.             END
  455.         END ;
  456.         Texts.Append(T, TW.buf)
  457.     END CopyCaption;
  458.     PROCEDURE HandleCaption(obj: Object; VAR M: Msg);
  459.         VAR dx, x1, dy, y1, w, w1, h1, len: INTEGER;
  460.             pos: LONGINT;
  461.             ch: CHAR; pat: Display.Pattern; fnt: Fonts.Font;
  462.             R: Texts.Reader;
  463.     BEGIN
  464.         IF M IS FontMsg THEN
  465.             fnt := M(FontMsg).fnt; w := 0; len := 0; pos := obj(Caption).pos;
  466.             Texts.OpenReader(R, T, pos); Texts.Read(R, ch); dy := R.fnt.minY;
  467.             WHILE ch > 0DX DO
  468.                 Display.GetChar(fnt.raster, ch, dx, x1, y1, w1, h1, pat);
  469.                 INC(w, dx); INC(len); Texts.Read(R, ch)
  470.             END ;
  471.             INC(obj.y, fnt.minY-dy); obj.w := w; obj.h := fnt.height;
  472.             Texts.ChangeLooks(T, pos, pos+len, {0}, fnt, 0 , 0)
  473.         ELSIF M IS ColorMsg THEN obj.col := M(ColorMsg).col
  474.         END
  475.     END HandleCaption;
  476.     PROCEDURE CaptionSelectable(obj: Object; x, y: INTEGER): BOOLEAN;
  477.     BEGIN
  478.         RETURN (obj.x <= x) & (x < obj.x + obj.w) & (obj.y <= y) & (y < obj.y + obj.h)
  479.     END CaptionSelectable;
  480.     PROCEDURE ReadCaption(obj: Object; VAR R: Files.Rider; VAR C: Context);
  481.         VAR ch: CHAR; fno: SHORTINT; len: INTEGER;
  482.     BEGIN obj(Caption).pos := SHORT(T.len + 1); Texts.Write(TW, 0DX);
  483.         Files.Read(R, fno); TW.fnt := C.font[fno]; len := 0; Files.Read(R, ch);
  484.         WHILE ch > 0DX DO Texts.Write(TW, ch); INC(len); Files.Read(R, ch) END ;
  485.         obj(Caption).len := len; Texts.Append(T, TW.buf)
  486.     END ReadCaption;
  487.     PROCEDURE WriteCaption(obj: Object; cno: SHORTINT; VAR W: Files.Rider; VAR C: Context);
  488.         VAR ch: CHAR; fno: SHORTINT;
  489.             TR: Texts.Reader;
  490.     BEGIN
  491.         IF obj(Caption).len > 0 THEN
  492.             Texts.OpenReader(TR, T, obj(Caption).pos); Texts.Read(TR, ch);
  493.             fno := FontNo(W, C, TR.fnt);
  494.             WriteObj(W, cno, obj); Files.Write(W, fno);
  495.             WHILE ch > 0DX DO  Files.Write(W, ch); Texts.Read(TR, ch) END ;
  496.             Files.Write(W, 0X)
  497.         END
  498.     END WriteCaption;
  499.     PROCEDURE PrintCaption(obj: Object; x, y: INTEGER);
  500.         VAR fnt: Fonts.Font;
  501.             i: INTEGER; ch: CHAR;
  502.             R: Texts.Reader;
  503.             s: ARRAY 128 OF CHAR;
  504.     BEGIN
  505.         IF obj(Caption).len > 0 THEN
  506.             Texts.OpenReader(R, T, obj(Caption).pos); Texts.Read(R, ch);
  507.             fnt := R.fnt; DEC(y, fnt.minY*4); i := 0;
  508.             WHILE ch >= " " DO s[i] := ch; INC(i); Texts.Read(R, ch) END ;
  509.             s[i] := 0X;
  510.             IF i > 0 THEN Printer.String(obj.x*4 + x, obj.y*4 + y, s, fnt.name) END
  511.         END
  512.     END PrintCaption;
  513.     (* ---------------------- Macro Methods ------------------------ *)
  514.     PROCEDURE NewMacro;
  515.         VAR mac: Macro;
  516.     BEGIN NEW(mac); new := mac; mac.do := MacMethod
  517.     END NewMacro;
  518.     PROCEDURE CopyMacro(src, dst: Object);
  519.     BEGIN dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h;
  520.         dst.col := src.col; dst(Macro).mac := src(Macro).mac
  521.     END CopyMacro;
  522.     PROCEDURE HandleMacro(obj: Object; VAR M: Msg);
  523.     BEGIN
  524.         IF M IS ColorMsg THEN obj.col := M(ColorMsg).col END
  525.     END HandleMacro;
  526.     PROCEDURE MacroSelectable(obj: Object; x, y: INTEGER): BOOLEAN;
  527.     BEGIN
  528.         RETURN (obj.x <= x) & (x <= obj.x + 8) & (obj.y <= y) & (y <= obj.y + 8)
  529.     END MacroSelectable;
  530.     PROCEDURE ReadMacro(obj: Object; VAR R: Files.Rider; VAR C: Context);
  531.         VAR lno: SHORTINT; name: ARRAY 32 OF CHAR;
  532.     BEGIN Files.Read(R, lno);
  533.         Files.ReadString(R, name); obj(Macro).mac := ThisMac(C.lib[lno], name)
  534.     END ReadMacro;
  535.     PROCEDURE WriteMacro(obj: Object; cno: SHORTINT; VAR W1: Files.Rider; VAR C: Context);
  536.         VAR lno: SHORTINT;
  537.     BEGIN lno := 0;
  538.         WITH obj: Macro DO
  539.             WHILE (lno < C.noflibs) & (obj.mac.lib # C.lib[lno]) DO INC(lno) END ;
  540.             IF lno = C.noflibs THEN
  541.                 Files.Write(W1, 0); Files.Write(W1, 1); Files.Write(W1, lno);
  542.                 Files.WriteString(W1, obj.mac.lib.name); C.lib[lno] := obj.mac.lib; INC(C.noflibs)
  543.             END ;
  544.             WriteObj(W1, cno, obj); Files.Write(W1, lno); Files.WriteString(W1, obj.mac.name)
  545.         END
  546.     END WriteMacro;
  547.     PROCEDURE PrintMacro(obj: Object; x, y: INTEGER);
  548.         VAR elem: Object; mh: MacHead;
  549.     BEGIN mh := obj(Macro).mac;
  550.         IF mh # NIL THEN elem := mh.first;
  551.             WHILE elem # NIL DO elem.do.print(elem, obj.x*4 + x, obj.y*4 + y); elem := elem.next END
  552.         END
  553.     END PrintMacro;
  554.     PROCEDURE Notify(T: Texts.Text; op: INTEGER; beg, end: LONGINT);
  555.     BEGIN
  556.     END Notify;
  557. BEGIN Texts.OpenWriter(W); Texts.OpenWriter(TW); width := 1;
  558.     NEW(T); Texts.Open(T, ""); T.notify := Notify;
  559.     NEW(LineMethod); LineMethod.new := NewLine; LineMethod.copy := CopyLine;
  560.     LineMethod.selectable := LineSelectable; LineMethod.handle := HandleLine;
  561.     LineMethod.read := ReadLine; LineMethod.write := WriteLine; LineMethod.print := PrintLine;
  562.     NEW(CapMethod); CapMethod.new := NewCaption; CapMethod.copy := CopyCaption;
  563.     CapMethod.selectable := CaptionSelectable; CapMethod.handle := HandleCaption;
  564.     CapMethod.read := ReadCaption; CapMethod.write := WriteCaption; CapMethod.print := PrintCaption;
  565.     NEW(MacMethod); MacMethod.new := NewMacro; MacMethod.copy := CopyMacro;
  566.     MacMethod.selectable := MacroSelectable; MacMethod.handle := HandleMacro;
  567.     MacMethod.read := ReadMacro; MacMethod.write := WriteMacro; MacMethod.print := PrintMacro
  568. END Graphics.
  569.