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.