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;

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 *)

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

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;

(*========================================================================*)
(*  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 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;
    (* 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;
BEGIN
    GetWinSize(r, c);
    IF (r # rows) OR (c # cols) 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;

PROCEDURE DrawTree;
BEGIN
    Clear(A(LightGray, Blue, FALSE));
    HideCursor;
    clipN := 0;
    IF desk # NIL THEN DrawView(desk) END
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 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 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 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;
BEGIN
    IF e.kind = evNone THEN RETURN cmNone 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                                                      *)
(*========================================================================*)

PROCEDURE Message (title : ARRAY OF CHAR; text : ARRAY OF CHAR);
    VAR w, t, b : ViewPtr; e : Event;
        tw, ww, wx, wy : INTEGER; cmd : INTEGER; done : BOOLEAN;
BEGIN
    tw := TextLen(text);
    ww := tw + 6;
    IF ww < 24 THEN ww := 24 END;
    IF ww > cols - 4 THEN ww := cols - 4 END;
    wx := (cols - ww) DIV 2; wy := (rows - 7) DIV 2;
    w := NewView(VWindow, wx, wy, ww, 7);
    SetText(w, title);
    t := NewView(VText, wx + 2, wy + 2, ww - 4, 1);
    SetText(t, text);
    AddView(w, t);
    b := NewView(VButton, wx + (ww - 8) DIV 2, wy + 4, 8, 1);
    SetText(b, "OK");
    SetTag(b, cmOK);
    AddView(w, b);
    AddView(desk, w);
    BringToFront(w);
    FocusView(b);
    modal := w;
    done := FALSE;
    WHILE NOT done DO
        Finish;
        cmd := cmNone;
        IF ReadEvent(e) THEN
            IF e.kind = evKey THEN
                IF e.key = kEsc THEN cmd := cmOK END
            END;
            IF cmd = cmNone THEN cmd := HandleEvent(e) END
        END;
        IF (cmd = cmOK) OR (cmd = cmClose) THEN done := TRUE END
    END;
    modal := NIL;
    DelView(w)
END Message;

END tv.