Oberon/V2/Graphics

MODULE Graphics; (*NW 21.12.89 / 3.2.92*) IMPORT Files, Modules, Display, Fonts, Printer, Texts, Oberon; CONST NameLen* = 16; GraphFileId = 0F9X; LibFileId = 0FDX; TYPE Graph* = POINTER TO GraphDesc; Object* = POINTER TO ObjectDesc; Method* = POINTER TO MethodDesc; Line* = POINTER TO LineDesc; Caption* = POINTER TO CaptionDesc; Macro* = POINTER TO MacroDesc; ObjectDesc* = RECORD x*, y*, w*, h*, col*: INTEGER; selected*, marked*: BOOLEAN; do*: Method; next, dmy: Object END ; Msg* = RECORD END ; WidMsg* = RECORD (Msg) w*: INTEGER END ; ColorMsg* = RECORD (Msg) col*: INTEGER END ; FontMsg* = RECORD (Msg) fnt*: Fonts.Font END ; Name* = ARRAY NameLen OF CHAR; GraphDesc* = RECORD time*: LONGINT; sel*, first: Object END ; MacHead* = POINTER TO MacHeadDesc; MacExt* = POINTER TO MacExtDesc; Library* = POINTER TO LibraryDesc; MacHeadDesc* = RECORD name*: Name; w*, h*: INTEGER; ext*: MacExt; lib*: Library; first: Object; next: MacHead END ; LibraryDesc* = RECORD name*: Name; first: MacHead; next: Library END ; MacExtDesc* = RECORD END ; Context* = RECORD nofonts, noflibs, nofclasses: INTEGER; font: ARRAY 10 OF Fonts.Font; lib: ARRAY 4 OF Library; class: ARRAY 10 OF Modules.Command END; MethodDesc* = RECORD module*, allocator*: Name; new*: Modules.Command; copy*: PROCEDURE (from, to: Object); draw*, handle*: PROCEDURE (obj: Object; VAR msg: Msg); selectable*: PROCEDURE (obj: Object; x, y: INTEGER): BOOLEAN; read*: PROCEDURE (obj: Object; VAR R: Files.Rider; VAR C: Context); write*: PROCEDURE (obj: Object; cno: SHORTINT; 					VAR R: Files.Rider; VAR C: Context); print*: PROCEDURE (obj: Object; x, y: INTEGER) END ; LineDesc* = RECORD (ObjectDesc) END ; CaptionDesc* = RECORD (ObjectDesc) pos*, len*: INTEGER END ; MacroDesc* = RECORD (ObjectDesc) mac*: MacHead END ; VAR new*: Object; width*, res*: INTEGER; T*: Texts.Text; (*captions*) LineMethod*, CapMethod*, MacMethod* : Method; FirstLib: Library; W, TW: Texts.Writer; PROCEDURE Add*(G: Graph; obj: Object); BEGIN obj.marked := FALSE; obj.selected := TRUE; obj.next := G.first; G.first := obj; G.sel := obj; G.time := Oberon.Time END Add; PROCEDURE Draw*(G: Graph; VAR M: Msg); VAR obj: Object; BEGIN obj := G.first; WHILE obj # NIL DO obj.do.draw(obj, M); obj := obj.next END END Draw; PROCEDURE ThisObj*(G: Graph; x, y: INTEGER): Object; VAR obj: Object; BEGIN obj := G.first; WHILE (obj # NIL) & ~obj.do.selectable(obj, x ,y) DO obj := obj.next END ; RETURN obj END ThisObj; PROCEDURE SelectObj*(G: Graph; obj: Object); BEGIN IF obj # NIL THEN obj.selected := TRUE; G.sel := obj; G.time := Oberon.Time END END SelectObj; PROCEDURE SelectArea*(G: Graph; x0, y0, x1, y1: INTEGER); VAR obj: Object; t: INTEGER; BEGIN obj := G.first; IF x1 < x0 THEN t := x0; x0 := x1; x1 := t END ; IF y1 < y0 THEN t := y0; y0 := y1; y1 := t END ; WHILE obj # NIL DO 			IF (x0 <= obj.x) & (obj.x + obj.w <= x1) & (y0 <= obj.y) & (obj.y + obj.h <= y1) THEN obj.selected := TRUE; G.sel := obj END ; obj := obj.next END ; IF G.sel # NIL THEN G.time := Oberon.Time END END SelectArea; PROCEDURE Enumerate*(G: Graph; 			handle: PROCEDURE (obj: Object; VAR done: BOOLEAN)); VAR obj: Object; done: BOOLEAN; BEGIN done := FALSE; obj := G.first; WHILE (obj # NIL) & ~done DO handle(obj, done); obj := obj.next END END Enumerate; (*procedures operating on selection ---*) PROCEDURE Deselect*(G: Graph); VAR obj: Object; BEGIN obj := G.first; G.sel := NIL; G.time := 0; WHILE obj # NIL DO obj.selected := FALSE; obj := obj.next END END Deselect; PROCEDURE DrawSel*(G: Graph; VAR M: Msg); VAR obj: Object; BEGIN obj := G.first; WHILE obj # NIL DO 			IF obj.selected THEN obj.do.draw(obj, M) END ; obj := obj.next END END DrawSel; PROCEDURE Handle*(G: Graph; VAR M: Msg); VAR obj: Object; BEGIN obj := G.first; WHILE obj # NIL DO 			IF obj.selected THEN obj.do.handle(obj, M) END ; obj := obj.next END END Handle; PROCEDURE Move*(G: Graph; dx, dy: INTEGER); VAR obj, ob0: Object; x0, x1, y0, y1: INTEGER; BEGIN obj := G.first; WHILE obj # NIL DO 			IF obj.selected & ~(obj IS Caption) THEN x0 := obj.x; x1 := obj.w + x0; y0 := obj.y; y1 := obj.h + y0; IF dx = 0 THEN (*vertical move*) ob0 := G.first; WHILE ob0 # NIL DO 						IF ~ob0.selected & (ob0 IS Line) & (x0 <= ob0.x) 									& (ob0.x <= x1) & (ob0.w < ob0.h) THEN IF (y0 <= ob0.y) & (ob0.y <= y1) THEN INC(ob0.y, dy); DEC(ob0.h, dy); ob0.marked := TRUE ELSIF (y0 <= ob0.y + ob0.h) & (ob0.y + ob0.h <= y1) THEN INC(ob0.h, dy); ob0.marked := TRUE END END ; ob0 := ob0.next END ELSIF dy = 0 THEN (*horizontal move*) ob0 := G.first; WHILE ob0 # NIL DO 						IF ~ob0.selected & (ob0 IS Line) & (y0 <= ob0.y) 								& (ob0.y <= y1) & (ob0.h < ob0.w) THEN IF (x0 <= ob0.x) & (ob0.x <= x1) THEN INC(ob0.x, dx); DEC(ob0.w, dx); ob0.marked := TRUE ELSIF (x0 <= ob0.x + ob0.w) & (ob0.x + ob0.w <= x1) THEN INC(ob0.w, dx); ob0.marked := TRUE END END ; ob0 := ob0.next END END END ; obj := obj.next END ; obj := G.first; (*now move*) WHILE obj # NIL DO 			IF obj.selected THEN INC(obj.x, dx); INC(obj.y, dy) END ; obj.marked := FALSE; obj := obj.next END END Move; PROCEDURE Copy*(Gs, Gd: Graph; dx, dy: INTEGER); VAR obj: Object; BEGIN obj := Gs.first; WHILE obj # NIL DO 			IF obj.selected THEN obj.do.new; obj.do.copy(obj, new); INC(new.x, dx); INC(new.y, dy); obj.selected := FALSE; Add(Gd, new) END ; obj := obj.next END ; new := NIL END Copy; PROCEDURE Delete*(G: Graph); VAR obj, pred: Object; BEGIN G.sel := NIL; obj := G.first; WHILE (obj # NIL) & obj.selected DO obj := obj.next END ; G.first := obj; IF obj # NIL THEN pred := obj; obj := obj.next; WHILE obj # NIL DO 				IF obj.selected THEN pred.next := obj.next ELSE pred := obj END ; obj := obj.next END END END Delete; (* -- File I/O *) PROCEDURE ReadInt*(VAR R: Files.Rider; VAR x: INTEGER); VAR c0: CHAR; s1: SHORTINT; BEGIN Files.Read(R, c0); Files.Read(R, s1); x := s1; x := x * 100H + ORD(c0) END ReadInt; PROCEDURE ReadLInt*(VAR R: Files.Rider; VAR x: LONGINT); VAR c0, c1, c2: CHAR; s3: SHORTINT; BEGIN Files.Read(R, c0); Files.Read(R, c1); Files.Read(R, c2); Files.Read(R, s3); x := s3; x := ((x * 100H + LONG(c2)) * 100H + LONG(c1)) * 100H + LONG(c0) END ReadLInt; PROCEDURE ReadString*(VAR R: Files.Rider; VAR s: ARRAY OF CHAR); VAR i: INTEGER; ch: CHAR; BEGIN i := 0; REPEAT Files.Read(R, ch); s[i] := ch; INC(i) UNTIL ch = 0X END ReadString; PROCEDURE ReadObj(VAR R: Files.Rider; obj: Object); BEGIN ReadInt(R, obj.x); ReadInt(R, obj.y); ReadInt(R, obj.w); ReadInt(R, obj.h); ReadInt(R, obj.col) END ReadObj; PROCEDURE WriteInt*(VAR W: Files.Rider; x: INTEGER); BEGIN Files.Write(W, CHR(x)); Files.Write(W, CHR(x DIV 100H)) END WriteInt; PROCEDURE WriteLInt*(VAR W: Files.Rider; x: LONGINT); BEGIN Files.Write(W, CHR(x)); Files.Write(W, CHR(x DIV 100H)); Files.Write(W, CHR(x DIV 10000H)); Files.Write(W, CHR(x DIV 1000000H)) END WriteLInt; PROCEDURE WriteString*(VAR W: Files.Rider; VAR s: ARRAY OF CHAR); VAR i: INTEGER; ch: CHAR; BEGIN i := 0; REPEAT ch := s[i]; INC(i); Files.Write(W, ch) UNTIL ch = 0X END WriteString; PROCEDURE WriteObj*(VAR W: Files.Rider; cno: SHORTINT; obj: Object); BEGIN Files.Write(W, cno); WriteInt(W, obj.x); WriteInt(W, obj.y); WriteInt(W, obj.w); WriteInt(W, obj.h); WriteInt(W, obj.col) END WriteObj; (* -- Storing --- *) PROCEDURE WMsg(s0, s1: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s0); Texts.WriteString(W, s1); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END WMsg; PROCEDURE InitContext(VAR C: Context); BEGIN C.nofonts := 0; C.noflibs := 0; C.nofclasses := 4; C.class[1] := LineMethod.new; C.class[2] := CapMethod.new; C.class[3] := MacMethod.new END InitContext; PROCEDURE FontNo*(VAR W: Files.Rider; VAR C: Context; fnt: Fonts.Font): SHORTINT; VAR fno: SHORTINT; BEGIN fno := 0; WHILE (fno < C.nofonts) & (C.font[fno] # fnt) DO INC(fno) END ; IF fno = C.nofonts THEN Files.Write(W, 0); Files.Write(W, 0); Files.Write(W, fno); WriteString(W, fnt.name); C.font[fno] := fnt; INC(C.nofonts) END ; RETURN fno END FontNo; PROCEDURE StoreElems(VAR W: Files.Rider; VAR C: Context; obj: Object); VAR cno: INTEGER; BEGIN WHILE obj # NIL DO 			cno := 1; WHILE (cno < C.nofclasses) & (obj.do.new # C.class[cno]) DO INC(cno) END ; IF cno = C.nofclasses THEN Files.Write(W, 0); Files.Write(W, 2); Files.Write(W, SHORT(cno)); WriteString(W, obj.do.module); WriteString(W, obj.do.allocator); C.class[cno] := obj.do.new; INC(C.nofclasses) END ; obj.do.write(obj, SHORT(cno), W, C); obj := obj.next END ; Files.Write(W, -1) END StoreElems; PROCEDURE Store*(G: Graph; VAR W: Files.Rider); VAR C: Context; BEGIN InitContext(C); StoreElems(W, C, G.first) END Store; PROCEDURE WriteFile*(G: Graph; name: ARRAY OF CHAR); VAR F: Files.File; W: Files.Rider; C: Context; BEGIN F := Files.New(name); Files.Set(W, F, 0); Files.Write(W, GraphFileId); InitContext(C); StoreElems(W, C, G.first); Files.Register(F) END WriteFile; PROCEDURE Print*(G: Graph; x0, y0: INTEGER); VAR obj: Object; BEGIN obj := G.first; WHILE obj # NIL DO obj.do.print(obj, x0, y0); obj := obj.next END END Print; (* -- Loading *) PROCEDURE ThisClass*(VAR module, allocator: ARRAY OF CHAR): Modules.Command; VAR mod: Modules.Module; com: Modules.Command; BEGIN mod := Modules.ThisMod(module); IF mod # NIL THEN com := Modules.ThisCommand(mod, allocator); IF com = NIL THEN WMsg(allocator, " unknown") END ELSE WMsg(module, " not available"); com := NIL END ; RETURN com END ThisClass; PROCEDURE Font*(VAR R: Files.Rider; VAR C: Context): Fonts.Font; VAR fno: SHORTINT; BEGIN Files.Read(R, fno); RETURN C.font[fno] END Font; PROCEDURE^ ThisLib*(VAR name: ARRAY OF CHAR; replace: BOOLEAN): Library; PROCEDURE LoadElems(VAR R: Files.Rider; VAR C: Context; VAR obj: Object); VAR cno, len, k: SHORTINT; name, name1: ARRAY 32 OF CHAR; BEGIN obj := NIL; Files.Read(R, cno); WHILE ~R.eof & (cno >= 0) DO 			IF cno = 0 THEN Files.Read(R, cno); Files.Read(R, k); ReadString(R, name); IF cno = 0 THEN C.font[k] := Fonts.This(name) ELSIF cno = 1 THEN C.lib[k] := ThisLib(name, FALSE) ELSE ReadString(R, name1); C.class[k] := ThisClass(name, name1) END ELSIF C.class[cno] # NIL THEN C.class[cno]; ReadObj(R, new); new.selected := FALSE; new.marked := FALSE; new.next := obj; obj := new; new.do.read(new, R, C) 			ELSE Files.Set(R, Files.Base(R), Files.Pos(R) + 10); Files.Read(R, len); Files.Set(R, Files.Base(R), Files.Pos(R) + len) END ; Files.Read(R, cno) END ; new := NIL END LoadElems; PROCEDURE Load*(G: Graph; VAR R: Files.Rider); VAR C: Context; BEGIN G.sel := NIL; InitContext(C); LoadElems(R, C, G.first) END Load; PROCEDURE Open*(G: Graph; name: ARRAY OF CHAR); VAR tag: CHAR; F: Files.File; R: Files.Rider; C: Context; BEGIN G.first := NIL; G.sel := NIL; G.time := 0; F := Files.Old(name); IF F # NIL THEN Files.Set(R, F, 0); Files.Read(R, tag); IF tag = GraphFileId THEN InitContext(C); LoadElems(R, C, G.first); res := 0 ELSE res := 1 END ELSE res := 2 END END Open; (* - Macros / Libraries --- *) PROCEDURE ThisLib*(VAR name: ARRAY OF CHAR; replace: BOOLEAN): Library; VAR i, j: INTEGER; ch: CHAR; L: Library; mh: MacHead; F: Files.File; R: Files.Rider; C: Context; Lname, Fname: ARRAY 32 OF CHAR; BEGIN L := FirstLib; i := 0; WHILE name[i] >= "0" DO Lname[i] := name[i]; INC(i) END ; Lname[i] := 0X; WHILE (L # NIL) & (L.name # Lname) DO L := L.next END ; IF (L = NIL) OR replace THEN (*load library*) j := 0; WHILE name[j] > 0X DO Fname[j] := name[j]; INC(j) END ; IF i = j THEN Fname[j] := "."; Fname[j+1] := "L"; Fname[j+2] := "i"; Fname[j+3] := "b"; INC(j, 4) END ; Fname[j] := 0X; F := Files.Old(Fname); IF F # NIL THEN WMsg("loading ", name); Files.Set(R, F, 0); Files.Read(R, ch); IF ch = LibFileId THEN IF L = NIL THEN NEW(L); COPY(Lname, L.name); L.next := FirstLib; FirstLib := L 					END ; L.first := NIL; InitContext(C); WHILE ~R.eof DO 						NEW(mh); LoadElems(R, C, mh.first); ReadInt(R, mh.w); ReadInt(R, mh.h); ReadString(R, mh.name); mh.lib := L; mh.next := L.first; L.first := mh; END ELSE L := NIL; WMsg(name, " bad library") END ELSE WMsg(name, " not found") END END ; RETURN L 	END ThisLib; PROCEDURE NewLib*(VAR Lname: ARRAY OF CHAR): Library; VAR L: Library; BEGIN NEW(L); COPY(Lname, L.name); L.first := NIL; L.next := FirstLib; FirstLib := L; RETURN L 	END NewLib; PROCEDURE StoreLib*(L: Library; VAR Fname: ARRAY OF CHAR); VAR mh: MacHead; F: Files.File; W: Files.Rider; C: Context; BEGIN F := Files.New(Fname); Files.Set(W, F, 0); Files.Write(W, LibFileId); InitContext(C); mh := L.first; WHILE mh # NIL DO 			WriteInt(W, mh.w); WriteInt(W, mh.h); WriteString(W, mh.name); StoreElems(W, C, mh.first); mh := mh.next END END StoreLib; PROCEDURE RemoveLibraries*; BEGIN FirstLib := NIL END RemoveLibraries; PROCEDURE ThisMac*(L: Library; VAR Mname: ARRAY OF CHAR): MacHead; VAR mh: MacHead; BEGIN mh := L.first; WHILE (mh # NIL) & (mh.name # Mname) DO mh := mh.next END ; RETURN mh 	END ThisMac; PROCEDURE OpenMac*(mh: MacHead; G: Graph; x, y: INTEGER); VAR obj: Object; BEGIN obj := mh.first; WHILE obj # NIL DO 			obj.do.new; obj.do.copy(obj, new); INC(new.x, x); INC(new.y, y); new.selected := TRUE; Add(G, new); obj := obj.next END ; new := NIL END OpenMac; PROCEDURE DrawMac*(mh: MacHead; VAR M: Msg); VAR elem: Object; BEGIN elem := mh.first; WHILE elem # NIL DO elem.do.draw(elem, M); elem := elem.next END END DrawMac; PROCEDURE MakeMac*(G: Graph; x, y, w, h: INTEGER; 			VAR Mname: ARRAY OF CHAR): MacHead; VAR obj, last: Object; mh: MacHead; BEGIN obj := G.first; last := NIL; WHILE obj # NIL DO 			IF obj.selected THEN obj.do.new; obj.do.copy(obj, new); new.next := last; new.selected := FALSE; DEC(new.x, x); DEC(new.y, y); last := new END ; obj := obj.next END ; NEW(mh); mh.w := w; mh.h := h; mh.first := last; mh.ext := NIL; COPY(Mname, mh.name); new := NIL; RETURN mh 	END MakeMac; PROCEDURE InsertMac*(mh: MacHead; L: Library; VAR new: BOOLEAN); VAR mh1: MacHead; BEGIN mh.lib := L; mh1 := L.first; WHILE (mh1 # NIL) & (mh1.name # mh.name) DO mh1 := mh1.next END ; IF mh1 = NIL THEN new := TRUE; mh.next := L.first; L.first := mh 		ELSE new := FALSE; mh1.w := mh.w; mh1.h := mh.h; mh1.first := mh.first END END InsertMac; (* Line Methods -*) PROCEDURE* NewLine; VAR line: Line; BEGIN NEW(line); new := line; line.do := LineMethod END NewLine; PROCEDURE* CopyLine(src, dst: Object); BEGIN dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col END CopyLine; PROCEDURE* HandleLine(obj: Object; VAR M: Msg); BEGIN IF M IS WidMsg THEN IF obj.w < obj.h THEN IF obj.w <= 7 THEN obj.w := M(WidMsg).w END ELSIF obj.h <= 7 THEN obj.h := M(WidMsg).w 			END ELSIF M IS ColorMsg THEN obj.col := M(ColorMsg).col END END HandleLine; PROCEDURE* LineSelectable(obj: Object; x, y: INTEGER): BOOLEAN; BEGIN RETURN (obj.x <= x) & (x < obj.x + obj.w) & (obj.y <= y) & (y < obj.y + obj.h) 	END LineSelectable; PROCEDURE* ReadLine(obj: Object; VAR R: Files.Rider; VAR C: Context); BEGIN END ReadLine; PROCEDURE* WriteLine(obj: Object; cno: SHORTINT; 			VAR W: Files.Rider; VAR C: Context); BEGIN WriteObj(W, cno, obj) END WriteLine; PROCEDURE* PrintLine(obj: Object; x, y: INTEGER); VAR w, h: INTEGER; BEGIN w := obj.w * 2; h := obj.h * 2; IF w < h THEN h := 2*h ELSE w := 2*w END ; Printer.ReplConst(obj.x * 4 + x, obj.y *4 + y, w, h) 	END PrintLine; (* -- Caption Methods *) PROCEDURE* NewCaption; VAR cap: Caption; BEGIN NEW(cap); new := cap; cap.do := CapMethod END NewCaption; PROCEDURE* CopyCaption(src, dst: Object); VAR ch: CHAR; R: Texts.Reader; BEGIN WITH src: Caption DO 			WITH dst: Caption DO 				dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col; dst.pos := SHORT(T.len + 1); dst.len := src.len; Texts.Write(TW, 0DX); Texts.OpenReader(R, T, src.pos); Texts.Read(R, ch); TW.fnt := R.fnt; WHILE ch > 0DX DO Texts.Write(TW, ch); Texts.Read(R, ch) END END END ; Texts.Append(T, TW.buf) END CopyCaption; PROCEDURE* HandleCaption(obj: Object; VAR M: Msg); VAR dx, x1, dy, y1, w, w1, h1, len: INTEGER; pos: LONGINT; ch: CHAR; pat: Display.Pattern; fnt: Fonts.Font; R: Texts.Reader; BEGIN IF M IS FontMsg THEN fnt := M(FontMsg).fnt; w := 0; len := 0; pos := obj(Caption).pos; Texts.OpenReader(R, T, pos); Texts.Read(R, ch); dy := R.fnt.minY; WHILE ch > 0DX DO 				Display.GetChar(fnt.raster, ch, dx, x1, y1, w1, h1, pat); INC(w, dx); INC(len); Texts.Read(R, ch) END ; INC(obj.y, fnt.minY-dy); obj.w := w; obj.h := fnt.height; Texts.ChangeLooks(T, pos, pos+len, {0}, fnt, 0, 0) ELSIF M IS ColorMsg THEN obj.col := M(ColorMsg).col END END HandleCaption; PROCEDURE* CaptionSelectable(obj: Object; x, y: INTEGER): BOOLEAN; BEGIN RETURN (obj.x <= x) & (x < obj.x + obj.w) & (obj.y <= y) & (y < obj.y + obj.h) 	END CaptionSelectable; PROCEDURE* ReadCaption(obj: Object; VAR R: Files.Rider; VAR C: Context); VAR ch: CHAR; fno: SHORTINT; len: INTEGER; BEGIN obj(Caption).pos := SHORT(T.len + 1); Texts.Write(TW, 0DX); Files.Read(R, fno); TW.fnt := C.font[fno]; len := 0; Files.Read(R, ch); WHILE ch > 0DX DO Texts.Write(TW, ch); INC(len); Files.Read(R, ch) END ; obj(Caption).len := len; Texts.Append(T, TW.buf) END ReadCaption; PROCEDURE* WriteCaption(obj: Object; cno: SHORTINT; 			VAR W: Files.Rider; VAR C: Context); VAR ch: CHAR; fno: SHORTINT; TR: Texts.Reader; BEGIN Texts.OpenReader(TR, T, obj(Caption).pos); Texts.Read(TR, ch); fno := FontNo(W, C, TR.fnt); WriteObj(W, cno, obj); Files.Write(W, fno); WHILE ch > 0DX DO Files.Write(W, ch); Texts.Read(TR, ch) END ; Files.Write(W, 0X) END WriteCaption; PROCEDURE* PrintCaption(obj: Object; x, y: INTEGER); VAR fnt: Fonts.Font; i: INTEGER; ch: CHAR; R: Texts.Reader; s: ARRAY 128 OF CHAR; BEGIN Texts.OpenReader(R, T, obj(Caption).pos); Texts.Read(R, ch); fnt := R.fnt; DEC(y, fnt.minY*4); i := 0; WHILE ch >= " " DO s[i] := ch; INC(i); Texts.Read(R, ch) END ; s[i] := 0X; IF i > 0 THEN Printer.String(obj.x*4 + x, obj.y*4 + y, s, fnt.name) END END PrintCaption; (* -- Macro Methods *) PROCEDURE* NewMacro; VAR mac: Macro; BEGIN NEW(mac); new := mac; mac.do := MacMethod END NewMacro; PROCEDURE* CopyMacro(src, dst: Object); BEGIN dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; 		dst.col := src.col; dst(Macro).mac := src(Macro).mac END CopyMacro; PROCEDURE* HandleMacro(obj: Object; VAR M: Msg); BEGIN IF M IS ColorMsg THEN obj.col := M(ColorMsg).col END END HandleMacro; PROCEDURE* MacroSelectable(obj: Object; x, y: INTEGER): BOOLEAN; BEGIN RETURN (obj.x <= x) & (x <= obj.x + 8) & (obj.y <= y) & (y <= obj.y + 8) END MacroSelectable; PROCEDURE* ReadMacro(obj: Object; VAR R: Files.Rider; VAR C: Context); VAR lno: SHORTINT; name: ARRAY 32 OF CHAR; BEGIN Files.Read(R, lno); ReadString(R, name); obj(Macro).mac := ThisMac(C.lib[lno], name) END ReadMacro; PROCEDURE* WriteMacro(obj: Object; cno: SHORTINT; 			VAR W1: Files.Rider; VAR C: Context); VAR ch: CHAR; lno: SHORTINT; TR: Texts.Reader; BEGIN lno := 0; WITH obj: Macro DO 			WHILE (lno < C.noflibs) & (obj.mac.lib # C.lib[lno]) DO INC(lno) END ; IF lno = C.noflibs THEN Files.Write(W1, 0); Files.Write(W1, 1); Files.Write(W1, lno); WriteString(W1, obj.mac.lib.name); C.lib[lno] := obj.mac.lib; INC(C.noflibs) END ; WriteObj(W1, cno, obj); Files.Write(W1, lno); WriteString(W1, obj.mac.name) END END WriteMacro; PROCEDURE* PrintMacro(obj: Object; x, y: INTEGER); VAR elem: Object; mh: MacHead; BEGIN mh := obj(Macro).mac; IF mh # NIL THEN elem := mh.first; WHILE elem # NIL DO 				elem.do.print(elem, obj.x*4 + x, obj.y*4 + y); elem := elem.next END END END PrintMacro; PROCEDURE* Notify(T: Texts.Text; op: INTEGER; beg, end: LONGINT); BEGIN END Notify; BEGIN Texts.OpenWriter(W); Texts.OpenWriter(TW); width := 1; NEW(T); Texts.Open(T, ""); T.notify := Notify; NEW(LineMethod); LineMethod.new := NewLine; LineMethod.copy := CopyLine; LineMethod.selectable := LineSelectable; LineMethod.handle := HandleLine; LineMethod.read := ReadLine; LineMethod.write := WriteLine; LineMethod.print := PrintLine; NEW(CapMethod); CapMethod.new := NewCaption; CapMethod.copy := CopyCaption; CapMethod.selectable := CaptionSelectable; CapMethod.handle := HandleCaption; CapMethod.read := ReadCaption; CapMethod.write := WriteCaption; CapMethod.print := PrintCaption; NEW(MacMethod); MacMethod.new := NewMacro; MacMethod.copy := CopyMacro; MacMethod.selectable := MacroSelectable; MacMethod.handle := HandleMacro; MacMethod.read := ReadMacro; MacMethod.write := WriteMacro; MacMethod.print := PrintMacro END Graphics.