Oberon/A2/Oberon.Texts.Mod

(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich. Refer to the "General ETH Oberon System Source License" contract available at : http : //www.oberon.ethz.ch/ *) MODULE Texts IN Oberon; (** portable *)	(*JG 23.8.94*) (** The Texts module implements the text abstract data type. Texts are sequences of characters and objects, with different colors, different fonts, and vertical offsets. &#42;) &#160;&#160;IMPORT Files, Objects, Display, Fonts, Reals IN A2; &#160;&#160;CONST &#160;&#160;&#160;&#160;(** Scanner symbol classes.*) &#160;&#160;&#160;&#160;Inval* &#61; 0;          (** Invalid symbol. *) &#160;&#160;&#160;&#160;Name* &#61; 1;       (** Name s (of length len).*) &#160;&#160;&#160;&#160;String* &#61; 2;       (** Quoted string s (length len). *) &#160;&#160;&#160;&#160;Int* &#61; 3;            (** Integer i (decimal or hexadecimal). *) &#160;&#160;&#160;&#160;Real* &#61; 4;         (** Real number x. *) &#160;&#160;&#160;&#160;LongReal* &#61; 5; (** Long real number y. *) &#160;&#160;&#160;&#160;Char* &#61; 6;         (** Special character c. *) &#9;Object* &#61; 7;     (** Object obj. *) &#160;&#160;&#160;&#160;TAB &#61; 9X; CR &#61; 0DX; LF &#61; 0AX; &#160;&#160;&#160;&#160;OldTextBlockId &#61; 1X; OldTextSpex &#61; 0F0X; &#160;&#160;&#160;&#160;(* TextBlock &#61; TextBlockId type hlen run &#123;run&#125; 0 tlen &#123;AsciiCode&#125; &#91;font block&#93;. &#160;&#160;&#160;&#160;&#160;&#160;run &#61; font &#91;name&#93; col voff len. *) &#160;&#160;&#160;&#160;BufSize &#61; 64; TYPE &#160;&#160;&#160;&#160;Piece &#61; POINTER TO PieceDesc; &#160;&#160;&#160;&#160;PieceDesc &#61; RECORD &#160;&#160;&#160;&#160;&#160;&#160;f : Files.File; &#160;&#160;&#160;&#160;&#160;&#160;off : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;len : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;obj : Objects.Object; &#160;&#160;&#160;&#160;&#160;&#160;lib : Objects.Library; &#160;&#160;&#160;&#160;&#160;&#160;ref : INTEGER; (* ref no in obs lib *) &#160;&#160;&#160;&#160;&#160;&#160;col : SHORTINT; &#160;&#160;&#160;&#160;&#160;&#160;voff : SHORTINT; &#160;&#160;&#160;&#160;&#160;&#160;prev, next : Piece &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Text* &#61; POINTER TO TextDesc; &#160;&#160;&#160;&#160;TextDesc* &#61; RECORD (Objects.ObjDesc) &#160;&#160;&#160;&#160;&#160;&#160;len* : LONGINT;	(** Text consists of characters 0 to T.len - 1. *) &#160;&#160;&#160;&#160;&#160;&#160;obs : Objects.Library;	(* Library containing objects located in text. *) &#160;&#160;&#160;&#160;&#160;&#160;trailer : Piece; &#160;&#160;&#160;&#160;&#160;&#160;org : LONGINT; (*cache*) &#160;&#160;&#160;&#160;&#160;&#160;pce : Piece &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;UpdateMsg* &#61; RECORD (Display.FrameMsg)	(** Message broadcast to indicate that part of a text changed. *) &#160;&#160;&#160;&#160;&#160;&#160;text* : Text;	(** The text that changed. *) &#160;&#160;&#160;&#160;&#160;&#160;beg*, end*, len* : LONGINT	(** Change location. *) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Finder* &#61; RECORD	(** Finder of (non-character) objects located in text. *) &#160;&#160;&#160;&#160;&#160;&#160;eot* : BOOLEAN;	(** End-of-text reached during search. *) &#160;&#160;&#160;&#160;&#160;&#160;pos* : LONGINT;	(** Offset of Finder in text. *) &#160;&#160;&#160;&#160;&#160;&#160;T : Text; &#160;&#160;&#160;&#160;&#160;&#160;ref : Piece &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Reader* &#61; RECORD	(** Character-wise reader of a text stream. *) &#160;&#160;&#160;&#160;&#160;&#160;ref : Piece; &#160;&#160;&#160;&#160;&#160;&#160;T : Text; &#160;&#160;&#160;&#160;&#160;&#160;org : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;off : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;R : Files.Rider; &#160;&#160;&#160;&#160;&#160;&#160;stamp : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;buf : ARRAY BufSize OF CHAR; &#160;&#160;&#160;&#160;&#160;&#160;bufpos, buflen : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;lib* : Objects.Library;	(** Library of last character/object read. *) &#160;&#160;&#160;&#160;&#160;&#160;col* : SHORTINT;	(** Color index of last character read. *) &#160;&#160;&#160;&#160;&#160;&#160;voff* : SHORTINT;	(** vertical offset of last character read. *) &#160;&#160;&#160;&#160;&#160;&#160;eot* : BOOLEAN	(** Reader has reached end of the text stream. *) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Scanner* &#61; RECORD (Reader)	(** Scanner for symbol streams. *) &#160;&#160;&#160;&#160;&#160;&#160;nextCh* : CHAR;	(** Character immediately following the last symbol scanned. *) &#160;&#160;&#160;&#160;&#160;&#160;line* : INTEGER;	(** # carriage returns scanned so far. *) &#160;&#160;&#160;&#160;&#160;&#160;class* : INTEGER;	(** Scan result : Int, Real, String etc. *) &#160;&#160;&#160;&#160;&#160;&#160;i* : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;x* : REAL; &#160;&#160;&#160;&#160;&#160;&#160;y* : LONGREAL; &#160;&#160;&#160;&#160;&#160;&#160;c* : CHAR; &#160;&#160;&#160;&#160;&#160;&#160;len* : SHORTINT;	(** Length of name or string scanned. *) &#160;&#160;&#160;&#160;&#160;&#160;s* : ARRAY 256 OF CHAR; &#160;&#160;&#160;&#160;&#160;&#160;obj* : Objects.Object &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Buffer* &#61; POINTER TO BufDesc;	(** Temporary container of text stretches. *) &#160;&#160;&#160;&#160;BufDesc* &#61; RECORD &#160;&#160;&#160;&#160;&#160;&#160;len* : LONGINT;	(** # characters in buffer. *) &#160;&#160;&#160;&#160;&#160;&#160;header, last : Piece &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Writer* &#61; RECORD	(** Used to write a stream of textual data in a buffer. *) &#160;&#160;&#160;&#160;&#160;&#160;R : Files.Rider; &#160;&#160;&#160;&#160;&#160;&#160;buf* : Buffer;	(** Associated buffer. *) &#160;&#160;&#160;&#160;&#160;&#160;lib* : Objects.Library;	(** Current font/library of characters written. *) &#160;&#160;&#160;&#160;&#160;&#160;col* : SHORTINT;	(** Current color of text being written. *) &#160;&#160;&#160;&#160;&#160;&#160;voff* : SHORTINT	(** Current vertical offset of text being written. *) &#160;&#160;&#160;&#160;END; &#160;&#160;VAR TextBlockId* (** First character of a text block. *), DocBlockId, NoSpex, NoSpex2, TextSpex : CHAR; &#160;&#160;&#160;&#160;Wfile : Files.File; R : Files.Rider; DelBuf : Buffer; H : Objects.Handler; &#9;nameChars* : ARRAY 256 OF BOOLEAN; &#9;obs : Objects.Library; (** Load text block from ASCII file f to text T. *) &#160;&#160;PROCEDURE LoadAscii* (T : Text; f : Files.File); &#160;&#160;&#160;&#160;VAR Q, q : Piece; len : LONGINT; &#160;&#160;BEGIN len : &#61; Files.Length(f); &#160;&#160;&#160;&#160;NEW(Q); Q.f : &#61; Wfile; Q.off : &#61; 0; Q.len : &#61; 1; Q.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;Q.lib : &#61; NIL; Q.col : &#61; 127; Q.voff : &#61; 0; &#160;&#160;&#160;&#160;NEW(q); q.f : &#61; f; q.off : &#61; 0; q.len : &#61; len; q.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;q.lib : &#61; Fonts.Default; q.col : &#61; 15; q.voff : &#61; 0; &#160;&#160;&#160;&#160;Q.next : &#61; q; q.prev : &#61; Q; q.next : &#61; Q; Q.prev : &#61; q; &#160;&#160;&#160;&#160;T.handle : &#61; H; T.obs : &#61; NIL; &#160;&#160;&#160;&#160;T.trailer : &#61; Q; T.len : &#61; len; &#160;&#160;&#160;&#160;T.org : &#61; -1; T.pce : &#61; T.trailer (*init cache*) &#160;&#160;END LoadAscii; &#160;&#160;PROCEDURE ReadDocHeader(VAR R : Files.Rider; VAR ch : CHAR); &#160;&#160;&#160;&#160;VAR len : LONGINT; x, y, w, h : INTEGER; name : ARRAY 256 OF CHAR; &#160;&#160;BEGIN Files.Read(R, ch); &#160;&#160;&#160;&#160;Files.ReadString(R, name); &#160;&#160;&#160;&#160;Files.ReadInt(R, x); Files.ReadInt(R, y); &#160;&#160;&#160;&#160;Files.ReadInt(R, w); Files.ReadInt(R, h); &#9;Files.Read(R, ch); &#9;IF ch &#61; 0F7X THEN	(* skip meta info *) &#9;&#9;Files.Read(R, ch); &#9;&#9;IF ch &#61; 08X THEN &#9;&#9;&#9;Files.ReadLInt(R, len); Files.Set(R, Files.Base(R), Files.Pos(R) + len); Files.Read(R, ch) &#9;&#9;END &#9;END &#160;&#160;END ReadDocHeader; (** Load text block from file f at position pos to text T (assumes that the text id has been read already). len returns length. *) &#160;&#160;PROCEDURE Load* (T : Text; f : Files.File; pos : LONGINT; VAR len : LONGINT); &#160;&#160;&#160;&#160;VAR &#160;&#160;&#160;&#160;&#160;&#160;R, S : Files.Rider; &#160;&#160;&#160;&#160;&#160;&#160;Q, q, p : Piece; &#160;&#160;&#160;&#160;&#160;&#160;hlen, tlen, flen, off : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;N, lib : SHORTINT; &#160;&#160;&#160;&#160;&#160;&#160;type, ref, tag : CHAR; &#160;&#160;&#160;&#160;&#160;&#160;LName : ARRAY 256 OF CHAR; &#160;&#160;&#160;&#160;&#160;&#160;Dict : ARRAY 64 OF Objects.Library; &#160;&#160;&#160;&#160;&#160;&#160;i : INTEGER; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;&#160;&#160;NEW(Q); Q.f : &#61; Wfile; Q.off : &#61; 0; Q.len : &#61; 1; Q.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;&#160;&#160;Q.lib : &#61; NIL; Q.col : &#61; 127; Q.voff : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;p : &#61; Q; &#160;&#160;&#160;&#160;&#160;&#160;Files.Set(R, f, pos); &#160;&#160;&#160;&#160;&#160;&#160;Files.Read(R, type); &#160;&#160;&#160;&#160;&#160;&#160;Files.ReadLInt(R, hlen); &#160;&#160;&#160;&#160;&#160;&#160;Files.Set(S, f, pos - 1 + hlen - 4); &#160;&#160;&#160;&#160;&#160;&#160;Files.ReadLInt(S, tlen); &#160;&#160;&#160;&#160;&#160;&#160;IF (type &#61; TextSpex) OR (type &#61; OldTextSpex) THEN T.obs : &#61; NIL; flen : &#61; 0 &#160;&#160;&#160;&#160;&#160;&#160;ELSE NEW(T.obs); Objects.OpenLibrary(T.obs); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.Set(S, f, pos - 1 + hlen + tlen); Files.Read(S, tag); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF tag &#61; Objects.LibBlockId THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Objects.LoadLibrary(T.obs, f, pos - 1 + hlen + tlen + 1, flen) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;INC(flen) &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;Dict&#91;0&#93; : &#61; T.obs; &#160;&#160;&#160;&#160;&#160;&#160;N : &#61; 1; &#160;&#160;&#160;&#160;&#160;&#160;off : &#61; pos - 1 + hlen; &#160;&#160;&#160;&#160;&#160;&#160;WHILE Files.Pos(R) &#60; pos - 1 + hlen - 5 DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.Read(R, lib); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF lib &#61; N THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.ReadString(R, LName); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Dict&#91;N&#93; : &#61; Objects.ThisLibrary(LName); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;INC(N) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;NEW(q); q.lib : &#61; Dict&#91;lib&#93;; q.obj : &#61; NIL; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF &#126;(q.lib IS Fonts.Font) THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.Set(S, f, off); Files.Read(S, ref); (*q.lib.GetObj(q.lib, ORD(ref), q.obj)*) q.ref : &#61; ORD(ref) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;q.ref : &#61; MIN(INTEGER) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.Read(R, q.col); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.Read(R, q.voff); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.ReadLInt(R, q.len); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF q.len &#60; 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;LoadAscii (T, f); RETURN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;q.f : &#61; f; q.off : &#61; off; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;off : &#61; off + q.len; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;p.next : &#61; q; q.prev : &#61; p; p : &#61; q &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;p.next : &#61; Q; Q.prev : &#61; p; &#160;&#160;&#160;&#160;&#160;&#160;T.handle : &#61; H; &#160;&#160;&#160;&#160;&#160;&#160;T.trailer : &#61; Q; T.len : &#61; tlen; &#160;&#160;&#160;&#160;&#160;&#160;T.org : &#61; -1; T.pce : &#61; T.trailer; (*init cache*) &#160;&#160;&#160;&#160;&#160;&#160;IF type &#61; NoSpex2 THEN &#160;&#160;&#160;&#160;&#160;&#160;&#9;(* generate multiple private libs with &#60;&#61; 256 objs *) &#160;&#160;&#160;&#160;&#160;&#160;&#9;FOR i : &#61; 0 TO 31 DO &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;Dict&#91;i&#93; : &#61; NIL &#160;&#160;&#160;&#160;&#160;&#160;&#9;END; &#160;&#160;&#160;&#160;&#160;&#160;&#9;Files.Set(R, f, pos - 1 + hlen + tlen + flen); &#160;&#160;&#160;&#160;&#160;&#160;&#9;p : &#61; T.trailer.next; &#160;&#160;&#160;&#160;&#160;&#160;&#9;WHILE p # T.trailer DO &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;IF p.lib &#61; T.obs THEN &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;Files.ReadInt(R, i); &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;INC(flen, 2); &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;IF Dict&#91;i DIV 256&#93; &#61; NIL THEN &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;NEW(Dict&#91;i DIV 256&#93;); &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;Objects.OpenLibrary(Dict&#91;i DIV 256&#93;) &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;END; &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;(*T.obs.GetObj(T.obs, i, p.obj);*) p.obj : &#61; NIL; p.ref : &#61; i; &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;p.lib : &#61; Dict&#91;i DIV 256&#93;; &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;&#9;(*Dict&#91;i DIV 256&#93;.PutObj(Dict&#91;i DIV 256&#93;, i MOD 256, p.obj)*) &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;END; &#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;p : &#61; p.next &#160;&#160;&#160;&#160;&#160;&#160;&#9;END &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;len : &#61; hlen - 1 + tlen + flen &#160;&#160;END Load; &#9;PROCEDURE SyncPiece(T : Text; p : Piece); &#9;&#9;VAR &#9;&#9;&#9;R : Files.Rider; &#9;&#9;&#9;ch : CHAR; &#9;BEGIN &#9;&#9;IF (p.ref &#62;&#61; 0) &#38; (p.obj &#61; NIL) &#38; &#126;(p.lib IS Fonts.Font) THEN &#9;&#9;&#9;T.obs.GetObj(T.obs, p.ref, p.obj); &#9;&#9;&#9;Files.Set(R, p.f, p.off); Files.Read(R, ch); &#9;&#9;&#9;p.lib.PutObj(p.lib, ORD(ch), p.obj) &#9;&#9;END &#9;END SyncPiece; (** Store text T on disk file f at position pos. Writes the first id character too. len is the number of bytes written. *) &#160;&#160;PROCEDURE Store* (T : Text; f : Files.File; pos : LONGINT; VAR len : LONGINT); &#9;TYPE &#9;&#9;ObjsBlock &#61; POINTER TO ObjsBlockDesc; &#9;&#9;ObjsBlockDesc &#61; RECORD &#9;&#9;&#9;objs : ARRAY 256 OF Objects.Object; &#9;&#9;&#9;next : ObjsBlock &#9;&#9;END; &#160;&#160;&#160;&#160;VAR &#160;&#160;&#160;&#160;&#160;&#160;p, q : Piece; &#160;&#160;&#160;&#160;&#160;&#160;R, W : Files.Rider; &#160;&#160;&#160;&#160;&#160;&#160;hlen, flen, rlen, m : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;id, i : INTEGER; &#160;&#160;&#160;&#160;&#160;&#160;N, n : SHORTINT; &#160;&#160;&#160;&#160;&#160;&#160;type, ch : CHAR; &#160;&#160;&#160;&#160;&#160;&#160;obj : Objects.Object; &#160;&#160;&#160;&#160;&#160;&#160;M : Objects.BindMsg; &#160;&#160;&#160;&#160;&#160;&#160;Dict : ARRAY 64 OF Objects.Name; &#160;&#160;&#160;&#160;&#160;&#160;allObjs, curObjs, objs : ObjsBlock; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;Files.Set(W, f, pos); &#160;&#160;&#160;&#160;Files.Write(W, TextBlockId); &#160;&#160;&#160;&#160;Files.Write(W, 0X (*type*)); (*place holder*) &#160;&#160;&#160;&#160;Files.WriteLInt(W, 0 (*hlen*)); (*place holder*) &#160;&#160;&#160;&#160;Dict&#91;0&#93; : &#61; ""; &#160;&#160;&#160;&#160;N : &#61; 1; &#160;&#160;&#160;&#160;p : &#61; T.trailer.next; &#160;&#160;&#160;&#160;WHILE p # T.trailer DO &#160;&#160;&#160;&#160;&#160;&#160;rlen : &#61; p.len; q : &#61; p.next; &#160;&#160;&#160;&#160;&#160;&#160;IF p.lib IS Fonts.Font THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE (q # T.trailer) &#38; (q.lib &#61; p.lib) &#38; (q.col &#61; p.col) &#38; (q.voff &#61; p.voff) DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;rlen : &#61; rlen + q.len; q : &#61; q.next &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;Dict&#91;N&#93; : &#61; p.lib.name; &#160;&#160;&#160;&#160;&#160;&#160;n : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;WHILE Dict&#91;n&#93; # p.lib.name DO INC(n) END; &#160;&#160;&#160;&#160;&#160;&#160;Files.Write(W, n); &#160;&#160;&#160;&#160;&#160;&#160;IF n &#61; N THEN Files.WriteString(W, p.lib.name); INC(N) END; &#160;&#160;&#160;&#160;&#160;&#160;Files.Write(W, p.col); &#160;&#160;&#160;&#160;&#160;&#160;Files.Write(W, p.voff); &#160;&#160;&#160;&#160;&#160;&#160;Files.WriteLInt(W, rlen); &#160;&#160;&#160;&#160;&#160;&#160;p : &#61; q &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Files.Write(W, 0X); Files.WriteLInt(W, T.len); &#160;&#160;&#160;&#160;NEW(allObjs); &#160;&#160;&#160;&#160;allObjs.next : &#61; NIL; &#160;&#160;&#160;&#160;curObjs : &#61; allObjs; &#160;&#160;&#160;&#160;hlen : &#61; Files.Pos(W) - pos; &#160;&#160;&#160;&#160;id : &#61; 0; p : &#61; T.trailer.next; &#160;&#160;&#160;&#160;WHILE p # T.trailer DO &#160;&#160;&#160;&#160;&#160;&#160;Files.Set(R, p.f, p.off); m : &#61; p.len; &#160;&#160;&#160;&#160;&#160;&#160;WHILE m # 0 DO Files.Read(R, ch); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF p.lib.name&#91;0&#93; &#61; 0X THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;SyncPiece(T, p); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;p.lib.GetObj(p.lib, ORD(ch), obj); p.obj : &#61; obj; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;curObjs.objs&#91;id MOD 256&#93; : &#61; obj; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;i : &#61; 0; objs : &#61; allObjs; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE objs.objs&#91;i MOD 256&#93; # obj DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;INC(i); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;IF (i MOD 256) &#61; 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;objs : &#61; objs.next &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF i &#61; id THEN INC(id); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;IF (id MOD 256) &#61; 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;NEW(curObjs.next); p.ref : &#61; id; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;curObjs : &#61; curObjs.next; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;curObjs.next : &#61; NIL &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ch : &#61; CHR(i) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.Write(W, ch); DEC(m) &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;p : &#61; p.next &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;IF id &#62; 0 THEN &#160;&#160;&#160;&#160;&#9;IF id &#62; 255 THEN type : &#61; NoSpex2 &#160;&#160;&#160;&#160;&#9;ELSE type : &#61; NoSpex &#160;&#160;&#160;&#160;&#9;END; &#160;&#160;&#160;&#160;&#9;NEW(T.obs); Objects.OpenLibrary(T.obs); &#160;&#160;&#160;&#160;&#9;i : &#61; 0; objs : &#61; allObjs; &#160;&#160;&#160;&#160;&#9;REPEAT &#160;&#160;&#160;&#160;&#9;&#9;T.obs.PutObj(T.obs, i, objs.objs&#91;i MOD 256&#93;); &#160;&#160;&#160;&#160;&#9;&#9;INC(i); &#160;&#160;&#160;&#160;&#9;&#9;IF (i MOD 256) &#61; 0 THEN objs : &#61; objs.next END &#160;&#160;&#160;&#160;&#9;UNTIL i &#61; id; &#160;&#160;&#160;&#160;&#9;M.lib : &#61; T.obs; &#160;&#160;&#160;&#160;&#9;i : &#61; 0; objs : &#61; allObjs; &#160;&#160;&#160;&#160;&#9;REPEAT &#160;&#160;&#160;&#160;&#9;&#9;objs.objs&#91;i MOD 256&#93;.handle(objs.objs&#91;i MOD 256&#93;, M); &#160;&#160;&#160;&#160;&#9;&#9;INC(i); &#160;&#160;&#160;&#160;&#9;&#9;IF (i MOD 256) &#61; 0 THEN objs : &#61; objs.next END &#160;&#160;&#160;&#160;&#9;UNTIL i &#61; id; &#160;&#160;&#160;&#160;&#9;Objects.StoreLibrary(T.obs, f, pos + hlen + T.len, flen); &#160;&#160;&#160;&#160;&#9;IF type &#61; NoSpex2 THEN &#9;&#9;&#9;(* append a reference block to the text file *) &#160;&#160;&#160;&#160;&#9;&#9;Files.Set(W, f, pos + hlen + T.len + flen); &#160;&#160;&#160;&#160;&#9;&#9;p : &#61; T.trailer.next; &#160;&#160;&#160;&#160;&#9;&#9;WHILE p # T.trailer DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;IF p.lib.name&#91;0&#93; &#61; 0X THEN &#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;i : &#61; 0; objs : &#61; allObjs; &#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;WHILE objs.objs&#91;i MOD 256&#93; # p.obj DO &#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;&#9;INC(i); &#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;&#9;IF (i MOD 256) &#61; 0 THEN objs : &#61; objs.next END &#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;END; &#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;Files.WriteInt(W, i); &#160;&#160;&#160;&#160;&#9;&#9;&#9;&#9;INC(flen, 2) &#160;&#160;&#160;&#160;&#9;&#9;&#9;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#9;&#9;p : &#61; p.next &#160;&#160;&#160;&#160;&#9;&#9;END &#160;&#160;&#160;&#160;&#9;END &#160;&#160;&#160;&#160;ELSE type : &#61; TextSpex; flen : &#61; 0 (*no integrated objects*) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Files.Set(W, f, pos + 1); &#160;&#160;&#160;&#160;Files.Write(W, type); (*fixup*) &#160;&#160;&#160;&#160;Files.WriteLInt(W, hlen); (*fixup*) &#160;&#160;&#160;&#160;len : &#61; hlen + T.len + flen &#160;&#160;END Store; &#160;&#160;PROCEDURE GenNew (T : Text); &#160;&#160;&#160;&#160;VAR Q : Piece; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;NEW(Q); Q.f : &#61; Wfile; Q.off : &#61; 0; Q.len : &#61; 1; Q.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;Q.lib : &#61; NIL; Q.col : &#61; 127; Q.voff : &#61; 0; &#160;&#160;&#160;&#160;Q.next : &#61; Q; Q.prev : &#61; Q; &#160;&#160;&#160;&#160;T.handle : &#61; H; T.obs : &#61; NIL; &#160;&#160;&#160;&#160;T.trailer : &#61; Q; T.len : &#61; 0; &#160;&#160;&#160;&#160;T.org : &#61; -1; T.pce : &#61; T.trailer (*init cache*) &#160;&#160;END GenNew; (** Open text T from file specified by name. A new text is opened when name &#61; "". *) &#160;&#160;PROCEDURE Open* (T : Text; CONST name : ARRAY OF CHAR); &#160;&#160;&#160;&#160;VAR f : Files.File; R : Files.Rider; len : LONGINT; ch : CHAR; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;obs : &#61; NIL; &#160;&#160;&#160;&#160;f : &#61; Files.Old(name); &#160;&#160;&#160;&#160;IF f # NIL THEN &#160;&#160;&#160;&#160;&#160;&#160;Files.Set(R, f, 0); Files.Read(R, ch); &#160;&#160;&#160;&#160;&#160;&#160;IF ch &#61; DocBlockId THEN ReadDocHeader(R, ch) END; &#160;&#160;&#160;&#160;&#160;&#160;IF (ch &#61; TextBlockId) OR (ch &#61; OldTextBlockId) THEN Load(T, f, Files.Pos(R), len) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE LoadAscii(T, f) &#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;ELSE GenNew(T) &#160;&#160;&#160;&#160;END &#160;&#160;END Open; (** Text generator procedure. Resulting text is assigned to Objects.NewObj. *) &#160;&#160;PROCEDURE New*; &#160;&#160;&#160;&#160;VAR T : Text; &#160;&#160;BEGIN NEW(T); T.handle : &#61; H; GenNew (T); Objects.NewObj : &#61; T &#160;&#160;END New; &#160;&#160;PROCEDURE FindPiece (T : Text; pos : LONGINT; VAR org : LONGINT; VAR p : Piece); &#9;VAR n : LONGINT; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF pos &#60; T.org THEN T.org : &#61; -1; T.pce : &#61; T.trailer END; &#160;&#160;&#160;&#160;org : &#61; T.org; p : &#61; T.pce; (*from cache*) &#160;&#160;&#160;&#160;n : &#61; 0; &#160;&#160;&#160;&#160;WHILE pos &#62;&#61; org + p.len DO org : &#61; org + p.len; p : &#61; p.next; INC(n) END; &#160;&#160;&#160;&#160;IF n &#62; 50 THEN T.org : &#61; org; T.pce : &#61; p END &#160;&#160;END FindPiece; &#160;&#160;PROCEDURE SplitPiece (p : Piece; off : LONGINT; VAR pr : Piece); &#160;&#160;&#160;&#160;VAR q : Piece; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF off &#62; 0 THEN NEW(q); q.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;&#160;&#160;q.lib : &#61; p.lib; q.col : &#61; p.col; q.voff : &#61; p.voff; &#160;&#160;&#160;&#160;&#160;&#160;q.len : &#61; p.len - off; &#160;&#160;&#160;&#160;&#160;&#160;q.f : &#61; p.f; q.off : &#61; p.off + off; &#160;&#160;&#160;&#160;&#160;&#160;p.len : &#61; off; &#160;&#160;&#160;&#160;&#160;&#160;q.next : &#61; p.next; p.next : &#61; q; &#160;&#160;&#160;&#160;&#160;&#160;q.prev : &#61; p; q.next.prev : &#61; q; &#160;&#160;&#160;&#160;&#160;&#160;pr : &#61; q &#160;&#160;&#160;&#160;ELSE pr : &#61; p &#160;&#160;&#160;&#160;END &#160;&#160;END SplitPiece; (** Insert buffer B in text T position pos. B is emptied. *) &#160;&#160;PROCEDURE Insert* (T : Text; pos : LONGINT; B : Buffer); &#160;&#160;&#160;&#160;VAR pl, pr, p, qb, qe : Piece; org : LONGINT; M : UpdateMsg; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;FindPiece(T, pos, org, p); SplitPiece(p, pos - org, pr); &#160;&#160;&#160;&#160;IF T.org &#62;&#61; org THEN (*adjust cache*) &#160;&#160;&#160;&#160;&#160;&#160;T.org : &#61; org - p.prev.len; T.pce : &#61; p.prev &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;pl : &#61; pr.prev; qb : &#61; B.header.next; &#160;&#160;&#160;&#160;IF (qb # NIL) &#38; (qb.f &#61; pl.f) &#38; (qb.off &#61; pl.off + pl.len) &#38; (pl.lib IS Fonts.Font) &#160;&#160;&#160;&#160;&#160;&#160;&#38; (pl.lib &#61; qb.lib) &#38; (pl.col &#61; qb.col) &#38; (pl.voff &#61; qb.voff) THEN &#160;&#160;&#160;&#160;&#160;&#160;pl.len : &#61; pl.len + qb.len; qb : &#61; qb.next &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;IF qb # NIL THEN &#160;&#160;&#160;&#160;&#160;&#160;qe : &#61; B.last; qb.prev : &#61; pl; pl.next : &#61; qb; qe.next : &#61; pr; pr.prev : &#61; qe &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;T.len : &#61; T.len + B.len; &#160;&#160;&#160;&#160;M.text : &#61; T; M.F : &#61; NIL; M.beg : &#61; pos; M.end : &#61; pos; M.len : &#61; B.len; &#160;&#160;&#160;&#160;B.last : &#61; B.header; B.last.next : &#61; NIL; B.len : &#61; 0; &#160;&#160;&#160;&#160;Display.Broadcast(M); T.stamp : &#61; M.stamp &#160;&#160;END Insert; (** Append buffer to the end of text T. B is emptied. *) &#160;&#160;PROCEDURE Append* (T : Text; B : Buffer); &#160;&#160;BEGIN Insert(T, T.len, B) &#160;&#160;END Append; (** Delete text stretch &#91;beg, end&#91;. *) &#160;&#160;PROCEDURE Delete* (T : Text; beg, end : LONGINT); &#160;&#160;&#160;&#160;VAR pb, pe, pbr, per : Piece; orgb, orge : LONGINT; M : UpdateMsg; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF beg &#60; end THEN &#160;&#160;&#160;&#160;&#160;&#160;FindPiece(T, beg, orgb, pb); SplitPiece(pb, beg - orgb, pbr); &#160;&#160;&#160;&#160;&#160;&#160;FindPiece(T, end, orge, pe); SplitPiece(pe, end - orge, per); &#160;&#160;&#160;&#160;&#160;&#160;IF T.org &#62;&#61; orgb THEN (*adjust cache*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;T.org : &#61; orgb - pb.prev.len; T.pce : &#61; pb.prev &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;DelBuf.header.next : &#61; pbr; DelBuf.last : &#61; per.prev; &#160;&#160;&#160;&#160;&#160;&#160;DelBuf.last.next : &#61; NIL; DelBuf.len : &#61; end - beg; &#160;&#160;&#160;&#160;&#160;&#160;per.prev : &#61; pbr.prev; pbr.prev.next : &#61; per; &#160;&#160;&#160;&#160;&#160;&#160;T.len : &#61; T.len - end + beg; &#160;&#160;&#160;&#160;&#160;&#160;M.text : &#61; T; M.F : &#61; NIL; M.beg : &#61; beg; M.end : &#61; end; M.len : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;Display.Broadcast(M); T.stamp : &#61; M.stamp &#160;&#160;&#160;&#160;END &#160;&#160;END Delete; (** Replace &#91;beg, end&#91; of T with contents of buffer B. B is emptied. *) &#160;&#160;PROCEDURE Replace* (T : Text; beg, end : LONGINT; B : Buffer); &#160;&#160;&#160;&#160;VAR M : UpdateMsg; pb, pe, pbr, per, pl, qb, qe : Piece; orgb, orge : LONGINT; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF beg &#60; end THEN &#160;&#160;&#160;&#160;&#160;&#160;FindPiece(T, beg, orgb, pb); SplitPiece(pb, beg - orgb, pbr); &#160;&#160;&#160;&#160;&#160;&#160;FindPiece(T, end, orge, pe); SplitPiece(pe, end - orge, per); &#160;&#160;&#160;&#160;&#160;&#160;IF T.org &#62;&#61; orgb THEN (*adjust cache*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;T.org : &#61; orgb - pb.prev.len; T.pce : &#61; pb.prev &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;DelBuf.header.next : &#61; pbr; DelBuf.last : &#61; per.prev; &#160;&#160;&#160;&#160;&#160;&#160;DelBuf.last.next : &#61; NIL; DelBuf.len : &#61; end - beg; &#160;&#160;&#160;&#160;&#160;&#160;per.prev : &#61; pbr.prev; pbr.prev.next : &#61; per; &#160;&#160;&#160;&#160;&#160;&#160;pl : &#61; pbr.prev; qb : &#61; B.header.next; &#160;&#160;&#160;&#160;&#160;&#160;IF (qb # NIL) &#38; (qb.f &#61; pl.f) &#38; (qb.off &#61; pl.off + pl.len) &#38; (pl.lib IS Fonts.Font) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#38; (pl.lib &#61; qb.lib) &#38; (pl.col &#61; qb.col) &#38; (pl.voff &#61; qb.voff) THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;pl.len : &#61; pl.len + qb.len; qb : &#61; qb.next &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;IF qb # NIL THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;qe : &#61; B.last; qb.prev : &#61; pl; pl.next : &#61; qb; qe.next : &#61; per; per.prev : &#61; qe &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;T.len : &#61; T.len - end + beg + B.len; &#160;&#160;&#160;&#160;&#160;&#160;M.text : &#61; T; M.F : &#61; NIL; M.beg : &#61; beg; M.end : &#61; end; M.len : &#61; B.len; &#160;&#160;&#160;&#160;&#160;&#160;B.last : &#61; B.header; B.last.next : &#61; NIL; B.len : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;Display.Broadcast(M); T.stamp : &#61; M.stamp &#160;&#160;&#160;&#160;END &#160;&#160;END Replace; (** Change character attributes within stretch &#91;beg, end&#91; of text T. sel selects the attributes to be changed : 0, 1, 2 IN sel &#61; fnt, col, voff selected. *) &#160;&#160;PROCEDURE ChangeLooks* (T : Text; beg, end : LONGINT; sel : SET; lib : Objects.Library; col, voff : SHORTINT); &#160;&#160;&#160;&#160;VAR pb, pe, p : Piece; org : LONGINT; M : UpdateMsg; A : Objects.AttrMsg; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF beg &#60; end THEN &#160;&#160;&#160;&#160;&#160;&#160;FindPiece(T, beg, org, p); SplitPiece(p, beg - org, pb); &#160;&#160;&#160;&#160;&#160;&#160;FindPiece(T, end, org, p); SplitPiece(p, end - org, pe); &#160;&#160;&#160;&#160;&#160;&#160;p : &#61; pb; &#160;&#160;&#160;&#160;&#160;&#160;REPEAT &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;(*IF (0 IN sel) &#38; (p.lib IS Fonts.Font) THEN p.lib : &#61; lib END;*) &#9;&#9;IF (0 IN sel) &#38; (p.lib IS Fonts.Font) THEN &#9;&#9;&#9;p.lib : &#61; lib &#9;&#9;ELSIF &#126;(p.lib IS Fonts.Font) THEN &#9;&#9;&#9;SyncPiece(T, p); &#9;&#9;&#9;IF (p.obj # NIL) &#38; (p.obj.handle # NIL) THEN &#9;&#9;&#9;&#9;IF 1 IN sel THEN &#9;&#9;&#9;&#9;&#9;A.id : &#61; Objects.get; A.name : &#61; "Color"; A.class : &#61; Objects.Inval; A.res : &#61; -1; &#9;&#9;&#9;&#9;&#9;p.obj.handle(p.obj, A); &#9;&#9;&#9;&#9;&#9;IF A.res &#61; 0 THEN &#9;&#9;&#9;&#9;&#9;&#9;A.id : &#61; Objects.set; A.class : &#61; Objects.Int; A.i : &#61; LONG(col) MOD 256; &#9;&#9;&#9;&#9;&#9;&#9;p.obj.handle(p.obj, A) &#9;&#9;&#9;&#9;&#9;END &#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;IF (0 IN sel) &#38; (lib # NIL) &#38; (lib IS Fonts.Font) THEN &#9;&#9;&#9;&#9;&#9;A.id : &#61; Objects.get; A.name : &#61; "Font"; A.class : &#61; Objects.Inval; A.res : &#61; -1; &#9;&#9;&#9;&#9;&#9;p.obj.handle(p.obj, A); &#9;&#9;&#9;&#9;&#9;IF A.res &#61; 0 THEN &#9;&#9;&#9;&#9;&#9;&#9;A.id : &#61; Objects.set; A.class : &#61; Objects.String; COPY(lib(Fonts.Font).name, A.s); &#9;&#9;&#9;&#9;&#9;&#9;p.obj.handle(p.obj, A) &#9;&#9;&#9;&#9;&#9;END &#9;&#9;&#9;&#9;END &#9;&#9;&#9;END &#9;&#9;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF 1 IN sel THEN p.col : &#61; col END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF 2 IN sel THEN p.voff : &#61; voff END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;p : &#61; p.next &#160;&#160;&#160;&#160;&#160;&#160;UNTIL p &#61; pe; &#160;&#160;&#160;&#160;&#160;&#160;M.text : &#61; T; M.F : &#61; NIL; M.beg : &#61; beg; M.end : &#61; end; M.len : &#61; end - beg; &#160;&#160;&#160;&#160;&#160;&#160;Display.Broadcast(M); T.stamp : &#61; M.stamp &#160;&#160;&#160;&#160;END &#160;&#160;END ChangeLooks; (** Open a new text buffer B. *) &#160;&#160;PROCEDURE OpenBuf* (B : Buffer); &#160;&#160;BEGIN NEW(B.header); (*null piece*) B.header.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;B.last : &#61; B.header; B.len : &#61; 0 &#160;&#160;END OpenBuf; (** Save stretch &#91;beg, end&#91; of T in buffer B. *) &#160;&#160;PROCEDURE Save* (T : Text; beg, end : LONGINT; B : Buffer); &#160;&#160;&#160;&#160;VAR p, q, qb, qe : Piece; org : LONGINT; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF beg &#60; end THEN &#160;&#160;&#160;&#160;&#160;&#160;FindPiece(T, beg, org, p); SyncPiece(T, p); &#160;&#160;&#160;&#160;&#160;&#160;NEW(qb); qb^ : &#61; p^; qb.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;&#160;&#160;qb.len : &#61; qb.len - (beg - org); &#160;&#160;&#160;&#160;&#160;&#160;qb.off : &#61; qb.off + (beg - org); &#160;&#160;&#160;&#160;&#160;&#160;qe : &#61; qb; &#160;&#160;&#160;&#160;&#160;&#160;WHILE end &#62; org + p.len DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;org : &#61; org + p.len; p : &#61; p.next; SyncPiece(T, p); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;NEW(q); q^ : &#61; p^; q.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;&#160;&#160;&#160;qe.next : &#61; q; q.prev : &#61; qe; qe : &#61; q &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;qe.next : &#61; NIL; qe.len : &#61; qe.len - (org + p.len - end); &#160;&#160;&#160;&#160;&#160;&#160;B.last.next : &#61; qb; qb.prev : &#61; B.last; B.last : &#61; qe; &#160;&#160;&#160;&#160;&#160;&#160;B.len : &#61; B.len + (end - beg) &#160;&#160;&#160;&#160;END &#160;&#160;END Save; (** Append copy of source buffer SB to destination buffer DB. *) &#160;&#160;PROCEDURE Copy* (SB, DB : Buffer); &#160;&#160;&#160;&#160;VAR Q, q, p : Piece; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;p : &#61; SB.header; Q : &#61; DB.last; &#160;&#160;&#160;&#160;WHILE p # SB.last DO p : &#61; p.next; &#160;&#160;&#160;&#160;&#160;&#160;NEW(q); q.ref : &#61; MIN(INTEGER); q^ : &#61; p^; Q.next : &#61; q; q.prev : &#61; Q; Q : &#61; q &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;DB.last : &#61; Q; DB.len : &#61; DB.len + SB.len &#160;&#160;END Copy; (** Recall previously deleted text. *) &#160;&#160;PROCEDURE Recall* (VAR B : Buffer); (*deleted text*) &#160;&#160;BEGIN Copy(DelBuf, B) &#160;&#160;END Recall; (** Default handler for text objects. This handler understands Objects.AttrMsg(for Gen attribute), Objects.CopyMsg, Objects.BindMsg, and Objects.FileMsg only. *) &#160;&#160;PROCEDURE Handle* (obj : Objects.Object; VAR M : Objects.ObjMsg); &#160;&#160;&#160;&#160;VAR T : Text; B : Buffer; len : LONGINT; id : INTEGER; ch : CHAR; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;WITH obj : Text DO &#160;&#160;&#160;&#160;&#160;&#160;IF M IS Objects.AttrMsg THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WITH M : Objects.AttrMsg DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF M.name &#61; "Gen" THEN M.class : &#61; Objects.String; M.s : &#61; "Texts.New"; M.res : &#61; 0 END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;ELSIF M IS Objects.CopyMsg THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WITH M : Objects.CopyMsg DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;NEW(B); OpenBuf(B); Save(obj, 0, obj.len, B); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;NEW(T); T.handle : &#61; obj.handle; GenNew(T); Insert(T, 0, B); M.obj : &#61; T &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;ELSIF M IS Objects.BindMsg THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WITH M : Objects.BindMsg DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF (obj.lib &#61; NIL) OR (obj.lib.name&#91;0&#93; &#61; 0X) &#38; (obj.lib # M.lib) THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;M.lib.GenRef(M.lib, id); M.lib.PutObj(M.lib, id, obj) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;ELSIF M IS Objects.FileMsg THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WITH M : Objects.FileMsg DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF M.id &#61; Objects.load THEN Files.Read(M.R, ch); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF ch &#61; DocBlockId THEN ReadDocHeader(R, ch) END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF (ch &#61; TextBlockId) OR (ch &#61; OldTextBlockId) THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Load(obj, Files.Base(M.R), Files.Pos(M.R), len); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.Set(M.R, Files.Base(M.R), Files.Pos(M.R) + len) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE (*M.id &#61; Objects.store*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Store(obj, Files.Base(M.R), Files.Pos(M.R), len); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.Set(M.R, Files.Base(M.R), Files.Pos(M.R) + len) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;END &#160;&#160;END Handle; (** Open Finder at position pos in T. The finder is automatically advanced to the next object in text. *) &#160;&#160;PROCEDURE OpenFinder* (VAR F : Finder; T : Text; pos : LONGINT); &#160;&#160;&#160;&#160;VAR p : Piece; org : LONGINT; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;FindPiece(T, pos, org, p); F.T : &#61; T; &#160;&#160;&#160;&#160;WHILE (p.f # Wfile) &#38; (p.lib IS Fonts.Font) DO &#160;&#160;&#160;&#160;&#160;&#160;org : &#61; org + p.len; p : &#61; p.next &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;F.pos : &#61; org; F.ref : &#61; p; F.eot : &#61; FALSE &#160;&#160;END OpenFinder; &#160;&#160;(** Advance Finder to next object in text and return current object. *) &#160;&#160;PROCEDURE FindObj* (VAR F : Finder; VAR obj : Objects.Object); &#160;&#160;&#160;&#160;VAR p : Piece; org : LONGINT; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;obj : &#61; F.ref.obj; &#160;&#160;&#160;&#160;IF obj &#61; NIL THEN (* load object *) &#9;&#9;SyncPiece(F.T, F.ref); obj : &#61; F.ref.obj &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;IF F.ref.f &#61; Wfile THEN F.eot : &#61; TRUE END; &#160;&#160;&#160;&#160;org : &#61; F.pos; p : &#61; F.ref; &#160;&#160;&#160;&#160;REPEAT org : &#61; org + p.len; p : &#61; p.next &#160;&#160;&#160;&#160;UNTIL (p.f &#61; Wfile) OR &#126;(p.lib IS Fonts.Font); &#160;&#160;&#160;&#160;F.pos : &#61; org; F.ref : &#61; p &#160;&#160;END FindObj; (** Open text reader R and set it up at position pos in text T. *) &#160;&#160;PROCEDURE OpenReader* (VAR R : Reader; T : Text; pos : LONGINT); &#160;&#160;&#160;&#160;VAR p : Piece; org : LONGINT; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;FindPiece(T, pos, org, p); R.T : &#61; T; R.lib : &#61; NIL; &#9;R.stamp : &#61; T.stamp; R.bufpos : &#61; 0; R.buflen : &#61; 0; &#160;&#160;&#160;&#160;R.ref : &#61; p; R.org : &#61; org; R.off : &#61; pos - org; &#9;R.lib : &#61; p.lib; R.col : &#61; p.col; R.voff : &#61; p.voff; &#160;&#160;&#160;&#160;IF p.ref &#62;&#61; 0 THEN SyncPiece(T, p) END; &#160;&#160;&#160;&#160;Files.Set(R.R, p.f, p.off + R.off); R.eot : &#61; p.f &#61; Wfile &#160;&#160;END OpenReader; (** Read next character into ch. R.eot is set when the last character is read. The fields lib, voff and col of R give information about the last character read. *) &#160;&#160;PROCEDURE Read* (VAR R : Reader; VAR ch : CHAR); &#9;VAR ref : Piece; &#160;&#160;BEGIN &#9;IF (R.stamp # R.T.stamp) OR (R.bufpos &#62;&#61; R.buflen) THEN &#9;&#9;IF R.stamp &#61; R.T.stamp THEN &#9;&#9;&#9;ref : &#61; R.ref; R.bufpos : &#61; 0; R.buflen : &#61; ref.len-R.off; &#9;&#9;&#9;IF R.buflen &#60;&#61; 0 THEN &#9;&#9;&#9;&#9;R.org : &#61; R.org + ref.len; R.off : &#61; 0; ref : &#61; ref.next; R.ref : &#61; ref; &#9;&#9;&#9;&#9;R.lib : &#61; ref.lib; R.col : &#61; ref.col; R.voff : &#61; ref.voff; &#9;&#9;&#9;&#9;IF ref.ref &#62;&#61; 0 THEN SyncPiece(R.T, ref) END; &#9;&#9;&#9;&#9;Files.Set(R.R, ref.f, ref.off); &#9;&#9;&#9;&#9;R.buflen : &#61; ref.len; IF ref.f &#61; Wfile THEN R.eot : &#61; TRUE END &#9;&#9;&#9;END; &#9;&#9;&#9;IF R.buflen &#62; BufSize THEN R.buflen : &#61; BufSize END; &#9;&#9;&#9;Files.ReadBytes(R.R, R.buf, R.buflen) &#9;&#9;ELSE &#9;&#9;&#9;OpenReader(R, R.T, R.org + R.off); &#9;&#9;&#9;Read(R, ch); RETURN &#9;&#9;END &#9;END; &#9;ch : &#61; R.buf&#91;R.bufpos&#93;; INC(R.bufpos); INC(R.off) &#160;&#160;END Read; (** Return reader&#39;s position within the text. *) &#160;&#160;PROCEDURE Pos* (VAR R : Reader) : LONGINT; &#160;&#160;BEGIN RETURN R.org + R.off &#160;&#160;END Pos; (** Open text scanner S and set it up at position pos in text T. *) &#160;&#160;PROCEDURE OpenScanner* (VAR S : Scanner; T : Text; pos : LONGINT); &#160;&#160;BEGIN OpenReader(S, T, pos); S.line : &#61; 0; S.class : &#61; Inval; Read(S, S.nextCh) &#160;&#160;END OpenScanner; &#160;&#160;(* Scanners --- NW --- *) &#160;&#160;(*IEEE floating-point formats (BM 1992.1.1) : (-1)^s * 1.m * 2^(e-e0), where &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;s                 e                 e0              m &#160;&#160;&#160;&#160;&#160;&#160;REAL             1-bit     8-bit biased      127    1+23-bit explicit &#160;&#160;&#160;&#160;&#160;&#160;LONGREAL   1-bit   11-bit biased     1023   1+52-bit explicit*) (** Read the next symbol. Whitespace is ignored. CR increments the line counter. *) &#160;&#160;PROCEDURE Scan* (VAR S : Scanner); &#160;&#160;&#160;&#160;CONST maxD &#61; 256; (* fixed size : maxD &#60;&#61; LEN(S.s)! *) &#160;&#160;&#160;&#160;VAR ch, E : CHAR; &#160;&#160;&#160;&#160;&#160;&#160;neg, negE, hex, sign : BOOLEAN; &#160;&#160;&#160;&#160;&#160;&#160;i, j, h, e, k, k1, k2, k3 : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;y : LONGREAL; &#160;&#160;&#160;&#160;&#160;&#160;d : ARRAY maxD OF CHAR; &#160;&#160;BEGIN ch : &#61; S.nextCh; i : &#61; 0; &#160;&#160;&#160;&#160;LOOP &#160;&#160;&#160;&#160;&#160;&#160;IF (S.lib &#61; NIL) OR &#126;(S.lib IS Fonts.Font) THEN EXIT &#160;&#160;&#160;&#160;&#160;&#160;ELSIF ch &#61; CR THEN INC(S.line) &#160;&#160;&#160;&#160;&#160;&#160;ELSIF (ch # " ") &#38; (ch # TAB) &#38; (ch # LF) THEN EXIT &#160;&#160;&#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;&#160;&#160;Read(S, ch) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;IF S.lib &#61; NIL THEN &#160;&#160;&#160;&#160;&#160;&#160;S.class : &#61; Inval; S.eot : &#61; TRUE; Read(S, ch) &#160;&#160;&#160;&#160;ELSIF &#126;(S.lib IS Fonts.Font) THEN &#160;&#160;&#160;&#160;&#160;&#160;S.class : &#61; Object; S.lib.GetObj(S.lib, ORD(ch), S.obj); Read(S, ch) &#160;&#160;&#160;&#160;ELSIF ("A" &#60;&#61; CAP(ch)) &#38; (CAP(ch) &#60;&#61; "Z") OR (ch &#61; ".") OR (ch &#61; "/") (*OR (ch &#61; " : ")*) THEN (*name*) &#160;&#160;&#160;&#160;&#160;&#160;REPEAT &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;S.s&#91;i&#93; : &#61; ch; INC(i); Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;UNTIL &#126;(nameChars&#91;ORD(ch)&#93;) OR &#126;(S.lib IS Fonts.Font) OR (i &#61; LEN(S.s)-1); &#160;&#160;&#160;&#160;&#160;&#160;S.s&#91;i&#93; : &#61; 0X; &#160;&#160;&#160;&#160;&#160;&#160;IF (i &#61; 1) &#38; ((CAP(S.s&#91;0&#93;) &#60; "A") OR (CAP(S.s&#91;0&#93;) &#62; "Z")) THEN &#160;&#160;&#160;&#160;&#160;&#160;&#9;S.c : &#61; S.s&#91;0&#93;; S.class : &#61; Char &#160;&#160;&#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;&#9;S.len : &#61; SHORT(SHORT(i)); S.class : &#61; Name &#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;ELSIF ch &#61; 22X THEN (*literal string*) &#160;&#160;&#160;&#160;&#160;&#160;Read(S, ch); &#160;&#160;&#160;&#160;&#160;&#160;WHILE (ch # 22X) &#38; (ch &#62;&#61; " ") &#38; (S.lib IS Fonts.Font) &#38; (i # LEN(S.s)-1) DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;S.s&#91;i&#93; : &#61; ch; INC(i); Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;WHILE (ch # 22X) &#38; (ch &#62;&#61; " ") &#38; (S.lib IS Fonts.Font) DO Read(S, ch) END; &#160;&#160;&#160;&#160;&#160;&#160;S.s&#91;i&#93; : &#61; 0X; S.len : &#61; SHORT(SHORT(i)); Read(S, ch); S.class : &#61; String &#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;IF ch &#61; "-" THEN sign : &#61; TRUE; neg : &#61; TRUE; Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;ELSIF ch &#61; "+" THEN sign : &#61; TRUE; neg : &#61; FALSE; Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;ELSE sign : &#61; FALSE; neg : &#61; FALSE &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;IF ("0" &#60;&#61; ch) &#38; (ch &#60;&#61; "9") &#38; (S.lib IS Fonts.Font) THEN (*number*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;hex : &#61; FALSE; j : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;LOOP &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;d&#91;i&#93; : &#61; ch; INC(i); Read(S, ch); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF (ch &#60; "0") OR &#126;(S.lib IS Fonts.Font) OR (i &#62;&#61; maxD) THEN EXIT END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF "9" &#60; ch THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF ("A" &#60;&#61; ch) &#38; (ch &#60;&#61; "F") THEN hex : &#61; TRUE; ch : &#61; CHR(ORD(ch)-7) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSIF ("a" &#60;&#61; ch) &#38; (ch &#60;&#61; "f") THEN hex : &#61; TRUE; ch : &#61; CHR(ORD(ch)-27H) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE EXIT &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF (ch &#61; "H") &#38; (S.lib IS Fonts.Font) THEN (*hex number*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Read(S, ch); S.class : &#61; Int; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF i-j &#62; 8 THEN j : &#61; i-8 END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;k : &#61; ORD(d&#91;j&#93;) - 30H; INC(j); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF (i-j &#61; 7) &#38; (k &#62;&#61; 8) THEN DEC(k, 16) END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE j &#60; i DO k : &#61; k*10H + (ORD(d&#91;j&#93;) - 30H); INC(j) END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF neg THEN S.i : &#61; -k ELSE S.i : &#61; k END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSIF (ch &#61; ".") &#38; (S.lib IS Fonts.Font) THEN (*read real*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Read(S, ch); h : &#61; i; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE ("0" &#60;&#61; ch) &#38; (ch &#60;&#61; "9") &#38; (S.lib IS Fonts.Font) &#38; (i &#60; maxD) DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;d&#91;i&#93; : &#61; ch; INC(i); Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;(* begin floating-point handling BM 1993.3.10 ---*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE i MOD 8 # 0 DO d&#91;i&#93; : &#61; "0"; INC(i) END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;j : &#61; 0; k : &#61; 0; k1 : &#61; 0; k2 : &#61; 0; k3 : &#61; 0; (* store digits 0..7, 8..15, 16..23, 24..31 in k, k1, k2, k3 *) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE j &#60; 8 DO k : &#61; k*10 + ORD(d&#91;j&#93;) - ORD("0"); INC(j) END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF 8 &#60; i THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE j &#60; 16 DO k1 : &#61; k1*10 + ORD(d&#91;j&#93;) - ORD("0"); INC(j) END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF 16 &#60; i THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE j &#60; 24 DO k2 : &#61; k2*10 + ORD(d&#91;j&#93;) - ORD("0"); INC(j) END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF 24 &#60; i THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE j &#60; 32 DO k3 : &#61; k3*10 + ORD(d&#91;j&#93;) - ORD("0"); INC(j) END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;e : &#61; 0; E : &#61; ch; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF ((E &#61; "D") OR (E &#61; "E")) &#38; (S.lib IS Fonts.Font) THEN Read(S, ch); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF (ch &#61; "-") &#38; (S.lib IS Fonts.Font) THEN negE : &#61; TRUE; Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE negE : &#61; FALSE; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF (ch &#61; "+") &#38; (S.lib IS Fonts.Font) THEN Read(S, ch) END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE ("0" &#60;&#61; ch) &#38; (ch &#60;&#61; "9") &#38; (S.lib IS Fonts.Font) DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;e : &#61; e*10 + ORD(ch) - ORD("0"); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF negE THEN e : &#61; - e END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;y : &#61; k3*Reals.Ten(-32) + k2*Reals.Ten(-24); y : &#61; y + k1*Reals.Ten(-16); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF ABS(e+h) &#60; 308 THEN y : &#61; (y + k*Reals.Ten(-8)) / Reals.Ten(-e-h) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE y : &#61; (y + k*Reals.Ten(-8)) * Reals.Ten(h); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF (e &#60;&#61; 308-32) OR (e &#60;&#61; 308) &#38; (y &#60; MAX(LONGREAL) / Reals.Ten(e)) THEN y : &#61; y * Reals.Ten(e) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE y : &#61; MAX(LONGREAL) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF E &#61; "D" THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF y &#61; MAX(LONGREAL) THEN S.class : &#61; Inval (* NaN *) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE S.class : &#61; LongReal; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF neg THEN S.y : &#61; - y ELSE S.y : &#61; y END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF Reals.ExpoL(S.y) &#61; 0 THEN S.y : &#61; 0 END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSIF MAX(REAL) &#60; y THEN S.class : &#61; Inval (* NaN *) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE S.class : &#61; Real; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF neg THEN S.x : &#61; SHORT(- y) ELSE S.x : &#61; SHORT(y) END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF Reals.Expo(S.x) &#61; 0 THEN S.x : &#61; 0 END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;(* end floating-point handling BM 1993.3.10 ---*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF hex THEN S.class : &#61; Inval END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE (*decimal integer*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;S.class : &#61; Int; k : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE (j # i) &#38; ((k &#60; MAX(LONGINT) DIV 10) OR &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;(k &#61; MAX(LONGINT) DIV 10) &#38; ((ORD(d&#91;j&#93;) - 30H) &#60;&#61; MAX(LONGINT) MOD 10)) DO (*JG*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;k : &#61; k*10 + (ORD(d&#91;j&#93;) - 30H); INC(j) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF j # i THEN S.class : &#61; Inval &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF neg THEN S.i : &#61; -k ELSE S.i : &#61; k END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF hex THEN S.class : &#61; Inval ELSE S.class : &#61; Int END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;ELSE S.class : &#61; Char; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF sign THEN IF neg THEN S.c : &#61; "-" ELSE S.c : &#61; "+" END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE S.c : &#61; ch; Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;S.nextCh : &#61; ch &#160;&#160;END Scan; (** Open a new writer W. *) &#160;&#160;PROCEDURE OpenWriter* (VAR W : Writer); &#160;&#160;BEGIN &#160;&#160;&#160;&#160;NEW(W.buf); OpenBuf(W.buf); W.lib : &#61; Fonts.Default; W.col : &#61; 15; W.voff : &#61; 0; &#160;&#160;&#160;&#160;Files.Set(W.R, Files.New(""), 0) &#160;&#160;END OpenWriter; (** Set writer W to font fnt. *) &#160;&#160;PROCEDURE SetFont* (VAR W : Writer; fnt : Objects.Library); &#160;&#160;BEGIN W.lib : &#61; fnt &#160;&#160;END SetFont; (** Set writer W to color col. *) &#160;&#160;PROCEDURE SetColor* (VAR W : Writer; col : SHORTINT); &#160;&#160;BEGIN W.col : &#61; col &#160;&#160;END SetColor; (** Set writer W to vertical offset voff. Vertical offset controls the writing of super- and sub-scripts. *) &#160;&#160;PROCEDURE SetOffset* (VAR W : Writer; voff : SHORTINT); &#160;&#160;BEGIN W.voff : &#61; voff &#160;&#160;END SetOffset; (** Write character ch to writer W&#39;s buffer. *) &#160;&#160;PROCEDURE Write* (VAR W : Writer; ch : CHAR); &#160;&#160;&#160;&#160;VAR p, q : Piece; &#160;&#160;BEGIN p : &#61; W.buf.last; &#160;&#160;&#160;&#160;IF &#126;(W.lib IS Fonts.Font) OR (W.lib # p.lib) OR (W.col # p.col) OR (W.voff # p.voff) OR (Files.Base(W.R) # p.f) THEN &#160;&#160;&#160;&#160;&#160;&#160;NEW(q); q.ref : &#61; MIN(INTEGER); &#160;&#160;&#160;&#160;&#160;&#160;IF &#126;(W.lib IS Fonts.Font) THEN W.lib.GetObj(W.lib, ORD(ch), q.obj) END; &#160;&#160;&#160;&#160;&#160;&#160;q.f : &#61; Files.Base(W.R); q.off : &#61; Files.Pos(W.R); q.len : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;q.lib : &#61; W.lib; q.col : &#61; W.col; q.voff : &#61; W.voff; &#160;&#160;&#160;&#160;&#160;&#160;q.next : &#61; NIL; p.next : &#61; q; q.prev : &#61; p; p : &#61; q; &#160;&#160;&#160;&#160;&#160;&#160;W.buf.last : &#61; p &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Files.Write(W.R, ch); &#160;&#160;&#160;&#160;INC(p.len); INC(W.buf.len) &#160;&#160;END Write; (** Write an end-of-line character to W&#39;s buffer. *) &#160;&#160;PROCEDURE WriteLn* (VAR W : Writer); &#160;&#160;BEGIN Write(W, CR) &#160;&#160;END WriteLn; (** Write string s to W&#39;s buffer. *) &#160;&#160;PROCEDURE WriteString* (VAR W : Writer; CONST s : ARRAY OF CHAR); &#9;VAR i : LONGINT; &#160;&#160;BEGIN i : &#61; 0; &#160;&#160;&#160;&#160;WHILE s&#91;i&#93; # 0X DO Write(W, s&#91;i&#93;); INC(i) END &#160;&#160;END WriteString; (** Write integer x to W&#39;s buffer. Spaces are padded to the left until the number field is at least n characters long. *) PROCEDURE WriteInt* (VAR W : Writer; x, n : LONGINT); &#160;&#160;&#160;&#160;VAR i, x0 : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;a : ARRAY 10 OF CHAR; &#160;&#160;BEGIN i : &#61; 0; &#160;&#160;&#160;&#160;IF x &#60; 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;IF x &#61; MIN(LONGINT) THEN WriteString(W, " -2147483648"); RETURN &#160;&#160;&#160;&#160;&#160;&#160;ELSE DEC(n); x0 : &#61; -x &#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;ELSE x0 : &#61; x &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;REPEAT &#160;&#160;&#160;&#160;&#160;&#160;a&#91;i&#93; : &#61; CHR(x0 MOD 10 + 30H); x0 : &#61; x0 DIV 10; INC(i) &#160;&#160;&#160;&#160;UNTIL x0 &#61; 0; &#160;&#160;&#160;&#160;WHILE n &#62; i DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;IF x &#60; 0 THEN Write(W, "-") END; &#160;&#160;&#160;&#160;REPEAT DEC(i); Write(W, a&#91;i&#93;) UNTIL i &#61; 0 &#160;&#160;END WriteInt; (** Write a hexadecimal representation of x to W&#39;s buffer. *) PROCEDURE WriteHex* (VAR W : Writer; x : LONGINT); &#160;&#160;&#160;&#160;VAR i, y : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;a : ARRAY 10 OF CHAR; &#160;&#160;BEGIN i : &#61; 0; Write(W, " "); &#160;&#160;&#160;&#160;REPEAT y : &#61; x MOD 10H; &#160;&#160;&#160;&#160;&#160;&#160;IF y &#60; 10 THEN a&#91;i&#93; : &#61; CHR(y + 30H) ELSE a&#91;i&#93; : &#61; CHR(y + 37H) END; &#160;&#160;&#160;&#160;&#160;&#160;x : &#61; x DIV 10H; INC(i) &#160;&#160;&#160;&#160;UNTIL i &#61; 8; &#160;&#160;&#160;&#160;REPEAT DEC(i); Write(W, a&#91;i&#93;) UNTIL i &#61; 0 &#160;&#160;END WriteHex; (** Write the hexadecimal representation of x to W&#39;s buffer. *) PROCEDURE WriteRealHex* (VAR W : Writer; x : REAL); BEGIN (* BM 1991.12.25 *) WriteHex(W, Reals.Int(x)) END WriteRealHex; (** Write the hexadecimal representation of x to W&#39;s buffer. *) PROCEDURE WriteLongRealHex* (VAR W : Writer; x : LONGREAL); &#9;VAR h, l : LONGINT; (* BM 1991.12.25 *) BEGIN Reals.IntL(x, h, l); WriteHex(W, h); WriteHex(W, l) END WriteLongRealHex; (** Write real x to W&#39;s buffer using n character positions. *) PROCEDURE WriteReal* (VAR W : Writer; x : REAL; n : LONGINT); &#160;&#160;(* BM 1993.4.22. Do not simplify rounding! *) &#160;&#160;VAR e, h, i : LONGINT; y : LONGREAL; z : REAL; d : ARRAY 8 OF CHAR; BEGIN &#160;&#160;e : &#61; Reals.Expo(x); &#160;&#160;IF e &#61; 255 THEN &#160;&#160;&#160;&#160;WHILE n &#62; 8 DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;h : &#61; Reals.NaNCode(x); &#160;&#160;&#160;&#160;IF h # 0 THEN WriteString(W, "    NaN") &#160;&#160;&#160;&#160;ELSIF x &#60; 0 THEN WriteString(W, "   -INF") &#160;&#160;&#160;&#160;ELSE WriteString(W, "     INF") &#160;&#160;&#160;&#160;END &#160;&#160;ELSE &#160;&#160;&#160;&#160;IF n &#60;&#61; 8 THEN n : &#61; 1 ELSE DEC(n, 7) END; &#160;&#160;&#160;&#160;REPEAT Write(W, " "); DEC(n) UNTIL n &#60;&#61; 7; (* 0 &#60;&#61; n &#60;&#61; 7 fraction digits *) &#160;&#160;&#160;&#160;IF (e # 0) &#38; (x &#60; 0) THEN Write(W, "-"); x : &#61; - x ELSE Write(W, " ") END; &#160;&#160;&#160;&#160;IF e &#61; 0 THEN h : &#61; 0 (* no denormals *) &#160;&#160;&#160;&#160;ELSE e : &#61; (e - 127) * 301 DIV 1000; (* ln(2)/ln(10) &#61; 0.301029996 *) &#160;&#160;&#160;&#160;&#160;&#160;IF e &#60; 38 THEN z : &#61; SHORT(Reals.Ten(e+1)); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF x &#62;&#61; z THEN y : &#61; LONG(x)/LONG(z); INC(e) ELSE y : &#61; x * Reals.Ten(-e) END &#160;&#160;&#160;&#160;&#160;&#160;ELSE y : &#61; x * Reals.Ten(-38) END; &#160;&#160;&#160;&#160;&#160;&#160;IF y &#62;&#61; 10 THEN y : &#61; y * Reals.Ten(-1) + 0.5D0 / Reals.Ten(n); INC(e) &#160;&#160;&#160;&#160;&#160;&#160;ELSE y : &#61; y + 0.5D0 / Reals.Ten(n); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF y &#62;&#61; 10 THEN y : &#61; y * Reals.Ten(-1); INC(e) END &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;y : &#61; y * Reals.Ten(7); h : &#61; ENTIER(y) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;i : &#61; 7; &#160;&#160;&#160;&#160;WHILE i &#62;&#61; 0 DO d&#91;i&#93; : &#61; CHR(h MOD 10 + ORD("0")); h : &#61; h DIV 10; DEC(i) END; &#160;&#160;&#160;&#160;Write(W, d&#91;0&#93;); Write(W, "."); i : &#61; 1; WHILE i &#60;&#61; n DO Write(W, d&#91;i&#93;); INC(i) END; &#160;&#160;&#160;&#160;IF e &#60; 0 THEN WriteString(W, "E-"); e : &#61; - e ELSE WriteString(W, "E+") END; &#160;&#160;&#160;&#160;Write(W, CHR(e DIV 10 + ORD("0"))); &#160;&#160;&#160;&#160;Write(W, CHR(e MOD 10 + ORD("0"))) &#160;&#160;END END WriteReal; (** Write real x in a fixed point notation. n is the overall minimal length for the output field, f the number of fraction digits following the decimal point, E the fixed exponent (printed only when E # 0). *) PROCEDURE WriteRealFix* (VAR W : Writer; x : REAL; n, f, E : LONGINT); &#160;&#160;(* BM 1993.4.22. Do not simplify rounding ! / JG formatting adjusted *) &#160;&#160;VAR e, h, i : LONGINT; r, y : LONGREAL; z : REAL; s : CHAR; d : ARRAY 8 OF CHAR; BEGIN &#160;&#160;e : &#61; Reals.Expo(x); &#160;&#160;IF (e &#61; 255) OR (ABS(E) &#62; 38) THEN &#160;&#160;&#160;&#160;WHILE n &#62; 8 DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;h : &#61; Reals.NaNCode(x); &#160;&#160;&#160;&#160;IF h # 0 THEN WriteString(W, "    NaN") &#160;&#160;&#160;&#160;ELSIF x &#60; 0 THEN WriteString(W, "   -INF") &#160;&#160;&#160;&#160;ELSE WriteString(W, "     INF") &#160;&#160;&#160;&#160;END &#160;&#160;ELSE &#160;&#160;&#160;&#160;IF E &#61; 0 THEN DEC(n, 2) ELSE DEC(n, 6) END; &#160;&#160;&#160;&#160;IF f &#60; 0 THEN f : &#61; 0 END; &#160;&#160;&#160;&#160;IF n &#60; f + 2 THEN n : &#61; f + 2 END; &#160;&#160;&#160;&#160;DEC(n, f); &#160;&#160;&#160;&#160;IF (e # 0) &#38; (x &#60; 0) THEN s : &#61; "-"; x : &#61; - x ELSE s : &#61; " " END; &#160;&#160;&#160;&#160;IF e &#61; 0 THEN h : &#61; 0; DEC(e, E-1) (* no denormals *) &#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;e : &#61; (e - 127) * 301 DIV 1000; (* ln(2)/ln(10) &#61; 0.301029996 *) &#160;&#160;&#160;&#160;&#160;&#160;IF e &#60; 38 THEN z : &#61; SHORT(Reals.Ten(e+1)); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF x &#62;&#61; z THEN y : &#61; LONG(x)/LONG(z); INC(e) ELSE y : &#61; x * Reals.Ten(-e) END &#160;&#160;&#160;&#160;&#160;&#160;ELSE y : &#61; x * Reals.Ten(-38) END; &#160;&#160;&#160;&#160;&#160;&#160;DEC(e, E-1); i : &#61; -(e+f); &#160;&#160;&#160;&#160;&#160;&#160;IF i &#60;&#61; 0 THEN r : &#61; 5 * Reals.Ten(i) ELSE r : &#61; 0 END; &#160;&#160;&#160;&#160;&#160;&#160;IF y &#62;&#61; 10 THEN y : &#61; y * Reals.Ten(-1) + r; INC(e) &#160;&#160;&#160;&#160;&#160;&#160;ELSE y : &#61; y + r; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF y &#62;&#61; 10 THEN y : &#61; y * Reals.Ten(-1); INC(e) END &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;y : &#61; y * Reals.Ten(7); h : &#61; ENTIER(y) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;i : &#61; 7; &#160;&#160;&#160;&#160;WHILE i &#62;&#61; 0 DO d&#91;i&#93; : &#61; CHR(h MOD 10 + ORD("0")); h : &#61; h DIV 10; DEC(i) END; &#160;&#160;&#160;&#160;IF n &#60;&#61; e THEN n : &#61; e + 1 END; &#160;&#160;&#160;&#160;IF e &#62; 0 THEN WHILE n &#62; e DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, s); e : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;WHILE n &#62; 0 DO DEC(n); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF e &#60; 8 THEN Write(W, d&#91;e&#93;); INC(e) ELSE Write(W, "0") END &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, ".") &#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;WHILE n &#62; 1 DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, s); Write(W, "0"); Write(W, "."); &#160;&#160;&#160;&#160;&#160;&#160;WHILE (0 &#60; f) &#38; (e &#60; 0) DO Write(W, "0"); DEC(f); INC(e) END &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;WHILE f &#62; 0 DO DEC(f); &#160;&#160;&#160;&#160;&#160;&#160;IF e &#60; 8 THEN Write(W, d&#91;e&#93;); INC(e) ELSE Write(W, "0") END &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;IF E # 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;IF E &#60; 0 THEN WriteString(W, "E-"); E : &#61; - E &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE WriteString(W, "E+") &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, CHR(E DIV 10 + ORD("0"))); Write(W, CHR(E MOD 10 + ORD("0"))) &#160;&#160;&#160;&#160;END &#160;&#160;END END WriteRealFix; (** Write LONGREAL x to W&#39;s buffer using n character positions. *) PROCEDURE WriteLongReal* (VAR W : Writer; x : LONGREAL; n : LONGINT); &#160;&#160;(* BM 1993.4.22. Do not simplify rounding! *) &#160;&#160;VAR e, h, l, i : LONGINT; z : LONGREAL; d : ARRAY 16 OF CHAR; BEGIN &#160;&#160;e : &#61; Reals.ExpoL(x); &#160;&#160;IF e &#61; 2047 THEN &#160;&#160;&#160;&#160;WHILE n &#62; 9 DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;Reals.NaNCodeL(x, h, l); &#160;&#160;&#160;&#160;IF (h # 0) OR (l # 0) THEN WriteString(W, "     NaN") &#160;&#160;&#160;&#160;ELSIF x &#60; 0 THEN WriteString(W, "    -INF") &#160;&#160;&#160;&#160;ELSE WriteString(W, "     INF") &#160;&#160;&#160;&#160;END &#160;&#160;ELSE &#160;&#160;&#160;&#160;IF n &#60;&#61; 9 THEN n : &#61; 1 ELSE DEC(n, 8) END; &#160;&#160;&#160;&#160;REPEAT Write(W, " "); DEC(n) UNTIL n &#60;&#61; 15; (* 0 &#60;&#61; n &#60;&#61; 15 fraction digits *) &#160;&#160;&#160;&#160;IF (e # 0) &#38; (x &#60; 0) THEN Write(W, "-"); x : &#61; - x ELSE Write(W, " ") END; &#160;&#160;&#160;&#160;IF e &#61; 0 THEN h : &#61; 0; l : &#61; 0 (* no denormals *) &#160;&#160;&#160;&#160;ELSE e : &#61; (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) &#61; 0.301029996 *) &#160;&#160;&#160;&#160;&#160;&#160;z : &#61; Reals.Ten(e+1); &#160;&#160;&#160;&#160;&#160;&#160;IF x &#62;&#61; z THEN x : &#61; x/z; INC(e) ELSE x : &#61; x * Reals.Ten(-e) END; &#160;&#160;&#160;&#160;&#160;&#160;IF x &#62;&#61; 10 THEN x : &#61; x * Reals.Ten(-1) + 0.5D0 / Reals.Ten(n); INC(e) &#160;&#160;&#160;&#160;&#160;&#160;ELSE x : &#61; x + 0.5D0 / Reals.Ten(n); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF x &#62;&#61; 10 THEN x : &#61; x * Reals.Ten(-1); INC(e) END &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;x : &#61; x * Reals.Ten(7); h : &#61; ENTIER(x); x : &#61; (x-h) * Reals.Ten(8); l : &#61; ENTIER(x) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;i : &#61; 15; WHILE i &#62; 7 DO d&#91;i&#93; : &#61; CHR(l MOD 10 + ORD("0")); l : &#61; l DIV 10; DEC(i) END; &#160;&#160;&#160;&#160;WHILE i &#62;&#61; 0 DO d&#91;i&#93; : &#61; CHR(h MOD 10 + ORD("0")); h : &#61; h DIV 10; DEC(i) END; &#160;&#160;&#160;&#160;Write(W, d&#91;0&#93;); Write(W, "."); i : &#61; 1; WHILE i &#60;&#61; n DO Write(W, d&#91;i&#93;); INC(i) END; &#160;&#160;&#160;&#160;IF e &#60; 0 THEN WriteString(W, "D-"); e : &#61; - e ELSE WriteString(W, "D+") END; &#160;&#160;&#160;&#160;Write(W, CHR(e DIV 100 + ORD("0"))); e : &#61; e MOD 100; &#160;&#160;&#160;&#160;Write(W, CHR(e DIV 10 + ORD("0"))); Write(W, CHR(e MOD 10 + ORD("0"))) &#160;&#160;END END WriteLongReal; (** Write LONGREAL x in a fixed point notation. n is the overall minimal length for the output field, f the number of fraction digits following the decimal point, D the fixed exponent (printed only when D # 0). *) PROCEDURE WriteLongRealFix* (VAR W : Writer; x : LONGREAL; n, f, D : LONGINT); &#160;&#160;(* BM 1993.4.22. Do not simplify rounding! / JG formatting adjusted *) &#160;&#160;VAR e, h, l, i : LONGINT; r, z : LONGREAL; d : ARRAY 16 OF CHAR; s : CHAR; BEGIN &#160;&#160;e : &#61; Reals.ExpoL(x); &#160;&#160;IF (e &#61; 2047) OR (ABS(D) &#62; 308) THEN &#160;&#160;&#160;&#160;WHILE n &#62; 9 DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;Reals.NaNCodeL(x, h, l); &#160;&#160;&#160;&#160;IF (h # 0) OR (l # 0) THEN WriteString(W, "     NaN") &#160;&#160;&#160;&#160;ELSIF x &#60; 0 THEN WriteString(W, "    -INF") &#160;&#160;&#160;&#160;ELSE WriteString(W, "     INF") &#160;&#160;&#160;&#160;END &#160;&#160;ELSE &#160;&#160;&#160;&#160;IF D &#61; 0 THEN DEC(n, 2) ELSE DEC(n, 7) END; &#160;&#160;&#160;&#160;IF n &#60; 2 THEN n : &#61; 2 END; &#160;&#160;&#160;&#160;IF f &#60; 0 THEN f : &#61; 0 END; &#160;&#160;&#160;&#160;IF n &#60; f + 2 THEN n : &#61; f + 2 END; &#160;&#160;&#160;&#160;DEC(n, f); &#160;&#160;&#160;&#160;IF (e # 0) &#38; (x &#60; 0) THEN s : &#61; "-"; x : &#61; - x ELSE s : &#61; " " END; &#160;&#160;&#160;&#160;IF e &#61; 0 THEN h : &#61; 0; l : &#61; 0; DEC(e, D-1) (* no denormals *) &#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;e : &#61; (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) &#61; 0.301029996 *) &#160;&#160;&#160;&#160;&#160;&#160;z : &#61; Reals.Ten(e+1); &#160;&#160;&#160;&#160;&#160;&#160;IF x &#62;&#61; z THEN x : &#61; x/z; INC(e) ELSE x : &#61; x * Reals.Ten(-e) END; &#160;&#160;&#160;&#160;&#160;&#160;DEC(e, D-1); i : &#61; -(e+f); &#160;&#160;&#160;&#160;&#160;&#160;IF i &#60;&#61; 0 THEN r : &#61; 5 * Reals.Ten(i) ELSE r : &#61; 0 END; &#160;&#160;&#160;&#160;&#160;&#160;IF x &#62;&#61; 10 THEN x : &#61; x * Reals.Ten(-1) + r; INC(e) &#160;&#160;&#160;&#160;&#160;&#160;ELSE x : &#61; x + r; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF x &#62;&#61; 10 THEN x : &#61; x * Reals.Ten(-1); INC(e) END &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;x : &#61; x * Reals.Ten(7); h : &#61; ENTIER(x); x : &#61; (x-h) * Reals.Ten(8); l : &#61; ENTIER(x) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;i : &#61; 15; &#160;&#160;&#160;&#160;WHILE i &#62; 7 DO d&#91;i&#93; : &#61; CHR(l MOD 10 + ORD("0")); l : &#61; l DIV 10; DEC(i) END; &#160;&#160;&#160;&#160;WHILE i &#62;&#61; 0 DO d&#91;i&#93; : &#61; CHR(h MOD 10 + ORD("0")); h : &#61; h DIV 10; DEC(i) END; &#160;&#160;&#160;&#160;IF n &#60;&#61; e THEN n : &#61; e + 1 END; &#160;&#160;&#160;&#160;IF e &#62; 0 THEN WHILE n &#62; e DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, s); e : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;WHILE n &#62; 0 DO DEC(n); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF e &#60; 16 THEN Write(W, d&#91;e&#93;); INC(e) ELSE Write(W, "0") END &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, ".") &#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;WHILE n &#62; 1 DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, s); Write(W, "0"); Write(W, "."); &#160;&#160;&#160;&#160;&#160;&#160;WHILE (0 &#60; f) &#38; (e &#60; 0) DO Write(W, "0"); DEC(f); INC(e) END &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;WHILE f &#62; 0 DO DEC(f); &#160;&#160;&#160;&#160;&#160;&#160;IF e &#60; 16 THEN Write(W, d&#91;e&#93;); INC(e) ELSE Write(W, "0") END &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;IF D # 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;IF D &#60; 0 THEN WriteString(W, "D-"); D : &#61; - D &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE WriteString(W, "D+") &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, CHR(D DIV 100 + ORD("0"))); D : &#61; D MOD 100; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, CHR(D DIV 10 + ORD("0"))); Write(W, CHR(D MOD 10 + ORD("0"))) &#160;&#160;&#160;&#160;END &#160;&#160;END END WriteLongRealFix; (** Write the time and date to W&#39;s buffer. *) &#160;&#160;PROCEDURE WriteDate* (VAR W : Writer; t, d : LONGINT); &#160;&#160;PROCEDURE WritePair(ch : CHAR; x : LONGINT); &#160;&#160;BEGIN Write(W, ch); &#160;&#160;&#160;&#160;Write(W, CHR(x DIV 10 + 30H)); Write(W, CHR(x MOD 10 + 30H)) &#160;&#160;END WritePair; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;WritePair(" ", d MOD 32); WritePair(".", d DIV 32 MOD 16); &#160;&#160;&#160;&#160;Write(W, "."); WriteInt(W, 1900 + d DIV 512, 1); &#160;&#160;&#160;&#160;WritePair(" ", t DIV 4096 MOD 32); WritePair(" : ", t DIV 64 MOD 64); WritePair(" : ", t MOD 64) &#160;&#160;END WriteDate; (** Write a SET value to writer W. *) PROCEDURE WriteSet*(VAR W : Writer; s : SET); &#9;VAR &#9;&#9;i, last : LONGINT; &#9;&#9;dots : BOOLEAN; BEGIN &#9;Write(W, "&#123;"); last : &#61; MIN(LONGINT); &#9;FOR i : &#61; MIN(SET) TO MAX(SET) DO &#9;&#9;IF i IN s THEN &#9;&#9;&#9;IF last &#61; (i-1) THEN &#9;&#9;&#9;&#9;IF dots THEN &#9;&#9;&#9;&#9;&#9;WriteString(W, " .. "); dots : &#61; FALSE &#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;IF (i &#61; MAX(SET)) OR &#126;((i+1) IN s) THEN &#9;&#9;&#9;&#9;&#9;WriteInt(W, i, 0) &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSE &#9;&#9;&#9;&#9;IF last &#62;&#61; MIN(SET) THEN &#9;&#9;&#9;&#9;&#9;WriteString(W, ", ") &#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;WriteInt(W, i, 0); dots : &#61; TRUE &#9;&#9;&#9;END; &#9;&#9;&#9;last : &#61; i &#9;&#9;END &#9;END; &#9;Write(W, "&#125;") END WriteSet; (** Write obj to writer W. *) &#9;PROCEDURE WriteObj*(VAR W : Writer; obj : Objects.Object); &#9;&#9;VAR lib : Objects.Library; &#9;BEGIN &#9;&#9;IF (obj.lib &#61; NIL) OR (obj.ref &#60; 0) OR (obj.lib.name &#61; "") THEN (* free or private *) &#9;&#9;&#9;IF obs &#61; NIL THEN &#9;&#9;&#9;&#9;NEW(obs); Objects.OpenLibrary(obs) &#9;&#9;&#9;END; &#9;&#9;&#9;obs.GenRef(obs, obj.ref); &#9;&#9;&#9;IF obj.ref &#62;&#61; 256 THEN &#9;&#9;&#9;&#9;NEW(obs); Objects.OpenLibrary(obs); &#9;&#9;&#9;&#9;obs.GenRef(obs, obj.ref) &#9;&#9;&#9;END; &#9;&#9;&#9;obs.PutObj(obs, obj.ref, obj) &#9;&#9;END; &#9;&#9;ASSERT(obj.ref &#60; 256); &#9;&#9;lib : &#61; W.lib; &#9;&#9;SetFont(W, obj.lib); &#9;&#9;Write(W, CHR(obj.ref)); &#9;&#9;SetFont(W, lib) &#9;END WriteObj; &#9;PROCEDURE InitScan; &#9;&#9;VAR i : LONGINT; &#9;BEGIN &#9;&#9;FOR i : &#61; 0 TO 255 DO nameChars&#91;i&#93; : &#61; FALSE END; &#9;&#9;FOR i : &#61; 80H TO 96H DO nameChars&#91;i&#93; : &#61; TRUE END; (* german characters *) &#9;&#9;FOR i : &#61; ORD("0") TO ORD("9") DO nameChars&#91;i&#93; : &#61; TRUE END; &#9;&#9;FOR i : &#61; ORD("A") TO ORD("Z") DO nameChars&#91;i&#93; : &#61; TRUE END; &#9;&#9;FOR i : &#61; ORD("a") TO ORD("z") DO nameChars&#91;i&#93; : &#61; TRUE END; &#9;&#9;nameChars&#91;ORD("@")&#93; : &#61; TRUE;	(* mail, compiler *) &#9;&#9;nameChars&#91;ORD(".")&#93; : &#61; TRUE;	(* mail, filenames, compiler *) &#9;&#9;nameChars&#91;ORD("/")&#93; : &#61; TRUE;	(* filenames *) &#9;&#9;nameChars&#91;ORD(" : ")&#93; : &#61; TRUE;	(* filenames (Mac) *) &#9;&#9;nameChars&#91;ORD("_")&#93; : &#61; TRUE &#9;END InitScan; BEGIN &#160;&#160;TextBlockId : &#61; 0F0X; DocBlockId : &#61; 0F7X; NoSpex : &#61; 0X; TextSpex : &#61; 1X; NoSpex2 : &#61; 2X; &#160;&#160;H : &#61; Handle; Wfile : &#61; Files.New(""); Files.Set(R, Wfile, 0); Files.Write(R, 0X); &#160;&#160;NEW(DelBuf); OpenBuf(DelBuf); InitScan; obs : &#61; NIL END Texts. (** Remarks : 1. Text streams consists of sequence of characters (type Fonts.Char) and and non-character objects (in different colors, fonts, and vertical offsets). The only way to distinguish between a character and an object in the text stream is by fetching the character/object from its library and then making a type test. The library of a character/object is given by the lib field of the reader while advancing through a text stream. The reference number of a character/object is the ordinal number of the character read (i.e. ORD(ch)). As character objects are bound to character fonts (Fonts.Font), a quick type test of the Reader lib field against Fonts.Font also settles the question. Non-character objects of a text are typically bound to the obs library field of the text descriptor. 2. The non-character objects of a text stream must have reference numbers in the range 0 &#60;&#61; ref &#60; 256, and must be bound to a library (not necessarily obs of the text descriptor). Writing non-character objects involves binding it to a library (say T.obs), changing the font of the Writer, and the writing the reference number of the non-character object into the writer&#39;s buffer. Afterwards the writer font is reset to its old value. More that 256 non-character objects can be written into the text by allocating a new library when the old library is full, and attaching it to the obs field of the text descriptor. The obs field just acts as a placeholder for libraries and is not used by the texts directly. 3. There are two mechanisms to read from a text and one to write to a text. The Readers allow characterwise reading from a certain text position onwards. The Scanners allow reading of formatted tokens like names, strings, numbers and characters. Writers are used to write characters into temporary holding areas called buffers. Buffers contains large sequences of objects (both character and non-character) and allow low-level temporary manipulation. The difference between texts and buffers involve the display update operations. Each text can possibly be represented on the display by some kind of text editor or viewer. When a module manipulates a text, a message called the UpdateMsg (type Texts.UpdateMsg) is broadcast to all viewers or text editors representing the text. They then update their representation accordingly. To prevent broadcasts being sent for potentially each character being written into a text, the text manipulation is first done in a buffer. Operations on buffers do not result in update messages being broadcasted. Only when a buffer is applied to a text (inserted or appended), the texts broadcasts an update message. By convention, once a buffer is applied to a text, its contents is emptied. 4. The scanner classes indicate what token was scanned. The scanner understands the following token types : &#9;Name	Longest sequence starting with "A".."Z", "a".."z", ".", "/", and containing &#9;&#9;"A".."Z", "a".."z", "0".."9", "@", ".", "/", " : ", "_", 80X..96X &#9;String	Any character sequence surrounded by double quotes, i.e. "string". &#9;&#9;The quotes are not returned in the s field of the scanner descriptor. &#9;Int	Any valid integer number. &#9;Real	Any valid REAL number, including exponent E. &#9;LongReal	Any valid LONGREAL number, including exponent D. &#9;Char	A character (single) not classified as one of the above. 5. The end of line character is carriage return (CR or 0DX), tabulators are 9X. Unprintable characters are show on the display as smallish square boxes. 6. Vertical offsets are typically measured in screen pixels (positive or negative to the text base line). 7. The Finder allow quick searching for non-character objects in a text. 8. The meaning of the UpdateMsg fields are defined as in the following table listed according to the procedures that broadcast the message. Note that a text stretch identified by (beg, end) does not include the character at position end in the text. Below, M is of type Texts.UpdateMsg and B stands for a buffer. &#9;Delete(beg, end)	M.beg &#61; beg &#9;&#9;M.end &#61; end &#9;&#9;M.len &#61; 0 &#9;Replace(beg, end, B)	M.beg &#61; beg &#9;&#9;M.end &#61; end &#9;&#9;M.len &#61; B.len &#9;ChangeLooks(beg, end)	M.beg &#61; beg &#9;&#9;M.end &#61; end &#9;&#9;M.len &#61; end - beg &#9;Insert(pos, buf)	M.beg &#61; pos &#9;&#9;M.end &#61; pos &#9;&#9;M.len &#61; B.len The general scheme is that the stretch between M.beg and M.end was "deleted", and a new stretch of length M.len was inserted at M.beg. The message indicates a change AFTER it has already been made by the texts module. 9. There is an asymmetry in writing and reading texts to a file. Each text "block" in a file is identified by a first character. Reading a text block requires that the starting position does not include this character, while writing a text block writes the id character automatically. 10. Opening of non-text files is allowed with Texts.Open; they are simply converted to ASCII streams. Storing such an opened text will convert it into an Oberon text. Note that the EditTools package allows the manipulation of ASCII texts both in MSDOS and UNIX format. &#42;)