Tigr-m2/tvision-m2/tv.mod

IMPLEMENTATION MODULE tv;

(* Terminal (ANSI + termios) backend and a small retained view-tree toolkit.
   See tv.def.  Pure ISO GNU Modula-2 apart from the libc binding tvtty.def. *)

FROM SYSTEM IMPORT ADDRESS, ADR, ADDADR, CAST, BYTE;
FROM tvtty IMPORT tcgetattr, tcsetattr, ioctl, read, write, signal;

CONST
    MAXROWS  = 120;
    MAXCOLS  = 300;
    MAXCELLS = MAXROWS * MAXCOLS;
    OUTCAP   = 262144;

    ESCc = CHR(27);

    TCSAFLUSH = 2;  TIOCGWINSZ = 5413H;
    ICANON = 2; ECHO = 8; ISIG = 1; IEXTEN = 32768;
    ICRNL = 256; IXON = 1024;
    CC_OFF = 17; VMIN = 6; VTIME = 5;

    H_SINGLE = 2500H; V_SINGLE = 2502H;
    TL_SINGLE = 250CH; TR_SINGLE = 2510H; BL_SINGLE = 2514H; BR_SINGLE = 2518H;
    H_DOUBLE = 2550H; V_DOUBLE = 2551H;
    TL_DOUBLE = 2554H; TR_DOUBLE = 2557H; BL_DOUBLE = 255AH; BR_DOUBLE = 255DH;

    vfPressed = 8;   (* internal, transient *)

    MAXMENUS = 8;
    MAXMITEMS = 16;

TYPE
    Cell = RECORD cp : CARDINAL; attr : CARDINAL; END;
    BytePtr = POINTER TO BYTE;

    MenuItem = RECORD
                   text : ARRAY [0..47] OF CHAR;
                   tag  : INTEGER;
                   sep  : BOOLEAN;
               END;
    MenuDef = RECORD
                  title : ARRAY [0..31] OF CHAR;
                  items : ARRAY [0..MAXMITEMS - 1] OF MenuItem;
                  count : INTEGER;
              END;

VAR
    cols, rows       : INTEGER;
    cells            : ARRAY [0..MAXCELLS - 1] OF Cell;
    prev             : ARRAY [0..MAXCELLS - 1] OF Cell;
    prevValid        : BOOLEAN;
    outBuf           : ARRAY [0..OUTCAP - 1] OF CHAR;
    outLen           : CARDINAL;
    inBuf            : ARRAY [0..255] OF BYTE;
    inLen, inPos     : INTEGER;
    term             : ARRAY [0..63] OF BYTE;
    cursorX, cursorY : INTEGER;
    cursorShown      : BOOLEAN;

    clipStack : ARRAY [0..15] OF Rect;
    clipN     : INTEGER;

    pool   : ARRAY [0..MAXVIEWS - 1] OF View;
    used   : ARRAY [0..MAXVIEWS - 1] OF BOOLEAN;
    desk   : ViewPtr;
    modal  : ViewPtr;

    dragWin : ViewPtr;
    lastSender : ViewPtr;
    dragOX, dragOY : INTEGER;

    focusList  : ARRAY [0..MAXVIEWS - 1] OF ViewPtr;
    focusCount : INTEGER;

    menus     : ARRAY [0..MAXMENUS - 1] OF MenuDef;
    menuCount : INTEGER;
    menuOpen  : INTEGER;
    menuSel   : INTEGER;
    menuShown : BOOLEAN;

    winch    : BOOLEAN;
    oldWinch : ADDRESS;

    dlg        : ViewPtr;
    dlgW       : INTEGER;
    dlgWX, dlgWY, dlgX, dlgY, dlgInputX, dlgBtnX, dlgBtnY : INTEGER;
    dlgItems   : ARRAY [0..31] OF ViewPtr;
    dlgCount   : INTEGER;

(*========================================================================*)
(*  libc struct helpers                                                    *)
(*========================================================================*)

PROCEDURE GetDWord(p : ADDRESS; off : INTEGER) : CARDINAL;
    VAR q : BytePtr; v : CARDINAL;
BEGIN
    q := CAST(BytePtr, ADDADR(p, off));
    v := VAL(CARDINAL, q^);
    q := CAST(BytePtr, ADDADR(q, 1)); v := v + VAL(CARDINAL, q^) * 256;
    q := CAST(BytePtr, ADDADR(q, 1)); v := v + VAL(CARDINAL, q^) * 65536;
    q := CAST(BytePtr, ADDADR(q, 1)); v := v + VAL(CARDINAL, q^) * 16777216;
    RETURN v
END GetDWord;

PROCEDURE PutDWord(p : ADDRESS; off : INTEGER; v : CARDINAL);
    VAR q : BytePtr; x : CARDINAL;
BEGIN
    x := v;
    q := CAST(BytePtr, ADDADR(p, off)); q^ := VAL(BYTE, x MOD 256); x := x DIV 256;
    q := CAST(BytePtr, ADDADR(q, 1));  q^ := VAL(BYTE, x MOD 256); x := x DIV 256;
    q := CAST(BytePtr, ADDADR(q, 1));  q^ := VAL(BYTE, x MOD 256); x := x DIV 256;
    q := CAST(BytePtr, ADDADR(q, 1));  q^ := VAL(BYTE, x MOD 256)
END PutDWord;

PROCEDURE GetWinSize(VAR r, c : INTEGER);
    VAR ws : ARRAY [0..7] OF BYTE;
BEGIN
    IF ioctl(1, TIOCGWINSZ, ADR(ws)) = 0 THEN
        r := VAL(INTEGER, ws[0]) + VAL(INTEGER, ws[1]) * 256;
        c := VAL(INTEGER, ws[2]) + VAL(INTEGER, ws[3]) * 256
    ELSE
        r := 24; c := 80
    END;
    IF r < 3 THEN r := 24 END;
    IF c < 20 THEN c := 80 END;
    IF r > MAXROWS THEN r := MAXROWS END;
    IF c > MAXCOLS THEN c := MAXCOLS END
END GetWinSize;

(*========================================================================*)
(*  Output buffer + escape helpers                                         *)
(*========================================================================*)

PROCEDURE OutCh(c : CHAR);
BEGIN
    IF outLen < OUTCAP THEN
        outBuf[outLen] := c;
        outLen := outLen + 1
    END
END OutCh;

PROCEDURE OutStr(s : ARRAY OF CHAR);
    VAR i : INTEGER;
BEGIN
    i := 0;
    WHILE (i <= VAL(INTEGER, HIGH(s))) AND (s[i] # 0C) DO
        OutCh(s[i]);
        i := i + 1
    END
END OutStr;

PROCEDURE OutInt(n : INTEGER);
    VAR buf : ARRAY [0..15] OF CHAR;
BEGIN
    IntToText(buf, n, 0);
    OutStr(buf)
END OutInt;

PROCEDURE OutCP(cp : CARDINAL);
BEGIN
    IF cp < 80H THEN
        OutCh(CHR(cp))
    ELSIF cp < 800H THEN
        OutCh(CHR(0C0H + cp DIV 64));
        OutCh(CHR(80H + cp MOD 64))
    ELSIF cp < 10000H THEN
        OutCh(CHR(0E0H + cp DIV 4096));
        OutCh(CHR(80H + (cp DIV 64) MOD 64));
        OutCh(CHR(80H + cp MOD 64))
    ELSE
        OutCh(CHR(0F0H + cp DIV 262144));
        OutCh(CHR(80H + (cp DIV 4096) MOD 64));
        OutCh(CHR(80H + (cp DIV 64) MOD 64));
        OutCh(CHR(80H + cp MOD 64))
    END
END OutCP;

PROCEDURE EmitSGR(attr : Attr);
    VAR fg, bg, bl : INTEGER;
BEGIN
    fg := VAL(INTEGER, attr MOD 16);
    bg := VAL(INTEGER, (attr DIV 16) MOD 16);
    bl := VAL(INTEGER, (attr DIV 256) MOD 2);
    OutCh(ESCc); OutCh('[');
    IF fg < 8 THEN OutInt(30 + fg) ELSE OutInt(90 + fg - 8) END;
    OutCh(';');
    IF bg < 8 THEN OutInt(40 + bg) ELSE OutInt(100 + bg - 8) END;
    (* blink is a mode: always emit it explicitly (5 = on, 25 = off) so that
       it does not leak into subsequent cells *)
    IF bl # 0 THEN OutStr(";5") ELSE OutStr(";25") END;
    OutCh('m')
END EmitSGR;

PROCEDURE EmitMove(x, y : INTEGER);
BEGIN
    OutCh(ESCc); OutCh('[');
    OutInt(y + 1); OutCh(';'); OutInt(x + 1); OutCh('H')
END EmitMove;

PROCEDURE FlushOut;
BEGIN
    IF outLen > 0 THEN
        IF write(1, ADR(outBuf), outLen) < 0 THEN END;
        outLen := 0
    END
END FlushOut;

(*========================================================================*)
(*  Terminal setup                                                         *)
(*========================================================================*)

PROCEDURE OnWinch (sig : INTEGER);
BEGIN
    winch := TRUE
END OnWinch;

PROCEDURE Init() : BOOLEAN;
    VAR lf, iff : CARDINAL; i : INTEGER;
BEGIN
    IF tcgetattr(0, ADR(term)) # 0 THEN RETURN FALSE END;
    lf := GetDWord(ADR(term), 12);
    lf := VAL(CARDINAL, CAST(BITSET, lf) *
              CAST(BITSET, MAX(CARDINAL) - (ICANON + ECHO + ISIG + IEXTEN)));
    PutDWord(ADR(term), 12, lf);
    iff := GetDWord(ADR(term), 0);
    iff := VAL(CARDINAL, CAST(BITSET, iff) *
               CAST(BITSET, MAX(CARDINAL) - (ICRNL + IXON)));
    PutDWord(ADR(term), 0, iff);
    term[CC_OFF + VMIN] := VAL(BYTE, 0);
    term[CC_OFF + VTIME] := VAL(BYTE, 1);
    IF tcsetattr(0, TCSAFLUSH, ADR(term)) # 0 THEN RETURN FALSE END;
    GetWinSize(rows, cols);
    prevValid := FALSE;
    inLen := 0; inPos := 0;
    cursorX := 0; cursorY := 0; cursorShown := FALSE;
    clipN := 0;
    modal := NIL; dragWin := NIL; lastSender := NIL;
    menuCount := 0; menuOpen := -1; menuSel := 0; menuShown := FALSE;
    winch := FALSE;
    oldWinch := signal(28, ADR(OnWinch));
    dlg := NIL; dlgCount := 0;
    (* reset view pool *)
    FOR i := 0 TO MAXVIEWS - 1 DO used[i] := FALSE END;
    desk := NIL;
    OutCh(ESCc); OutStr("[?1049h");
    OutCh(ESCc); OutStr("[2J");
    OutCh(ESCc); OutStr("[?1002h");   (* button/mouse-drag reporting *)
    OutCh(ESCc); OutStr("[?1006h");   (* SGR mouse encoding *)
    OutCh(ESCc); OutStr("[?25l");
    FlushOut;
    Clear(A(LightGray, Blue, FALSE));
    Present;
    desk := NewView(VGroup, 0, 0, cols, rows);
    RETURN TRUE
END Init;

PROCEDURE Done;
BEGIN
    OutCh(ESCc); OutStr("[?1006l");
    OutCh(ESCc); OutStr("[?1002l");
    OutCh(ESCc); OutStr("[0m");
    OutCh(ESCc); OutStr("[?25h");
    OutCh(ESCc); OutStr("[?1049l");
    FlushOut;
    IF tcsetattr(0, TCSAFLUSH, ADR(term)) # 0 THEN END
END Done;

PROCEDURE Cols() : INTEGER;
BEGIN RETURN cols END Cols;

PROCEDURE Rows() : INTEGER;
BEGIN RETURN rows END Rows;

PROCEDURE Resized() : BOOLEAN;
    VAR r, c : INTEGER; changed : BOOLEAN;
BEGIN
    GetWinSize(r, c);
    changed := winch OR (r # rows) OR (c # cols);
    winch := FALSE;
    IF changed THEN
        rows := r; cols := c;
        prevValid := FALSE;
        Clear(A(LightGray, Blue, FALSE));
        RETURN TRUE
    END;
    RETURN FALSE
END Resized;

(*========================================================================*)
(*  Drawing primitives (with a clip stack)                                 *)
(*========================================================================*)

PROCEDURE A (fg, bg : INTEGER; blink : BOOLEAN) : Attr;
BEGIN
    RETURN VAL(CARDINAL, fg) + VAL(CARDINAL, bg) * 16 +
           VAL(CARDINAL, blink) * 256
END A;

PROCEDURE Idx(x, y : INTEGER) : INTEGER;
BEGIN RETURN y * cols + x END Idx;

PROCEDURE InClip(x, y : INTEGER) : BOOLEAN;
BEGIN
    IF (x < 0) OR (x >= cols) OR (y < 0) OR (y >= rows) THEN RETURN FALSE END;
    IF clipN = 0 THEN RETURN TRUE END;
    RETURN (x >= clipStack[clipN - 1].x) AND
           (x < clipStack[clipN - 1].x + clipStack[clipN - 1].w) AND
           (y >= clipStack[clipN - 1].y) AND
           (y < clipStack[clipN - 1].y + clipStack[clipN - 1].h)
END InClip;

PROCEDURE PushClipRect(r : Rect);
    VAR cur : Rect; i1, j1, i2, j2 : INTEGER;
BEGIN
    IF clipN = 0 THEN
        cur.x := 0; cur.y := 0; cur.w := cols; cur.h := rows
    ELSE
        cur := clipStack[clipN - 1]
    END;
    i1 := r.x; IF i1 < cur.x THEN i1 := cur.x END;
    j1 := r.y; IF j1 < cur.y THEN j1 := cur.y END;
    i2 := r.x + r.w; IF i2 > cur.x + cur.w THEN i2 := cur.x + cur.w END;
    j2 := r.y + r.h; IF j2 > cur.y + cur.h THEN j2 := cur.y + cur.h END;
    IF i2 < i1 THEN i2 := i1 END;
    IF j2 < j1 THEN j2 := j1 END;
    IF clipN < 16 THEN
        clipStack[clipN].x := i1; clipStack[clipN].y := j1;
        clipStack[clipN].w := i2 - i1; clipStack[clipN].h := j2 - j1;
        clipN := clipN + 1
    END
END PushClipRect;

PROCEDURE PopClip;
BEGIN
    IF clipN > 0 THEN clipN := clipN - 1 END
END PopClip;

PROCEDURE DrawCh(x, y : INTEGER; cp : CARDINAL; attr : Attr);
BEGIN
    IF InClip(x, y) THEN
        cells[Idx(x, y)].cp := cp;
        cells[Idx(x, y)].attr := attr
    END
END DrawCh;

PROCEDURE Fill(x, y, w, h : INTEGER; cp : CARDINAL; attr : Attr);
    VAR i, j : INTEGER;
BEGIN
    FOR j := y TO y + h - 1 DO
        FOR i := x TO x + w - 1 DO
            DrawCh(i, j, cp, attr)
        END
    END
END Fill;

PROCEDURE Clear(attr : Attr);
BEGIN
    clipN := 0;
    Fill(0, 0, cols, rows, VAL(CARDINAL, ORD(' ')), attr)
END Clear;

PROCEDURE DrawText(x, y : INTEGER; s : ARRAY OF CHAR; attr : Attr);
    VAR i : INTEGER;
BEGIN
    i := 0;
    WHILE (i <= VAL(INTEGER, HIGH(s))) AND (s[i] # 0C) DO
        DrawCh(x + i, y, VAL(CARDINAL, ORD(s[i])), attr);
        i := i + 1
    END
END DrawText;

PROCEDURE DrawHLine(x, y, w : INTEGER; cp : CARDINAL; attr : Attr);
    VAR i : INTEGER;
BEGIN
    FOR i := x TO x + w - 1 DO DrawCh(i, y, cp, attr) END
END DrawHLine;

PROCEDURE DrawVLine(x, y, h : INTEGER; cp : CARDINAL; attr : Attr);
    VAR i : INTEGER;
BEGIN
    FOR i := y TO y + h - 1 DO DrawCh(x, i, cp, attr) END
END DrawVLine;

PROCEDURE DrawBox(r : Rect; style : INTEGER; attr : Attr);
    VAR hz, vt, tl, tr, bl, br : CARDINAL;
        x2, y2 : INTEGER;
BEGIN
    IF (r.w < 2) OR (r.h < 2) THEN RETURN END;
    IF style = DoubleFrame THEN
        hz := H_DOUBLE; vt := V_DOUBLE;
        tl := TL_DOUBLE; tr := TR_DOUBLE; bl := BL_DOUBLE; br := BR_DOUBLE
    ELSE
        hz := H_SINGLE; vt := V_SINGLE;
        tl := TL_SINGLE; tr := TR_SINGLE; bl := BL_SINGLE; br := BR_SINGLE
    END;
    x2 := r.x + r.w - 1;
    y2 := r.y + r.h - 1;
    DrawHLine(r.x + 1, r.y, r.w - 2, hz, attr);
    DrawHLine(r.x + 1, y2, r.w - 2, hz, attr);
    DrawVLine(r.x, r.y + 1, r.h - 2, vt, attr);
    DrawVLine(x2, r.y + 1, r.h - 2, vt, attr);
    DrawCh(r.x, r.y, tl, attr);
    DrawCh(x2, r.y, tr, attr);
    DrawCh(r.x, y2, bl, attr);
    DrawCh(x2, y2, br, attr)
END DrawBox;

PROCEDURE DrawShadow(r : Rect; attr : Attr);
BEGIN
    Fill(r.x + 2, r.y + r.h, r.w - 1, 1, VAL(CARDINAL, ORD(' ')), attr);
    Fill(r.x + r.w, r.y + 1, 1, r.h, VAL(CARDINAL, ORD(' ')), attr)
END DrawShadow;

PROCEDURE SetCursor(x, y : INTEGER);
BEGIN cursorX := x; cursorY := y; cursorShown := TRUE END SetCursor;

PROCEDURE HideCursor;
BEGIN cursorShown := FALSE END HideCursor;

PROCEDURE Present;
    VAR x, y, i, outX, outY : INTEGER;
        outAttr : CARDINAL;
        c : Cell;
BEGIN
    outLen := 0;
    OutCh(ESCc); OutStr("[?25l");
    outX := -1; outY := -1; outAttr := MAX(CARDINAL);
    FOR y := 0 TO rows - 1 DO
        FOR x := 0 TO cols - 1 DO
            i := Idx(x, y);
            c := cells[i];
            IF (NOT prevValid) OR (c.cp # prev[i].cp) OR (c.attr # prev[i].attr) THEN
                IF (x # outX) OR (y # outY) THEN
                    EmitMove(x, y);
                    outX := x; outY := y
                END;
                IF c.attr # outAttr THEN
                    EmitSGR(c.attr);
                    outAttr := c.attr
                END;
                OutCP(c.cp);
                outX := outX + 1
            END;
            prev[i] := c
        END
    END;
    prevValid := TRUE;
    OutCh(ESCc); OutStr("[0m");
    IF cursorShown AND (cursorX >= 0) AND (cursorX < cols) AND
       (cursorY >= 0) AND (cursorY < rows) THEN
        OutCh(ESCc); OutStr("[?25h");
        EmitMove(cursorX, cursorY)
    ELSE
        OutCh(ESCc); OutStr("[?25l")
    END;
    FlushOut
END Present;

(*========================================================================*)
(*  Text helpers                                                           *)
(*========================================================================*)

PROCEDURE TextLen (s : ARRAY OF CHAR) : INTEGER;
    VAR i : INTEGER;
BEGIN
    i := 0;
    WHILE (i <= VAL(INTEGER, HIGH(s))) AND (s[i] # 0C) DO i := i + 1 END;
    RETURN i
END TextLen;

PROCEDURE CopyText (VAR dest : ARRAY OF CHAR; s : ARRAY OF CHAR);
    VAR i : INTEGER;
BEGIN
    i := 0;
    WHILE (i <= VAL(INTEGER, HIGH(s))) AND (i < VAL(INTEGER, HIGH(dest))) AND (s[i] # 0C) DO
        dest[i] := s[i];
        i := i + 1
    END;
    dest[i] := 0C
END CopyText;

PROCEDURE AppendText (VAR dest : ARRAY OF CHAR; s : ARRAY OF CHAR);
    VAR i, j : INTEGER;
BEGIN
    i := TextLen(dest);
    j := 0;
    WHILE (j <= VAL(INTEGER, HIGH(s))) AND (i < VAL(INTEGER, HIGH(dest))) AND (s[j] # 0C) DO
        dest[i] := s[j];
        i := i + 1;
        j := j + 1
    END;
    dest[i] := 0C
END AppendText;

PROCEDURE PadText (VAR dest : ARRAY OF CHAR; s : ARRAY OF CHAR; width : INTEGER);
    VAR i, n : INTEGER;
BEGIN
    n := TextLen(s);
    IF n > width THEN n := width END;
    FOR i := 0 TO width - 1 DO
        IF i < n THEN dest[i] := s[i] ELSE dest[i] := ' ' END
    END;
    dest[width] := 0C
END PadText;

PROCEDURE IntToText (VAR dest : ARRAY OF CHAR; n : INTEGER; width : INTEGER);
    VAR tmp : ARRAY [0..15] OF CHAR;
        k, i, p, v : INTEGER;
        neg : BOOLEAN;
BEGIN
    k := 0; neg := FALSE; v := n;
    IF v < 0 THEN neg := TRUE; v := 0 - v END;
    IF v = 0 THEN
        tmp[0] := '0'; k := 1
    ELSE
        WHILE v > 0 DO
            tmp[k] := CHR(ORD('0') + VAL(CARDINAL, v MOD 10));
            k := k + 1;
            v := v DIV 10
        END
    END;
    p := 0;
    IF neg THEN dest[p] := '-'; p := p + 1 END;
    i := k;
    WHILE i > 0 DO
        i := i - 1;
        dest[p] := tmp[i];
        p := p + 1
    END;
    WHILE (width > 0) AND (p < width) DO
        dest[p] := ' ';
        p := p + 1
    END;
    dest[p] := 0C
END IntToText;

(*========================================================================*)
(*  Input                                                                  *)
(*========================================================================*)

PROCEDURE FillIn;
BEGIN
    IF inPos >= inLen THEN
        inLen := read(0, ADR(inBuf), 64);
        IF inLen < 0 THEN inLen := 0 END;
        inPos := 0
    END
END FillIn;

PROCEDURE PeekByte(VAR ok : BOOLEAN) : CARDINAL;
BEGIN
    FillIn;
    IF inPos >= inLen THEN ok := FALSE; RETURN 0 END;
    ok := TRUE;
    RETURN VAL(CARDINAL, inBuf[inPos])
END PeekByte;

PROCEDURE TakeByte;
BEGIN
    IF inPos < inLen THEN inPos := inPos + 1 END
END TakeByte;

PROCEDURE ReadEvent (VAR e : Event) : BOOLEAN;
    VAR b, b2, c1, c2, c3, cp, num : CARDINAL;
        ok : BOOLEAN;
BEGIN
    e.kind := evNone; e.key := kNone; e.ch := 0; e.ctrl := FALSE;
    e.mpressed := FALSE; e.mreleased := FALSE; e.mwheel := 0;
    FillIn;
    IF inPos >= inLen THEN RETURN FALSE END;
    b := PeekByte(ok); TakeByte;
    IF b = 1BH THEN
        b2 := PeekByte(ok);
        IF NOT ok THEN e.kind := evKey; e.key := kEsc; RETURN TRUE END;
        IF b2 = VAL(CARDINAL, ORD('[')) THEN
            TakeByte;
            b2 := PeekByte(ok);
            IF NOT ok THEN e.kind := evKey; e.key := kEsc; RETURN TRUE END;
            IF b2 = VAL(CARDINAL, ORD('<')) THEN
                (* SGR mouse: ESC [ < b ; x ; y M/m *)
                TakeByte;
                num := 0;
                b2 := PeekByte(ok);
                WHILE ok AND (b2 >= VAL(CARDINAL, ORD('0'))) AND
                      (b2 <= VAL(CARDINAL, ORD('9'))) DO
                    num := num * 10 + (b2 - VAL(CARDINAL, ORD('0')));
                    TakeByte; b2 := PeekByte(ok)
                END;
                IF ok THEN TakeByte END;   (* ; *)
                e.mx := 0;
                b2 := PeekByte(ok);
                WHILE ok AND (b2 >= VAL(CARDINAL, ORD('0'))) AND
                      (b2 <= VAL(CARDINAL, ORD('9'))) DO
                    e.mx := e.mx * 10 + VAL(INTEGER, b2 - VAL(CARDINAL, ORD('0')));
                    TakeByte; b2 := PeekByte(ok)
                END;
                IF ok THEN TakeByte END;   (* ; *)
                e.my := 0;
                b2 := PeekByte(ok);
                WHILE ok AND (b2 >= VAL(CARDINAL, ORD('0'))) AND
                      (b2 <= VAL(CARDINAL, ORD('9'))) DO
                    e.my := e.my * 10 + VAL(INTEGER, b2 - VAL(CARDINAL, ORD('0')));
                    TakeByte; b2 := PeekByte(ok)
                END;
                IF ok THEN
                    IF b2 = VAL(CARDINAL, ORD('M')) THEN
                        IF (num >= 64) AND (num <= 65) THEN
                            e.mwheel := 1
                        ELSIF (num >= 128) AND (num <= 129) THEN
                            e.mwheel := -1
                        ELSIF num >= 32 THEN
                            e.mbtn := VAL(INTEGER, num - 32) + 1
                        ELSE
                            e.mbtn := VAL(INTEGER, num) + 1;
                            e.mpressed := TRUE
                        END
                    ELSE
                        e.mbtn := VAL(INTEGER, num) + 1;
                        e.mreleased := TRUE
                    END;
                    TakeByte
                END;
                e.mx := e.mx - 1; e.my := e.my - 1;
                e.kind := evMouse;
                RETURN TRUE
            ELSIF (b2 >= VAL(CARDINAL, ORD('0'))) AND (b2 <= VAL(CARDINAL, ORD('9'))) THEN
                num := 0;
                WHILE ok AND (b2 >= VAL(CARDINAL, ORD('0'))) AND
                      (b2 <= VAL(CARDINAL, ORD('9'))) DO
                    num := num * 10 + (b2 - VAL(CARDINAL, ORD('0')));
                    TakeByte; b2 := PeekByte(ok)
                END;
                IF NOT ok THEN e.kind := evKey; e.key := kEsc; RETURN TRUE END;
                WHILE ok AND (b2 = VAL(CARDINAL, ORD(';'))) DO
                    TakeByte; b2 := PeekByte(ok);
                    WHILE ok AND (b2 >= VAL(CARDINAL, ORD('0'))) AND
                          (b2 <= VAL(CARDINAL, ORD('9'))) DO
                        TakeByte; b2 := PeekByte(ok)
                    END
                END;
                IF ok THEN TakeByte END;
                e.kind := evKey;
                IF b2 = VAL(CARDINAL, ORD('~')) THEN
                    IF num = 1 THEN e.key := kHome
                    ELSIF num = 2 THEN e.key := kIns
                    ELSIF num = 3 THEN e.key := kDel
                    ELSIF num = 4 THEN e.key := kEnd
                    ELSIF num = 5 THEN e.key := kPgUp
                    ELSIF num = 6 THEN e.key := kPgDn
                    ELSIF num = 15 THEN e.key := kF5
                    ELSIF num = 17 THEN e.key := kF6
                    ELSIF num = 18 THEN e.key := kF7
                    ELSIF num = 19 THEN e.key := kF8
                    ELSIF num = 20 THEN e.key := kF9
                    ELSIF num = 21 THEN e.key := kF10
                    ELSIF num = 23 THEN e.key := kF11
                    ELSIF num = 24 THEN e.key := kF12
                    ELSE e.key := kNone
                    END
                ELSIF b2 = VAL(CARDINAL, ORD('A')) THEN e.key := kUp
                ELSIF b2 = VAL(CARDINAL, ORD('B')) THEN e.key := kDown
                ELSIF b2 = VAL(CARDINAL, ORD('C')) THEN e.key := kRight
                ELSIF b2 = VAL(CARDINAL, ORD('D')) THEN e.key := kLeft
                ELSIF b2 = VAL(CARDINAL, ORD('H')) THEN e.key := kHome
                ELSIF b2 = VAL(CARDINAL, ORD('F')) THEN e.key := kEnd
                ELSIF b2 = VAL(CARDINAL, ORD('Z')) THEN e.key := kTab; e.ctrl := TRUE
                ELSIF b2 = VAL(CARDINAL, ORD('P')) THEN e.key := kF1
                ELSIF b2 = VAL(CARDINAL, ORD('Q')) THEN e.key := kF2
                ELSIF b2 = VAL(CARDINAL, ORD('R')) THEN e.key := kF3
                ELSIF b2 = VAL(CARDINAL, ORD('S')) THEN e.key := kF4
                ELSE e.key := kNone
                END;
                RETURN TRUE
            ELSE
                TakeByte;
                e.kind := evKey;
                IF b2 = VAL(CARDINAL, ORD('A')) THEN e.key := kUp
                ELSIF b2 = VAL(CARDINAL, ORD('B')) THEN e.key := kDown
                ELSIF b2 = VAL(CARDINAL, ORD('C')) THEN e.key := kRight
                ELSIF b2 = VAL(CARDINAL, ORD('D')) THEN e.key := kLeft
                ELSIF b2 = VAL(CARDINAL, ORD('H')) THEN e.key := kHome
                ELSIF b2 = VAL(CARDINAL, ORD('F')) THEN e.key := kEnd
                ELSIF b2 = VAL(CARDINAL, ORD('Z')) THEN e.key := kTab; e.ctrl := TRUE
                ELSE e.key := kNone
                END;
                RETURN TRUE
            END
        ELSIF b2 = VAL(CARDINAL, ORD('O')) THEN
            TakeByte;
            b2 := PeekByte(ok);
            IF ok THEN TakeByte END;
            e.kind := evKey;
            IF b2 = VAL(CARDINAL, ORD('P')) THEN e.key := kF1
            ELSIF b2 = VAL(CARDINAL, ORD('Q')) THEN e.key := kF2
            ELSIF b2 = VAL(CARDINAL, ORD('R')) THEN e.key := kF3
            ELSIF b2 = VAL(CARDINAL, ORD('S')) THEN e.key := kF4
            ELSIF b2 = VAL(CARDINAL, ORD('A')) THEN e.key := kUp
            ELSIF b2 = VAL(CARDINAL, ORD('B')) THEN e.key := kDown
            ELSIF b2 = VAL(CARDINAL, ORD('C')) THEN e.key := kRight
            ELSIF b2 = VAL(CARDINAL, ORD('D')) THEN e.key := kLeft
            ELSIF b2 = VAL(CARDINAL, ORD('H')) THEN e.key := kHome
            ELSIF b2 = VAL(CARDINAL, ORD('F')) THEN e.key := kEnd
            END;
            RETURN TRUE
        ELSE
            e.kind := evKey; e.key := kEsc;
            RETURN TRUE
        END
    ELSIF (b = 0DH) OR (b = 0AH) THEN e.kind := evKey; e.key := kEnter; RETURN TRUE
    ELSIF b = 09H THEN e.kind := evKey; e.key := kTab; RETURN TRUE
    ELSIF b = 20H THEN e.kind := evKey; e.key := kSpace; RETURN TRUE
    ELSIF (b = 7FH) OR (b = 08H) THEN e.kind := evKey; e.key := kBack; RETURN TRUE
    ELSIF b = 03H THEN e.kind := evKey; e.key := kCtrlC; RETURN TRUE
    ELSIF b < 20H THEN e.kind := evKey; e.key := kNone; RETURN TRUE
    ELSIF b < 80H THEN e.kind := evKey; e.key := kChar; e.ch := b; RETURN TRUE
    ELSE
        IF b < 0E0H THEN
            c1 := PeekByte(ok); IF ok THEN TakeByte ELSE c1 := 80H END;
            cp := (b - 0C0H) * 64 + (c1 - 80H)
        ELSIF b < 0F0H THEN
            c1 := PeekByte(ok); IF ok THEN TakeByte ELSE c1 := 80H END;
            c2 := PeekByte(ok); IF ok THEN TakeByte ELSE c2 := 80H END;
            cp := (b - 0E0H) * 4096 + (c1 - 80H) * 64 + (c2 - 80H)
        ELSE
            c1 := PeekByte(ok); IF ok THEN TakeByte ELSE c1 := 80H END;
            c2 := PeekByte(ok); IF ok THEN TakeByte ELSE c2 := 80H END;
            c3 := PeekByte(ok); IF ok THEN TakeByte ELSE c3 := 80H END;
            cp := (b - 0F0H) * 262144 + (c1 - 80H) * 4096 +
                  (c2 - 80H) * 64 + (c3 - 80H)
        END;
        e.kind := evKey; e.key := kChar; e.ch := cp;
        RETURN TRUE
    END
END ReadEvent;

(*========================================================================*)
(*  View tree                                                              *)
(*========================================================================*)

PROCEDURE NewView (k : VKind; x, y, w, h : INTEGER) : ViewPtr;
    VAR i : INTEGER;
BEGIN
    i := 0;
    WHILE (i < MAXVIEWS) AND used[i] DO i := i + 1 END;
    IF i >= MAXVIEWS THEN RETURN NIL END;
    used[i] := TRUE;
    pool[i].kind := k;
    pool[i].rect.x := x; pool[i].rect.y := y;
    pool[i].rect.w := w; pool[i].rect.h := h;
    pool[i].parent := NIL; pool[i].next := NIL; pool[i].prev := NIL;
    pool[i].first := NIL; pool[i].last := NIL; pool[i].focus := NIL;
    pool[i].clipKids := FALSE;
    pool[i].text[0] := 0C; pool[i].len := 0; pool[i].pos := 0;
    pool[i].value := 0; pool[i].minv := 0; pool[i].maxv := 0; pool[i].tag := 0;
    pool[i].flags := 0; pool[i].list := NIL;
    RETURN ADR(pool[i])
END NewView;

PROCEDURE FreeView (v : ViewPtr);
    VAR i : INTEGER;
BEGIN
    IF v = NIL THEN RETURN END;
    i := 0;
    WHILE (i < MAXVIEWS) AND (ADR(pool[i]) # v) DO i := i + 1 END;
    IF i < MAXVIEWS THEN used[i] := FALSE END
END FreeView;

PROCEDURE AddView (parent, child : ViewPtr);
BEGIN
    IF (parent = NIL) OR (child = NIL) THEN RETURN END;
    child^.parent := parent;
    child^.next := NIL;
    child^.prev := parent^.last;
    IF parent^.last # NIL THEN parent^.last^.next := child END;
    parent^.last := child;
    IF parent^.first = NIL THEN parent^.first := child END;
    IF parent^.kind = VWindow THEN child^.clipKids := FALSE END
END AddView;

PROCEDURE DelView (v : ViewPtr);
    VAR c, n : ViewPtr;
BEGIN
    IF v = NIL THEN RETURN END;
    c := v^.first;
    WHILE c # NIL DO
        n := c^.next;
        DelView(c);
        c := n
    END;
    IF v^.prev # NIL THEN v^.prev^.next := v^.next END;
    IF v^.next # NIL THEN v^.next^.prev := v^.prev END;
    IF v^.parent # NIL THEN
        IF v^.parent^.first = v THEN v^.parent^.first := v^.next END;
        IF v^.parent^.last = v THEN v^.parent^.last := v^.prev END
    END;
    FreeView(v)
END DelView;

PROCEDURE SetText (v : ViewPtr; s : ARRAY OF CHAR);
BEGIN
    IF v # NIL THEN CopyText(v^.text, s); v^.len := TextLen(v^.text) END
END SetText;

PROCEDURE SetTag (v : ViewPtr; t : INTEGER);
BEGIN
    IF v # NIL THEN v^.tag := t END
END SetTag;

PROCEDURE Desk () : ViewPtr;
BEGIN RETURN desk END Desk;

PROCEDURE BringToFront (v : ViewPtr);
    VAR p : ViewPtr;
BEGIN
    IF (v = NIL) OR (v^.parent = NIL) THEN RETURN END;
    IF v^.parent^.last = v THEN RETURN END;
    p := v^.parent;
    (* unlink *)
    IF v^.prev # NIL THEN v^.prev^.next := v^.next END;
    IF v^.next # NIL THEN v^.next^.prev := v^.prev END;
    IF p^.first = v THEN p^.first := v^.next END;
    (* append *)
    v^.prev := p^.last; v^.next := NIL;
    IF p^.last # NIL THEN p^.last^.next := v END;
    p^.last := v
END BringToFront;

PROCEDURE FocusView (v : ViewPtr);
    VAR p : ViewPtr;
BEGIN
    p := v;
    WHILE (p # NIL) AND (p^.parent # NIL) DO
        p^.parent^.focus := p;
        p := p^.parent
    END
END FocusView;

PROCEDURE IsFocusable(v : ViewPtr) : BOOLEAN;
BEGIN
    RETURN (v # NIL) AND ((v^.flags DIV vfDisabled) MOD 2 = 0) AND
           ((v^.kind = VInput) OR (v^.kind = VButton) OR (v^.kind = VCheck) OR
            (v^.kind = VRadio) OR (v^.kind = VList) OR (v^.kind = VScroll))
END IsFocusable;

PROCEDURE CollectFocus(v : ViewPtr);
    VAR c : ViewPtr;
BEGIN
    IF v = NIL THEN RETURN END;
    IF IsFocusable(v) THEN
        IF focusCount < MAXVIEWS THEN
            focusList[focusCount] := v;
            focusCount := focusCount + 1
        END
    END;
    c := v^.first;
    WHILE c # NIL DO
        CollectFocus(c);
        c := c^.next
    END
END CollectFocus;

PROCEDURE CurrentFocus() : ViewPtr;
    VAR v : ViewPtr;
BEGIN
    v := desk;
    WHILE (v # NIL) AND (v^.focus # NIL) DO v := v^.focus END;
    RETURN v
END CurrentFocus;

PROCEDURE FocusNext (backwards : BOOLEAN);
    VAR cur, nxt : ViewPtr; i, idx : INTEGER;
BEGIN
    focusCount := 0;
    CollectFocus(desk);
    IF focusCount = 0 THEN RETURN END;
    cur := CurrentFocus();
    idx := -1;
    FOR i := 0 TO focusCount - 1 DO
        IF focusList[i] = cur THEN idx := i END
    END;
    IF idx < 0 THEN
        nxt := focusList[0]
    ELSIF backwards THEN
        nxt := focusList[(idx + focusCount - 1) MOD focusCount]
    ELSE
        nxt := focusList[(idx + 1) MOD focusCount]
    END;
    FocusView(nxt)
END FocusNext;

PROCEDURE MoveViewBy (v : ViewPtr; dx, dy : INTEGER);
    VAR c : ViewPtr;
BEGIN
    IF v = NIL THEN RETURN END;
    v^.rect.x := v^.rect.x + dx;
    v^.rect.y := v^.rect.y + dy;
    c := v^.first;
    WHILE c # NIL DO
        MoveViewBy(c, dx, dy);
        c := c^.next
    END
END MoveViewBy;

PROCEDURE OffsetView(v : ViewPtr; dx, dy : INTEGER);
BEGIN MoveViewBy(v, dx, dy) END OffsetView;

(*========================================================================*)
(*  Widget drawing                                                         *)
(*========================================================================*)

PROCEDURE IsFocused(v : ViewPtr) : BOOLEAN;
BEGIN RETURN CurrentFocus() = v END IsFocused;

PROCEDURE DrawWindow(v : ViewPtr);
    VAR frame, title, shadow : Attr;
        x2 : INTEGER;
BEGIN
    shadow := A(Black, Black, FALSE);
    frame  := A(White, Blue, FALSE);
    title  := A(Yellow, Blue, FALSE);
    DrawShadow(v^.rect, shadow);
    Fill(v^.rect.x, v^.rect.y, v^.rect.w, v^.rect.h,
         VAL(CARDINAL, ORD(' ')), A(Black, Cyan, FALSE));
    DrawBox(v^.rect, DoubleFrame, frame);
    DrawText(v^.rect.x + 2, v^.rect.y, v^.text, title);
    (* close box *)
    x2 := v^.rect.x + v^.rect.w - 3;
    DrawText(x2, v^.rect.y, " X ", A(White, Red, FALSE))
END DrawWindow;

PROCEDURE DrawInput(v : ViewPtr);
    VAR bg, fg : Attr; s : ARRAY [0..MAXLINE - 1] OF CHAR;
BEGIN
    bg := A(Black, White, FALSE);
    Fill(v^.rect.x, v^.rect.y, v^.rect.w, v^.rect.h,
         VAL(CARDINAL, ORD(' ')), bg);
    DrawText(v^.rect.x, v^.rect.y, v^.text, bg);
    IF IsFocused(v) THEN
        SetCursor(v^.rect.x + v^.pos, v^.rect.y)
    END
END DrawInput;

PROCEDURE DrawButton(v : ViewPtr);
    VAR s : ARRAY [0..MAXLINE - 1] OF CHAR;
        attr : Attr; w : INTEGER;
BEGIN
    CopyText(s, "[ ");
    AppendText(s, v^.text);
    AppendText(s, " ]");
    w := TextLen(s);
    IF IsFocused(v) THEN
        attr := A(White, Blue, FALSE)
    ELSE
        attr := A(Black, LightGray, FALSE)
    END;
    IF (v^.flags DIV vfPressed) MOD 2 = 1 THEN
        attr := A(White, Green, FALSE)
    END;
    Fill(v^.rect.x, v^.rect.y, w, 1, VAL(CARDINAL, ORD(' ')),
         A(Black, Cyan, FALSE));
    DrawText(v^.rect.x, v^.rect.y, s, attr)
END DrawButton;

PROCEDURE DrawCheck(v : ViewPtr);
    VAR s : ARRAY [0..1] OF CHAR; attr : Attr;
BEGIN
    IF v^.flags DIV vfSelected MOD 2 = 1 THEN s := "X" ELSE s := " " END;
    attr := A(Black, Cyan, FALSE);
    DrawText(v^.rect.x, v^.rect.y, "[", attr);
    DrawText(v^.rect.x + 1, v^.rect.y, s, A(White, Blue, FALSE));
    DrawText(v^.rect.x + 2, v^.rect.y, "]", attr);
    DrawText(v^.rect.x + 4, v^.rect.y, v^.text, attr)
END DrawCheck;

PROCEDURE DrawRadio(v : ViewPtr);
    VAR m : ARRAY [0..1] OF CHAR; attr : Attr;
BEGIN
    IF v^.flags DIV vfSelected MOD 2 = 1 THEN m := "*" ELSE m := " " END;
    attr := A(Black, Cyan, FALSE);
    DrawText(v^.rect.x, v^.rect.y, "(", attr);
    DrawText(v^.rect.x + 1, v^.rect.y, m, A(White, Blue, FALSE));
    DrawText(v^.rect.x + 2, v^.rect.y, ")", attr);
    DrawText(v^.rect.x + 4, v^.rect.y, v^.text, attr)
END DrawRadio;

PROCEDURE DrawList(v : ViewPtr);
    VAR i, first, vis, y : INTEGER; attr, sel : Attr;
BEGIN
    IF v^.list = NIL THEN RETURN END;
    DrawBox(v^.rect, SingleFrame, A(White, Cyan, FALSE));
    vis := v^.rect.h - 2;
    first := v^.pos;
    FOR i := 0 TO vis - 1 DO
        y := v^.rect.y + 1 + i;
        IF (first + i) < v^.list^.count THEN
            IF (v^.list # NIL) AND (first + i = v^.value) THEN
                attr := A(White, Blue, FALSE)
            ELSE
                attr := A(Black, Cyan, FALSE)
            END;
            Fill(v^.rect.x + 1, y, v^.rect.w - 2, 1,
                 VAL(CARDINAL, ORD(' ')), attr);
            DrawText(v^.rect.x + 1, y, v^.list^.items[first + i], attr)
        END
    END;
    IF v^.list # NIL THEN
        IF v^.list^.count > vis THEN
            DrawText(v^.rect.x + v^.rect.w - 2, v^.rect.y + 1, "^",
                     A(White, Cyan, FALSE));
            DrawText(v^.rect.x + v^.rect.w - 2, v^.rect.y + v^.rect.h - 2, "v",
                     A(White, Cyan, FALSE))
        END
    END
END DrawList;

PROCEDURE DrawScroll(v : ViewPtr);
    VAR h, t, yy : INTEGER; attr : Attr;
BEGIN
    attr := A(Black, LightGray, FALSE);
    Fill(v^.rect.x, v^.rect.y, v^.rect.w, v^.rect.h,
         VAL(CARDINAL, ORD(' ')), attr);
    IF v^.maxv > 0 THEN
        h := v^.rect.h;
        t := h DIV (v^.maxv + 1);
        IF t < 1 THEN t := 1 END;
        yy := v^.rect.y + (v^.value * (h - t)) DIV v^.maxv;
        Fill(v^.rect.x, yy, v^.rect.w, t, VAL(CARDINAL, ORD(' ')),
             A(White, Blue, FALSE))
    END
END DrawScroll;

PROCEDURE DrawTextCtl(v : ViewPtr);
BEGIN
    Fill(v^.rect.x, v^.rect.y, v^.rect.w, 1,
         VAL(CARDINAL, ORD(' ')), A(Black, Cyan, FALSE));
    DrawText(v^.rect.x, v^.rect.y, v^.text, A(Black, Cyan, FALSE))
END DrawTextCtl;

PROCEDURE DrawView(v : ViewPtr);
    VAR c : ViewPtr;
BEGIN
    IF v = NIL THEN RETURN END;
    CASE v^.kind OF
        VGroup : (* nothing *)
        |
        VWindow : DrawWindow(v)
        |
        VText : DrawTextCtl(v)
        |
        VFrame : DrawBox(v^.rect, SingleFrame, A(White, Cyan, FALSE))
        |
        VInput : DrawInput(v)
        |
        VButton : DrawButton(v)
        |
        VCheck : DrawCheck(v)
        |
        VRadio : DrawRadio(v)
        |
        VList : DrawList(v)
        |
        VScroll : DrawScroll(v)
    END;
    IF v^.first # NIL THEN
        IF (v^.kind = VWindow) OR v^.clipKids THEN
            PushClipRect(v^.rect)
        END;
        c := v^.first;
        WHILE c # NIL DO
            DrawView(c);
            c := c^.next
        END;
        IF (v^.kind = VWindow) OR v^.clipKids THEN PopClip END
    END
END DrawView;

(*========================================================================*)
(*  Menu bar + drop-down menus                                             *)
(*========================================================================*)

PROCEDURE MenuBarInit;
BEGIN
    menuCount := 0; menuOpen := -1; menuSel := 0; menuShown := FALSE
END MenuBarInit;

PROCEDURE MenuAdd (title : ARRAY OF CHAR);
BEGIN
    IF menuCount < MAXMENUS THEN
        CopyText(menus[menuCount].title, title);
        menus[menuCount].count := 0;
        menuCount := menuCount + 1;
        menuShown := TRUE
    END
END MenuAdd;

PROCEDURE MenuItemAdd (text : ARRAY OF CHAR; tag : INTEGER);
    VAR i : INTEGER;
BEGIN
    IF menuCount > 0 THEN
        i := menus[menuCount - 1].count;
        IF i < MAXMITEMS THEN
            CopyText(menus[menuCount - 1].items[i].text, text);
            menus[menuCount - 1].items[i].tag := tag;
            menus[menuCount - 1].items[i].sep := FALSE;
            menus[menuCount - 1].count := i + 1
        END
    END
END MenuItemAdd;

PROCEDURE MenuSep;
    VAR i : INTEGER;
BEGIN
    IF menuCount > 0 THEN
        i := menus[menuCount - 1].count;
        IF i < MAXMITEMS THEN
            menus[menuCount - 1].items[i].text[0] := 0C;
            menus[menuCount - 1].items[i].tag := 0;
            menus[menuCount - 1].items[i].sep := TRUE;
            menus[menuCount - 1].count := i + 1
        END
    END
END MenuSep;

PROCEDURE MenuBar (show : BOOLEAN);
BEGIN
    menuShown := show;
    IF NOT show THEN menuOpen := -1 END
END MenuBar;

PROCEDURE MenuTitleX (i : INTEGER) : INTEGER;
    VAR k, x : INTEGER;
BEGIN
    x := 1;
    FOR k := 0 TO i - 1 DO
        x := x + TextLen(menus[k].title) + 2
    END;
    RETURN x
END MenuTitleX;

PROCEDURE MenuWidth (i : INTEGER) : INTEGER;
    VAR k, w, l : INTEGER;
BEGIN
    w := TextLen(menus[i].title) + 2;
    FOR k := 0 TO menus[i].count - 1 DO
        l := TextLen(menus[i].items[k].text) + 4;
        IF l > w THEN w := l END
    END;
    RETURN w
END MenuWidth;

PROCEDURE MenuTitleAt (x : INTEGER) : INTEGER;
    VAR i, xx : INTEGER;
BEGIN
    FOR i := 0 TO menuCount - 1 DO
        xx := MenuTitleX(i);
        IF (x >= xx) AND (x < xx + TextLen(menus[i].title)) THEN RETURN i END
    END;
    RETURN -1
END MenuTitleAt;

PROCEDURE FirstSel (i : INTEGER) : INTEGER;
    VAR k : INTEGER;
BEGIN
    k := 0;
    WHILE (k < menus[i].count) AND menus[i].items[k].sep DO k := k + 1 END;
    IF k >= menus[i].count THEN k := 0 END;
    RETURN k
END FirstSel;

PROCEDURE MenuStep (i, cur, dir : INTEGER) : INTEGER;
    VAR k, n : INTEGER; found : BOOLEAN;
BEGIN
    n := menus[i].count;
    IF n = 0 THEN RETURN 0 END;
    k := cur; found := FALSE;
    WHILE NOT found DO
        k := (k + dir + n) MOD n;
        IF (NOT menus[i].items[k].sep) OR (k = cur) THEN found := TRUE END
    END;
    RETURN k
END MenuStep;

PROCEDURE DrawMenuBar;
    VAR i, k, x : INTEGER; r : Rect; attr : Attr;
        space : CARDINAL;
BEGIN
    IF (NOT menuShown) OR (menuCount = 0) THEN RETURN END;
    space := VAL(CARDINAL, ORD(' '));
    Fill(0, 0, cols, 1, space, A(Black, LightGray, FALSE));
    FOR i := 0 TO menuCount - 1 DO
        x := MenuTitleX(i);
        IF menuOpen = i THEN attr := A(White, Blue, FALSE)
        ELSE attr := A(Black, LightGray, FALSE) END;
        DrawText(x, 0, menus[i].title, attr)
    END;
    IF menuOpen < 0 THEN RETURN END;
    i := menuOpen;
    r.x := MenuTitleX(i); r.y := 1;
    r.w := MenuWidth(i); r.h := menus[i].count + 2;
    DrawShadow(r, A(Black, Black, FALSE));
    Fill(r.x, r.y, r.w, r.h, space, A(Black, LightGray, FALSE));
    DrawBox(r, SingleFrame, A(Black, LightGray, FALSE));
    FOR k := 0 TO menus[i].count - 1 DO
        IF menus[i].items[k].sep THEN
            DrawHLine(r.x + 1, r.y + 1 + k, r.w - 2, H_SINGLE,
                      A(DarkGray, LightGray, FALSE))
        ELSE
            IF k = menuSel THEN attr := A(White, Blue, FALSE)
            ELSE attr := A(Black, LightGray, FALSE) END;
            Fill(r.x + 1, r.y + 1 + k, r.w - 2, 1, space, attr);
            DrawText(r.x + 2, r.y + 1 + k, menus[i].items[k].text, attr)
        END
    END
END DrawMenuBar;

PROCEDURE MenuHandle (e : Event; VAR handled : BOOLEAN) : INTEGER;
    VAR i, idx : INTEGER; r : Rect;
BEGIN
    handled := FALSE;
    IF (NOT menuShown) OR (menuCount = 0) THEN RETURN cmNone END;

    IF e.kind = evKey THEN
        IF e.key = kCtrlC THEN RETURN cmNone END;
        IF e.key = kF10 THEN
            IF menuOpen < 0 THEN menuOpen := 0 ELSE menuOpen := (menuOpen + 1) MOD menuCount END;
            menuSel := FirstSel(menuOpen);
            handled := TRUE; RETURN cmNone
        END;
        IF menuOpen >= 0 THEN
            handled := TRUE;
            IF e.key = kEsc THEN menuOpen := -1
            ELSIF e.key = kLeft THEN
                menuOpen := (menuOpen + menuCount - 1) MOD menuCount;
                menuSel := FirstSel(menuOpen)
            ELSIF e.key = kRight THEN
                menuOpen := (menuOpen + 1) MOD menuCount;
                menuSel := FirstSel(menuOpen)
            ELSIF e.key = kUp THEN menuSel := MenuStep(menuOpen, menuSel, -1)
            ELSIF e.key = kDown THEN menuSel := MenuStep(menuOpen, menuSel, +1)
            ELSIF (e.key = kEnter) OR (e.key = kSpace) THEN
                IF NOT menus[menuOpen].items[menuSel].sep THEN
                    i := menus[menuOpen].items[menuSel].tag;
                    menuOpen := -1; lastSender := NIL;
                    RETURN i
                END
            END;
            RETURN cmNone
        END;
        RETURN cmNone
    END;

    IF e.kind # evMouse THEN RETURN cmNone END;

    (* mouse over a title *)
    IF e.my = 0 THEN
        i := MenuTitleAt(e.mx);
        IF i >= 0 THEN
            handled := TRUE;
            IF e.mpressed THEN
                IF menuOpen = i THEN menuOpen := -1
                ELSE menuOpen := i; menuSel := FirstSel(i) END
            ELSIF (e.mbtn > 0) OR (e.mwheel # 0) THEN
                menuOpen := i; menuSel := FirstSel(i)
            ELSIF menuOpen >= 0 THEN
                menuOpen := i; menuSel := FirstSel(i)
            END;
            RETURN cmNone
        END
    END;

    IF menuOpen >= 0 THEN
        r.x := MenuTitleX(menuOpen); r.y := 1;
        r.w := MenuWidth(menuOpen); r.h := menus[menuOpen].count + 2;
        IF Contains(r, e.mx, e.my) THEN
            handled := TRUE;
            idx := e.my - (r.y + 1);
            IF (idx >= 0) AND (idx < menus[menuOpen].count) AND
               (NOT menus[menuOpen].items[idx].sep) THEN
                menuSel := idx;
                IF e.mpressed THEN
                    i := menus[menuOpen].items[idx].tag;
                    menuOpen := -1; lastSender := NIL;
                    RETURN i
                END
            END;
            RETURN cmNone
        ELSIF e.mpressed THEN
            menuOpen := -1;
            handled := TRUE
        END
    END;
    RETURN cmNone
END MenuHandle;

PROCEDURE DrawTree;
BEGIN
    Clear(A(LightGray, Blue, FALSE));
    HideCursor;
    clipN := 0;
    IF desk # NIL THEN DrawView(desk) END;
    DrawMenuBar
END DrawTree;

PROCEDURE Finish;
BEGIN
    DrawTree;
    Present
END Finish;

(*========================================================================*)
(*  Geometry + hit testing                                                 *)
(*========================================================================*)

PROCEDURE Contains(r : Rect; x, y : INTEGER) : BOOLEAN;
BEGIN
    RETURN (x >= r.x) AND (x < r.x + r.w) AND (y >= r.y) AND (y < r.y + r.h)
END Contains;

PROCEDURE HitTest(v : ViewPtr; x, y : INTEGER) : ViewPtr;
    VAR c, hit : ViewPtr;
BEGIN
    IF (v = NIL) OR (NOT Contains(v^.rect, x, y)) THEN RETURN NIL END;
    c := v^.last;
    WHILE c # NIL DO
        IF Contains(c^.rect, x, y) THEN
            hit := HitTest(c, x, y);
            IF hit # NIL THEN RETURN hit END
        END;
        c := c^.prev
    END;
    RETURN v
END HitTest;

PROCEDURE WindowAncestor(v : ViewPtr) : ViewPtr;
    VAR p : ViewPtr;
BEGIN
    p := v;
    WHILE p # NIL DO
        IF p^.kind = VWindow THEN RETURN p END;
        p := p^.parent
    END;
    RETURN NIL
END WindowAncestor;

(*========================================================================*)
(*  Event dispatch                                                         *)
(*========================================================================*)

PROCEDURE EditKey(v : ViewPtr; VAR e : Event);
    VAR i : INTEGER;
BEGIN
    IF e.key = kLeft THEN
        IF v^.pos > 0 THEN v^.pos := v^.pos - 1 END
    ELSIF e.key = kRight THEN
        IF v^.pos < v^.len THEN v^.pos := v^.pos + 1 END
    ELSIF e.key = kHome THEN v^.pos := 0
    ELSIF e.key = kEnd THEN v^.pos := v^.len
    ELSIF e.key = kBack THEN
        IF v^.pos > 0 THEN
            i := v^.pos - 1;
            WHILE i < v^.len - 1 DO v^.text[i] := v^.text[i + 1]; i := i + 1 END;
            v^.len := v^.len - 1; v^.pos := v^.pos - 1; v^.text[v^.len] := 0C
        END
    ELSIF e.key = kDel THEN
        IF v^.pos < v^.len THEN
            i := v^.pos;
            WHILE i < v^.len - 1 DO v^.text[i] := v^.text[i + 1]; i := i + 1 END;
            v^.len := v^.len - 1; v^.text[v^.len] := 0C
        END
    ELSIF e.key = kChar THEN
        IF (v^.len < MAXLINE - 1) AND (e.ch < 256) THEN
            i := v^.len;
            WHILE i > v^.pos DO v^.text[i] := v^.text[i - 1]; i := i - 1 END;
            v^.text[v^.pos] := CHR(e.ch);
            v^.len := v^.len + 1; v^.pos := v^.pos + 1
        END
    END
END EditKey;

PROCEDURE SelectRadio(v : ViewPtr);
    VAR c : ViewPtr;
BEGIN
    IF (v = NIL) OR (v^.parent = NIL) THEN RETURN END;
    c := v^.parent^.first;
    WHILE c # NIL DO
        IF (c # v) AND (c^.kind = VRadio) AND
           ((c^.flags DIV vfSelected) MOD 2 = 1) THEN
            c^.flags := c^.flags - vfSelected
        END;
        c := c^.next
    END;
    IF (v^.flags DIV vfSelected) MOD 2 = 0 THEN
        v^.flags := v^.flags + vfSelected
    END
END SelectRadio;

PROCEDURE WidgetKey(v : ViewPtr; VAR e : Event) : INTEGER;
    VAR cmd : INTEGER;
BEGIN
    cmd := cmNone;
    IF v^.kind = VInput THEN
        EditKey(v, e)
    ELSIF v^.kind = VButton THEN
        IF (e.key = kEnter) OR (e.key = kSpace) THEN cmd := v^.tag END
    ELSIF v^.kind = VCheck THEN
        IF (e.key = kEnter) OR (e.key = kSpace) THEN
            v^.flags := v^.flags / 4 * 4;
            IF v^.flags DIV vfSelected MOD 2 = 0 THEN
                v^.flags := v^.flags + vfSelected
            END;
            cmd := v^.tag
        END
    ELSIF v^.kind = VRadio THEN
        IF (e.key = kEnter) OR (e.key = kSpace) THEN
            SelectRadio(v);
            cmd := v^.tag
        END
    ELSIF v^.kind = VList THEN
        IF e.key = kUp THEN
            IF v^.value > 0 THEN v^.value := v^.value - 1 END;
            IF v^.value < v^.pos THEN v^.pos := v^.value END
        ELSIF e.key = kDown THEN
            IF (v^.list # NIL) AND (v^.value < v^.list^.count - 1) THEN
                v^.value := v^.value + 1
            END;
            IF v^.value >= v^.pos + (v^.rect.h - 2) THEN
                v^.pos := v^.value - (v^.rect.h - 2) + 1
            END
        ELSIF (e.key = kEnter) OR (e.key = kSpace) THEN
            cmd := v^.tag
        END
    ELSIF v^.kind = VScroll THEN
        IF e.key = kUp THEN
            IF v^.value > 0 THEN v^.value := v^.value - 1 END
        ELSIF e.key = kDown THEN
            IF v^.value < v^.maxv THEN v^.value := v^.value + 1 END
        END
    END;
    IF cmd # cmNone THEN lastSender := v END;
    RETURN cmd
END WidgetKey;

PROCEDURE WidgetMouse(v : ViewPtr; VAR e : Event) : INTEGER;
    VAR cmd : INTEGER; rel : INTEGER;
BEGIN
    cmd := cmNone;
    IF v^.kind = VButton THEN
        IF e.mpressed THEN
            v^.flags := v^.flags + vfPressed
        ELSIF e.mreleased THEN
            IF (v^.flags DIV vfPressed) MOD 2 = 1 THEN
                cmd := v^.tag
            END;
            v^.flags := v^.flags / 8 * 8
        END
    ELSIF v^.kind = VCheck THEN
        IF e.mreleased THEN
            IF v^.flags DIV vfSelected MOD 2 = 1 THEN
                v^.flags := v^.flags - vfSelected
            ELSE
                v^.flags := v^.flags + vfSelected
            END;
            cmd := v^.tag
        END
    ELSIF v^.kind = VRadio THEN
        IF e.mreleased THEN
            SelectRadio(v);
            cmd := v^.tag
        END
    ELSIF v^.kind = VList THEN
        IF e.mwheel # 0 THEN
            IF (e.mwheel < 0) AND (v^.pos > 0) THEN v^.pos := v^.pos - 1 END;
            IF (e.mwheel > 0) AND (v^.list # NIL) AND
               (v^.pos + (v^.rect.h - 2) < v^.list^.count) THEN
                v^.pos := v^.pos + 1
            END
        ELSIF e.mreleased THEN
            rel := e.my - v^.rect.y - 1;
            IF (rel >= 0) AND (v^.list # NIL) AND
               (v^.pos + rel < v^.list^.count) THEN
                v^.value := v^.pos + rel
            END
        END
    ELSIF v^.kind = VInput THEN
        IF e.mpressed THEN
            rel := e.mx - v^.rect.x;
            IF rel < 0 THEN rel := 0 END;
            IF rel > v^.len THEN rel := v^.len END;
            v^.pos := rel
        END
    ELSIF v^.kind = VScroll THEN
        IF e.mpressed OR e.mreleased THEN
            IF v^.rect.h > 1 THEN
                v^.value := ((e.my - v^.rect.y) * v^.maxv) DIV (v^.rect.h - 1)
            END;
            IF v^.value < 0 THEN v^.value := 0 END;
            IF v^.value > v^.maxv THEN v^.value := v^.maxv END
        END
    END;
    IF cmd # cmNone THEN lastSender := v END;
    RETURN cmd
END WidgetMouse;

PROCEDURE HandleWindow(v : ViewPtr; VAR e : Event) : INTEGER;
    VAR w : ViewPtr; nx, ny : INTEGER;
BEGIN
    IF (e.kind = evMouse) AND e.mpressed THEN
        (* close box? *)
        IF (e.my = v^.rect.y) AND
           (e.mx >= v^.rect.x + v^.rect.w - 3) AND (e.mx < v^.rect.x + v^.rect.w) THEN
            lastSender := v;
            RETURN cmClose
        END;
        (* drag by the title row *)
        IF (e.my = v^.rect.y) AND (e.mx < v^.rect.x + v^.rect.w - 3) THEN
            dragWin := v;
            dragOX := e.mx - v^.rect.x;
            dragOY := e.my - v^.rect.y
        END
    ELSIF (e.kind = evMouse) AND e.mreleased THEN
        dragWin := NIL
    ELSIF (e.kind = evMouse) AND (e.mbtn > 0) AND (NOT e.mpressed) AND
          (NOT e.mreleased) THEN
        IF dragWin # NIL THEN
            nx := e.mx - dragOX;
            ny := e.my - dragOY;
            (* keep the window's title corner on screen *)
            IF nx < 0 THEN nx := 0 END;
            IF nx > cols - 6 THEN nx := cols - 6 END;
            IF ny < 0 THEN ny := 0 END;
            IF ny > rows - 1 THEN ny := rows - 1 END;
            MoveViewBy(dragWin, nx - dragWin^.rect.x, ny - dragWin^.rect.y)
        END
    END;
    RETURN cmNone
END HandleWindow;

PROCEDURE DispatchMouse(v : ViewPtr; VAR e : Event) : INTEGER;
    VAR hit : ViewPtr; cmd : INTEGER; w : ViewPtr;
BEGIN
    cmd := cmNone;
    hit := HitTest(v, e.mx, e.my);
    IF hit = NIL THEN RETURN cmNone END;
    IF hit # v THEN
        w := WindowAncestor(hit);
        IF (w # NIL) AND e.mpressed THEN BringToFront(w) END
    END;
    IF e.mpressed AND IsFocusable(hit) THEN FocusView(hit) END;
    IF hit^.kind = VWindow THEN
        cmd := HandleWindow(hit, e)
    ELSE
        cmd := WidgetMouse(hit, e)
    END;
    RETURN cmd
END DispatchMouse;

PROCEDURE DispatchKey(v : ViewPtr; VAR e : Event) : INTEGER;
    VAR cmd : INTEGER; f : ViewPtr;
BEGIN
    cmd := cmNone;
    IF (v^.kind = VGroup) OR (v^.kind = VWindow) THEN
        f := v^.focus;
        IF f # NIL THEN cmd := DispatchKey(f, e) END
    ELSE
        cmd := WidgetKey(v, e)
    END;
    RETURN cmd
END DispatchKey;

PROCEDURE HandleEvent (e : Event) : INTEGER;
    VAR cmd : INTEGER; root : ViewPtr; handled : BOOLEAN;
BEGIN
    IF e.kind = evNone THEN RETURN cmNone END;
    IF modal = NIL THEN
        cmd := MenuHandle(e, handled);
        IF handled THEN RETURN cmd END
    END;
    root := modal;
    IF root = NIL THEN root := desk END;
    IF root = NIL THEN RETURN cmNone END;
    IF e.kind = evKey THEN
        IF e.key = kCtrlC THEN RETURN cmClose END;
        IF e.key = kTab THEN
            FocusNext(e.ctrl);
            RETURN cmNone
        END;
        cmd := DispatchKey(root, e)
    ELSE
        (* while a window is being dragged, keep sending motion/release to it
           even if the cursor has left the window (otherwise dragging up and
           sideways stops as soon as the pointer leaves the frame) *)
        IF dragWin # NIL THEN
            cmd := HandleWindow(dragWin, e)
        ELSE
            cmd := DispatchMouse(root, e)
        END
    END;
    RETURN cmd
END HandleEvent;

PROCEDURE Sender () : ViewPtr;
BEGIN RETURN lastSender END Sender;

(*========================================================================*)
(*  Modal message box                                                      *)
(*========================================================================*)

(*========================================================================*)
(*  Generic dialog builder                                                 *)
(*========================================================================*)

PROCEDURE NewDlgItem (k : VKind; x, y, w, h : INTEGER;
                      text : ARRAY OF CHAR) : ViewPtr;
    VAR v : ViewPtr;
BEGIN
    v := NewView(k, x, y, w, h);
    SetText(v, text);
    AddView(dlg, v);
    IF dlgCount < 32 THEN
        dlgItems[dlgCount] := v;
        dlgCount := dlgCount + 1
    END;
    RETURN v
END NewDlgItem;

PROCEDURE Dialog (title : ARRAY OF CHAR; w, h : INTEGER);
    VAR x, y : INTEGER;
BEGIN
    x := (cols - w) DIV 2;
    y := (rows - h) DIV 2;
    IF x < 0 THEN x := 0 END;
    IF y < 0 THEN y := 0 END;
    dlg := NewView(VWindow, x, y, w, h);
    SetText(dlg, title);
    dlgW := w; dlgWX := x; dlgWY := y;
    dlgX := x + 2; dlgY := y + 2; dlgInputX := x + 18;
    dlgBtnX := x + 2; dlgBtnY := y + h - 2;
    dlgCount := 0
END Dialog;

PROCEDURE DlgLabel (text : ARRAY OF CHAR);
    VAR v : ViewPtr;
BEGIN
    IF dlg = NIL THEN RETURN END;
    v := NewView(VText, dlgX, dlgY, dlgW - 4, 1);
    SetText(v, text);
    AddView(dlg, v);
    dlgY := dlgY + 1
END DlgLabel;

PROCEDURE DlgInput (label : ARRAY OF CHAR; initial : ARRAY OF CHAR) : INTEGER;
    VAR lv : ViewPtr; iw : INTEGER;
BEGIN
    IF dlg = NIL THEN RETURN -1 END;
    IF TextLen(label) > 0 THEN
        lv := NewView(VText, dlgX, dlgY, dlgInputX - dlgX - 1, 1);
        SetText(lv, label);
        AddView(dlg, lv)
    END;
    iw := dlgWX + dlgW - 2 - dlgInputX;
    IF iw < 8 THEN iw := 8 END;
    IF NewDlgItem(VInput, dlgInputX, dlgY, iw, 1, initial) = NIL THEN END;
    dlgY := dlgY + 2;
    RETURN dlgCount - 1
END DlgInput;

PROCEDURE DlgCheck (label : ARRAY OF CHAR; checked : BOOLEAN) : INTEGER;
    VAR v : ViewPtr; idx : INTEGER;
BEGIN
    IF dlg = NIL THEN RETURN -1 END;
    v := NewDlgItem(VCheck, dlgX, dlgY, dlgW - 4, 1, label);
    idx := dlgCount - 1;
    IF (v # NIL) AND checked THEN v^.flags := v^.flags + vfSelected END;
    dlgY := dlgY + 1;
    RETURN idx
END DlgCheck;

PROCEDURE DlgRadio (label : ARRAY OF CHAR; selected : BOOLEAN) : INTEGER;
    VAR v : ViewPtr; idx : INTEGER;
BEGIN
    IF dlg = NIL THEN RETURN -1 END;
    v := NewDlgItem(VRadio, dlgX, dlgY, dlgW - 4, 1, label);
    idx := dlgCount - 1;
    IF (v # NIL) AND selected THEN v^.flags := v^.flags + vfSelected END;
    dlgY := dlgY + 1;
    RETURN idx
END DlgRadio;

PROCEDURE DlgButton (text : ARRAY OF CHAR; tag : INTEGER);
    VAR v : ViewPtr; w : INTEGER;
BEGIN
    IF dlg = NIL THEN RETURN END;
    w := TextLen(text) + 4;
    v := NewView(VButton, dlgBtnX, dlgBtnY, w, 1);
    SetText(v, text);
    SetTag(v, tag);
    AddView(dlg, v);
    dlgBtnX := dlgBtnX + w + 2
END DlgButton;

PROCEDURE DlgTextAt (idx : INTEGER; VAR s : ARRAY OF CHAR);
BEGIN
    IF (idx >= 0) AND (idx < dlgCount) AND (dlgItems[idx]^.kind = VInput) THEN
        CopyText(s, dlgItems[idx]^.text)
    ELSE
        s[0] := 0C
    END
END DlgTextAt;

PROCEDURE DlgValue (idx : INTEGER) : INTEGER;
BEGIN
    IF (idx >= 0) AND (idx < dlgCount) AND
       ((dlgItems[idx]^.flags DIV vfSelected) MOD 2 = 1) THEN
        RETURN 1
    END;
    RETURN 0
END DlgValue;

PROCEDURE DlgRun () : INTEGER;
    VAR e : Event; cmd : INTEGER; done : BOOLEAN; f : ViewPtr;
BEGIN
    IF dlg = NIL THEN RETURN cmCancel END;
    AddView(desk, dlg);
    BringToFront(dlg);
    f := dlg^.first;
    WHILE (f # NIL) AND (NOT IsFocusable(f)) DO f := f^.next END;
    IF f # NIL THEN FocusView(f) END;
    modal := dlg;
    done := FALSE; cmd := cmNone;
    WHILE NOT done DO
        Finish;
        IF ReadEvent(e) THEN
            IF (e.kind = evKey) AND (e.key = kEsc) THEN
                cmd := cmCancel; done := TRUE
            ELSE
                cmd := HandleEvent(e);
                IF cmd # cmNone THEN done := TRUE END
            END
        END
    END;
    modal := NIL;
    DelView(dlg);
    dlg := NIL;
    RETURN cmd
END DlgRun;

PROCEDURE MessageBox (title : ARRAY OF CHAR; text : ARRAY OF CHAR;
                      kind : INTEGER) : INTEGER;
    VAR w, total, left : INTEGER; b1, b2 : ViewPtr;
BEGIN
    w := TextLen(text) + 6;
    IF w < 30 THEN w := 30 END;
    IF w > cols - 4 THEN w := cols - 4 END;
    Dialog(title, w, 7);
    DlgLabel(text);
    b1 := NIL; b2 := NIL;
    IF kind = mbOKCancel THEN
        DlgButton("OK", cmOK); b1 := dlg^.last;
        DlgButton("Cancel", cmCancel); b2 := dlg^.last
    ELSIF kind = mbYesNo THEN
        DlgButton("Yes", cmYes); b1 := dlg^.last;
        DlgButton("No", cmNo); b2 := dlg^.last
    ELSE
        DlgButton("OK", cmOK); b1 := dlg^.last
    END;
    IF b1 # NIL THEN
        IF b2 # NIL THEN total := b1^.rect.w + b2^.rect.w + 2
        ELSE total := b1^.rect.w END;
        left := dlgWX + (dlgW - total) DIV 2;
        MoveViewBy(b1, left - b1^.rect.x, 0);
        IF b2 # NIL THEN MoveViewBy(b2, left + b1^.rect.w + 2 - b2^.rect.x, 0) END
    END;
    RETURN DlgRun()
END MessageBox;

PROCEDURE Message (title : ARRAY OF CHAR; text : ARRAY OF CHAR);
    VAR discard : INTEGER;
BEGIN
    discard := MessageBox(title, text, mbOK)
END Message;

END tv.