Oberon/V5/Texts.Mod

MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014*) &#160;&#160;IMPORT Files, Fonts; &#160;&#160;CONST (*scanner symbol classes*) &#160;&#160;&#160;&#160;Inval* &#61; 0;        (*invalid symbol*) &#160;&#160;&#160;&#160;Name* &#61; 1;         (*name s (length len)*) &#160;&#160;&#160;&#160;String* &#61; 2;       (*literal 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;Char* &#61; 6;         (*special character c*) &#160;&#160;&#160;&#160;(* TextBlock &#61; TextTag "1" offset run &#123;run&#125; "0" len &#123;AsciiCode&#125;. &#160;&#160;&#160;&#160;&#160;&#160;run &#61; fnt &#91;name&#93; col voff len. *) &#160;&#160;&#160;&#160;TAB &#61; 9X; CR &#61; 0DX; maxD &#61; 9; &#160;&#160;&#160;&#160;TextTag &#61; 0F1X; &#160;&#160;&#160;&#160;replace* &#61; 0; insert* &#61; 1; delete* &#61; 2; unmark* &#61; 3; (*op-codes*) &#160;&#160;TYPE 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, len : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;fnt : Fonts.Font; &#160;&#160;&#160;&#160;&#160;&#160;col, voff : INTEGER; &#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;Notifier* &#61; PROCEDURE (T : Text; op : INTEGER; beg, end : LONGINT); &#160;&#160;&#160;&#160;TextDesc* &#61; RECORD &#160;&#160;&#160;&#160;&#160;&#160;len* : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;changed* : BOOLEAN; &#160;&#160;&#160;&#160;&#160;&#160;notify* : Notifier; &#160;&#160;&#160;&#160;&#160;&#160;trailer : Piece; &#160;&#160;&#160;&#160;&#160;&#160;pce : Piece; (*cache*) &#160;&#160;&#160;&#160;&#160;&#160;org : LONGINT; (*cache*) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Reader* &#61; RECORD &#160;&#160;&#160;&#160;&#160;&#160;eot* : BOOLEAN; &#160;&#160;&#160;&#160;&#160;&#160;fnt* : Fonts.Font; &#160;&#160;&#160;&#160;&#160;&#160;col*, voff* : INTEGER; &#160;&#160;&#160;&#160;&#160;&#160;ref : Piece; &#160;&#160;&#160;&#160;&#160;&#160;org : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;off : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;rider : Files.Rider &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Scanner* &#61; RECORD (Reader) &#160;&#160;&#160;&#160;&#160;&#160;nextCh* : CHAR; &#160;&#160;&#160;&#160;&#160;&#160;line*, class* : INTEGER; &#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* : INTEGER; &#160;&#160;&#160;&#160;&#160;&#160;s* : ARRAY 32 OF CHAR &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Buffer* &#61; POINTER TO BufDesc; &#160;&#160;&#160;&#160;BufDesc* &#61; RECORD &#160;&#160;&#160;&#160;&#160;&#160;len* : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;header, last : Piece &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Writer* &#61; RECORD &#160;&#160;&#160;&#160;&#160;&#160;buf* : Buffer; &#160;&#160;&#160;&#160;&#160;&#160;fnt* : Fonts.Font; &#160;&#160;&#160;&#160;&#160;&#160;col*, voff* : INTEGER; &#160;&#160;&#160;&#160;&#160;&#160;rider : Files.Rider &#160;&#160;&#160;&#160;END; &#160;&#160;VAR TrailerFile : Files.File; &#160;&#160;(* Filing *) &#160;&#160;PROCEDURE Trailer : Piece; &#160;&#160;&#160;&#160;VAR Q : Piece; &#160;&#160;BEGIN NEW(Q); &#160;&#160;&#160;&#160;Q.f : &#61; TrailerFile; Q.off : &#61; -1; Q.len : &#61; 1; Q.fnt : &#61; NIL; Q.col : &#61; 0; Q.voff : &#61; 0; RETURN Q &#160;&#160;END Trailer; &#160;&#160;PROCEDURE Load* (VAR R : Files.Rider; T : Text); &#160;&#160;&#160;&#160;VAR Q, q, p : Piece; &#160;&#160;&#160;&#160;&#160;&#160;off : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;N, fno : INTEGER; bt : BYTE; &#160;&#160;&#160;&#160;&#160;&#160;f : Files.File; &#160;&#160;&#160;&#160;&#160;&#160;FName : ARRAY 32 OF CHAR; &#160;&#160;&#160;&#160;&#160;&#160;Dict : ARRAY 32 OF Fonts.Font; &#160;&#160;BEGIN f : &#61; Files.Base(R); N : &#61; 1; Q : &#61; Trailer; p : &#61; Q; &#160;&#160;&#160;&#160;Files.ReadInt(R, off); Files.ReadByte(R, bt); fno : &#61; bt; &#160;&#160;&#160;&#160;WHILE fno # 0 DO &#160;&#160;&#160;&#160;&#160;&#160;IF fno &#61; N THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Files.ReadString(R, FName); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Dict&#91;N&#93; : &#61; Fonts.This(FName); INC(N) &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;NEW(q); q.fnt : &#61; Dict&#91;fno&#93;; &#160;&#160;&#160;&#160;&#160;&#160;Files.ReadByte(R, bt); q.col : &#61; bt; &#160;&#160;&#160;&#160;&#160;&#160;Files.ReadByte(R, bt); q.voff : &#61; ASR(LSL(bt, -24), 24); &#160;&#160;&#160;&#160;&#160;&#160;Files.ReadInt(R, q.len); &#160;&#160;&#160;&#160;&#160;&#160;Files.ReadByte(R, bt); fno : &#61; bt; &#160;&#160;&#160;&#160;&#160;&#160;q.f : &#61; f; q.off : &#61; off; off : &#61; off + q.len; &#160;&#160;&#160;&#160;&#160;&#160;p.next : &#61; q; q.prev : &#61; p; p : &#61; q &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;p.next : &#61; Q; Q.prev : &#61; p; &#160;&#160;&#160;&#160;T.trailer : &#61; Q; Files.ReadInt(R, T.len); (*Files.Set(R, f, Files.Pos(R) + T.len)*) &#160;&#160;END Load; &#160;&#160;PROCEDURE Open* (T : Text; name : ARRAY OF CHAR); &#160;&#160;&#160;&#160;VAR f : Files.File; R : Files.Rider; Q, q : Piece; &#160;&#160;&#160;&#160;&#160;&#160;tag : CHAR; len : LONGINT; &#160;&#160;BEGIN 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, tag); &#160;&#160;&#160;&#160;&#160;&#160;IF tag &#61; TextTag THEN Load(R, T) &#160;&#160;&#160;&#160;&#160;&#160;ELSE (*Ascii file*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;len : &#61; Files.Length(f); Q : &#61; Trailer; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;NEW(q); q.fnt : &#61; Fonts.Default; q.col : &#61; 1; q.voff : &#61; 0; q.f : &#61; f; q.off : &#61; 0; q.len : &#61; len; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Q.next : &#61; q; q.prev : &#61; Q; q.next : &#61; Q; Q.prev : &#61; q; T.trailer : &#61; Q; T.len : &#61; len &#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;ELSE (*create new text*) &#160;&#160;&#160;&#160;&#160;&#160;Q : &#61; Trailer; Q.next : &#61; Q; Q.prev : &#61; Q; T.trailer : &#61; Q; T.len : &#61; 0 &#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;T.changed : &#61; FALSE; T.org : &#61; -1; T.pce : &#61; T.trailer (*init cache*) &#160;&#160;END Open; &#160;&#160;PROCEDURE Store* (VAR W : Files.Rider; T : Text); &#160;&#160;&#160;&#160;VAR p, q : Piece; &#160;&#160;&#160;&#160;&#160;&#160;R : Files.Rider; &#160;&#160;&#160;&#160;&#160;&#160;off, rlen, pos : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;N, n : INTEGER; &#160;&#160;&#160;&#160;&#160;&#160;ch : CHAR; &#160;&#160;&#160;&#160;&#160;&#160;Dict : ARRAY 32, 32 OF CHAR; &#160;&#160;BEGIN pos : &#61; Files.Pos(W); Files.WriteInt(W, 0); (*place holder*) &#160;&#160;&#160;&#160;N : &#61; 1; 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;WHILE (q # T.trailer) &#38; (q.fnt &#61; p.fnt) &#38; (q.col &#61; p.col) &#38; (q.voff &#61; p.voff) DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;rlen : &#61; rlen + q.len; q : &#61; q.next &#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;Dict&#91;N&#93; : &#61; p.fnt.name; &#160;&#160;&#160;&#160;&#160;&#160;n : &#61; 1; &#160;&#160;&#160;&#160;&#160;&#160;WHILE Dict&#91;n&#93; # p.fnt.name DO INC(n) END; &#160;&#160;&#160;&#160;&#160;&#160;Files.WriteByte(W, n); &#160;&#160;&#160;&#160;&#160;&#160;IF n &#61; N THEN Files.WriteString(W, p.fnt.name); INC(N) END; &#160;&#160;&#160;&#160;&#160;&#160;Files.WriteByte(W, p.col); Files.WriteByte(W, p.voff); Files.WriteInt(W, rlen); &#160;&#160;&#160;&#160;&#160;&#160;p : &#61; q &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Files.WriteByte(W, 0); Files.WriteInt(W, T.len); &#160;&#160;&#160;&#160;off : &#61; Files.Pos(W); p : &#61; T.trailer.next; &#160;&#160;&#160;&#160;WHILE p # T.trailer DO &#160;&#160;&#160;&#160;&#160;&#160;rlen : &#61; p.len; Files.Set(R, p.f, p.off); &#160;&#160;&#160;&#160;&#160;&#160;WHILE rlen &#62; 0 DO Files.Read(R, ch); Files.Write(W, ch); DEC(rlen) END ; &#160;&#160;&#160;&#160;&#160;&#160;p : &#61; p.next &#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;Files.Set(W, Files.Base(W), pos); Files.WriteInt(W, off); (*fixup*) &#160;&#160;&#160;&#160;T.changed : &#61; FALSE; &#160;&#160;&#160;&#160;IF T.notify # NIL THEN T.notify(T, unmark, 0, 0) END &#160;&#160;END Store; &#160;&#160;PROCEDURE Close*(T : Text; name : ARRAY OF CHAR); &#160;&#160;&#160;&#160;VAR f : Files.File; w : Files.Rider; &#160;&#160;BEGIN f : &#61; Files.New(name); Files.Set(w, f, 0); &#160;&#160;&#160;&#160;Files.Write(w, TextTag); Store(w, T); Files.Register(f) &#160;&#160;END Close; &#160;&#160;(* Editing --- *) &#160;&#160;PROCEDURE OpenBuf* (B : Buffer); &#160;&#160;BEGIN NEW(B.header); (*null piece*) &#160;&#160;&#160;&#160;B.last : &#61; B.header; B.len : &#61; 0 &#160;&#160;END OpenBuf; &#160;&#160;PROCEDURE FindPiece (T : Text; pos : LONGINT; VAR org : LONGINT; VAR pce : Piece); &#160;&#160;&#160;&#160;VAR p : Piece; porg : LONGINT; &#160;&#160;BEGIN p : &#61; T.pce; porg : &#61; T.org; &#160;&#160;&#160;&#160;IF pos &#62;&#61; porg THEN &#160;&#160;&#160;&#160;&#160;&#160;WHILE pos &#62;&#61; porg + p.len DO INC(porg, p.len); p : &#61; p.next END &#160;&#160;&#160;&#160;ELSE p : &#61; p.prev; DEC(porg, p.len); &#160;&#160;&#160;&#160;&#160;&#160;WHILE pos &#60; porg DO p : &#61; p.prev; DEC(porg, p.len) END &#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;T.pce : &#61; p; T.org : &#61; porg; (*update cache*) &#160;&#160;&#160;&#160;pce : &#61; p; org : &#61; porg &#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); &#160;&#160;&#160;&#160;&#160;&#160;q.fnt : &#61; p.fnt; 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; &#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 end &#62; T.len THEN end : &#61; T.len END; &#160;&#160;&#160;&#160;FindPiece(T, beg, org, p); &#160;&#160;&#160;&#160;NEW(qb); qb^ : &#61; p^; &#160;&#160;&#160;&#160;qb.len : &#61; qb.len - (beg - org); &#160;&#160;&#160;&#160;qb.off : &#61; qb.off + (beg - org); &#160;&#160;&#160;&#160;qe : &#61; qb; &#160;&#160;&#160;&#160;WHILE end &#62; org + p.len DO &#160;&#160;&#160;&#160;&#160;&#160;org : &#61; org + p.len; p : &#61; p.next; &#160;&#160;&#160;&#160;&#160;&#160;NEW(q); q^ : &#61; p^; qe.next : &#61; q; q.prev : &#61; qe; qe : &#61; q &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;qe.next : &#61; NIL; qe.len : &#61; qe.len - (org + p.len - end); &#160;&#160;&#160;&#160;B.last.next : &#61; qb; qb.prev : &#61; B.last; B.last : &#61; qe; &#160;&#160;&#160;&#160;B.len : &#61; B.len + (end - beg) &#160;&#160;END Save; &#160;&#160;PROCEDURE Copy* (SB, DB : Buffer); &#160;&#160;&#160;&#160;VAR Q, q, p : Piece; &#160;&#160;BEGIN 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^ : &#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; &#160;&#160;PROCEDURE Insert* (T : Text; pos : LONGINT; B : Buffer); &#160;&#160;&#160;&#160;VAR pl, pr, p, qb, qe : Piece; org, end : LONGINT; &#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 T.org : &#61; org - p.prev.len; T.pce : &#61; p.prev 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) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#38; (qb.fnt &#61; pl.fnt) &#38; (qb.col &#61; pl.col) &#38; (qb.voff &#61; pl.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 qe : &#61; B.last; &#160;&#160;&#160;&#160;&#160;&#160;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; end : &#61; pos + B.len; &#160;&#160;&#160;&#160;B.last : &#61; B.header; B.last.next : &#61; NIL; B.len : &#61; 0; &#160;&#160;&#160;&#160;T.changed : &#61; TRUE; T.notify(T, insert, pos, end) &#160;&#160;END Insert; &#160;&#160;PROCEDURE Append* (T : Text; B : Buffer); &#160;&#160;BEGIN Insert(T, T.len, B) &#160;&#160;END Append; &#160;&#160;PROCEDURE Delete* (T : Text; beg, end : LONGINT; B : Buffer); &#160;&#160;&#160;&#160;VAR pb, pe, pbr, per : Piece; orgb, orge : LONGINT; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF end &#62; T.len THEN end : &#61; T.len END; &#160;&#160;&#160;&#160;FindPiece(T, beg, orgb, pb); SplitPiece(pb, beg - orgb, pbr); &#160;&#160;&#160;&#160;FindPiece(T, end, orge, pe); &#160;&#160;&#160;&#160;SplitPiece(pe, end - orge, per); &#160;&#160;&#160;&#160;IF T.org &#62;&#61; orgb THEN (*adjust cache*) &#160;&#160;&#160;&#160;&#160;&#160;T.org : &#61; orgb - pb.prev.len; T.pce : &#61; pb.prev &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;B.header.next : &#61; pbr; B.last : &#61; per.prev; &#160;&#160;&#160;&#160;B.last.next : &#61; NIL; B.len : &#61; end - beg; &#160;&#160;&#160;&#160;per.prev : &#61; pbr.prev; pbr.prev.next : &#61; per; &#160;&#160;&#160;&#160;T.len : &#61; T.len - B.len; &#160;&#160;&#160;&#160;T.changed : &#61; TRUE; T.notify(T, delete, beg, end) &#160;&#160;END Delete; &#160;&#160;PROCEDURE ChangeLooks* (T : Text; beg, end : LONGINT; sel : SET; fnt : Fonts.Font; col, voff : INTEGER); &#160;&#160;&#160;&#160;VAR pb, pe, p : Piece; org : LONGINT; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF end &#62; T.len THEN end : &#61; T.len END; &#160;&#160;&#160;&#160;FindPiece(T, beg, org, p); SplitPiece(p, beg - org, pb); &#160;&#160;&#160;&#160;FindPiece(T, end, org, p); SplitPiece(p, end - org, pe); &#160;&#160;&#160;&#160;p : &#61; pb; &#160;&#160;&#160;&#160;REPEAT &#160;&#160;&#160;&#160;&#160;&#160;IF 0 IN sel THEN p.fnt : &#61; fnt END; &#160;&#160;&#160;&#160;&#160;&#160;IF 1 IN sel THEN p.col : &#61; col END; &#160;&#160;&#160;&#160;&#160;&#160;IF 2 IN sel THEN p.voff : &#61; voff END; &#160;&#160;&#160;&#160;&#160;&#160;p : &#61; p.next &#160;&#160;&#160;&#160;UNTIL p &#61; pe; &#160;&#160;&#160;&#160;T.changed : &#61; TRUE; T.notify(T, replace, beg, end) &#160;&#160;END ChangeLooks; &#160;&#160;PROCEDURE Attributes*(T : Text; pos : LONGINT; VAR fnt : Fonts.Font; VAR col, voff : INTEGER); &#160;&#160;&#160;&#160;VAR p : Piece; org : LONGINT; &#160;&#160;BEGIN FindPiece(T, pos, org, p); fnt : &#61; p.fnt; col : &#61; p.col; voff : &#61; p.voff &#160;&#160;END Attributes; &#160;&#160;(* -- Access : Readers - *) &#160;&#160;PROCEDURE OpenReader* (VAR R : Reader; T : Text; pos : LONGINT); &#160;&#160;&#160;&#160;VAR p : Piece; org : LONGINT; &#160;&#160;BEGIN FindPiece(T, pos, org, p); &#160;&#160;&#160;&#160;R.ref : &#61; p; R.org : &#61; org; R.off : &#61; pos - org; &#160;&#160;&#160;&#160;Files.Set(R.rider, p.f, p.off + R.off); R.eot : &#61; FALSE &#160;&#160;END OpenReader; &#160;&#160;PROCEDURE Read* (VAR R : Reader; VAR ch : CHAR); &#160;&#160;BEGIN Files.Read(R.rider, ch); &#160;&#160;&#160;&#160;R.fnt : &#61; R.ref.fnt; R.col : &#61; R.ref.col; R.voff : &#61; R.ref.voff; &#160;&#160;&#160;&#160;INC(R.off); &#160;&#160;&#160;&#160;IF R.off &#61; R.ref.len THEN &#160;&#160;&#160;&#160;&#160;&#160;IF R.ref.f &#61; TrailerFile THEN R.eot : &#61; TRUE END; &#160;&#160;&#160;&#160;&#160;&#160;R.org : &#61; R.org + R.off; R.off : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;R.ref : &#61; R.ref.next; R.org : &#61; R.org + R.off; R.off : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;Files.Set(R.rider, R.ref.f, R.ref.off) &#160;&#160;&#160;&#160;END &#160;&#160;END Read; &#160;&#160;PROCEDURE Pos* (VAR R : Reader) : LONGINT; &#160;&#160;BEGIN RETURN R.org + R.off &#160;&#160;END Pos; &#160;&#160;(* -- Access : Scanners (NW) - *) &#160;&#160;PROCEDURE OpenScanner* (VAR S : Scanner; T : Text; pos : LONGINT); &#160;&#160;BEGIN OpenReader(S, T, pos); S.line : &#61; 0; S.nextCh : &#61; " " &#160;&#160;END OpenScanner; &#160;&#160;(*floating point formats : &#160;&#160;&#160;&#160;x &#61; 1.m * 2^(e-127)   bit 0 : sign, bits 1- 8 : e, bits  9-31 : m &#160;&#160;&#160;&#160;x &#61; 1.m * 2^(e-1023)  bit 0 : sign, bits 1-11 : e, bits 12-63 : m *) &#160;&#160;PROCEDURE Ten(n : INTEGER) : REAL; &#160;&#160;&#160;&#160;VAR t, p : REAL; &#160;&#160;BEGIN t : &#61; 1.0; p : &#61; 10.0;  (*compute 10^n *) &#160;&#160;&#160;&#160;WHILE n &#62; 0 DO &#160;&#160;&#160;&#160;&#160;&#160;IF ODD(n) THEN t : &#61; p * t END ; &#160;&#160;&#160;&#160;&#160;&#160;p : &#61; p*p; n : &#61; n DIV 2 &#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;RETURN t &#160;&#160;END Ten; &#160;&#160;PROCEDURE Scan* (VAR S : Scanner); &#160;&#160;&#160;&#160;CONST maxExp &#61; 38; maxM &#61; 16777216; (*2^24*) &#160;&#160;&#160;&#160;VAR ch, term : CHAR; &#160;&#160;&#160;&#160;&#160;&#160;neg, negE, hex : BOOLEAN; &#160;&#160;&#160;&#160;&#160;&#160;i, j, h, d, e, n, s : INTEGER; &#160;&#160;&#160;&#160;&#160;&#160;k : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;x : REAL; &#160;&#160;BEGIN ch : &#61; S.nextCh; i : &#61; 0; &#160;&#160;&#160;&#160;WHILE (ch &#61; " ") OR (ch &#61; TAB) OR (ch &#61; CR) DO &#160;&#160;&#160;&#160;&#160;&#160;IF ch &#61; CR THEN INC(S.line) END ; &#160;&#160;&#160;&#160;&#160;&#160;Read(S, ch) &#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;IF ("A" &#60;&#61; ch) &#38; (ch &#60;&#61; "Z") OR ("a" &#60;&#61; ch) &#38; (ch &#60;&#61; "z") THEN (*name*) &#160;&#160;&#160;&#160;&#160;&#160;REPEAT S.s&#91;i&#93; : &#61; ch; INC(i); Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;UNTIL ((ch &#60; "0") &#38; (ch # ".") OR ("9" &#60; ch) &#38; (ch &#60; "A") OR ("Z" &#60; ch) &#38; (ch &#60; "a") OR ("z" &#60; ch)) OR (i &#61; 31); &#160;&#160;&#160;&#160;&#160;&#160;S.s&#91;i&#93; : &#61; 0X; S.len : &#61; i; S.class : &#61; Name &#160;&#160;&#160;&#160;ELSIF ch &#61; 22X THEN (*string*) &#160;&#160;&#160;&#160;&#160;&#160;Read(S, ch); &#160;&#160;&#160;&#160;&#160;&#160;WHILE (ch # 22X) &#38; (ch &#62;&#61; " ") &#38; (i # 31) DO S.s&#91;i&#93; : &#61; ch; INC(i); Read(S, ch) END; &#160;&#160;&#160;&#160;&#160;&#160;S.s&#91;i&#93; : &#61; 0X; S.len : &#61; i+1; Read(S, ch); S.class : &#61; String &#160;&#160;&#160;&#160;ELSE hex : &#61; FALSE; &#160;&#160;&#160;&#160;&#160;&#160;IF ch &#61; "-" THEN neg : &#61; TRUE; Read(S, ch) ELSE neg : &#61; FALSE END ; &#160;&#160;&#160;&#160;&#160;&#160;IF ("0" &#60;&#61; ch) &#38; (ch &#60;&#61; "9") THEN (*number*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;n : &#61; ORD(ch) - 30H; h : &#61; n; Read(S, ch); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE ("0" &#60;&#61; ch) &#38; (ch &#60;&#61; "9") OR ("A" &#60;&#61; ch) &#38; (ch &#60;&#61; "F") DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF ch &#60;&#61; "9" THEN d : &#61; ORD(ch) - 30H ELSE d : &#61; ORD(ch) - 37H; hex : &#61; TRUE END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;n : &#61; 10*n + d; h : &#61; 10H*h + d; Read(S, ch) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF ch &#61; "H" THEN (*hex integer*) Read(S, ch); S.i : &#61; h; S.class : &#61; Int (*neg?*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSIF ch &#61; "." THEN (*real number*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Read(S, ch); x : &#61; 0.0; e : &#61; 0; j : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE ("0" &#60;&#61; ch) &#38; (ch &#60;&#61; "9") DO (*fraction*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;h : &#61; 10*n + (ORD(ch) - 30H); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF h &#60; maxM THEN n : &#61; h; INC(j) END ; &#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;END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF ch &#61; "E" THEN (*scale factor*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;s : &#61; 0; Read(S, ch); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF ch &#61; "-" 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; "+" 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") DO &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;s : &#61; s*10 + ORD(ch) - 30H; 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 DEC(e, s) ELSE INC(e, s) END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;x : &#61; FLT(n); DEC(e, j); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF e &#60; 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF e &#62;&#61; -maxExp THEN x : &#61; x / Ten(-e) ELSE x : &#61; 0.0 END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSIF e &#62; 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF e &#60;&#61; maxExp THEN x : &#61; Ten(e) * x ELSE x : &#61; 0.0 END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF neg THEN S.x : &#61; -x ELSE S.x : &#61; x END ; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF hex THEN S.class : &#61; 0 ELSE S.class : &#61; Real END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE (*decimal integer*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF neg THEN S.i : &#61; -n ELSE S.i : &#61; n END; &#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;END &#160;&#160;&#160;&#160;&#160;&#160;ELSE (*spectal character*) S.class : &#61; Char; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF neg THEN S.c : &#61; "-" ELSE S.c : &#61; ch; Read(S, ch) 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; &#160;&#160;(* --- Access : Writers (NW) -- *) &#160;&#160;PROCEDURE OpenWriter* (VAR W : Writer); &#160;&#160;BEGIN NEW(W.buf); &#160;&#160;&#160;&#160;OpenBuf(W.buf); W.fnt : &#61; Fonts.Default; W.col : &#61; 15; W.voff : &#61; 0; &#160;&#160;&#160;&#160;Files.Set(W.rider, Files.New(""), 0) &#160;&#160;END OpenWriter; &#160;&#160;PROCEDURE SetFont* (VAR W : Writer; fnt : Fonts.Font); &#160;&#160;BEGIN W.fnt : &#61; fnt &#160;&#160;END SetFont; &#160;&#160;PROCEDURE SetColor* (VAR W : Writer; col : INTEGER); &#160;&#160;BEGIN W.col : &#61; col &#160;&#160;END SetColor; &#160;&#160;PROCEDURE SetOffset* (VAR W : Writer; voff : INTEGER); &#160;&#160;BEGIN W.voff : &#61; voff &#160;&#160;END SetOffset; &#160;&#160;PROCEDURE Write* (VAR W : Writer; ch : CHAR); &#160;&#160;&#160;&#160;VAR p : Piece; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF (W.buf.last.fnt # W.fnt) OR (W.buf.last.col # W.col) OR (W.buf.last.voff # W.voff) THEN &#160;&#160;&#160;&#160;&#160;&#160;NEW(p); p.f : &#61; Files.Base(W.rider); p.off : &#61; Files.Pos(W.rider); p.len : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;p.fnt : &#61; W.fnt; p.col : &#61; W.col; p.voff : &#61; W.voff; &#160;&#160;&#160;&#160;&#160;&#160;p.next : &#61; NIL; W.buf.last.next : &#61; p; &#160;&#160;&#160;&#160;&#160;&#160;p.prev : &#61; W.buf.last; W.buf.last : &#61; p &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Files.Write(W.rider, ch); &#160;&#160;&#160;&#160;INC(W.buf.last.len); INC(W.buf.len) &#160;&#160;END Write; &#160;&#160;PROCEDURE WriteLn* (VAR W : Writer); &#160;&#160;BEGIN Write(W, CR) &#160;&#160;END WriteLn; &#160;&#160;PROCEDURE WriteString* (VAR W : Writer; s : ARRAY OF CHAR); &#160;&#160;&#160;&#160;VAR i : INTEGER; &#160;&#160;BEGIN i : &#61; 0; &#160;&#160;&#160;&#160;WHILE s&#91;i&#93; &#62;&#61; " " DO Write(W, s&#91;i&#93;); INC(i) END &#160;&#160;END WriteString; &#160;&#160;PROCEDURE WriteInt* (VAR W : Writer; x, n : LONGINT); &#160;&#160;&#160;&#160;VAR i : INTEGER; x0 : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;a : ARRAY 10 OF CHAR; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF ROR(x, 31) &#61; 1 THEN WriteString(W, " -2147483648") &#160;&#160;&#160;&#160;ELSE i : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;IF x &#60; 0 THEN DEC(n); x0 : &#61; -x ELSE x0 : &#61; x END; &#160;&#160;&#160;&#160;&#160;&#160;REPEAT &#160;&#160;&#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;&#160;&#160;UNTIL x0 &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;WHILE n &#62; i DO Write(W, " "); DEC(n) END; &#160;&#160;&#160;&#160;&#160;&#160;IF x &#60; 0 THEN Write(W, "-") END; &#160;&#160;&#160;&#160;&#160;&#160;REPEAT DEC(i); Write(W, a&#91;i&#93;) UNTIL i &#61; 0 &#160;&#160;&#160;&#160;END &#160;&#160;END WriteInt; &#160;&#160;PROCEDURE WriteHex* (VAR W : Writer; x : LONGINT); &#160;&#160;&#160;&#160;VAR i : INTEGER; 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; &#160;PROCEDURE WriteReal* (VAR W : Writer; x : REAL; n : INTEGER); &#160;&#160;&#160;&#160;VAR e, i, m : INTEGER; &#160;&#160;&#160;&#160;&#160;&#160;d : ARRAY 16 OF CHAR; &#160;&#160;BEGIN e : &#61; ASR(ORD(x), 23) MOD 100H; (*binary exponent*) &#160;&#160;&#160;&#160;IF e &#61; 0 THEN &#160;&#160;&#160;&#160;&#160;&#160;WriteString(W, " 0 "); &#160;&#160;&#160;&#160;&#160;&#160;WHILE n &#62;&#61; 3 DO Write(W, " "); DEC(n) END &#160;&#160;&#160;&#160;ELSIF e &#61; 255 THEN WriteString(W, " NaN ") &#160;&#160;&#160;&#160;ELSE Write(W, " "); &#160;&#160;&#160;&#160;&#160;&#160;WHILE n &#62;&#61; 15 DO DEC(n); Write(W, " ") END ; &#160;&#160;&#160;&#160;&#160;&#160;(* 2 &#60; n &#60; 9 digits to be written*) &#160;&#160;&#160;&#160;&#160;&#160;IF x &#60; 0.0 THEN Write(W, "-"); x : &#61; -x ELSE Write(W, " ") END ; &#160;&#160;&#160;&#160;&#160;&#160;e : &#61; (e - 127) * 77 DIV 256 - 6; (*decimal exponent*) &#160;&#160;&#160;&#160;&#160;&#160;IF e &#62;&#61; 0 THEN x : &#61; x / Ten(e) ELSE x : &#61; Ten(-e) * x END ; &#160;&#160;&#160;&#160;&#160;&#160;m : &#61; FLOOR(x + 0.5); i : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;IF m &#62;&#61; 10000000 THEN INC(e); m : &#61; m DIV 10 END ; &#160;&#160;&#160;&#160;&#160;&#160;REPEAT d&#91;i&#93; : &#61; CHR(m MOD 10 + 30H); m : &#61; m DIV 10; INC(i) UNTIL m &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;DEC(i); Write(W, d&#91;i&#93;); Write(W, "."); &#160;&#160;&#160;&#160;&#160;&#160;IF i &#60; n-7 THEN n : &#61; 0 ELSE n : &#61; 14 - n END ; &#160;&#160;&#160;&#160;&#160;&#160;WHILE i &#62; n DO DEC(i); Write(W, d&#91;i&#93;) END ; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, "E"); INC(e, 6); &#160;&#160;&#160;&#160;&#160;&#160;&#160;IF e &#60; 0 THEN Write(W, "-"); e : &#61; -e ELSE Write(W, "+") END ; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, CHR(e DIV 10 + 30H)); Write(W, CHR(e MOD 10 + 30H)) &#160;&#160;&#160;&#160;END &#160;&#160;END WriteReal; &#160;&#160;PROCEDURE WriteRealFix* (VAR W : Writer; x : REAL; n, k : INTEGER); &#160;&#160;&#160;&#160;VAR i, m : INTEGER; neg : BOOLEAN; &#160;&#160;&#160;&#160;&#160;&#160;d : ARRAY 12 OF CHAR; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;IF x &#61; 0.0 THEN WriteString(W, " 0") &#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;IF x &#60; 0.0 THEN x : &#61; -x; neg : &#61; TRUE ELSE neg : &#61; FALSE END ; &#160;&#160;&#160;&#160;&#160;&#160;IF k &#62; 7 THEN k : &#61; 7 END ; &#160;&#160;&#160;&#160;&#160;&#160;x : &#61; Ten(k) * x; m : &#61; FLOOR(x + 0.5); &#160;&#160;&#160;&#160;&#160;&#160;i : &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;REPEAT d&#91;i&#93; : &#61; CHR(m MOD 10 + 30H); m : &#61; m DIV 10; INC(i) UNTIL m &#61; 0; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, " "); &#160;&#160;&#160;&#160;&#160;&#160;WHILE n &#62; i+3 DO Write(W, " "); DEC(n) END ; &#160;&#160;&#160;&#160;&#160;&#160;IF neg THEN Write(W, "-"); DEC(n) ELSE Write(W, " ") END ; &#160;&#160;&#160;&#160;&#160;&#160;WHILE i &#62; k DO DEC(i); Write(W, d&#91;i&#93;) END ; &#160;&#160;&#160;&#160;&#160;&#160;Write(W, "."); &#160;&#160;&#160;&#160;&#160;&#160;WHILE k &#62; i DO DEC(k); Write(W, "0") END ; &#160;&#160;&#160;&#160;&#160;&#160;WHILE i &#62; 0 DO DEC(i); Write(W, d&#91;i&#93;) END &#160;&#160;&#160;&#160;END &#160;&#160;END WriteRealFix; &#160;&#160;PROCEDURE WritePair(VAR W : Writer; 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;PROCEDURE WriteClock* (VAR W : Writer; d : LONGINT); &#160;&#160;BEGIN &#160;&#160;&#160;&#160;WritePair(W, " ", d DIV 20000H MOD 20H);  (*day*) &#160;&#160;&#160;&#160;WritePair(W, ".", d DIV 400000H MOD 10H); (*month*) &#160;&#160;&#160;&#160;WritePair(W, ".", d DIV 4000000H MOD 40H);  (*year*) &#160;&#160;&#160;&#160;WritePair(W, " ", d DIV 1000H MOD 20H);  (*hour*) &#160;&#160;&#160;&#160;WritePair(W, " : ", d DIV 40H MOD 40H); (*min*) &#160;&#160;&#160;&#160;WritePair(W, " : ", d MOD 40H) (*sec*) &#160;&#160;END WriteClock; BEGIN TrailerFile : &#61; Files.New("") END Texts.