MODULE Graphics; (*NW 21.12.89 / 18.11.201 / 8.4.2016*) IMPORT SYSTEM, Files, Modules, Fonts, (*Printer,*) Texts, Oberon; CONST NameLen* = 32; GraphFileId = 0FAX; LibFileId = 0FBX; 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*: INTEGER; col*: BYTE; selected*, marked*: BOOLEAN; do*: Method; next: 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; changed*: BOOLEAN 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 6 OF Modules.Command END; MethodDesc* = RECORD module*, allocator*: Name; new*: Modules.Command; copy*: PROCEDURE (from, to: Object); draw*, change*: 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: INTEGER; VAR R: Files.Rider; VAR C: Context); print*: PROCEDURE (obj: Object; x, y: INTEGER) END ; LineDesc* = RECORD (ObjectDesc) unused*: INTEGER END ; CaptionDesc* = RECORD (ObjectDesc) pos*, len*: INTEGER END ; MacroDesc* = RECORD (ObjectDesc) mac*: MacHead END ; VAR width*, res*: INTEGER; new: Object; T*: Texts.Text; (*captions*) LineMethod*, CapMethod*, MacMethod* : Method; GetLib0: PROCEDURE (name: ARRAY OF CHAR; replace: BOOLEAN; VAR Lib: Library); FirstLib: Library; W, TW, XW: Texts.Writer; PROCEDURE New*(obj: Object); BEGIN new := obj END New; 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(); G.changed := TRUE END Add; 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 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 List*(G: Graph); VAR obj: Object; tag: INTEGER; BEGIN obj := G.first; WHILE obj # NIL DO Texts.Write(XW, 9X); Texts.WriteHex(XW, ORD(obj)); Texts.Write(XW, 9X); Texts.WriteInt(XW, obj.x, 5); Texts.WriteInt(XW, obj.y, 5); Texts.WriteInt(XW, obj.w, 5); Texts.WriteInt(XW, obj.h, 5); Texts.Write(XW, "/"); SYSTEM.GET(ORD(obj)-8, tag); Texts.WriteHex(XW, tag); SYSTEM.GET(ORD(obj)-4, tag); Texts.WriteHex(XW, tag); Texts.WriteLn(XW); obj := obj.next END ; Texts.Append(Oberon.Log, XW.buf) END List; (*----------------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 Change*(G: Graph; VAR M: Msg); VAR obj: Object; BEGIN obj := G.first; G.changed := TRUE; WHILE obj # NIL DO IF obj.selected THEN obj.do.change(obj, M) END ; obj := obj.next END END Change; PROCEDURE Move*(G: Graph; dx, dy: INTEGER); VAR obj, ob0: Object; x0, x1, y0, y1: INTEGER; BEGIN obj := G.first; G.changed := TRUE; 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; Gd.changed := TRUE; 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; G.changed := TRUE; 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; (* ---------------------- 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): INTEGER; VAR fno: INTEGER; BEGIN fno := 0; WHILE (fno < C.nofonts) & (C.font[fno] # fnt) DO INC(fno) END ; IF fno = C.nofonts THEN Files.WriteByte(W, 0); Files.WriteByte(W, 0); Files.WriteByte(W, fno); Files.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.WriteByte(W, 0); Files.WriteByte(W, 2); Files.WriteByte(W, cno); Files.WriteString(W, obj.do.module); Files.WriteString(W, obj.do.allocator); C.class[cno] := obj.do.new; INC(C.nofclasses) END ; obj.do.write(obj, cno, W, C); obj := obj.next END ; Files.WriteByte(W, 255) END StoreElems; PROCEDURE Store*(G: Graph; VAR W: Files.Rider); VAR C: Context; BEGIN InitContext(C); StoreElems(W, C, G.first); G.changed := FALSE END Store; PROCEDURE WriteObj*(VAR W: Files.Rider; cno: INTEGER; obj: Object); BEGIN Files.WriteByte(W, cno); Files.WriteInt(W, obj.y * 10000H + obj.x); Files.WriteInt(W, obj.h * 10000H + obj.w); Files.WriteByte(W, obj.col) END WriteObj; 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 GetClass*(module, allocator: ARRAY OF CHAR; VAR com: Modules.Command); VAR mod: Modules.Module; BEGIN Modules.Load(module, mod); 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 END GetClass; PROCEDURE Font*(VAR R: Files.Rider; VAR C: Context): Fonts.Font; VAR fno: BYTE; BEGIN Files.ReadByte(R, fno); RETURN C.font[fno] END Font; PROCEDURE ReadObj(VAR R: Files.Rider; obj: Object); VAR xy, wh: INTEGER; dmy: BYTE; BEGIN Files.ReadInt(R, xy); obj.y := xy DIV 10000H; obj.x := xy * 10000H DIV 10000H; Files.ReadInt(R, wh); obj.h := wh DIV 10000H; obj.w := wh * 10000H DIV 10000H; Files.ReadByte(R, obj.col) END ReadObj; PROCEDURE LoadElems(VAR R: Files.Rider; VAR C: Context; VAR fobj: Object); VAR cno, m, n, len: BYTE; pos: INTEGER; obj: Object; fnt: Fonts.Font; name, name1: ARRAY 32 OF CHAR; BEGIN obj := NIL; Files.ReadByte(R, cno); WHILE ~R.eof & (cno < 255) DO IF cno = 0 THEN Files.ReadByte(R, m); Files.ReadByte(R, n); Files.ReadString(R, name); IF m = 0 THEN fnt := Fonts.This(name); C.font[n] := fnt ELSIF m = 1 THEN GetLib0(name, FALSE, C.lib[n]) ELSIF m = 2 THEN Files.ReadString(R, name1); GetClass(name, name1, C.class[n]) 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 ReadObj(R, new); Files.ReadByte(R, len); pos := Files.Pos(R); Files.Set(R, Files.Base(R), pos + len) END ; Files.ReadByte(R, cno) END ; new := NIL; fobj := obj 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; G.changed := FALSE; 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; PROCEDURE SetWidth*(w: INTEGER); BEGIN width := w END SetWidth; (* --------------------- Macros / Libraries ----------------------- *) PROCEDURE GetLib*(name: ARRAY OF CHAR; replace: BOOLEAN; VAR Lib: Library); VAR i, wh: INTEGER; ch: CHAR; L: Library; mh: MacHead; obj: Object; F: Files.File; R: Files.Rider; C: Context; Lname, Fname: ARRAY 32 OF CHAR; BEGIN L := FirstLib; i := 0; WHILE (L # NIL) & (L.name # name) DO L := L.next END ; IF L = NIL THEN (*load library from file*) i := 0; WHILE name[i] > 0X DO Fname[i] := name[i]; INC(i) END ; Fname[i] := "."; Fname[i+1] := "L"; Fname[i+2] := "i"; Fname[i+3] := "b"; Fname[i+4] := 0X; F := Files.Old(Fname); IF F # NIL THEN WMsg("loading ", Fname); Files.Set(R, F, 0); Files.Read(R, ch); IF ch = LibFileId THEN IF L = NIL THEN NEW(L); L.name := name; L.next := FirstLib; FirstLib := L END ; L.first := NIL; InitContext(C); LoadElems(R, C, obj); WHILE obj # NIL DO NEW(mh); mh.first := obj; Files.ReadInt(R, wh); mh.h := wh DIV 10000H MOD 10000H; mh.w := wh MOD 10000H; Files.ReadString(R, mh.name); mh.lib := L; mh.next := L.first; L.first := mh; LoadElems(R, C, obj) END ; ELSE L := NIL END ELSE L := NIL END END ; Lib := L END GetLib; PROCEDURE NewLib*(Lname: ARRAY OF CHAR): Library; VAR L: Library; BEGIN NEW(L); L.name := Lname; L.first := NIL; L.next := FirstLib; FirstLib := L; RETURN L END NewLib; PROCEDURE StoreLib*(L: Library; Fname: ARRAY OF CHAR); VAR i: INTEGER; mh: MacHead; F: Files.File; W: Files.Rider; C: Context; Gname: ARRAY 32 OF CHAR; BEGIN L := FirstLib; WHILE (L # NIL) & (L.name # Fname) DO L := L.next END ; IF L # NIL THEN i := 0; WHILE Fname[i] > 0X DO Gname[i] := Fname[i]; INC(i) END ; Gname[i] := "."; Gname[i+1] := "L"; Gname[i+2] := "i"; Gname[i+3] := "b"; Gname[i+4] := 0X; F := Files.New(Gname); Files.Set(W, F, 0); Files.Write(W, LibFileId); InitContext(C); mh := L.first; WHILE mh # NIL DO StoreElems(W, C, mh.first); Files.WriteInt(W, mh.h * 10000H + mh.w); Files.WriteString(W, mh.name); mh := mh.next END ; Files.WriteByte(W, 255); Files.Register(F) ELSE Texts.WriteString(TW, Fname); Texts.WriteString(TW, " not found"); Texts.WriteLn(TW); Texts.Append(Oberon.Log, TW.buf) END END StoreLib; PROCEDURE RemoveLibraries*; BEGIN FirstLib := NIL END RemoveLibraries; PROCEDURE ThisMac*(L: Library; 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 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; (* -------------------- Procedures for designing macros---------------------*) 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 MakeMac*(G: Graph; VAR head: MacHead); VAR x0, y0, x1, y1: INTEGER; obj, last: Object; mh: MacHead; BEGIN obj := G.first; last := NIL; x0 := 1024; x1 := 0; y0 := 1024; y1 := 0; WHILE obj # NIL DO IF obj.selected THEN obj.do.new; obj.do.copy(obj, new); new.next := last; new.selected := FALSE; last := new; IF obj.x < x0 THEN x0 := obj.x END ; IF obj.x + obj.w > x1 THEN x1 := obj.x + obj.w END ; IF obj.y < y0 THEN y0 := obj.y END ; IF obj.y + obj.h > y1 THEN y1 := obj.y + obj.h END END ; obj := obj.next END ; obj := last; WHILE obj # NIL DO obj.x := obj.x - x0; obj.y := obj.y - y0; obj := obj.next END ; NEW(mh); mh.w := x1 - x0; mh.h := y1 - y0; mh.first := last; mh.ext := NIL; new := NIL; head := 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 ChangeLine(obj: Object; VAR M: Msg); BEGIN CASE M OF WidMsg: IF obj.w < obj.h THEN IF obj.w <= 7 THEN obj.w := M.w END ELSIF obj.h <= 7 THEN obj.h := M.w END | ColorMsg: obj.col := M.col END END ChangeLine; 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: INTEGER; 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 dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col; dst(Caption).pos := T.len + 1; dst(Caption).len := src(Caption).len; Texts.Write(TW, 0DX); Texts.OpenReader(R, T, src(Caption).pos); Texts.Read(R, ch); TW.fnt := R.fnt; WHILE ch > 0DX DO Texts.Write(TW, ch); Texts.Read(R, ch) END ; Texts.Append(T, TW.buf) END CopyCaption; PROCEDURE ChangeCaption(obj: Object; VAR M: Msg); VAR dx, x1, dy, y1, w, w1, h1, len: INTEGER; pos: LONGINT; ch: CHAR; patadr: INTEGER; fnt: Fonts.Font; R: Texts.Reader; BEGIN CASE M OF FontMsg: 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 Fonts.GetPat(fnt, ch, dx, x1, y1, w1, h1, patadr); 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) | ColorMsg: obj.col := M(ColorMsg).col END END ChangeCaption; 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: BYTE; len: INTEGER; BEGIN obj(Caption).pos := T.len + 1; Texts.Write(TW, 0DX); Files.ReadByte(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: INTEGER; VAR W: Files.Rider; VAR C: Context); VAR ch: CHAR; fno: BYTE; TR: Texts.Reader; BEGIN IF obj(Caption).len > 0 THEN Texts.OpenReader(TR, T, obj(Caption).pos); Texts.Read(TR, ch); fno := FontNo(W, C, TR.fnt); WriteObj(W, cno, obj); Files.WriteByte(W, fno); WHILE ch > 0DX DO Files.Write(W, ch); Texts.Read(TR, ch) END ; Files.Write(W, 0X) END 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 IF obj(Caption).len > 0 THEN 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 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 ChangeMacro(obj: Object; VAR M: Msg); BEGIN CASE M OF ColorMsg: obj.col := M.col END END ChangeMacro; 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: BYTE; name: ARRAY 32 OF CHAR; BEGIN Files.ReadByte(R, lno); Files.ReadString(R, name); obj(Macro).mac := ThisMac(C.lib[lno], name) END ReadMacro; PROCEDURE WriteMacro(obj: Object; cno: INTEGER; VAR W1: Files.Rider; VAR C: Context); VAR lno: INTEGER; BEGIN lno := 0; WHILE (lno < C.noflibs) & (obj(Macro).mac.lib # C.lib[lno]) DO INC(lno) END ; IF lno = C.noflibs THEN Files.WriteByte(W1, 0); Files.WriteByte(W1, 1); Files.WriteByte(W1, lno); Files.WriteString(W1, obj(Macro).mac.lib.name); C.lib[lno] := obj(Macro).mac.lib; INC(C.noflibs) END ; WriteObj(W1, cno, obj); Files.WriteByte(W1, lno); Files.WriteString(W1, obj(Macro).mac.name) 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; PROCEDURE InstallDrawMethods*(drawLine, drawCaption, drawMacro: PROCEDURE (obj: Object; VAR msg: Msg)); BEGIN LineMethod.draw := drawLine; CapMethod.draw := drawCaption; MacMethod.draw := drawMacro END InstallDrawMethods; BEGIN Texts.OpenWriter(W); Texts.OpenWriter(TW); Texts.OpenWriter(XW); width := 1; GetLib0 := GetLib; NEW(T); Texts.Open(T, ""); T.notify := Notify; NEW(LineMethod); LineMethod.new := NewLine; LineMethod.copy := CopyLine; LineMethod.selectable := LineSelectable; LineMethod.change := ChangeLine; LineMethod.read := ReadLine; LineMethod.write := WriteLine; (*LineMethod.print := PrintLine;*) NEW(CapMethod); CapMethod.new := NewCaption; CapMethod.copy := CopyCaption; CapMethod.selectable := CaptionSelectable; CapMethod.change := ChangeCaption; CapMethod.read := ReadCaption; CapMethod.write := WriteCaption; (*CapMethod.print := PrintCaption;*) NEW(MacMethod); MacMethod.new := NewMacro; MacMethod.copy := CopyMacro; MacMethod.selectable := MacroSelectable; MacMethod.change := ChangeMacro; MacMethod.read := ReadMacro; MacMethod.write := WriteMacro; (*MacMethod.print := PrintMacro*) END Graphics.