Oberon/V2/Texts.Mod

MODULE Texts; (*JG 21.11.90*)

	IMPORT Files, Fonts, Reals;

	CONST
		(*symbol classes*)
		Inval* = 0;         (*invalid symbol*)
		Name* = 1;       (*name s (length len)*)
		String* = 2;       (*literal string s (length len)*)
		Int* = 3;            (*integer i (decimal or hexadecimal)*)
		Real* = 4;         (*real number x*)
		LongReal* = 5; (*long real number y*)
		Char* = 6;          (*special character c*)
		TAB = 9X; CR = 0DX; maxD = 9;

		(* TextBlock = TextBlockId off run {run} 0 len {AsciiCode}.
		run = fnt [name] col voff len. *)

		TextBlockId = 1FFH;

		replace* = 0; insert* = 1; delete* = 2; (*op-codes*)

	TYPE
		Piece = POINTER TO PieceDesc;
		PieceDesc = RECORD
		f: Files.File;
		off: LONGINT;
		len: LONGINT;
		fnt: Fonts.Font;
		col: SHORTINT;
		voff: SHORTINT;
		prev, next: Piece
		END;

		Text* = POINTER TO TextDesc;

		Notifier* = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);

		TextDesc* = RECORD
			len*: LONGINT;
			notify*: Notifier;
			trailer: Piece;
			org: LONGINT; (*cache*)
			pce: Piece
		END;

		Reader* = RECORD (Files.Rider)
			eot*: BOOLEAN;
			fnt*: Fonts.Font;
			col*: SHORTINT;
			voff*: SHORTINT;
			ref: Piece;
			org: LONGINT;
			off: LONGINT
		END;

		Scanner* = RECORD (Reader)
			nextCh*: CHAR;
			line*: INTEGER;
			class*: INTEGER;
			i*: LONGINT;
			x*: REAL;
			y*: LONGREAL;
			c*: CHAR;
			len*: SHORTINT;
			s*: ARRAY 32 OF CHAR
		END;
		
		Buffer* = POINTER TO BufDesc;
		BufDesc* = RECORD
			len*: LONGINT;
			header, last: Piece
		END;

		Writer* = RECORD (Files.Rider)
			buf*: Buffer;
			fnt*: Fonts.Font;
			col*: SHORTINT;
			voff*: SHORTINT
		END;

	VAR W: Writer; WFile: Files.File; DelBuf: Buffer;

	PROCEDURE EQ (VAR s, t: ARRAY OF CHAR): BOOLEAN;
		VAR i: INTEGER;
	BEGIN i := 0;
		WHILE (s[i] # 0X) & (t[i] # 0X) & (s[i] = t[i]) DO INC(i) END;
		RETURN s[i] = t[i]
	END EQ;

	PROCEDURE ReadName (VAR R: Files.Rider; VAR name: ARRAY OF CHAR);
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; Files.Read(R, ch);
		WHILE ch # 0X DO name[i] := ch; INC(i); Files.Read(R, ch) END;
		name[i] := 0X
	END ReadName;

	PROCEDURE WriteName (VAR W: Files.Rider; VAR name: ARRAY OF CHAR);
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; ch := name[i];
		WHILE ch # 0X DO Files.Write(W, ch); INC(i); ch := name[i] END;
		Files.Write(W, 0X)
	END WriteName;

	PROCEDURE Load* (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);
		VAR
			R: Files.Rider;
			Q, q, p: Piece;
			off: LONGINT;
			N, fnt: SHORTINT;
			FName: ARRAY 32 OF CHAR;
			Dict: ARRAY 32 OF Fonts.Font;
	BEGIN
		N := 1;
		NEW(Q); Q.f := WFile; Q.off := 0; Q.len := 1; Q.fnt := NIL; Q.col := 0; Q.voff := 0; p := Q;
		Files.Set(R, f, pos); Files.ReadBytes(R, off, 4);
		LOOP
			Files.Read(R, fnt);
			IF fnt = 0 THEN EXIT END;
			IF fnt = N THEN
				ReadName(R, FName);
				Dict[N] := Fonts.This(FName);
				INC(N)
			END;
			NEW(q);
			q.fnt := Dict[fnt];
			Files.Read(R, q.col);
			Files.Read(R, q.voff);
			Files.ReadBytes(R, q.len, 4);
			q.f := f; q.off := off;
			off := off + q.len;
			p.next := q; q.prev := p; p := q
		END;
		p.next := Q; Q.prev := p;
		T.trailer := Q; Files.ReadBytes(R, T.len, 4);
		T.org := -1; T.pce := T.trailer; (*init cache*)
		len := off - pos
	END Load;

	PROCEDURE Open* (T: Text; name: ARRAY OF CHAR);
		VAR f: Files.File; R: Files.Rider; Q, q: Piece;
			id: INTEGER; len: LONGINT;
	BEGIN
		f := Files.Old(name);
		IF f # NIL THEN
			Files.Set(R, f, 0); Files.ReadBytes(R, id, 2);
			IF id = TextBlockId THEN Load(T, f, 2, len)
			ELSE (*Ascii file*)
				len := Files.Length(f);
				NEW(Q); Q.fnt := NIL; Q.col := 0; Q.voff := 0; Q.f := WFile; Q.off := 0; Q.len := 1;
				NEW(q); q.fnt := Fonts.Default; q.col := 15; q.voff := 0; q.f := f; q.off := 0; q.len := len;
				Q.next := q; q.prev := Q; q.next := Q; Q.prev := q;
				T.trailer := Q; T.len := len;
				T.org := -1; T.pce := T.trailer (*init cache*)
			END
		ELSE (*create new text*)
			NEW(Q); Q.fnt := NIL; Q.col := 0; Q.voff := 0; Q.f := WFile; Q.off := 0; Q.len := 1;
			Q.next := Q; Q.prev := Q;
			T.trailer := Q; T.len := 0;
			T.org := -1; T.pce := T.trailer (*init cache*)
		END
	END Open;

	PROCEDURE OpenBuf* (B: Buffer);
	BEGIN NEW(B.header); (*null piece*)
		B.last := B.header; B.len := 0
	END OpenBuf;

	PROCEDURE FindPiece (T: Text; pos: LONGINT; VAR org: LONGINT; VAR p: Piece);
		VAR n: INTEGER;
	BEGIN
		IF pos < T.org THEN T.org := -1; T.pce := T.trailer END;
		org := T.org; p := T.pce; (*from cache*)
		n := 0;
		WHILE pos >= org + p.len DO org := org + p.len; p := p.next; INC(n) END;
		IF n > 50 THEN T.org := org; T.pce := p END
	END FindPiece;

	PROCEDURE SplitPiece (p: Piece; off: LONGINT; VAR pr: Piece);
		VAR q: Piece;
	BEGIN
		IF off > 0 THEN NEW(q);
			q.fnt := p.fnt; q.col := p.col; q.voff := p.voff;
			q.len := p.len - off;
			q.f := p.f; q.off := p.off + off;
			p.len := off;
			q.next := p.next; p.next := q;
			q.prev := p; q.next.prev := q;
			pr := q
		ELSE pr := p
		END
	END SplitPiece;

	PROCEDURE OpenReader* (VAR R: Reader; T: Text; pos: LONGINT);
		VAR p: Piece; org: LONGINT;
	BEGIN
		FindPiece(T, pos, org, p);
		R.ref := p; R.org := org; R.off := pos - org;
		Files.Set(R, R.ref.f, R.ref.off + R.off); R.eot := FALSE
	END OpenReader;

	PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);
	BEGIN
		Files.Read(R, ch); R.fnt := R.ref.fnt; R.col := R.ref.col; R.voff := R.ref.voff;
		INC(R.off);
		IF R.off = R.ref.len THEN
			IF R.ref.f = WFile THEN R.eot := TRUE END;
			R.org := R.org + R.off; R.off := 0;
			R.ref := R.ref.next; R.org := R.org + R.off; R.off := 0;
			Files.Set(R, R.ref.f, R.ref.off)
		END
	END Read;

	PROCEDURE Pos* (VAR R: Reader): LONGINT;
	BEGIN RETURN R.org + R.off
	END Pos;

	PROCEDURE Store* (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);
	VAR
		p, q: Piece;
		R: Reader; W: Files.Rider;
		off, rlen: LONGINT; id: INTEGER;
		N, n: SHORTINT; ch: CHAR;
		Dict: ARRAY 32 OF Fonts.Name;
	BEGIN
		Files.Set(W, f, pos);
		id := TextBlockId; Files.WriteBytes(W, id, 2);
		Files.WriteBytes(W, off, 4); (*place holder*)
		N := 1;
		p := T.trailer.next;
		WHILE p # T.trailer DO
			rlen := p.len; q := p.next;
			WHILE (q # T.trailer) & (q.fnt = p.fnt) & (q.col = p.col) & (q.voff = p.voff) DO
				rlen := rlen + q.len; q := q.next
			END;
			Dict[N] := p.fnt.name;
			n := 1;
			WHILE ~EQ(Dict[n], p.fnt.name) DO INC(n) END;
			Files.Write(W, n);
			IF n = N THEN WriteName(W, p.fnt.name); INC(N) END;
			Files.Write(W, p.col);
			Files.Write(W, p.voff);
			Files.WriteBytes(W, rlen, 4);
			p := q
		END;
		Files.Write(W, 0); Files.WriteBytes(W, T.len, 4);
		off := Files.Pos(W);
		OpenReader(R, T, 0); Read(R, ch);
		WHILE ~R.eot DO Files.Write(W, ch); Read(R, ch) END;
		Files.Set(W, f, pos + 2); Files.WriteBytes(W, off, 4); (*fixup*)
		len := off + T.len - pos
	END Store;

	PROCEDURE Save* (T: Text; beg, end: LONGINT; B: Buffer);
		VAR p, q, qb, qe: Piece; org: LONGINT;
	BEGIN
		IF end > T.len THEN end := T.len END;
		FindPiece(T, beg, org, p);
		NEW(qb); qb^ := p^;
		qb.len := qb.len - (beg - org);
		qb.off := qb.off + (beg - org);
		qe := qb;
		WHILE end > org + p.len DO
			org := org + p.len; p := p.next;
			NEW(q); q^ := p^; qe.next := q; q.prev := qe; qe := q
		END;
		qe.next := NIL; qe.len := qe.len - (org + p.len - end);
		B.last.next := qb; qb.prev := B.last; B.last := qe;
		B.len := B.len + (end - beg)
	END Save;

	PROCEDURE Copy* (SB, DB: Buffer);
		VAR Q, q, p: Piece;
	BEGIN
		p := SB.header; Q := DB.last;
		WHILE p # SB.last DO p := p.next;
			NEW(q); q^ := p^; Q.next := q; q.prev := Q; Q := q
		END;
		DB.last := Q; DB.len := DB.len + SB.len
	END Copy;

	PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: Fonts.Font; col, voff:
SHORTINT);
		VAR pb, pe, p: Piece; org: LONGINT;
	BEGIN
		IF end > T.len THEN end := T.len END;
		FindPiece(T, beg, org, p); SplitPiece(p, beg - org, pb);
		FindPiece(T, end, org, p); SplitPiece(p, end - org, pe);
		p := pb;
		REPEAT
			IF 0 IN sel THEN p.fnt := fnt END;
			IF 1 IN sel THEN p.col := col END;
			IF 2 IN sel THEN p.voff := voff END;
			p := p.next
		UNTIL p = pe;
		T.notify(T, replace, beg, end)
	END ChangeLooks;

	PROCEDURE Insert* (T: Text; pos: LONGINT; B: Buffer);
		VAR pl, pr, p, qb, qe: Piece; org, end: LONGINT;
	BEGIN
		FindPiece(T, pos, org, p); SplitPiece(p, pos - org, pr);
		IF T.org >= org THEN (*adjust cache*)
			T.org := org - p.prev.len; T.pce := p.prev
		END;
		pl := pr.prev; qb := B.header.next;
		IF (qb # NIL) & (qb.f = pl.f) & (qb.off = pl.off + pl.len)
			& (qb.fnt = pl.fnt) & (qb.col = pl.col) & (qb.voff = pl.voff) THEN
			pl.len := pl.len + qb.len; qb := qb.next
		END;
		IF qb # NIL THEN qe := B.last;
			qb.prev := pl; pl.next := qb; qe.next := pr; pr.prev := qe
		END;
		T.len := T.len + B.len; end := pos + B.len;
		B.last := B.header; B.last.next := NIL; B.len := 0;
		T.notify(T, insert, pos, end)
	END Insert;

	PROCEDURE Append* (T: Text; B: Buffer);
	BEGIN Insert(T, T.len, B)
	END Append;

	PROCEDURE Delete* (T: Text; beg, end: LONGINT);
		VAR pb, pe, pbr, per: Piece; orgb, orge: LONGINT;
	BEGIN
		IF end > T.len THEN end := T.len END;
		FindPiece(T, beg, orgb, pb); SplitPiece(pb, beg - orgb, pbr);
		FindPiece(T, end, orge, pe); SplitPiece(pe, end - orge, per);
		IF T.org >= orgb THEN (*adjust cache*)
			T.org := orgb - pb.prev.len; T.pce := pb.prev
		END;
		DelBuf.header.next := pbr; DelBuf.last := per.prev;
		DelBuf.last.next := NIL; DelBuf.len := end - beg;
		per.prev := pbr.prev; pbr.prev.next := per;
		T.len := T.len - DelBuf.len;
		T.notify(T, delete, beg, end)
	END Delete;

	PROCEDURE Recall* (VAR B: Buffer); (*deleted text*)
	BEGIN B := DelBuf; NEW(DelBuf); OpenBuf(DelBuf)
	END Recall;

	PROCEDURE OpenScanner* (VAR S: Scanner; T: Text; pos: LONGINT);
	BEGIN OpenReader(S, T, pos); S.line := 0; Read(S, S.nextCh)
	END OpenScanner;
	
	(*floating point formats:
		x = 1.m * 2^(e-127) bit 0: sign, bits 1- 8: e, bits 9-31: m
		x = 1.m * 2^(e-1023) bit 0: sign, bits 1-11: e, bits 12-63: m *)

	PROCEDURE Scan* (VAR S: Scanner);
		CONST maxD = 32;
		VAR ch, term: CHAR;
			neg, negE, hex: BOOLEAN;
			i, j, h: SHORTINT;
			e: INTEGER; k: LONGINT;
			x, f: REAL; y, g: LONGREAL;
			d: ARRAY maxD OF CHAR;

		PROCEDURE ReadScaleFactor;
		BEGIN Read(S, ch);
			IF ch = "-" THEN negE := TRUE; Read(S, ch)
			ELSE negE := FALSE;
				IF ch = "+" THEN Read(S, ch) END
			END;
			WHILE ("0" <= ch) & (ch <= "9") DO
				e := e*10 + ORD(ch) - 30H; Read(S, ch)
			END
		END ReadScaleFactor;

	BEGIN ch := S.nextCh; i := 0;
		LOOP
			IF ch = CR THEN INC(S.line)
			ELSIF (ch # " ") & (ch # TAB) THEN EXIT
			END ;
			Read(S, ch)
		END;
		IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") THEN (*name*)
			REPEAT S.s[i] := ch; INC(i); Read(S, ch)
			UNTIL (CAP(ch) > "Z")
				OR ("A" > CAP(ch)) & (ch > "9")
				OR ("0" > ch) & (ch # ".")
				OR (i = 31);
			S.s[i] := 0X; S.len := i; S.class := 1
		ELSIF ch = 22X THEN (*literal string*)
			Read(S, ch);
			WHILE (ch # 22X) & (ch >= " ") & (i # 31) DO
				S.s[i] := ch; INC(i); Read(S, ch)
			END;
			S.s[i] := 0X; S.len := i+1; Read(S, ch); S.class := 2
		ELSE
			IF ch = "-" THEN neg := TRUE; Read(S, ch) ELSE neg := FALSE END ;
			IF ("0" <= ch) & (ch <= "9") THEN (*number*)
				hex := FALSE; j := 0;
				LOOP d[i] := ch; INC(i); Read(S, ch);
					IF ch < "0" THEN EXIT END;
					IF "9" < ch THEN
						IF ("A" <= ch) & (ch <= "F") THEN hex := TRUE; ch := CHR(ORD(ch)-7)
						ELSIF ("a" <= ch) & (ch <= "f") THEN hex := TRUE; ch := CHR(ORD(ch)-27H)
						ELSE EXIT
						END
					END
				END;
				IF ch = "H" THEN (*hex number*)
					Read(S, ch); S.class := 3;
					IF i-j > 8 THEN j := i-8 END ;
					k := ORD(d[j]) - 30H; INC(j);
					IF (i-j = 7) & (k >= 8) THEN DEC(k, 16) END ;
					WHILE j < i DO k := k*10H + (ORD(d[j]) - 30H); INC(j) END ;
					IF neg THEN S.i := -k ELSE S.i := k END
				ELSIF ch = "." THEN (*read real*)
					Read(S, ch); h := i;
					WHILE ("0" <= ch) & (ch <= "9") DO d[i] := ch; INC(i); Read(S, ch) END ;
					IF ch = "D" THEN
						e := 0; y := 0; g := 1;
						REPEAT y := y*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = h;
						WHILE j < i DO g := g/10; y := (ORD(d[j]) - 30H)*g + y; INC(j) END ;
						ReadScaleFactor;
						IF negE THEN
							IF e <= 308 THEN y := y / Reals.TenL(e) ELSE y := 0 END
						ELSIF e > 0 THEN
							IF e <= 308 THEN y := Reals.TenL(e) * y ELSE HALT(40) END
						END ;
						IF neg THEN y := -y END ;
						S.class := 5; S.y := y
					ELSE e := 0; x := 0; f := 1;
						REPEAT x := x*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = h;
						WHILE j < i DO f := f/10; x := (ORD(d[j])-30H)*f + x; INC(j) END;
						IF ch = "E" THEN ReadScaleFactor END ;
						IF negE THEN
							IF e <= 38 THEN x := x / Reals.Ten(e) ELSE x := 0 END
						ELSIF e > 0 THEN
							IF e <= 38 THEN x := Reals.Ten(e) * x ELSE HALT(40) END
						END ;
						IF neg THEN x := -x END ;
						S.class := 4; S.x := x
					END ;
					IF hex THEN S.class := 0 END
				ELSE (*decimal integer*)
					S.class := 3; k := 0;
					REPEAT k := k*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = i;
					IF neg THEN S.i := -k ELSE S.i := k END;
					IF hex THEN S.class := 0 ELSE S.class := 3 END
				END
			ELSE S.class := 6;
				IF neg THEN S.c := "-" ELSE S.c := ch; Read(S, ch) END
			END
		END;
		S.nextCh := ch
	END Scan;

	PROCEDURE OpenWriter* (VAR W: Writer);
	BEGIN
		NEW(W.buf); OpenBuf(W.buf); W.fnt := Fonts.Default; W.col := 15; W.voff := 0;
		Files.Set(W, Files.New(""), 0)
	END OpenWriter;

	PROCEDURE SetFont* (VAR W: Writer; fnt: Fonts.Font);
	BEGIN W.fnt := fnt
	END SetFont;

	PROCEDURE SetColor* (VAR W: Writer; col: SHORTINT);
	BEGIN W.col := col
	END SetColor;

	PROCEDURE SetOffset* (VAR W: Writer; voff: SHORTINT);
	BEGIN W.voff := voff
	END SetOffset;

	PROCEDURE Write* (VAR W: Writer; ch: CHAR);
		VAR p: Piece;
	BEGIN
		IF (W.buf.last.fnt # W.fnt) OR (W.buf.last.col # W.col) OR (W.buf.last.voff # W.voff) THEN
			NEW(p);
			p.f := Files.Base(W); p.off := Files.Pos(W); p.len := 0;
			p.fnt := W.fnt; p.col := W.col; p.voff:= W.voff;
			p.next := NIL; W.buf.last.next := p;
			p.prev := W.buf.last; W.buf.last := p
		END;
		Files.Write(W, ch);
		INC(W.buf.last.len); INC(W.buf.len)
	END Write;

	PROCEDURE WriteLn* (VAR W: Writer);
	BEGIN Write(W, CR)
	END WriteLn;

	PROCEDURE WriteString* (VAR W: Writer; s: ARRAY OF CHAR);
		VAR i: INTEGER;
	BEGIN i := 0;
		WHILE s[i] >= " " DO Write(W, s[i]); INC(i) END
	END WriteString;

	PROCEDURE WriteInt* (VAR W: Writer; x, n: LONGINT);
		VAR i: INTEGER; x0: LONGINT;
		a: ARRAY 11 OF CHAR;
	BEGIN i := 0;
		IF x < 0 THEN
			IF x = MIN(LONGINT) THEN WriteString(W, " -2147483648"); RETURN
			ELSE DEC(n); x0 := -x
			END
			ELSE x0 := x
		END;
		REPEAT
			a[i] := CHR(x0 MOD 10 + 30H); x0 := x0 DIV 10; INC(i)
		UNTIL x0 = 0;
		WHILE n > i DO Write(W, " "); DEC(n) END;
		IF x < 0 THEN Write(W, "-") END;
		REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0
	END WriteInt;

	PROCEDURE WriteHex* (VAR W: Writer; x: LONGINT);
		VAR i: INTEGER; y: LONGINT;
			a: ARRAY 10 OF CHAR;
	
	BEGIN i := 0; Write(W, " ");
		REPEAT y := x MOD 10H;
			IF y < 10 THEN a[i] := CHR(y + 30H) ELSE a[i] := CHR(y + 37H) END;
			x := x DIV 10H; INC(i)
		UNTIL i = 8;
		REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0
	END WriteHex;

	PROCEDURE WriteReal* (VAR W: Writer; x: REAL; n: INTEGER);
		VAR e: INTEGER; x0: REAL;
			d: ARRAY maxD OF CHAR;
	BEGIN e := Reals.Expo(x);
		IF e = 0 THEN
			WriteString(W, " 0");
			REPEAT Write(W, " "); DEC(n) UNTIL n <= 3
		ELSIF e = 255 THEN
			WriteString(W, " NaN");
			WHILE n > 4 DO Write(W, " "); DEC(n) END
		ELSE
			IF n <= 9 THEN n := 3 ELSE DEC(n, 6) END;
			REPEAT Write(W, " "); DEC(n) UNTIL n <= 8;
			(*there are 2 < n <= 8 digits to be written*)
			IF x < 0.0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END;
			e := (e - 127) * 77 DIV 256;
			IF e >= 0 THEN x := x / Reals.Ten(e) ELSE x := Reals.Ten(-e) * x END;
			IF x >= 10.0 THEN x := 0.1*x; INC(e) END;
			x0 := Reals.Ten(n-1); x := x0*x + 0.5;
			IF x >= 10.0*x0 THEN x := x*0.1; INC(e) END;
			Reals.Convert(x, n, d);
			DEC(n); Write(W, d[n]); Write(W, ".");
			REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;
			Write(W, "E");
			IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END;
			Write(W, CHR(e DIV 10 + 30H)); Write(W, CHR(e MOD 10 + 30H))
		END
	END WriteReal;

	PROCEDURE WriteRealFix* (VAR W: Writer; x: REAL; n, k: INTEGER);
		VAR e, i: INTEGER; sign: CHAR; x0: REAL;
			d: ARRAY maxD OF CHAR;

		PROCEDURE seq(ch: CHAR; n: INTEGER);
		BEGIN WHILE n > 0 DO Write(W, ch); DEC(n) END
		END seq;
	
		PROCEDURE dig(n: INTEGER);
		BEGIN
			WHILE n > 0 DO
				DEC(i); Write(W, d[i]); DEC(n)
			END
		END dig;
		
	BEGIN e := Reals.Expo(x);
		IF k < 0 THEN k := 0 END;
		IF e = 0 THEN seq(" ", n-k-2); Write(W, "0"); seq(" ", k+1)
		ELSIF e = 255 THEN WriteString(W, " NaN"); seq(" ", n-4)
		ELSE e := (e - 127) * 77 DIV 256;
			IF x < 0 THEN sign := "-"; x := -x ELSE sign := " " END;
			IF e >= 0 THEN (*x >= 1.0, 77/256 = log 2*) x := x/Reals.Ten(e)
				ELSE (*x < 1.0*) x := Reals.Ten(-e) * x
			END;
			IF x >= 10.0 THEN x := 0.1*x; INC(e) END;
			(* 1 <= x < 10 *)
			IF k+e >= maxD-1 THEN k := maxD-1-e
				ELSIF k+e < 0 THEN k := -e; x := 0.0
			END;
			x0 := Reals.Ten(k+e); x := x0*x + 0.5;
			IF x >= 10.0*x0 THEN INC(e) END;
			(*e = no. of digits before decimal point*)
			INC(e); i := k+e; Reals.Convert(x, i, d);
			IF e > 0 THEN
				seq(" ", n-e-k-2); Write(W, sign); dig(e);
				Write(W, "."); dig(k)
			ELSE seq(" ", n-k-3);
				Write(W, sign); Write(W, "0"); Write(W, ".");
				seq("0", -e); dig(k+e)
			END
		END
	END WriteRealFix;

	PROCEDURE WriteRealHex* (VAR W: Writer; x: REAL);
		VAR i: INTEGER;
			d: ARRAY 8 OF CHAR;
	BEGIN Reals.ConvertH(x, d); i := 0;
		REPEAT Write(W, d[i]); INC(i) UNTIL i = 8
	END WriteRealHex;

	PROCEDURE WriteLongReal* (VAR W: Writer; x: LONGREAL; n: INTEGER);
		CONST maxD = 16;
		VAR e: INTEGER; x0: LONGREAL;
			d: ARRAY maxD OF CHAR;
	BEGIN e := Reals.ExpoL(x);
		IF e = 0 THEN
			WriteString(W, " 0");
			REPEAT Write(W, " "); DEC(n) UNTIL n <= 3
		ELSIF e = 2047 THEN
			WriteString(W, " NaN");
			WHILE n > 4 DO Write(W, " "); DEC(n) END
		ELSE
			IF n <= 10 THEN n := 3 ELSE DEC(n, 7) END;
			REPEAT Write(W, " "); DEC(n) UNTIL n <= maxD;
			(*there are 2 <= n <= maxD digits to be written*)
			IF x < 0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END;
			e := SHORT(LONG(e - 1023) * 77 DIV 256);
			IF e >= 0 THEN x := x / Reals.TenL(e) ELSE x := Reals.TenL(-e) * x END ;
			IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END ;
			x0 := Reals.TenL(n-1); x := x0*x + 0.5D0;
			IF x >= 10.0D0*x0 THEN x := 0.1D0 * x; INC(e) END ;
			Reals.ConvertL(x, n, d);
			DEC(n); Write(W, d[n]); Write(W, ".");
			REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;
			Write(W, "D");
			IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END;
			Write(W, CHR(e DIV 100 + 30H)); e := e MOD 100;
			Write(W, CHR(e DIV 10 + 30H));
			Write(W, CHR(e MOD 10 + 30H))
		END
	END WriteLongReal;

	PROCEDURE WriteLongRealHex* (VAR W: Writer; x: LONGREAL);
		VAR i: INTEGER;
			d: ARRAY 16 OF CHAR;
	BEGIN Reals.ConvertHL(x, d); i := 0;
		REPEAT Write(W, d[i]); INC(i) UNTIL i = 16
	END WriteLongRealHex;

	PROCEDURE WriteDate* (VAR W: Writer; t, d: LONGINT);

		PROCEDURE WritePair(ch: CHAR; x: LONGINT);
		BEGIN Write(W, ch);
			Write(W, CHR(x DIV 10 + 30H)); Write(W, CHR(x MOD 10 + 30H))
		END WritePair;

	BEGIN
		WritePair(" ", d MOD 32); WritePair(".", d DIV 32 MOD 16); WritePair(".", d DIV 512 MOD 128);
		WritePair(" ", t DIV 4096 MOD 32); WritePair(":", t DIV 64 MOD 64); WritePair(":", t MOD 64)
	END WriteDate;

BEGIN
	NEW(DelBuf); OpenBuf(DelBuf);
	OpenWriter(W); Write(W, 0X);
	WFile := Files.Base(W)
END Texts.