Project-Oberon-BlackBox/BlackBox/Po/Files/Texts.Mod.txt

MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 10.1.2019*)
  IMPORT Files, Fonts;

  CONST (*scanner symbol classes*)
    Inval* = 0;         (*invalid symbol*)
    Name* = 1;          (*name s (length len)*)
    String* = 2;        (*literal string s (length len)*)
    Int* = 3;           (*integer i (decimal or hexadecimal)*)
    Real* = 4;          (*real number x*)
    Char* = 6;          (*special character c*)

    (* TextBlock = TextTag offset run {run} "0" len {AsciiCode}.
      run = fnt [name] col voff len. *)

    TAB = 9X; CR = 0DX;
    TextTag = 0F1X;
    replace* = 0; insert* = 1; delete* = 2; unmark* = 3;  (*op-codes*)

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

    Text* = POINTER TO TextDesc;
    Notifier* = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);
    TextDesc* = RECORD
      len*: LONGINT;
      changed*: BOOLEAN;
      notify*: Notifier;
      trailer: Piece;
      pce: Piece;  (*cache*)
      org: LONGINT (*cache*)
    END;

    Reader* = RECORD
      eot*: BOOLEAN;
      fnt*: Fonts.Font;
      col*, voff*: INTEGER;
      ref: Piece;
      org: LONGINT;
      off: LONGINT;
      rider: Files.Rider
    END;

    Scanner* = RECORD (Reader)
      nextCh*: CHAR;
      line*, class*: INTEGER;
      i*: LONGINT;
      x*: REAL;
      y*: LONGREAL;
      c*: CHAR;
      len*: INTEGER;
      s*: ARRAY 32 OF CHAR
    END;

    Buffer* = POINTER TO BufDesc;
    BufDesc* = RECORD
      len*: LONGINT;
      header, last: Piece
    END;

    Writer* = RECORD
      buf*: Buffer;
      fnt*: Fonts.Font;
      col*, voff*: INTEGER;
      rider: Files.Rider
    END;     

  VAR TrailerFile: Files.File;

  (* -------------------- Filing ------------------------*)

  PROCEDURE Trailer(): Piece;
    VAR Q: Piece;
  BEGIN NEW(Q);
    Q.f := TrailerFile; Q.off := -1; Q.len := 1; Q.fnt := NIL; Q.col := 0; Q.voff := 0; RETURN Q
  END Trailer;

  PROCEDURE Load* (VAR R: Files.Rider; T: Text);
    VAR Q, q, p: Piece;
      off: LONGINT;
      N, fno: INTEGER; bt: BYTE;
      f: Files.File;
      FName: ARRAY 32 OF CHAR;
      Dict: ARRAY 32 OF Fonts.Font;
  BEGIN f := Files.Base(R); N := 1; Q := Trailer(); p := Q;
    Files.ReadInt(R, off); Files.ReadByte(R, bt); fno := bt;
    WHILE fno # 0 DO
      IF fno = N THEN
        Files.ReadString(R, FName);
        Dict[N] := Fonts.This(FName); INC(N)
      END;
      NEW(q); q.fnt := Dict[fno];
      Files.ReadByte(R, bt); q.col := bt;
      Files.ReadByte(R, bt); q.voff := ASR(LSL(bt, -24), 24);
      Files.ReadInt(R, q.len);
      Files.ReadByte(R, bt); fno := bt;
      q.f := f; q.off := off; off := off + q.len;
      p.next := q; q.prev := p; p := q
    END;
    p.next := Q; Q.prev := p;
    T.trailer := Q; Files.ReadInt(R, T.len); (*Files.Set(R, f, Files.Pos(R) + T.len)*)
  END Load;

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

  PROCEDURE Store* (VAR W: Files.Rider; T: Text);
    VAR p, q: Piece;
      R: Files.Rider;
      off, rlen, pos: LONGINT;
      N, n: INTEGER;
      ch: CHAR;
      Dict: ARRAY 32, 32 OF CHAR;
  BEGIN pos := Files.Pos(W); Files.WriteInt(W, 0); (*place holder*)
    N := 1; p := T.trailer.next;
    WHILE p # T.trailer DO
      rlen := p.len; q := p.next;
      WHILE (q # T.trailer) & (q.fnt = p.fnt) & (q.col = p.col) & (q.voff = p.voff) DO
        rlen := rlen + q.len; q := q.next
      END;
      Dict[N] := p.fnt.name;
      n := 1;
      WHILE Dict[n] # p.fnt.name DO INC(n) END;
      Files.WriteByte(W, n);
      IF n = N THEN Files.WriteString(W, p.fnt.name); INC(N) END;
      Files.WriteByte(W, p.col); Files.WriteByte(W, p.voff); Files.WriteInt(W, rlen);
      p := q
    END;
    Files.WriteByte(W, 0); Files.WriteInt(W, T.len);
    off := Files.Pos(W); p := T.trailer.next;
    WHILE p # T.trailer DO
      rlen := p.len; Files.Set(R, p.f, p.off);
      WHILE rlen > 0 DO Files.Read(R, ch); Files.Write(W, ch); DEC(rlen) END ;
      p := p.next
    END ;
    Files.Set(W, Files.Base(W), pos); Files.WriteInt(W, off); (*fixup*)
    T.changed := FALSE;
    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; w: Files.Rider;
  BEGIN f := Files.New(name); Files.Set(w, f, 0);
    Files.Write(w, TextTag); Store(w, T); Files.Register(f)
  END Close;

  (* -------------------- Editing ----------------------- *)

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

  PROCEDURE FindPiece (T: Text; pos: LONGINT; VAR org: LONGINT; VAR pce: Piece);
    VAR p: Piece; porg: LONGINT;
  BEGIN p := T.pce; porg := T.org;
    IF pos >= porg THEN
      WHILE pos >= porg + p.len DO INC(porg, p.len); p := p.next END
    ELSE p := p.prev; DEC(porg, p.len);
      WHILE pos < porg DO p := p.prev; DEC(porg, p.len) END
    END ;
    T.pce := p; T.org := porg;  (*update cache*)
    pce := p; org := porg
  END FindPiece;

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

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

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

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

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

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

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

  PROCEDURE Attributes*(T: Text; pos: LONGINT; VAR fnt: Fonts.Font; VAR col, voff: INTEGER);
    VAR p: Piece; org: LONGINT;
  BEGIN FindPiece(T, pos, org, p); fnt := p.fnt; col := p.col; voff := p.voff
  END Attributes;

  (* ------------------ Access: Readers ------------------------- *)

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

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

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

  (* ------------------ Access: Scanners (NW) ------------------------- *)

  PROCEDURE OpenScanner* (VAR S: Scanner; T: Text; pos: LONGINT);
  BEGIN OpenReader(S, T, pos); S.line := 0; S.nextCh := " "
  END OpenScanner;

  (*floating point formats:
    x = 1.m * 2^(e-127)   bit 0: sign, bits 1- 8: e, bits  9-31: m
    x = 1.m * 2^(e-1023)  bit 0: sign, bits 1-11: e, bits 12-63: m *)

  PROCEDURE Ten(n: INTEGER): REAL;
    VAR t, p: REAL;
  BEGIN t := 1.0; p := 10.0;   (*compute 10^n *)
    WHILE n > 0 DO
      IF ODD(n) THEN t := p * t END ;
      p := p*p; n := n DIV 2
    END ;
    RETURN t
  END Ten;

  PROCEDURE Scan* (VAR S: Scanner);
    CONST maxExp = 38; maxM = 16777216; (*2^24*)
    VAR ch: CHAR;
      neg, negE, hex: BOOLEAN;
      i, j, h, d, e, n, s: INTEGER;
      x: REAL;
  BEGIN ch := S.nextCh; i := 0;
    WHILE (ch = " ") OR (ch = TAB) OR (ch = CR) DO
      IF ch = CR THEN INC(S.line) END ;
      Read(S, ch)
    END ;
    IF ("A" <= ch) & (ch <= "Z") OR ("a" <= ch) & (ch <= "z") THEN (*name*)
      REPEAT S.s[i] := ch; INC(i); Read(S, ch)
      UNTIL ((ch < "0") & (ch # ".") OR ("9" < ch) & (ch < "A") OR ("Z" < ch) & (ch < "a") OR ("z" < ch)) OR (i = 31);
      S.s[i] := 0X; S.len := i; S.class := Name
    ELSIF ch = 22X THEN (*string*)
      Read(S, ch);
      WHILE (ch # 22X) & (ch >= " ") & (i # 31) DO S.s[i] := ch; INC(i); Read(S, ch) END;
      S.s[i] := 0X; S.len := i+1; Read(S, ch); S.class := String
    ELSE hex := FALSE;
      IF ch = "-" THEN neg := TRUE; Read(S, ch) ELSE neg := FALSE END ;
      IF ("0" <= ch) & (ch <= "9") THEN (*number*)
        n := ORD(ch) - 30H; h := n; Read(S, ch);
        WHILE ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") DO
          IF ch <= "9" THEN d := ORD(ch) - 30H ELSE d := ORD(ch) - 37H; hex := TRUE END ;
          n := 10*n + d; h := 10H*h + d; Read(S, ch)
        END ;
        IF ch = "H" THEN (*hex integer*) Read(S, ch); S.i := h; S.class := Int  (*neg?*)
        ELSIF ch = "." THEN (*real number*)
          Read(S, ch); x := 0.0; e := 0; j := 0;
          WHILE ("0" <= ch) & (ch <= "9") DO  (*fraction*)
            h := 10*n + (ORD(ch) - 30H);
            IF h < maxM THEN n := h; INC(j) END ;
            Read(S, ch)
          END ;
          IF ch = "E" THEN (*scale factor*)
            s := 0; 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
              s := s*10 + ORD(ch) - 30H; Read(S, ch)
            END ;
            IF negE THEN DEC(e, s) ELSE INC(e, s) END ;
          END ;
          x := FLT(n); DEC(e, j);
          IF e < 0 THEN
            IF e >= -maxExp THEN x := x / Ten(-e) ELSE x := 0.0 END
          ELSIF e > 0 THEN
            IF e <= maxExp THEN x := Ten(e) * x ELSE x := 0.0 END
          END ;
          IF neg THEN S.x := -x ELSE S.x := x END ;
          IF hex THEN S.class := 0 ELSE S.class := Real END
        ELSE (*decimal integer*)
          IF neg THEN S.i := -n ELSE S.i := n END;
          IF hex THEN S.class := Inval ELSE S.class := Int END
        END
      ELSE (*spectal character*) S.class := Char;
        IF neg THEN S.c := "-" ELSE S.c := ch; Read(S, ch) END
      END
    END ;
    S.nextCh := ch
  END Scan;

  (* --------------- Access: Writers (NW) ------------------ *)

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

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

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

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

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

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

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

  PROCEDURE WriteInt* (VAR W: Writer; x, n: LONGINT);
    VAR i: INTEGER; x0: LONGINT;
      a: ARRAY 10 OF CHAR;
  BEGIN
    IF ROR(x, 31) = 1 THEN WriteString(W, " -2147483648")
    ELSE i := 0;
      IF x < 0 THEN DEC(n); x0 := -x 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
  END WriteInt;

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

 PROCEDURE WriteReal* (VAR W: Writer; x: REAL; n: INTEGER);
    VAR e, i, k, m: INTEGER;
      d: ARRAY 16 OF CHAR;
  BEGIN e := ASR(ORD(x), 23) MOD 100H;  (*binary exponent*)
    IF e = 0 THEN
      WriteString(W, "  0 ");
      WHILE n >= 3 DO Write(W, " "); DEC(n) END
    ELSIF e = 255 THEN WriteString(W, " NaN ")
    ELSE Write(W, " ");
      WHILE n >= 15 DO DEC(n); Write(W, " ") END ;
      (* 2 < n < 9 digits to be written*)
      IF x < 0.0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END ;
      e := (e - 127) * 77 DIV 256 - 6;  (*decimal exponent*)
      IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END ;
      m := FLOOR(x + 0.5);
      IF m >= 10000000 THEN INC(e); m := m DIV 10 END ;
      i := 0; k := 13-n;
      REPEAT
         IF i = k THEN INC(m, 5) END ;    (*rounding*)
       d[i] := CHR(m MOD 10 + 30H); m := m DIV 10; INC(i)
      UNTIL m = 0;
      DEC(i); Write(W, d[i]); Write(W, ".");
      IF i < n-7 THEN n := 0 ELSE n := 14 - n END ;
      WHILE i > n DO DEC(i); Write(W, d[i]) END ;
      Write(W, "E"); INC(e, 6);
       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 i, m: INTEGER; neg: BOOLEAN;
      d: ARRAY 12 OF CHAR;
  BEGIN
    IF x = 0.0 THEN WriteString(W, "  0")
    ELSE
      IF x < 0.0 THEN x := -x; neg := TRUE ELSE neg := FALSE END ;
      IF k > 7 THEN k := 7 END ;
      x := Ten(k) * x; m := FLOOR(x + 0.5);
      i := 0;
      REPEAT d[i] := CHR(m MOD 10 + 30H); m := m DIV 10; INC(i) UNTIL m = 0;
      Write(W, " ");
      WHILE n > i+3 DO  Write(W, " "); DEC(n) END ;
      IF neg THEN Write(W, "-"); DEC(n) ELSE Write(W, " ") END ;
      WHILE i > k DO DEC(i); Write(W, d[i]) END ;
      Write(W, ".");
      WHILE k > i DO DEC(k); Write(W, "0") END ;
      WHILE i > 0 DO DEC(i); Write(W, d[i]) END
    END
  END WriteRealFix;

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

  PROCEDURE WriteClock* (VAR W: Writer; d: LONGINT);
  BEGIN
    WritePair(W, " ", d DIV 20000H MOD 20H);   (*day*)
    WritePair(W, ".", d DIV 400000H MOD 10H); (*month*)
    WritePair(W, ".", d DIV 4000000H MOD 40H);   (*year*)
    WritePair(W, " ", d DIV 1000H MOD 20H);   (*hour*)
    WritePair(W, ":", d DIV 40H MOD 40H);  (*min*)
    WritePair(W, ":", d MOD 40H)  (*sec*)
  END WriteClock;

BEGIN TrailerFile := Files.New("")
END Texts.