summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 317e2eb)
raw | patch | inline | side by side (parent: 317e2eb)
| author | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
| Sat, 16 Sep 2017 10:59:14 +0000 (13:59 +0300) | ||
| committer | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
| Sat, 16 Sep 2017 10:59:14 +0000 (13:59 +0300) |
| rtl/Texts.obn | patch | blob | history | |
| rtl/java/Files.java | patch | blob | history | |
| src/oberon.c | patch | blob | history |
diff --git a/rtl/Texts.obn b/rtl/Texts.obn
index b6fe9c0aa20ce5108cd2e76367249274d1adbae8..2acaf3c6937c00c5096701c534398286484df8c2 100644 (file)
--- a/rtl/Texts.obn
+++ b/rtl/Texts.obn
-MODULE Texts; (** CAS/HM 7.10.93 -- interface based on Texts by JG/NW 6.12.91**)\r (* Ported from Oberon V4 -- this version not depended on graphics *)\r\r IMPORT\r Files, Reals;\r\r (*--- insert field e: Elem into Texts.Scanner and change Texts.Scan to set it in case of class=6 *)\r\r\r CONST\r ElemChar* = 1CX;\r TAB = 9X; CR = 0DX; maxD = 9;\r (**FileMsg.id**)\r load* = 0; store* = 1;\r (**Notifier op**)\r replace* = 0; insert* = 1; delete* = 2;\r (**Scanner.class**)\r Inval* = 0; Name* = 1; String* = 2; Int* = 3; Real* = 4; LongReal* = 5; Char* = 6;\r\r textTag = 0F0X; version = 01X;\r\r Displaywhite = 15;\r\r TYPE\r FontsFont = POINTER TO FontDesc;\r FontDesc = RECORD\r name: ARRAY 32 OF CHAR;\r END;\r\r Run = POINTER TO RunDesc;\r RunDesc = RECORD\r prev, next: Run;\r len: LONGINT;\r fnt: FontsFont;\r col, voff: SHORTINT\r END;\r\r Piece = POINTER TO PieceDesc;\r PieceDesc = RECORD (RunDesc)\r file: Files.File;\r org: LONGINT\r END;\r\r Elem* = POINTER TO ElemDesc;\r Buffer* = POINTER TO BufDesc;\r Text* = POINTER TO TextDesc;\r\r ElemMsg* = RECORD END;\r Handler* = PROCEDURE (e: Elem; VAR msg: ElemMsg);\r\r ElemDesc* = RECORD (RunDesc)\r W*, H*: LONGINT;\r handle*: Handler;\r base: Text\r END;\r\r FileMsg* = RECORD (ElemMsg)\r id*: INTEGER;\r pos*: LONGINT;\r r*: Files.Rider\r END;\r\r CopyMsg* = RECORD (ElemMsg)\r e*: Elem\r END;\r\r IdentifyMsg* = RECORD (ElemMsg)\r mod*, proc*: ARRAY 32 OF CHAR\r END;\r\r\r BufDesc* = RECORD\r len*: LONGINT;\r head: Run\r END;\r\r Notifier* = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);\r\r TextDesc* = RECORD\r len*: LONGINT;\r notify*: Notifier;\r head, cache: Run;\r corg: LONGINT\r END;\r\r Reader* = RECORD\r eot*: BOOLEAN;\r fnt*: FontsFont;\r col*, voff*: SHORTINT;\r elem*: Elem;\r rider: Files.Rider;\r run: Run;\r org, off: LONGINT\r END;\r\r Scanner* = RECORD (Reader)\r nextCh*: CHAR;\r line*, class*: INTEGER;\r i*: LONGINT;\r x*: REAL;\r y*: LONGREAL;\r c*: CHAR;\r len*: SHORTINT;\r s*: ARRAY 32 OF CHAR\r END;\r\r Writer* = RECORD\r buf*: Buffer;\r fnt*: FontsFont;\r col*, voff*: SHORTINT;\r rider: Files.Rider;\r file: Files.File\r END;\r\r Alien = POINTER TO RECORD (ElemDesc)\r file: Files.File;\r org, span: LONGINT;\r mod, proc: ARRAY 32 OF CHAR\r END;\r\r\r VAR\r new*: Elem;\r del: Buffer;\r FontsDefault: FontsFont;\r\r\r (* run primitives *)\r\r PROCEDURE Find (T: Text; VAR pos: LONGINT; VAR u: Run; VAR org, off: LONGINT);\r VAR v: Run; m: LONGINT;\r BEGIN\r IF pos >= T.len THEN pos := T.len; u := T.head; org := T.len; off := 0; T.cache := T.head; T.corg := 0\r ELSE v := T.cache.next; m := pos - T.corg;\r IF pos >= T.corg THEN\r WHILE m >= v.len DO DEC(m, v.len); v := v.next END\r ELSE\r WHILE m < 0 DO v := v.prev; INC(m, v.len) END;\r END;\r u := v; org := pos - m; off := m; T.cache := v.prev; T.corg := org\r END\r END Find;\r\r PROCEDURE Split (off: LONGINT; VAR u, un: Run);\r VAR p, U: Piece;\r BEGIN\r IF off = 0 THEN un := u; u := un.prev\r ELSIF off >= u.len THEN un := u.next\r ELSE NEW(p); un := p; U := u(Piece);\r p^ := U^; INC(p.org, off); DEC(p.len, off); DEC(U.len, p.len);\r p.prev := U; p.next := U.next; p.next.prev := p; U.next := p\r END\r END Split;\r\r PROCEDURE Merge (T: Text; u: Run; VAR v: Run);\r VAR p, q: Piece;\r BEGIN\r IF (u IS Piece) & (v IS Piece) & (u.fnt.name = v.fnt.name) & (u.col = v.col) & (u.voff = v.voff) THEN\r p := u(Piece); q := v(Piece);\r IF (p.file = q.file) & (p.org + p.len = q.org) THEN\r IF T.cache = u THEN INC(T.corg, q.len)\r ELSIF T.cache = v THEN T.cache := T.head; T.corg := 0\r END;\r INC(p.len, q.len); v := v.next\r END\r END\r END Merge;\r\r PROCEDURE Splice (un, v, w: Run; base: Text); (* (u, un) -> (u, v, w, un) *)\r VAR u: Run;\r BEGIN\r IF v # w.next THEN u := un.prev;\r u.next := v; v.prev := u; un.prev := w; w.next := un;\r REPEAT\r IF v IS Elem THEN v(Elem).base := base END;\r v := v.next\r UNTIL v = un\r END\r END Splice;\r\r PROCEDURE ClonePiece (p: Piece): Piece;\r VAR q: Piece;\r BEGIN NEW(q); q^ := p^; RETURN q\r END ClonePiece;\r\r PROCEDURE CloneElem (e: Elem): Elem;\r VAR msg: CopyMsg;\r BEGIN msg.e := NIL; e.handle(e, msg); RETURN msg.e\r END CloneElem;\r\r\r (** Elements **)\r\r PROCEDURE CopyElem* (SE, DE: Elem);\r BEGIN DE.len := SE.len; DE.fnt := SE.fnt; DE.col := SE.col; DE.voff := SE.voff;\r DE.W := SE.W; DE.H := SE.H; DE.handle := SE.handle\r END CopyElem;\r\r PROCEDURE ElemBase* (E: Elem): Text;\r BEGIN RETURN E.base\r END ElemBase;\r \r PROCEDURE ElemPos* (E: Elem): LONGINT;\r VAR u: Run; pos: LONGINT;\r BEGIN u := E.base.head.next; pos := 0;\r WHILE u # E DO pos := pos + u.len; u := u.next END;\r RETURN pos\r END ElemPos;\r\r\r PROCEDURE HandleAlien (E: Elem; VAR msg: ElemMsg);\r VAR e: Alien; r: Files.Rider; i: LONGINT; ch: CHAR;\r BEGIN\r WITH E: Alien DO\r IF msg IS CopyMsg THEN\r (*\r WITH msg: CopyMsg DO NEW(e); CopyElem(E, e);\r e.file := E.file; e.org := E.org; e.span := E.span; e.mod := E.mod; e.proc := E.proc;\r msg.e := e\r END\r *)\r ELSIF msg IS IdentifyMsg THEN\r WITH msg: IdentifyMsg DO\r COPY(E.mod, msg.mod); COPY(E.proc, msg.proc); msg.mod[31] := 1X (*alien*)\r END\r ELSIF msg IS FileMsg THEN\r WITH msg: FileMsg DO\r IF msg.id = store THEN Files.Set(r, E.file, E.org); i := E.span;\r WHILE i > 0 DO Files.Read(r, ch); Files.Write(msg.r, ch); DEC(i) END\r END\r END\r END\r END\r END HandleAlien;\r\r\r (** Buffers **)\r\r PROCEDURE OpenBuf* (B: Buffer);\r VAR u: Run;\r BEGIN NEW(u); u.next := u; u.prev := u; B.head := u; B.len := 0\r END OpenBuf;\r\r PROCEDURE Copy* (SB, DB: Buffer);\r VAR u, v, vn: Run;\r BEGIN u := SB.head.next; v := DB.head.prev;\r WHILE u # SB.head DO\r IF u IS Piece THEN vn := ClonePiece(u(Piece)) ELSE vn := CloneElem(u(Elem)) END;\r v.next := vn; vn.prev := v; v := vn; u := u.next\r END;\r v.next := DB.head; DB.head.prev := v;\r INC(DB.len, SB.len)\r END Copy;\r\r PROCEDURE Recall* (VAR B: Buffer);\r BEGIN B := del; del := NIL\r END Recall;\r\r\r (** Texts **)\r\r PROCEDURE Save* (T: Text; beg, end: LONGINT; B: Buffer);\r VAR u, v, w, wn: Run; uo, ud, vo, vd: LONGINT;\r BEGIN Find(T, beg, u, uo, ud); Find(T, end, v, vo, vd);\r w := B.head.prev;\r WHILE u # v DO\r IF u IS Piece THEN wn := ClonePiece(u(Piece)); DEC(wn.len, ud); INC(wn(Piece).org, ud)\r ELSE wn := CloneElem(u(Elem))\r END;\r w.next := wn; wn.prev := w; w := wn; u := u.next; ud := 0\r END;\r IF vd > 0 THEN (*v IS Piece*) wn := ClonePiece(v(Piece)); wn.len := vd - ud; INC(wn(Piece).org, ud);\r w.next := wn; wn.prev := w; w := wn\r END;\r w.next := B.head; B.head.prev := w;\r INC(B.len, end - beg)\r END Save;\r\r PROCEDURE Insert* (T: Text; pos: LONGINT; B: Buffer);\r VAR u, un, v: Run; p, q: Piece; uo, ud, len: LONGINT;\r BEGIN Find(T, pos, u, uo, ud); Split(ud, u, un);\r len := B.len; v := B.head.next;\r Merge(T, u, v); Splice(un, v, B.head.prev, T);\r INC(T.len, len); B.head.next := B.head; B.head.prev := B.head; B.len := 0;\r IF T.notify # NIL THEN T.notify(T, insert, pos, pos + len) END\r END Insert;\r\r PROCEDURE Append* (T: Text; B: Buffer);\r VAR v: Run; pos, len: LONGINT;\r BEGIN pos := T.len; len := B.len; v := B.head.next;\r Merge(T, T.head.prev, v); Splice(T.head, v, B.head.prev, T);\r INC(T.len, len); B.head.next := B.head; B.head.prev := B.head; B.len := 0;\r IF T.notify # NIL THEN T.notify(T, insert, pos, pos + len) END\r END Append;\r\r PROCEDURE Delete* (T: Text; beg, end: LONGINT);\r VAR c, u, un, v, vn: Run; co, uo, ud, vo, vd: LONGINT;\r BEGIN\r Find(T, beg, u, uo, ud); Split(ud, u, un); c := T.cache; co := T.corg;\r Find(T, end, v, vo, vd); Split(vd, v, vn); T.cache := c; T.corg := co;\r NEW(del); OpenBuf(del); del.len := end - beg;\r Splice(del.head, un, v, NIL);\r Merge(T, u, vn); u.next := vn; vn.prev := u;\r DEC(T.len, end - beg);\r IF T.notify # NIL THEN T.notify(T, delete, beg, end) END\r END Delete;\r\r PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: FontsFont; col, voff: SHORTINT);\r VAR c, u, un, v, vn: Run; co, uo, ud, vo, vd: LONGINT;\r BEGIN Find(T, beg, u, uo, ud); Split(ud, u, un); c := T.cache; co := T.corg;\r Find(T, end, v, vo, vd); Split(vd, v, vn); T.cache := c; T.corg := co;\r WHILE un # vn DO\r IF (0 IN sel) & (fnt # NIL) THEN un.fnt := fnt END;\r IF 1 IN sel THEN un.col := col END;\r IF 2 IN sel THEN un.voff := voff END;\r Merge(T, u, un);\r IF u.next = un THEN u := un; un := un.next ELSE u.next := un; un.prev := u END\r END;\r Merge(T, u, un); u.next := un; un.prev := u;\r IF T.notify # NIL THEN T.notify(T, replace, beg, end) END\r END ChangeLooks;\r\r\r (** Readers **)\r\r PROCEDURE OpenReader* (VAR R: Reader; T: Text; pos: LONGINT);\r VAR u: Run;\r BEGIN\r IF pos >= T.len THEN pos := T.len END;\r Find(T, pos, u, R.org, R.off); R.run := u; R.eot := FALSE;\r IF u IS Piece THEN\r Files.Set(R.rider, u(Piece).file, u(Piece).org + R.off)\r END\r END OpenReader;\r\r PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);\r VAR u: Run;\r BEGIN u := R.run; R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; INC(R.off);\r IF u IS Piece THEN Files.Read(R.rider, ch); R.elem := NIL\r ELSIF u IS Elem THEN ch := ElemChar; R.elem := u(Elem)\r ELSE ch := 0X; R.elem := NIL; R.eot := TRUE\r END;\r IF R.off = u.len THEN INC(R.org, u.len); u := u.next;\r IF u IS Piece THEN\r WITH u: Piece DO Files.Set(R.rider, u.file, u.org) END\r END;\r R.run := u; R.off := 0\r END\r END Read;\r\r PROCEDURE ReadElem* (VAR R: Reader);\r VAR u, un: Run;\r BEGIN u := R.run;\r WHILE u IS Piece DO INC(R.org, u.len); u := u.next END;\r IF u IS Elem THEN un := u.next; R.run := un; INC(R.org); R.off := 0;\r R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; R.elem := u(Elem);\r IF un IS Piece THEN\r WITH un: Piece DO Files.Set(R.rider, un.file, un.org) END\r END\r ELSE R.eot := TRUE; R.elem := NIL\r END\r END ReadElem;\r\r PROCEDURE ReadPrevElem* (VAR R: Reader);\r VAR u: Run;\r BEGIN u := R.run.prev;\r WHILE u IS Piece DO DEC(R.org, u.len); u := u.prev END;\r IF u IS Elem THEN R.run := u; DEC(R.org); R.off := 0;\r R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; R.elem := u(Elem)\r ELSE R.eot := TRUE; R.elem := NIL\r END\r END ReadPrevElem;\r\r PROCEDURE Pos* (VAR R: Reader): LONGINT;\r BEGIN RETURN R.org + R.off\r END Pos;\r\r\r (** Scanners --------------- NW --------------- **)\r\r PROCEDURE OpenScanner* (VAR S: Scanner; T: Text; pos: LONGINT);\r BEGIN OpenReader(S, T, pos); S.line := 0; S.nextCh := " "\r END OpenScanner;\r\r (*IEEE floating point formats:\r x = 2^(e-127) * 1.m bit 0: sign, bits 1- 8: e, bits 9-31: m\r x = 2^(e-1023) * 1.m bit 0: sign, bits 1-11: e, bits 12-63: m *)\r\r PROCEDURE Scan* (VAR S: Scanner);\r CONST maxD = 32;\r VAR ch, term: CHAR;\r neg, negE, hex: BOOLEAN;\r i, j, h: SHORTINT;\r e: INTEGER; k: LONGINT;\r x, f: REAL; y, g: LONGREAL;\r d: ARRAY maxD OF CHAR;\r\r PROCEDURE ReadScaleFactor;\r BEGIN Read(S, ch);\r IF ch = "-" THEN negE := TRUE; Read(S, ch)\r ELSE negE := FALSE;\r IF ch = "+" THEN Read(S, ch) END\r END;\r WHILE ("0" <= ch) & (ch <= "9") DO\r e := e*10 + ORD(ch) - 30H; Read(S, ch)\r END\r END ReadScaleFactor;\r\r BEGIN ch := S.nextCh; i := 0;\r LOOP\r IF ch = CR THEN INC(S.line)\r ELSIF (ch # " ") & (ch # TAB) THEN EXIT\r END ;\r Read(S, ch)\r END;\r IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") THEN (*name*)\r REPEAT S.s[i] := ch; INC(i); Read(S, ch)\r UNTIL (CAP(ch) > "Z")\r OR ("A" > CAP(ch)) & (ch > "9")\r OR ("0" > ch) & (ch # ".")\r OR (i = 31);\r S.s[i] := 0X; S.len := i; S.class := 1\r ELSIF ch = 22X THEN (*literal string*)\r Read(S, ch);\r WHILE (ch # 22X) & (ch >= " ") & (i # 31) DO\r S.s[i] := ch; INC(i); Read(S, ch)\r END;\r S.s[i] := 0X; S.len := i; Read(S, ch); S.class := 2\r ELSE\r IF ch = "-" THEN neg := TRUE; Read(S, ch) ELSE neg := FALSE END ;\r IF ("0" <= ch) & (ch <= "9") THEN (*number*)\r hex := FALSE; j := 0;\r LOOP d[i] := ch; INC(i); Read(S, ch);\r IF ch < "0" THEN EXIT END;\r IF "9" < ch THEN\r IF ("A" <= ch) & (ch <= "F") THEN hex := TRUE; ch := CHR(ORD(ch)-7)\r ELSIF ("a" <= ch) & (ch <= "f") THEN hex := TRUE; ch := CHR(ORD(ch)-27H)\r ELSE EXIT\r END\r END\r END;\r IF ch = "H" THEN (*hex number*)\r Read(S, ch); S.class := 3;\r IF i-j > 8 THEN j := i-8 END ;\r k := ORD(d[j]) - 30H; INC(j);\r IF (i-j = 7) & (k >= 8) THEN DEC(k, 16) END ;\r WHILE j < i DO k := k*10H + (ORD(d[j]) - 30H); INC(j) END ;\r IF neg THEN S.i := -k ELSE S.i := k END \r ELSIF ch = "." THEN (*read real*)\r Read(S, ch); h := i;\r WHILE ("0" <= ch) & (ch <= "9") DO d[i] := ch; INC(i); Read(S, ch) END ;\r IF ch = "D" THEN\r e := 0; y := 0; g := 1;\r REPEAT y := y*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = h;\r WHILE j < i DO g := g/10; y := (ORD(d[j]) - 30H)*g + y; INC(j) END ;\r ReadScaleFactor;\r IF negE THEN\r IF e <= 308 THEN y := y / Reals.TenL(e) ELSE y := 0 END\r ELSIF e > 0 THEN\r IF e <= 308 THEN y := Reals.TenL(e) * y ELSE HALT(40) END \r END ;\r IF neg THEN y := -y END ;\r S.class := 5; S.y := y\r ELSE e := 0; x := 0; f := 1;\r REPEAT x := x*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = h;\r WHILE j < i DO f := f/10; x := (ORD(d[j])-30H)*f + x; INC(j) END;\r IF ch = "E" THEN ReadScaleFactor END ;\r IF negE THEN\r IF e <= 38 THEN x := x / Reals.Ten(e) ELSE x := 0 END\r ELSIF e > 0 THEN\r IF e <= 38 THEN x := Reals.Ten(e) * x ELSE HALT(40) END\r END ;\r IF neg THEN x := -x END ;\r S.class := 4; S.x := x\r END ;\r IF hex THEN S.class := 0 END\r ELSE (*decimal integer*)\r S.class := 3; k := 0;\r REPEAT k := k*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = i;\r IF neg THEN S.i := -k ELSE S.i := k END;\r IF hex THEN S.class := 0 ELSE S.class := 3 END\r END\r ELSE S.class := 6;\r IF neg THEN S.c := "-" ELSE S.c := ch; Read(S, ch) END\r END\r END;\r S.nextCh := ch\r END Scan;\r\r\r (** Writers **)\r\r PROCEDURE OpenWriter* (VAR W: Writer);\r BEGIN NEW(W.buf); OpenBuf(W.buf);\r W.fnt := FontsDefault; W.col := Displaywhite; W.voff := 0;\r W.file := Files.New(""); Files.Set(W.rider, W.file, 0)\r END OpenWriter;\r\r PROCEDURE SetFont* (VAR W: Writer; fnt: FontsFont);\r BEGIN W.fnt := fnt\r END SetFont;\r\r PROCEDURE SetColor* (VAR W: Writer; col: SHORTINT);\r BEGIN W.col := col\r END SetColor;\r\r PROCEDURE SetOffset* (VAR W: Writer; voff: SHORTINT);\r BEGIN W.voff := voff\r END SetOffset;\r\r\r PROCEDURE Write* (VAR W: Writer; ch: CHAR);\r VAR u, un: Run; p: Piece;\r BEGIN Files.Write(W.rider, ch); INC(W.buf.len); un := W.buf.head; u := un.prev;\r IF (u IS Piece) & (u(Piece).file = W.file) & (u.fnt.name = W.fnt.name) & (u.col = W.col) & (u.voff = W.voff) THEN\r INC(u.len)\r ELSE NEW(p); u.next := p; p.prev := u; p.next := un; un.prev := p;\r p.len := 1; p.fnt := W.fnt; p.col := W.col; p.voff := W.voff;\r p.file := W.file; p.org := Files.Length(W.file) - 1\r END\r END Write;\r\r PROCEDURE WriteElem* (VAR W: Writer; e: Elem);\r VAR u, un: Run;\r BEGIN\r IF e.base # NIL THEN HALT(99) END;\r INC(W.buf.len); e.len := 1; e.fnt := W.fnt; e.col := W.col; e.voff := W.voff;\r un := W.buf.head; u := un.prev; u.next := e; e.prev := u; e.next := un; un.prev := e\r END WriteElem;\r\r PROCEDURE WriteLn* (VAR W: Writer);\r BEGIN Write(W, CR)\r END WriteLn;\r\r PROCEDURE WriteString* (VAR W: Writer; s: ARRAY OF CHAR);\r VAR i: INTEGER;\r BEGIN i := 0;\r WHILE s[i] >= " " DO Write(W, s[i]); INC(i) END\r END WriteString;\r\r PROCEDURE WriteInt* (VAR W: Writer; x, n: LONGINT);\r VAR i: INTEGER; x0: LONGINT;\r a: ARRAY 11 OF CHAR;\r BEGIN i := 0;\r IF x < 0 THEN\r IF x = MIN(LONGINT) THEN WriteString(W, " -2147483648"); RETURN\r ELSE DEC(n); x0 := -x\r END\r ELSE x0 := x\r END;\r REPEAT\r a[i] := CHR(x0 MOD 10 + 30H); x0 := x0 DIV 10; INC(i)\r UNTIL x0 = 0;\r WHILE n > i DO Write(W, " "); DEC(n) END;\r IF x < 0 THEN Write(W, "-") END;\r REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0\r END WriteInt;\r\r PROCEDURE WriteHex* (VAR W: Writer; x: LONGINT);\r VAR i: INTEGER; y: LONGINT;\r a: ARRAY 10 OF CHAR;\r BEGIN i := 0; Write(W, " ");\r REPEAT y := x MOD 10H;\r IF y < 10 THEN a[i] := CHR(y + 30H) ELSE a[i] := CHR(y + 37H) END;\r x := x DIV 10H; INC(i)\r UNTIL i = 8;\r REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0\r END WriteHex;\r\r PROCEDURE WriteReal* (VAR W: Writer; x: REAL; n: INTEGER);\r VAR e: INTEGER; x0: REAL;\r d: ARRAY maxD OF CHAR;\r BEGIN e := Reals.Expo(x);\r IF e = 0 THEN\r WriteString(W, " 0");\r REPEAT Write(W, " "); DEC(n) UNTIL n <= 3\r ELSIF e = 255 THEN\r WriteString(W, " NaN");\r WHILE n > 4 DO Write(W, " "); DEC(n) END\r ELSE\r IF n <= 9 THEN n := 3 ELSE DEC(n, 6) END;\r REPEAT Write(W, " "); DEC(n) UNTIL n <= 8;\r (*there are 2 < n <= 8 digits to be written*)\r IF x < 0.0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END;\r e := (e - 127) * 77 DIV 256;\r IF e >= 0 THEN x := x / Reals.Ten(e) ELSE x := Reals.Ten(-e) * x END;\r IF x >= 10.0 THEN x := 0.1*x; INC(e) END;\r x0 := Reals.Ten(n-1); x := x0*x + 0.5;\r IF x >= 10.0*x0 THEN x := x*0.1; INC(e) END;\r Reals.Convert(x, n, d);\r DEC(n); Write(W, d[n]); Write(W, ".");\r REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;\r Write(W, "E");\r IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END;\r Write(W, CHR(e DIV 10 + 30H)); Write(W, CHR(e MOD 10 + 30H))\r END\r END WriteReal;\r\r PROCEDURE WriteRealFix* (VAR W: Writer; x: REAL; n, k: INTEGER);\r VAR e, i: INTEGER; sign: CHAR; x0: REAL;\r d: ARRAY maxD OF CHAR;\r\r PROCEDURE seq(ch: CHAR; n: INTEGER);\r BEGIN WHILE n > 0 DO Write(W, ch); DEC(n) END\r END seq;\r\r PROCEDURE dig(n: INTEGER);\r BEGIN\r WHILE n > 0 DO\r DEC(i); Write(W, d[i]); DEC(n)\r END\r END dig;\r\r BEGIN e := Reals.Expo(x);\r IF k < 0 THEN k := 0 END;\r IF e = 0 THEN seq(" ", n-k-2); Write(W, "0"); seq(" ", k+1)\r ELSIF e = 255 THEN WriteString(W, " NaN"); seq(" ", n-4)\r ELSE e := (e - 127) * 77 DIV 256;\r IF x < 0 THEN sign := "-"; x := -x ELSE sign := " " END;\r IF e >= 0 THEN (*x >= 1.0, 77/256 = log 2*) x := x/Reals.Ten(e)\r ELSE (*x < 1.0*) x := Reals.Ten(-e) * x\r END;\r IF x >= 10.0 THEN x := 0.1*x; INC(e) END;\r (* 1 <= x < 10 *)\r IF k+e >= maxD-1 THEN k := maxD-1-e\r ELSIF k+e < 0 THEN k := -e; x := 0.0\r END;\r x0 := Reals.Ten(k+e); x := x0*x + 0.5;\r IF x >= 10.0*x0 THEN INC(e) END;\r (*e = no. of digits before decimal point*)\r INC(e); i := k+e; Reals.Convert(x, i, d);\r IF e > 0 THEN\r seq(" ", n-e-k-2); Write(W, sign); dig(e);\r Write(W, "."); dig(k)\r ELSE seq(" ", n-k-3);\r Write(W, sign); Write(W, "0"); Write(W, ".");\r seq("0", -e); dig(k+e)\r END\r END\r END WriteRealFix;\r\r PROCEDURE WriteRealHex* (VAR W: Writer; x: REAL);\r VAR i: INTEGER;\r d: ARRAY 8 OF CHAR;\r BEGIN Reals.ConvertH(x, d); i := 0;\r REPEAT Write(W, d[i]); INC(i) UNTIL i = 8\r END WriteRealHex;\r\r PROCEDURE WriteLongReal* (VAR W: Writer; x: LONGREAL; n: INTEGER);\r CONST maxD = 16;\r VAR e: INTEGER; x0: LONGREAL;\r d: ARRAY maxD OF CHAR;\r BEGIN e := Reals.ExpoL(x);\r IF e = 0 THEN\r WriteString(W, " 0");\r REPEAT Write(W, " "); DEC(n) UNTIL n <= 3\r ELSIF e = 2047 THEN\r WriteString(W, " NaN");\r WHILE n > 4 DO Write(W, " "); DEC(n) END\r ELSE\r IF n <= 10 THEN n := 3 ELSE DEC(n, 7) END;\r REPEAT Write(W, " "); DEC(n) UNTIL n <= maxD;\r (*there are 2 <= n <= maxD digits to be written*)\r IF x < 0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END;\r e := SHORT(LONG(e - 1023) * 77 DIV 256);\r IF e >= 0 THEN x := x / Reals.TenL(e) ELSE x := Reals.TenL(-e) * x END ;\r IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END ;\r x0 := Reals.TenL(n-1); x := x0*x + 0.5D0;\r IF x >= 10.0D0*x0 THEN x := 0.1D0 * x; INC(e) END ;\r Reals.ConvertL(x, n, d);\r DEC(n); Write(W, d[n]); Write(W, ".");\r REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;\r Write(W, "D");\r IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END;\r Write(W, CHR(e DIV 100 + 30H)); e := e MOD 100;\r Write(W, CHR(e DIV 10 + 30H));\r Write(W, CHR(e MOD 10 + 30H))\r END\r END WriteLongReal;\r\r PROCEDURE WriteLongRealHex* (VAR W: Writer; x: LONGREAL);\r VAR i: INTEGER;\r d: ARRAY 16 OF CHAR;\r BEGIN Reals.ConvertHL(x, d); i := 0;\r REPEAT Write(W, d[i]); INC(i) UNTIL i = 16\r END WriteLongRealHex;\r\r PROCEDURE WriteDate* (VAR W: Writer; t, d: LONGINT);\r\r PROCEDURE WritePair(ch: CHAR; x: LONGINT);\r BEGIN Write(W, ch);\r Write(W, CHR(x DIV 10 + 30H)); Write(W, CHR(x MOD 10 + 30H))\r END WritePair;\r\r BEGIN\r WritePair(" ", d MOD 32); WritePair(".", d DIV 32 MOD 16); WritePair(".", d DIV 512 MOD 128);\r WritePair(" ", t DIV 4096 MOD 32); WritePair(":", t DIV 64 MOD 64); WritePair(":", t MOD 64)\r END WriteDate;\r\r\r (** Text Filing **)\r\r PROCEDURE Load0 (VAR r: Files.Rider; T: Text);\r VAR u, un: Run; p: Piece; e: Elem;\r org, pos, hlen, plen: LONGINT; ecnt, fno, fcnt, col, voff: SHORTINT;\r f: Files.File;\r msg: FileMsg;\r mods, procs: ARRAY 64, 32 OF CHAR;\r name: ARRAY 32 OF CHAR;\r fnts: ARRAY 32 OF FontsFont;\r\r PROCEDURE LoadElem (VAR r: Files.Rider; pos, span: LONGINT; VAR e: Elem);\r VAR (* M: Modules.Module; Cmd: Modules.Command; *) a: Alien;\r org, ew, eh: LONGINT; eno: SHORTINT;\r BEGIN new := NIL;\r Files.ReadLInt(r, ew); Files.ReadLInt(r, eh); Files.Read(r, eno);\r IF eno > ecnt THEN ecnt := eno; Files.ReadString(r, mods[eno]); Files.ReadString(r, procs[eno]) END;\r org := Files.Pos(r); (* M := Modules.ThisMod(mods[eno]);\r IF M # NIL THEN Cmd := Modules.ThisCommand(M, procs[eno]);\r IF Cmd # NIL THEN Cmd END\r END; *)\r e := new;\r IF e # NIL THEN e.W := ew; e.H := eh; e.base := T;\r msg.pos := pos; e.handle(e, msg);\r IF Files.Pos(r) # org + span THEN e := NIL END\r END;\r IF e = NIL THEN Files.Set(r, f, org + span);\r NEW(a); a.W := ew; a.H := eh; a.handle := HandleAlien; a.base := T;\r a.file := f; a.org := org; a.span := span;\r COPY(mods[eno], a.mod); COPY(procs[eno], a.proc);\r e := a\r END\r END LoadElem;\r\r BEGIN pos := Files.Pos(r); f := Files.Base(r);\r NEW(u); u.len := MAX(LONGINT); u.fnt := FontsDefault; u.col := Displaywhite;\r T.head := u; ecnt := 0; fcnt := 0;\r msg.id := load; msg.r := r;\r Files.ReadLInt(msg.r, hlen); (*!!!org := pos + hlen;*) org := pos -2 + hlen; pos := org; Files.Read(msg.r, fno);\r WHILE fno # 0 DO\r IF fno > fcnt THEN fcnt := fno; Files.ReadString(msg.r, name); (* fnts[fno] := Fonts.This(name) *) fnts[fno] := NIL END;\r Files.Read(msg.r, col); Files.Read(msg.r, voff); Files.ReadLInt(msg.r, plen);\r IF plen > 0 THEN NEW(p); p.file := f; p.org := pos; un := p; un.len := plen\r ELSE LoadElem(msg.r, pos - org, -plen, e); un := e; un.len := 1\r END;\r un.fnt := fnts[fno]; un.col := col; un.voff := voff;\r INC(pos, un.len); u.next := un; un.prev := u; u := un; Files.Read(msg.r, fno)\r END;\r u.next := T.head; T.head.prev := u; T.cache := T.head; T.corg := 0;\r Files.ReadLInt(msg.r, T.len); Files.Set(r, f, Files.Pos(msg.r) + T.len)\r END Load0;\r \r PROCEDURE Load* (VAR r: Files.Rider; T: Text);\r CONST oldTag = -4095;\r VAR tag: INTEGER;\r BEGIN\r (* for compatibility inner text tags are checked and skipped; remove this in a later version *)\r Files.ReadInt(r, tag); IF tag # oldTag THEN Files.Set(r, Files.Base(r), Files.Pos(r)-2) END;\r Load0(r, T)\r END Load;\r\r PROCEDURE Open* (T: Text; name: ARRAY OF CHAR);\r VAR f: Files.File; r: Files.Rider; u: Run; p: Piece; tag, version: CHAR;\r BEGIN f := Files.Old(name);\r IF f = NIL THEN f := Files.New("") END;\r Files.Set(r, f, 0); Files.Read(r, tag); Files.Read(r, version);\r IF (tag = textTag) OR (tag = 01X) & (version = textTag) THEN Load0(r, T)\r ELSE NEW(u); u.len := MAX(LONGINT); u.fnt := NIL; u.col := Displaywhite;\r T.len := Files.Length(f);\r IF T.len > 0 THEN NEW(p); p.len := T.len; p.fnt := FontsDefault;\r p.col := Displaywhite; p.voff := 0; p.file := f; p.org := 0;\r u.next := p; u.prev := p; p.next := u; p.prev := u\r ELSE u.next := u; u.prev := u\r END;\r T.head := u; T.cache := T.head; T.corg := 0\r END\r END Open;\r\r PROCEDURE Store* (VAR r: Files.Rider; T: Text);\r VAR r1: Files.Rider; u, un: Run; e: Elem; org, pos, delta, hlen, rlen: LONGINT; ecnt, fno, fcnt: SHORTINT;\r msg: FileMsg; iden: IdentifyMsg;\r mods, procs: ARRAY 64, 32 OF CHAR;\r fnts: ARRAY 32 OF FontsFont;\r block: ARRAY 1024 OF CHAR;\r\r PROCEDURE StoreElem (VAR r: Files.Rider; pos: LONGINT; e: Elem);\r VAR r1: Files.Rider; org, span: LONGINT; eno: SHORTINT;\r BEGIN COPY(iden.mod, mods[ecnt]); COPY(iden.proc, procs[ecnt]); eno := 1;\r WHILE (mods[eno] # iden.mod) OR (procs[eno] # iden.proc) DO INC(eno) END;\r Files.Set(r1, Files.Base(r), Files.Pos(r));\r Files.WriteLInt(r, 0); Files.WriteLInt(r, 0); Files.WriteLInt(r, 0); (*fixup slot*)\r Files.Write(r, eno);\r IF eno = ecnt THEN INC(ecnt); Files.WriteString(r, iden.mod); Files.WriteString(r, iden.proc) END;\r msg.pos := pos; org := Files.Pos(r); e.handle(e, msg); span := Files.Pos(r) - org;\r Files.WriteLInt(r1, -span); Files.WriteLInt(r1, e.W); Files.WriteLInt(r1, e.H) (*fixup*)\r END StoreElem;\r\r BEGIN\r org := Files.Pos(r); msg.id := store; msg.r := r; Files.WriteLInt(msg.r, 0); (*fixup slot*)\r u := T.head.next; pos := 0; delta := 0; fcnt := 1; ecnt := 1;\r WHILE u # T.head DO\r IF u IS Elem THEN iden.mod[0] := 0X; u(Elem).handle(u(Elem), iden) ELSE iden.mod[0] := 1X END;\r IF iden.mod[0] # 0X THEN\r fnts[fcnt] := u.fnt; fno := 1;\r WHILE fnts[fno].name # u.fnt.name DO INC(fno) END;\r Files.Write(msg.r, fno);\r IF fno = fcnt THEN INC(fcnt); Files.WriteString(msg.r, u.fnt.name) END;\r Files.Write(msg.r, u.col); Files.Write(msg.r, u.voff)\r END;\r IF u IS Piece THEN rlen := u.len; un := u.next;\r WHILE (un IS Piece) & (un.fnt = u.fnt) & (un.col = u.col) & (un.voff = u.voff) DO\r INC(rlen, un.len); un := un.next\r END;\r Files.WriteLInt(msg.r, rlen); INC(pos, rlen); u := un\r ELSIF iden.mod[0] # 0X THEN StoreElem(msg.r, pos, u(Elem)); INC(pos); u := u.next\r ELSE INC(delta); u := u.next\r END\r END;\r Files.Write(msg.r, 0); Files.WriteLInt(msg.r, T.len - delta);\r (*!!!hlen := Files.Pos(msg.r) - org;*) hlen := Files.Pos(msg.r) - org + 2;\r Files.Set(r1, Files.Base(msg.r), org); Files.WriteLInt(r1, hlen); (*fixup*)\r u := T.head.next;\r WHILE u # T.head DO\r IF u IS Piece THEN\r WITH u: Piece DO Files.Set(r1, u.file, u.org); delta := u.len;\r WHILE delta > LEN(block) DO Files.ReadBytes(r1, block, LEN(block));\r Files.WriteBytes(msg.r, block, LEN(block)); DEC(delta, LEN(block))\r END;\r Files.ReadBytes(r1, block, delta); Files.WriteBytes(msg.r, block, delta)\r END\r ELSE iden.mod[0] := 0X; u(Elem).handle(u(Elem), iden);\r IF iden.mod[0] # 0X THEN Files.Write(msg.r, ElemChar) END\r END;\r u := u.next\r END;\r r := msg.r;\r END Store;\r \r PROCEDURE Close* (T: Text; name: ARRAY OF CHAR);\r VAR f: Files.File; r: Files.Rider; i, res: INTEGER; bak: ARRAY 64 OF CHAR;\r BEGIN\r f := Files.New(name); Files.Set(r, f, 0); Files.Write(r, textTag); Files.Write(r, version); Store(r, T);\r i := 0; WHILE name[i] # 0X DO INC(i) END;\r COPY(name, bak); bak[i] := "."; bak[i+1] := "B"; bak[i+2] := "a"; bak[i+3] := "k"; bak[i+4] := 0X;\r Files.Rename(name, bak, res); Files.Register(f)\r END Close;\r\rBEGIN del := NIL; NEW(FontsDefault);\rEND Texts.\r
\ No newline at end of file
+MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**) (* << RC, MB, JT *)
+ IMPORT
+ Files, Reals, SYSTEM;
+
+ (*--- insert field e: Elem into Texts.Scanner and change Texts.Scan to set it in case of class=6 *)
+
+
+ CONST
+ Displaywhite = 15;
+ ElemChar* = 1CX;
+ TAB = 9X; CR = 0DX; maxD = 9;
+ (**FileMsg.id**)
+ load* = 0; store* = 1;
+ (**Notifier op**)
+ replace* = 0; insert* = 1; delete* = 2; unmark* = 3;
+ (**Scanner.class**)
+ Inval* = 0; Name* = 1; String* = 2; Int* = 3; Real* = 4; LongReal* = 5; Char* = 6;
+
+ textTag = 0F0X; DocBlockId = 0F7X; version = 01X;
+
+ TYPE
+ FontsFont = POINTER TO FontDesc;
+ FontDesc = RECORD
+ name: ARRAY 32 OF CHAR;
+ END ;
+
+ Run = POINTER TO RunDesc;
+ RunDesc = RECORD
+ prev, next: Run;
+ len: LONGINT;
+ fnt: FontsFont;
+ col, voff: SYSTEM.INT8;
+ ascii: BOOLEAN (* << *)
+ END;
+
+ Piece = POINTER TO PieceDesc;
+ PieceDesc = RECORD (RunDesc)
+ file: Files.File;
+ org: LONGINT
+ END;
+
+ Elem* = POINTER TO ElemDesc;
+ Buffer* = POINTER TO BufDesc;
+ Text* = POINTER TO TextDesc;
+
+ ElemMsg* = RECORD END;
+ Handler* = PROCEDURE (e: Elem; VAR msg: ElemMsg);
+
+ ElemDesc* = RECORD (RunDesc)
+ W*, H*: LONGINT;
+ handle*: Handler;
+ base: Text
+ END;
+
+ FileMsg* = RECORD (ElemMsg)
+ id*: INTEGER;
+ pos*: LONGINT;
+ r*: Files.Rider
+ END;
+
+ CopyMsg* = RECORD (ElemMsg)
+ e*: Elem
+ END;
+
+ IdentifyMsg* = RECORD (ElemMsg)
+ mod*, proc*: ARRAY 32 OF CHAR
+ END;
+
+
+ BufDesc* = RECORD
+ len*: LONGINT;
+ head: Run
+ END;
+
+ Notifier* = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);
+ TextDesc* = RECORD
+ len*: LONGINT;
+ notify*: Notifier;
+ head, cache: Run;
+ corg: LONGINT
+ END;
+
+ Reader* = RECORD
+ eot*: BOOLEAN;
+ fnt*: FontsFont;
+ col*, voff*: SYSTEM.INT8;
+ elem*: Elem;
+ rider: Files.Rider;
+ run: Run;
+ org, off: LONGINT
+ END;
+
+ Scanner* = RECORD (Reader)
+ nextCh*: CHAR;
+ line*, class*: INTEGER;
+ i*: LONGINT;
+ x*: REAL;
+ y*: LONGREAL;
+ c*: CHAR;
+ len*: SHORTINT;
+ s*: ARRAY 64 OF CHAR (* << *)
+ END;
+
+ Writer* = RECORD
+ buf*: Buffer;
+ fnt*: FontsFont;
+ col*, voff*: SYSTEM.INT8;
+ rider: Files.Rider;
+ file: Files.File
+ END;
+
+ Alien = POINTER TO RECORD (ElemDesc)
+ file: Files.File;
+ org, span: LONGINT;
+ mod, proc: ARRAY 32 OF CHAR
+ END;
+
+ VAR
+ new*: Elem;
+ del: Buffer;
+ FontsDefault: FontsFont;
+
+ PROCEDURE FontsThis(VAR name: ARRAY OF CHAR): FontsFont;
+ VAR F: FontsFont;
+ BEGIN
+ NEW(F); COPY(name, F.name); RETURN F
+ END FontsThis;
+
+ (* run primitives *)
+
+ PROCEDURE Find (T: Text; VAR pos: LONGINT; VAR u: Run; VAR org, off: LONGINT);
+ VAR v: Run; m: LONGINT;
+ BEGIN
+ IF pos >= T.len THEN pos := T.len; u := T.head; org := T.len; off := 0; T.cache := T.head; T.corg := 0
+ ELSE v := T.cache.next; m := pos - T.corg;
+ IF pos >= T.corg THEN
+ WHILE m >= v.len DO DEC(m, v.len); v := v.next END
+ ELSE
+ WHILE m < 0 DO v := v.prev; INC(m, v.len) END;
+ END;
+ u := v; org := pos - m; off := m; T.cache := v.prev; T.corg := org
+ END
+ END Find;
+
+ PROCEDURE Split (off: LONGINT; VAR u, un: Run);
+ VAR p, U: Piece;
+ BEGIN
+ IF off = 0 THEN un := u; u := un.prev
+ ELSIF off >= u.len THEN un := u.next
+ ELSE NEW(p); un := p; U := u(Piece);
+ p^ := U^; INC(p.org, off); DEC(p.len, off); DEC(U.len, p.len);
+ p.ascii := u.ascii; p.prev := U; p.next := U.next; p.next.prev := p; U.next := p (* << *)
+ END
+ END Split;
+
+ PROCEDURE Merge (T: Text; u: Run; VAR v: Run);
+ VAR p, q: Piece;
+ BEGIN
+ IF (u IS Piece) & (v IS Piece) & (u.fnt.name = v.fnt.name) & (u.col = v.col) & (u.voff = v.voff)
+ & (u(Piece).ascii = v(Piece).ascii) THEN (* << *)
+ p := u(Piece); q := v(Piece);
+ IF (p.file = q.file) & (p.org + p.len = q.org) THEN
+ IF T.cache = u THEN INC(T.corg, q.len)
+ ELSIF T.cache = v THEN T.cache := T.head; T.corg := 0
+ END;
+ INC(p.len, q.len); v := v.next
+ END
+ END
+ END Merge;
+
+ PROCEDURE Splice (un, v, w: Run; base: Text); (* (u, un) -> (u, v, w, un) *)
+ VAR u: Run;
+ BEGIN
+ IF v # w.next THEN u := un.prev;
+ u.next := v; v.prev := u; un.prev := w; w.next := un;
+ REPEAT
+ IF v IS Elem THEN v(Elem).base := base END;
+ v := v.next
+ UNTIL v = un
+ END
+ END Splice;
+
+ PROCEDURE ClonePiece (p: Piece): Piece;
+ VAR q: Piece;
+ BEGIN NEW(q); q^ := p^; RETURN q
+ END ClonePiece;
+
+ PROCEDURE CloneElem (e: Elem): Elem;
+ VAR msg: CopyMsg;
+ BEGIN msg.e := NIL; e.handle(e, msg); RETURN msg.e
+ END CloneElem;
+
+
+ (** Elements **)
+
+ PROCEDURE CopyElem* (SE, DE: Elem);
+ BEGIN DE.len := SE.len; DE.fnt := SE.fnt; DE.col := SE.col; DE.voff := SE.voff;
+ DE.W := SE.W; DE.H := SE.H; DE.handle := SE.handle
+ END CopyElem;
+
+ PROCEDURE ElemBase* (E: Elem): Text;
+ BEGIN RETURN E.base
+ END ElemBase;
+
+ PROCEDURE ElemPos* (E: Elem): LONGINT;
+ VAR u: Run; pos: LONGINT;
+ BEGIN u := E.base.head.next; pos := 0;
+ WHILE u # E DO pos := pos + u.len; u := u.next END;
+ RETURN pos
+ END ElemPos;
+
+
+ PROCEDURE HandleAlien (E: Elem; VAR msg: ElemMsg);
+ VAR e: Alien; r: Files.Rider; i: LONGINT; ch: CHAR;
+ BEGIN
+ WITH E: Alien DO
+ IF msg IS CopyMsg THEN
+ WITH msg: CopyMsg DO NEW(e); CopyElem(E, e);
+ e.file := E.file; e.org := E.org; e.span := E.span; e.mod := E.mod; e.proc := E.proc;
+ msg.e := e
+ END
+ ELSIF msg IS IdentifyMsg THEN
+ WITH msg: IdentifyMsg DO
+ COPY(E.mod, msg.mod); COPY(E.proc, msg.proc); msg.mod[31] := 1X (*alien*)
+ END
+ ELSIF msg IS FileMsg THEN
+ WITH msg: FileMsg DO
+ IF msg.id = store THEN Files.Set(r, E.file, E.org); i := E.span;
+ WHILE i > 0 DO Files.Read(r, ch); Files.Write(msg.r, ch); DEC(i) END
+ END
+ END
+ END
+ END
+ END HandleAlien;
+
+
+ (** Buffers **)
+
+ PROCEDURE OpenBuf* (B: Buffer);
+ VAR u: Run;
+ BEGIN NEW(u); u.next := u; u.prev := u; B.head := u; B.len := 0
+ END OpenBuf;
+
+ PROCEDURE Copy* (SB, DB: Buffer);
+ VAR u, v, vn: Run;
+ BEGIN u := SB.head.next; v := DB.head.prev;
+ WHILE u # SB.head DO
+ IF u IS Piece THEN vn := ClonePiece(u(Piece)) ELSE vn := CloneElem(u(Elem)) END;
+ v.next := vn; vn.prev := v; v := vn; u := u.next
+ END;
+ v.next := DB.head; DB.head.prev := v;
+ INC(DB.len, SB.len)
+ END Copy;
+
+ PROCEDURE Recall* (VAR B: Buffer);
+ BEGIN B := del; del := NIL
+ END Recall;
+
+
+ (** Texts **)
+
+ PROCEDURE Save* (T: Text; beg, end: LONGINT; B: Buffer);
+ VAR u, v, w, wn: Run; uo, ud, vo, vd: LONGINT;
+ BEGIN Find(T, beg, u, uo, ud); Find(T, end, v, vo, vd);
+ w := B.head.prev;
+ WHILE u # v DO
+ IF u IS Piece THEN wn := ClonePiece(u(Piece)); DEC(wn.len, ud); INC(wn(Piece).org, ud)
+ ELSE wn := CloneElem(u(Elem))
+ END;
+ w.next := wn; wn.prev := w; w := wn; u := u.next; ud := 0
+ END;
+ IF vd > 0 THEN (*v IS Piece*) wn := ClonePiece(v(Piece)); wn.len := vd - ud; INC(wn(Piece).org, ud);
+ w.next := wn; wn.prev := w; w := wn
+ END;
+ w.next := B.head; B.head.prev := w;
+ INC(B.len, end - beg)
+ END Save;
+
+ PROCEDURE Insert* (T: Text; pos: LONGINT; B: Buffer);
+ VAR u, un, v: Run; p, q: Piece; uo, ud, len: LONGINT;
+ BEGIN Find(T, pos, u, uo, ud); Split(ud, u, un);
+ len := B.len; v := B.head.next;
+ Merge(T, u, v); Splice(un, v, B.head.prev, T);
+ INC(T.len, len); B.head.next := B.head; B.head.prev := B.head; B.len := 0;
+ IF T.notify # NIL THEN T.notify(T, insert, pos, pos+len) END
+ END Insert;
+
+ PROCEDURE Append* (T: Text; B: Buffer);
+ VAR v: Run; pos, len: LONGINT;
+ BEGIN pos := T.len; len := B.len; v := B.head.next;
+ Merge(T, T.head.prev, v); Splice(T.head, v, B.head.prev, T);
+ INC(T.len, len); B.head.next := B.head; B.head.prev := B.head; B.len := 0;
+ IF T.notify # NIL THEN T.notify(T, insert, pos, pos+len) END
+ END Append;
+
+ PROCEDURE Delete* (T: Text; beg, end: LONGINT);
+ VAR c, u, un, v, vn: Run; co, uo, ud, vo, vd: LONGINT;
+ BEGIN
+ Find(T, beg, u, uo, ud); Split(ud, u, un); c := T.cache; co := T.corg;
+ Find(T, end, v, vo, vd); Split(vd, v, vn); T.cache := c; T.corg := co;
+ NEW(del); OpenBuf(del); del.len := end - beg;
+ Splice(del.head, un, v, NIL);
+ Merge(T, u, vn); u.next := vn; vn.prev := u;
+ DEC(T.len, end - beg);
+ IF T.notify # NIL THEN T.notify(T, delete, beg, end) END
+ END Delete;
+
+ PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: FontsFont; col, voff: SYSTEM.INT8);
+ VAR c, u, un, v, vn: Run; co, uo, ud, vo, vd: LONGINT;
+ BEGIN Find(T, beg, u, uo, ud); Split(ud, u, un); c := T.cache; co := T.corg;
+ Find(T, end, v, vo, vd); Split(vd, v, vn); T.cache := c; T.corg := co;
+ WHILE un # vn DO
+ IF (0 IN sel) & (fnt # NIL) THEN un.fnt := fnt END;
+ IF 1 IN sel THEN un.col := col END;
+ IF 2 IN sel THEN un.voff := voff END;
+ Merge(T, u, un);
+ IF u.next = un THEN u := un; un := un.next ELSE u.next := un; un.prev := u END
+ END;
+ Merge(T, u, un); u.next := un; un.prev := u;
+ IF T.notify # NIL THEN T.notify(T, replace, beg, end) END
+ END ChangeLooks;
+
+
+ (** Readers **)
+
+ PROCEDURE OpenReader* (VAR R: Reader; T: Text; pos: LONGINT);
+ VAR u: Run;
+ BEGIN
+ IF pos >= T.len THEN pos := T.len END;
+ Find(T, pos, u, R.org, R.off); R.run := u; R.eot := FALSE;
+ IF u IS Piece THEN
+ Files.Set(R.rider, u(Piece).file, u(Piece).org + R.off)
+ END
+ END OpenReader;
+
+ PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);
+ VAR u: Run; pos: LONGINT; nextch: CHAR;
+ BEGIN u := R.run; R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; INC(R.off);
+ IF u IS Piece THEN Files.Read(R.rider, ch); R.elem := NIL;
+ IF (ch = 0AX) & u(Piece).ascii THEN ch := CR (* << LF to CR *)
+ ELSIF (ch = CR) & u(Piece).ascii THEN (* << CR LF to CR *)
+ pos := Files.Pos(R.rider); Files.Read(R.rider, nextch);
+ IF nextch = 0AX THEN INC(R.off) ELSE Files.Set(R.rider, u(Piece).file, pos) END
+ END
+ ELSIF u IS Elem THEN ch := ElemChar; R.elem := u(Elem)
+ ELSE ch := 0X; R.elem := NIL; R.eot := TRUE
+ END;
+ IF R.off = u.len THEN INC(R.org, u.len); u := u.next;
+ IF u IS Piece THEN
+ WITH u: Piece DO Files.Set(R.rider, u.file, u.org) END
+ END;
+ R.run := u; R.off := 0
+ END
+ END Read;
+
+ PROCEDURE ReadElem* (VAR R: Reader);
+ VAR u, un: Run;
+ BEGIN u := R.run;
+ WHILE u IS Piece DO INC(R.org, u.len); u := u.next END;
+ IF u IS Elem THEN un := u.next; R.run := un; INC(R.org); R.off := 0;
+ R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; R.elem := u(Elem);
+ IF un IS Piece THEN
+ WITH un: Piece DO Files.Set(R.rider, un.file, un.org) END
+ END
+ ELSE R.eot := TRUE; R.elem := NIL
+ END
+ END ReadElem;
+
+ PROCEDURE ReadPrevElem* (VAR R: Reader);
+ VAR u: Run;
+ BEGIN u := R.run.prev;
+ WHILE u IS Piece DO DEC(R.org, u.len); u := u.prev END;
+ IF u IS Elem THEN R.run := u; DEC(R.org); R.off := 0;
+ R.fnt := u.fnt; R.col := u.col; R.voff := u.voff; R.elem := u(Elem)
+ ELSE R.eot := TRUE; R.elem := NIL
+ END
+ END ReadPrevElem;
+
+ PROCEDURE Pos* (VAR R: Reader): LONGINT;
+ BEGIN RETURN R.org + R.off
+ END Pos;
+
+
+ (** Scanners --------------- NW --------------- **)
+
+ PROCEDURE OpenScanner* (VAR S: Scanner; T: Text; pos: LONGINT);
+ BEGIN OpenReader(S, T, pos); S.line := 0; S.nextCh := " "
+ END OpenScanner;
+
+ (*IEEE floating point formats:
+ x = 2^(e-127) * 1.m bit 0: sign, bits 1- 8: e, bits 9-31: m
+ x = 2^(e-1023) * 1.m bit 0: sign, bits 1-11: e, bits 12-63: m *)
+
+ PROCEDURE Scan* (VAR S: Scanner);
+ CONST maxD = 32;
+ VAR ch, term: CHAR;
+ neg, negE, hex: BOOLEAN;
+ i, j, h: SHORTINT;
+ e: INTEGER; k: LONGINT;
+ x, f: REAL; y, g: LONGREAL;
+ d: ARRAY maxD OF CHAR;
+
+ PROCEDURE ReadScaleFactor;
+ BEGIN Read(S, ch);
+ IF ch = "-" THEN negE := TRUE; Read(S, ch)
+ ELSE negE := FALSE;
+ IF ch = "+" THEN Read(S, ch) END
+ END;
+ WHILE ("0" <= ch) & (ch <= "9") DO
+ e := e*10 + ORD(ch) - 30H; Read(S, ch)
+ END
+ END ReadScaleFactor;
+
+ BEGIN ch := S.nextCh; i := 0;
+ LOOP
+ IF ch = CR THEN INC(S.line)
+ ELSIF (ch # " ") & (ch # TAB) THEN EXIT
+ END ;
+ Read(S, ch)
+ END;
+ IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") OR (ch = "/") OR (ch = ".") THEN (*name*) (* << *)
+ REPEAT S.s[i] := ch; INC(i); Read(S, ch)
+ UNTIL (CAP(ch) > "Z") & (ch # "_") (* << *)
+ OR ("A" > CAP(ch)) & (ch > "9")
+ OR ("0" > ch) & (ch # ".") & (ch # "/") (* << *)
+ OR (i = 63); (* << *)
+ S.s[i] := 0X; S.len := i; S.class := 1
+ ELSIF ch = 22X THEN (*literal string*)
+ Read(S, ch);
+ WHILE (ch # 22X) & (ch >= " ") & (i # 63) DO (* << *)
+ S.s[i] := ch; INC(i); Read(S, ch)
+ END;
+ S.s[i] := 0X; S.len := i+1; Read(S, ch); S.class := 2
+ ELSE
+ IF ch = "-" THEN neg := TRUE; Read(S, ch) ELSE neg := FALSE END ;
+ IF ("0" <= ch) & (ch <= "9") THEN (*number*)
+ hex := FALSE; j := 0;
+ LOOP d[i] := ch; INC(i); Read(S, ch);
+ IF ch < "0" THEN EXIT END;
+ IF "9" < ch THEN
+ IF ("A" <= ch) & (ch <= "F") THEN hex := TRUE; ch := CHR(ORD(ch)-7)
+ ELSIF ("a" <= ch) & (ch <= "f") THEN hex := TRUE; ch := CHR(ORD(ch)-27H)
+ ELSE EXIT
+ END
+ END
+ END;
+ IF ch = "H" THEN (*hex number*)
+ Read(S, ch); S.class := 3;
+ IF i-j > 8 THEN j := i-8 END ;
+ k := ORD(d[j]) - 30H; INC(j);
+ IF (i-j = 7) & (k >= 8) THEN DEC(k, 16) END ;
+ WHILE j < i DO k := k*10H + (ORD(d[j]) - 30H); INC(j) END ;
+ IF neg THEN S.i := -k ELSE S.i := k END
+ ELSIF ch = "." THEN (*read real*)
+ Read(S, ch); h := i;
+ WHILE ("0" <= ch) & (ch <= "9") DO d[i] := ch; INC(i); Read(S, ch) END ;
+ IF ch = "D" THEN
+ e := 0; y := 0; g := 1;
+ REPEAT y := y*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = h;
+ WHILE j < i DO g := g/10; y := (ORD(d[j]) - 30H)*g + y; INC(j) END ;
+ ReadScaleFactor;
+ IF negE THEN
+ IF e <= 308 THEN y := y / Reals.TenL(e) ELSE y := 0 END
+ ELSIF e > 0 THEN
+ IF e <= 308 THEN y := Reals.TenL(e) * y ELSE HALT(40) END
+ END ;
+ IF neg THEN y := -y END ;
+ S.class := 5; S.y := y
+ ELSE e := 0; x := 0; f := 1;
+ REPEAT x := x*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = h;
+ WHILE j < i DO f := f/10; x := (ORD(d[j])-30H)*f + x; INC(j) END;
+ IF ch = "E" THEN ReadScaleFactor END ;
+ IF negE THEN
+ IF e <= 38 THEN x := x / Reals.Ten(e) ELSE x := 0 END
+ ELSIF e > 0 THEN
+ IF e <= 38 THEN x := Reals.Ten(e) * x ELSE HALT(40) END
+ END ;
+ IF neg THEN x := -x END ;
+ S.class := 4; S.x := x
+ END ;
+ IF hex THEN S.class := 0 END
+ ELSE (*decimal integer*)
+ S.class := 3; k := 0;
+ REPEAT k := k*10 + (ORD(d[j]) - 30H); INC(j) UNTIL j = i;
+ IF neg THEN S.i := -k ELSE S.i := k END;
+ IF hex THEN S.class := 0 ELSE S.class := 3 END
+ END
+ ELSE S.class := 6;
+ IF neg THEN S.c := "-" ELSE S.c := ch; Read(S, ch) END
+ END
+ END;
+ S.nextCh := ch
+ END Scan;
+
+
+ (** Writers **)
+
+ PROCEDURE OpenWriter* (VAR W: Writer);
+ BEGIN NEW(W.buf); OpenBuf(W.buf);
+ W.fnt := FontsDefault; W.col := Displaywhite; W.voff := 0;
+ W.file := Files.New(""); Files.Set(W.rider, W.file, 0)
+ END OpenWriter;
+
+ PROCEDURE SetFont* (VAR W: Writer; fnt: FontsFont);
+ BEGIN W.fnt := fnt
+ END SetFont;
+
+ PROCEDURE SetColor* (VAR W: Writer; col: SYSTEM.INT8);
+ BEGIN W.col := col
+ END SetColor;
+
+ PROCEDURE SetOffset* (VAR W: Writer; voff: SYSTEM.INT8);
+ BEGIN W.voff := voff
+ END SetOffset;
+
+
+ PROCEDURE Write* (VAR W: Writer; ch: CHAR);
+ VAR u, un: Run; p: Piece;
+ BEGIN Files.Write(W.rider, ch); INC(W.buf.len); un := W.buf.head; u := un.prev;
+ IF (u IS Piece) & (u(Piece).file = W.file) & (u.fnt.name = W.fnt.name) & (u.col = W.col) & (u.voff = W.voff)
+ & ~u(Piece).ascii THEN (* << *)
+ INC(u.len)
+ ELSE NEW(p); u.next := p; p.prev := u; p.next := un; un.prev := p;
+ p.len := 1; p.fnt := W.fnt; p.col := W.col; p.voff := W.voff;
+ p.file := W.file; p.org := Files.Length(W.file) - 1; p.ascii := FALSE (* << *)
+ END
+ END Write;
+
+ PROCEDURE WriteElem* (VAR W: Writer; e: Elem);
+ VAR u, un: Run;
+ BEGIN
+ IF e.base # NIL THEN HALT(99) END;
+ INC(W.buf.len); e.len := 1; e.fnt := W.fnt; e.col := W.col; e.voff := W.voff;
+ un := W.buf.head; u := un.prev; u.next := e; e.prev := u; e.next := un; un.prev := e
+ END WriteElem;
+
+ PROCEDURE WriteLn* (VAR W: Writer);
+ BEGIN Write(W, CR)
+ END WriteLn;
+
+ PROCEDURE WriteString* (VAR W: Writer; s: ARRAY OF CHAR);
+ VAR i: INTEGER;
+ BEGIN i := 0;
+ WHILE s[i] >= " " DO Write(W, s[i]); INC(i) END
+ END WriteString;
+
+ PROCEDURE WriteInt* (VAR W: Writer; x, n: SYSTEM.INT64);
+ VAR
+ i: INTEGER; x0: SYSTEM.INT64;
+ a: ARRAY 24 OF CHAR;
+ BEGIN i := 0;
+ IF x < 0 THEN
+ IF x = MIN(SYSTEM.INT64) THEN WriteString(W, " -9223372036854775808"); RETURN
+ ELSE DEC(n); x0 := -x
+ END
+ ELSE x0 := x
+ END;
+ REPEAT
+ a[i] := CHR(x0 MOD 10 + 30H); x0 := x0 DIV 10; INC(i)
+ UNTIL x0 = 0;
+ WHILE n > i DO Write(W, " "); DEC(n) END;
+ IF x < 0 THEN Write(W, "-") END;
+ REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0
+ END WriteInt;
+
+ PROCEDURE WriteHex* (VAR W: Writer; x: LONGINT);
+ VAR i: INTEGER; y: LONGINT;
+ a: ARRAY 20 OF CHAR;
+ BEGIN i := 0; Write(W, " ");
+ REPEAT y := x MOD 10H;
+ IF y < 10 THEN a[i] := CHR(y + 30H) ELSE a[i] := CHR(y + 37H) END;
+ x := x DIV 10H; INC(i)
+ UNTIL i = 8;
+ REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0
+ END WriteHex;
+
+ PROCEDURE WriteReal* (VAR W: Writer; x: REAL; n: INTEGER);
+ VAR e: INTEGER; x0: REAL;
+ d: ARRAY maxD OF CHAR;
+ BEGIN e := Reals.Expo(x);
+ IF e = 0 THEN
+ WriteString(W, " 0");
+ REPEAT Write(W, " "); DEC(n) UNTIL n <= 3
+ ELSIF e = 255 THEN
+ WriteString(W, " NaN");
+ WHILE n > 4 DO Write(W, " "); DEC(n) END
+ ELSE
+ IF n <= 9 THEN n := 3 ELSE DEC(n, 6) END;
+ REPEAT Write(W, " "); DEC(n) UNTIL n <= 8;
+ (*there are 2 < n <= 8 digits to be written*)
+ IF x < 0.0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END;
+ e := (e - 127) * 77 DIV 256;
+ IF e >= 0 THEN x := x / Reals.Ten(e) ELSE x := Reals.Ten(-e) * x END;
+ IF x >= 10.0 THEN x := 0.1*x; INC(e) END;
+ x0 := Reals.Ten(n-1); x := x0*x + 0.5;
+ IF x >= 10.0*x0 THEN x := x*0.1; INC(e) END;
+ Reals.Convert(x, n, d);
+ DEC(n); Write(W, d[n]); Write(W, ".");
+ REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;
+ Write(W, "E");
+ IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END;
+ Write(W, CHR(e DIV 10 + 30H)); Write(W, CHR(e MOD 10 + 30H))
+ END
+ END WriteReal;
+
+ PROCEDURE WriteRealFix* (VAR W: Writer; x: REAL; n, k: INTEGER);
+ VAR e, i: INTEGER; sign: CHAR; x0: REAL;
+ d: ARRAY maxD OF CHAR;
+
+ PROCEDURE seq(ch: CHAR; n: INTEGER);
+ BEGIN WHILE n > 0 DO Write(W, ch); DEC(n) END
+ END seq;
+
+ PROCEDURE dig(n: INTEGER);
+ BEGIN
+ WHILE n > 0 DO
+ DEC(i); Write(W, d[i]); DEC(n)
+ END
+ END dig;
+
+ BEGIN e := Reals.Expo(x);
+ IF k < 0 THEN k := 0 END;
+ IF e = 0 THEN seq(" ", n-k-2); Write(W, "0"); seq(" ", k+1)
+ ELSIF e = 255 THEN WriteString(W, " NaN"); seq(" ", n-4)
+ ELSE e := (e - 127) * 77 DIV 256;
+ IF x < 0 THEN sign := "-"; x := -x ELSE sign := " " END;
+ IF e >= 0 THEN (*x >= 1.0, 77/256 = log 2*) x := x/Reals.Ten(e)
+ ELSE (*x < 1.0*) x := Reals.Ten(-e) * x
+ END;
+ IF x >= 10.0 THEN x := 0.1*x; INC(e) END;
+ (* 1 <= x < 10 *)
+ IF k+e >= maxD-1 THEN k := maxD-1-e
+ ELSIF k+e < 0 THEN k := -e; x := 0.0
+ END;
+ x0 := Reals.Ten(k+e); x := x0*x + 0.5;
+ IF x >= 10.0*x0 THEN INC(e) END;
+ (*e = no. of digits before decimal point*)
+ INC(e); i := k+e; Reals.Convert(x, i, d);
+ IF e > 0 THEN
+ seq(" ", n-e-k-2); Write(W, sign); dig(e);
+ Write(W, "."); dig(k)
+ ELSE seq(" ", n-k-3);
+ Write(W, sign); Write(W, "0"); Write(W, ".");
+ seq("0", -e); dig(k+e)
+ END
+ END
+ END WriteRealFix;
+
+ PROCEDURE WriteRealHex* (VAR W: Writer; x: REAL);
+ VAR i: INTEGER;
+ d: ARRAY 8 OF CHAR;
+ BEGIN Reals.ConvertH(x, d); i := 0;
+ REPEAT Write(W, d[i]); INC(i) UNTIL i = 8
+ END WriteRealHex;
+
+ PROCEDURE WriteLongReal* (VAR W: Writer; x: LONGREAL; n: INTEGER);
+ CONST maxD = 16;
+ VAR e: INTEGER; x0: LONGREAL;
+ d: ARRAY maxD OF CHAR;
+ BEGIN e := Reals.ExpoL(x);
+ IF e = 0 THEN
+ WriteString(W, " 0");
+ REPEAT Write(W, " "); DEC(n) UNTIL n <= 3
+ ELSIF e = 2047 THEN
+ WriteString(W, " NaN");
+ WHILE n > 4 DO Write(W, " "); DEC(n) END
+ ELSE
+ IF n <= 10 THEN n := 3 ELSE DEC(n, 7) END;
+ REPEAT Write(W, " "); DEC(n) UNTIL n <= maxD;
+ (*there are 2 <= n <= maxD digits to be written*)
+ IF x < 0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END;
+
+ (* Scale e to be an exponent of 10 rather than 2 *)
+ e := SHORT(LONG(e - 1023) * 77 DIV 256);
+ IF e >= 0 THEN x := x / Reals.TenL(e) ELSE x := Reals.TenL(-e) * x END ;
+ IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
+
+ (* Scale x to the number of digits requested *)
+ x0 := Reals.TenL(n-1); x := x0*x + 0.5D0;
+ IF x >= 10.0D0*x0 THEN x := 0.1D0 * x; INC(e) END ;
+
+ (* Generate the mantissa digits of x *)
+ Reals.ConvertL(x, n, d);
+
+ DEC(n); Write(W, d[n]); Write(W, ".");
+ REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;
+
+ Write(W, "D");
+ IF e < 0 THEN Write(W, "-"); e := -e ELSE Write(W, "+") END;
+ Write(W, CHR(e DIV 100 + 30H)); e := e MOD 100;
+ Write(W, CHR(e DIV 10 + 30H));
+ Write(W, CHR(e MOD 10 + 30H))
+ END
+ END WriteLongReal;
+
+ PROCEDURE WriteLongRealHex* (VAR W: Writer; x: LONGREAL);
+ VAR i: INTEGER;
+ d: ARRAY 16 OF CHAR;
+ BEGIN Reals.ConvertHL(x, d); i := 0;
+ REPEAT Write(W, d[i]); INC(i) UNTIL i = 16
+ END WriteLongRealHex;
+
+ PROCEDURE WriteDate* (VAR W: Writer; t, d: LONGINT);
+
+ PROCEDURE WritePair(ch: CHAR; x: LONGINT);
+ BEGIN Write(W, ch);
+ Write(W, CHR(x DIV 10 + 30H)); Write(W, CHR(x MOD 10 + 30H))
+ END WritePair;
+
+ BEGIN
+ WritePair(" ", d MOD 32); WritePair(".", d DIV 32 MOD 16); WritePair(".", d DIV 512 MOD 128);
+ WritePair(" ", t DIV 4096 MOD 32); WritePair(":", t DIV 64 MOD 64); WritePair(":", t MOD 64)
+ END WriteDate;
+
+
+ (** Text Filing **)
+
+ PROCEDURE Load0 (VAR r: Files.Rider; T: Text);
+ VAR u, un: Run; p: Piece; e: Elem;
+ org, pos, hlen, plen: LONGINT; ecnt, fcnt: SHORTINT;
+ fno, col, voff: SYSTEM.INT8;
+ f: Files.File;
+ msg: FileMsg;
+ mods, procs: ARRAY 64, 32 OF CHAR;
+ name: ARRAY 32 OF CHAR;
+ fnts: ARRAY 32 OF FontsFont;
+
+ PROCEDURE LoadElem (VAR r: Files.Rider; pos, span: LONGINT; VAR e: Elem);
+ VAR a: Alien; org, ew, eh: LONGINT; eno: SYSTEM.INT8;
+ BEGIN new := NIL;
+ Files.ReadLInt(r, ew); Files.ReadLInt(r, eh); Files.Read(r, eno);
+ IF eno > ecnt THEN ecnt := eno; Files.ReadString(r, mods[eno]); Files.ReadString(r, procs[eno]) END;
+ org := Files.Pos(r);
+ e := new;
+ IF e # NIL THEN e.W := ew; e.H := eh; e.base := T;
+ msg.pos := pos; e.handle(e, msg);
+ IF Files.Pos(r) # org + span THEN e := NIL END
+ END;
+ IF e = NIL THEN Files.Set(r, f, org + span);
+ NEW(a); a.W := ew; a.H := eh; a.handle := HandleAlien; a.base := T;
+ a.file := f; a.org := org; a.span := span;
+ COPY(mods[eno], a.mod); COPY(procs[eno], a.proc);
+ e := a
+ END
+ END LoadElem;
+
+ BEGIN pos := Files.Pos(r); f := Files.Base(r);
+ NEW(u); u.len := MAX(LONGINT); (*u.fnt := FontsDefault;*)u.fnt := NIL; u.col := Displaywhite;
+ T.head := u; ecnt := 0; fcnt := 0;
+ msg.id := load; msg.r := r;
+ Files.ReadLInt(msg.r, hlen); (*!!!org := pos + hlen;*) org := pos -2 + hlen; pos := org; Files.Read(msg.r, fno);
+ WHILE fno # 0 DO
+ IF fno > fcnt THEN fcnt := fno; Files.ReadString(msg.r, name); fnts[fno] := FontsThis(name) END;
+ Files.Read(msg.r, col); Files.Read(msg.r, voff); Files.ReadLInt(msg.r, plen);
+ IF plen > 0 THEN NEW(p); p.file := f; p.org := pos; p.ascii := FALSE; un := p; un.len := plen
+ ELSE LoadElem(msg.r, pos - org, -plen, e); un := e; un.len := 1
+ END;
+ (*un.fnt := fnts[fno];*) un.col := col; un.voff := voff;
+ INC(pos, un.len); u.next := un; un.prev := u; u := un; Files.Read(msg.r, fno)
+ END;
+ u.next := T.head; T.head.prev := u; T.cache := T.head; T.corg := 0;
+ Files.ReadLInt(msg.r, T.len); Files.Set(r, f, Files.Pos(msg.r) + T.len)
+ END Load0;
+
+ PROCEDURE Load* (VAR r: Files.Rider; T: Text);
+ CONST oldTag = -4095;
+ VAR tag: INTEGER;
+ BEGIN
+ (* for compatibility inner text tags are checked and skipped; remove this in a later version *)
+ Files.ReadInt(r, tag); IF tag # oldTag THEN Files.Set(r, Files.Base(r), Files.Pos(r)-2) END;
+ Load0(r, T)
+ END Load;
+
+ PROCEDURE Open* (T: Text; name: ARRAY OF CHAR);
+ VAR f: Files.File; r: Files.Rider; u: Run; p: Piece; tag, version: CHAR; hlen: LONGINT;
+ BEGIN f := Files.Old(name);
+ IF f = NIL THEN f := Files.New("") END;
+ Files.Set(r, f, 0); Files.Read(r, tag); Files.Read(r, version);
+ IF (tag = textTag) OR (tag = 01X) & (version = textTag) THEN Load0(r, T)
+ ELSE (*ascii*)
+ NEW(u); u.len := MAX(LONGINT); u.fnt := NIL; u.col := Displaywhite;
+ NEW(p);
+ IF (tag = DocBlockId) & (version = 07X) THEN (* extract ascii text from System 3 text document *)
+ Files.Set(r, f, 28); Files.ReadLInt(r, hlen);
+ Files.Set(r, f, 22 + hlen); Files.ReadLInt(r, T.len); p.org := 26 + hlen
+ ELSE
+ T.len := Files.Length(f); p.org := 0
+ END ;
+ IF T.len > 0 THEN p.len := T.len; p.fnt := FontsDefault;
+ p.col := Displaywhite; p.voff := 0; p.file := f; p.ascii := TRUE;
+ u.next := p; u.prev := p; p.next := u; p.prev := u
+ ELSE u.next := u; u.prev := u
+ END;
+ T.head := u; T.cache := T.head; T.corg := 0
+ END
+ END Open;
+
+ PROCEDURE Store* (VAR r: Files.Rider; T: Text);
+ VAR r1: Files.Rider; u, un: Run; e: Elem; org, pos, delta, hlen, rlen: LONGINT; ecnt, fcnt: SHORTINT; ch: CHAR; (* << *)
+ fno: SYSTEM.INT8;
+ msg: FileMsg; iden: IdentifyMsg;
+ mods, procs: ARRAY 64, 32 OF CHAR;
+ fnts: ARRAY 32 OF FontsFont;
+ block: ARRAY 1024 OF CHAR;
+
+ PROCEDURE StoreElem (VAR r: Files.Rider; pos: LONGINT; e: Elem);
+ VAR r1: Files.Rider; org, span: LONGINT; eno: SYSTEM.INT8;
+ BEGIN COPY(iden.mod, mods[ecnt]); COPY(iden.proc, procs[ecnt]); eno := 1;
+ WHILE (mods[eno] # iden.mod) OR (procs[eno] # iden.proc) DO INC(eno) END;
+ Files.Set(r1, Files.Base(r), Files.Pos(r));
+ Files.WriteLInt(r, 0); Files.WriteLInt(r, 0); Files.WriteLInt(r, 0); (*fixup slot*)
+ Files.Write(r, eno);
+ IF eno = ecnt THEN INC(ecnt); Files.WriteString(r, iden.mod); Files.WriteString(r, iden.proc) END;
+ msg.pos := pos; org := Files.Pos(r); e.handle(e, msg); span := Files.Pos(r) - org;
+ Files.WriteLInt(r1, -span); Files.WriteLInt(r1, e.W); Files.WriteLInt(r1, e.H) (*fixup*)
+ END StoreElem;
+
+ BEGIN
+ org := Files.Pos(r); msg.id := store; msg.r := r; Files.WriteLInt(msg.r, 0); (*fixup slot*)
+ u := T.head.next; pos := 0; delta := 0; fcnt := 1; ecnt := 1;
+ WHILE u # T.head DO
+ IF u IS Elem THEN iden.mod[0] := 0X; u(Elem).handle(u(Elem), iden) ELSE iden.mod[0] := 1X END;
+ IF iden.mod[0] # 0X THEN
+ fnts[fcnt] := u.fnt; fno := 1;
+ WHILE fnts[fno].name # u.fnt.name DO INC(fno) END;
+ Files.Write(msg.r, fno);
+ IF fno = fcnt THEN INC(fcnt); Files.WriteString(msg.r, u.fnt.name) END;
+ Files.Write(msg.r, u.col); Files.Write(msg.r, u.voff)
+ END;
+ IF u IS Piece THEN rlen := u.len; un := u.next;
+ WHILE (un IS Piece) & (un.fnt = u.fnt) & (un.col = u.col) & (un.voff = u.voff) DO
+ INC(rlen, un.len); un := un.next
+ END;
+ Files.WriteLInt(msg.r, rlen); INC(pos, rlen); u := un
+ ELSIF iden.mod[0] # 0X THEN StoreElem(msg.r, pos, u(Elem)); INC(pos); u := u.next
+ ELSE INC(delta); u := u.next
+ END
+ END;
+ Files.Write(msg.r, 0); Files.WriteLInt(msg.r, T.len - delta);
+ (*!!!hlen := Files.Pos(msg.r) - org;*) hlen := Files.Pos(msg.r) - org + 2;
+ Files.Set(r1, Files.Base(msg.r), org); Files.WriteLInt(r1, hlen); (*fixup*)
+ u := T.head.next;
+ WHILE u # T.head DO
+ IF u IS Piece THEN
+ WITH u: Piece DO
+ IF u.ascii THEN Files.Set(r1, u.file, u.org); delta := u.len; (* << LF to CR *)
+ WHILE delta > 0 DO Files.Read(r1, ch); DEC(delta);
+ IF ch = 0AX THEN Files.Write(msg.r, CR) ELSE Files.Write(msg.r, ch) END
+ END
+ ELSE Files.Set(r1, u.file, u.org); delta := u.len;
+ WHILE delta > LEN(block) DO Files.ReadBytes(r1, block, LEN(block));
+ Files.WriteBytes(msg.r, block, LEN(block)); DEC(delta, LEN(block))
+ END;
+ Files.ReadBytes(r1, block, delta); Files.WriteBytes(msg.r, block, delta)
+ END
+ END
+ ELSE iden.mod[0] := 0X; u(Elem).handle(u(Elem), iden);
+ IF iden.mod[0] # 0X THEN Files.Write(msg.r, ElemChar) END
+ END;
+ u := u.next
+ END;
+ r := msg.r;
+ IF T.notify # NIL THEN T.notify(T, unmark, 0, 0) END
+ END Store;
+
+ PROCEDURE Close* (T: Text; name: ARRAY OF CHAR);
+ VAR f: Files.File; r: Files.Rider; i, res: INTEGER; bak: ARRAY 64 OF CHAR;
+ BEGIN
+ f := Files.New(name); Files.Set(r, f, 0); Files.Write(r, textTag); Files.Write(r, version); Store(r, T);
+ i := 0; WHILE name[i] # 0X DO INC(i) END;
+ COPY(name, bak); bak[i] := "."; bak[i+1] := "B"; bak[i+2] := "a"; bak[i+3] := "k"; bak[i+4] := 0X;
+ Files.Rename(name, bak, res); Files.Register(f)
+ END Close;
+
+BEGIN del := NIL; NEW(FontsDefault); FontsDefault.name := "Syntax10.Scn.Fnt"
+END Texts.
diff --git a/rtl/java/Files.java b/rtl/java/Files.java
index c201940c21cbb37cc41a3f0b85ee546288cea4b9..17694523dbba69ef510b4d21ffb0b4965c3f72df 100644 (file)
--- a/rtl/java/Files.java
+++ b/rtl/java/Files.java
public static void ReadInt(RECORD1 R[], int R$, short x[], int x$)
{
- RECORD1 rider = R[R$];
- RandomAccessFile desc = rider.base.desc;
-
- try
- {
- rider.base.SetActive(rider);
- byte[] buf = new byte[2];
- rider.res[0] = desc.read(buf, 0, 2);
- rider.eof[0] = (rider.res[0] != 0);
- x[x$] = (short) (((buf[1] & 0xff) << 8) | (buf[0] & 0xff));
- rider.position += 2 - rider.res[0];
- }
- catch(IOException e)
- {
- rider.res[0] = 2;
- rider.eof[0] = true;
- }
+ byte[][] buf = new byte[1][2];
+ ReadBytes(R, R$, buf, 0, 2);
+ x[x$] = (short) ((buf[0][1] & 0xff) << 8);
+ x[x$] |= (short) (buf[0][0] & 0xff);
}
public static void ReadLInt(RECORD1 R[], int R$, int x[], int x$)
{
- RECORD1 rider = R[R$];
- RandomAccessFile desc = rider.base.desc;
+ byte[][] buf = new byte[1][4];
+ ReadBytes(R, R$, buf, 0, 4);
+ x[x$] = (int) ((buf[0][3] & 0xff) << 24);
+ x[x$] |= (int) ((buf[0][2] & 0xff) << 16);
+ x[x$] |= (int) ((buf[0][1] & 0xff) << 8);
+ x[x$] |= (int) ((buf[0][0] & 0xff));
+ }
- try
- {
- rider.base.SetActive(rider);
- byte[] buf = new byte[4];
- rider.res[0] = desc.read(buf, 0, 4);
- rider.eof[0] = (rider.res[0] != 0);
- x[x$] = ((buf[3] & 0xff) << 24) | ((buf[2] & 0xff) << 16) | ((buf[1] & 0xff) << 8) | (buf[0] & 0xff);
- rider.position += 4 - rider.res[0];
- }
- catch(IOException e)
- {
- rider.res[0] = 4;
- rider.eof[0] = true;
- }
+ public static void ReadHInt(RECORD1 R[], int R$, long x[], int x$)
+ {
+ byte[][] buf = new byte[1][8];
+ ReadBytes(R, R$, buf, 0, 8);
+ x[x$] = (buf[0][7] & 0xff) << 56;
+ x[x$] |= (buf[0][6] & 0xff) << 48;
+ x[x$] |= (buf[0][5] & 0xff) << 40;
+ x[x$] |= (buf[0][4] & 0xff) << 32;
+ x[x$] |= (buf[0][3] & 0xff) << 24;
+ x[x$] |= (buf[0][2] & 0xff) << 16;
+ x[x$] |= (buf[0][1] & 0xff) << 8;
+ x[x$] |= (buf[0][0] & 0xff);
}
public static void ReadReal(RECORD1 R[], int R$, float x[], int x$)
{
- RECORD1 rider = R[R$];
- RandomAccessFile desc = rider.base.desc;
-
- try
- {
- rider.base.SetActive(rider);
- x[x$] = desc.readFloat();
- rider.position += 4;
- }
- catch(IOException e)
- {
- rider.res[0] = 4;
- rider.eof[0] = true;
- }
+ int[] i = new int[1];
+ ReadLInt(R, R$, i, 0);
+ x[x$] = Float.intBitsToFloat(i[0]);
}
public static void ReadLReal(RECORD1 R[], int R$, double x[], int x$)
{
- RECORD1 rider = R[R$];
- RandomAccessFile desc = rider.base.desc;
-
- try
- {
- rider.base.SetActive(rider);
- x[x$] = desc.readDouble();
- rider.position += 8;
- }
- catch(IOException e)
- {
- rider.res[0] = 8;
- rider.eof[0] = true;
- }
+ long[] i = new long[1];
+ ReadHInt(R, R$, i, 0);
+ x[x$] = Double.longBitsToDouble(i[0]);
}
public static void ReadNum(RECORD1 R[], int R$, int x[], int x$)
public static void ReadBool(RECORD1 R[], int R$, boolean x[], int x$)
{
- RECORD1 rider = R[R$];
- RandomAccessFile desc = rider.base.desc;
-
- try
- {
- rider.base.SetActive(rider);
- int i = desc.read();
- x[x$] = (i != 0);
- rider.position += 1;
- }
- catch(IOException e)
- {
- rider.res[0] = 1;
- rider.eof[0] = true;
- }
+ byte[] i = new byte[1];
+ Read(R, R$, i, 0);
+ x[x$] = (i[0] != 0);
}
public static void ReadBytes(RECORD1 r[], int r$, byte x[][], int x$, int n)
try
{
rider.base.SetActive(rider);
- rider.res[0] = desc.read(x[x$], 0, n);
+ int readed = desc.read(x[x$], 0, n);
+ rider.res[0] = (readed >= 0) ? (n - readed) : (0);
rider.eof[0] = (rider.res[0] != 0);
- rider.position += n - rider.res[0];
+ rider.position += (readed >= 0) ? (readed) : (0);
}
catch(IOException e)
{
public static void WriteInt(RECORD1 R[], int R$, short x)
{
byte[][] i = new byte[1][2];
- i[0][0] = (byte) ((x >>> 8) & 0xff);
- i[0][1] = (byte) ((x) & 0xff);
+ i[0][1] = (byte) ((x >>> 8) & 0xff);
+ i[0][0] = (byte) ((x) & 0xff);
WriteBytes(R, R$, i, 0, 2);
}
public static void WriteLInt(RECORD1 R[], int R$, int x)
{
byte[][] i = new byte[1][4];
- i[0][0] = (byte) ((x >>> 24) & 0xff);
- i[0][1] = (byte) ((x >>> 16) & 0xff);
- i[0][2] = (byte) ((x >>> 8) & 0xff);
- i[0][3] = (byte) ((x) & 0xff);
+ i[0][3] = (byte) ((x >>> 24) & 0xff);
+ i[0][2] = (byte) ((x >>> 16) & 0xff);
+ i[0][1] = (byte) ((x >>> 8) & 0xff);
+ i[0][0] = (byte) ((x) & 0xff);
WriteBytes(R, R$, i, 0, 4);
}
{
byte[][] i = new byte[1][];
i[0] = x;
- WriteBytes(R, R$, i, 0, SYSTEM.LEN(x));
+ WriteBytes(R, R$, i, 0, SYSTEM.LEN(x) + 1);
}
public static void WriteSet(RECORD1 R[], int R$, int x)
diff --git a/src/oberon.c b/src/oberon.c
index 5abb2090477536027219f41e2e0b9e78b69d9ab5..1d9e670e82fcc1c2e197b7bcbeea9b91cc935782 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
/* Types */
oberon_new_intrinsic_type(ctx, "BYTE", ctx -> system_byte_type);
oberon_new_intrinsic_type(ctx, "PTR", ctx -> system_ptr_type);
+ oberon_new_intrinsic_type(ctx, "INT8", ctx -> byte_type);
+ oberon_new_intrinsic_type(ctx, "INT16", ctx -> shortint_type);
oberon_new_intrinsic_type(ctx, "INT32", ctx -> int_type);
+ oberon_new_intrinsic_type(ctx, "INT64", ctx -> longint_type);
oberon_new_intrinsic_type(ctx, "SET32", ctx -> set_type);
/* Functions */