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,
                    fopen, fgets, fputs, fputc, fclose;

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;
    virtual  : BOOLEAN;

    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 CommonInit;
    VAR i : INTEGER;
BEGIN
    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;
    dlg := NIL; dlgCount := 0;
    FOR i := 0 TO MAXVIEWS - 1 DO used[i] := FALSE END;
    desk := NIL;
    Clear(A(LightGray, Blue, FALSE));
    desk := NewView(VGroup, 0, 0, cols, rows)
END CommonInit;

PROCEDURE Init() : BOOLEAN;
    VAR lf, iff : CARDINAL;
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);
    oldWinch := signal(28, ADR(OnWinch));
    virtual := FALSE;
    CommonInit;
    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;
    Present;
    RETURN TRUE
END Init;

PROCEDURE InitVirtual (c, r : INTEGER) : BOOLEAN;
BEGIN
    IF (c < 10) OR (r < 3) THEN RETURN FALSE END;
    IF c > MAXCOLS THEN c := MAXCOLS END;
    IF r > MAXROWS THEN r := MAXROWS END;
    cols := c; rows := r;
    virtual := TRUE;
    CommonInit;
    RETURN TRUE
END InitVirtual;

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 CellAt (x, y : INTEGER; VAR cp, attr : CARDINAL);
BEGIN
    IF (x >= 0) AND (x < cols) AND (y >= 0) AND (y < rows) THEN
        cp := cells[Idx(x, y)].cp;
        attr := cells[Idx(x, y)].attr
    ELSE
        cp := 0; attr := 0
    END
END CellAt;

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; pool[i].ed := 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) OR
            (v^.kind = VEditor))
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;

(*========================================================================*)
(*  Editor                                                                 *)
(*========================================================================*)

PROCEDURE EdClrLine (VAR l : ARRAY OF CHAR);
    VAR i : INTEGER;
BEGIN
    FOR i := 0 TO EDMAXCOL - 1 DO l[i] := 0C END
END EdClrLine;

PROCEDURE EdEnsure (data : EditorDataPtr);
BEGIN
    IF data = NIL THEN RETURN END;
    IF data^.count <= 0 THEN
        data^.count := 1;
        EdClrLine(data^.line[0]);
        data^.len[0] := 0;
        data^.cx := 0; data^.cy := 0
    END;
    IF data^.cy < 0 THEN data^.cy := 0 END;
    IF data^.cy >= data^.count THEN data^.cy := data^.count - 1 END;
    IF data^.cx < 0 THEN data^.cx := 0 END;
    IF data^.cx > data^.len[data^.cy] THEN data^.cx := data^.len[data^.cy] END
END EdEnsure;

PROCEDURE EdInsertChar (data : EditorDataPtr; cp : CARDINAL);
    VAR ln, i : INTEGER;
BEGIN
    EdEnsure(data);
    IF cp >= 256 THEN RETURN END;
    ln := data^.cy;
    IF data^.len[ln] >= EDMAXCOL - 1 THEN RETURN END;
    IF data^.ins OR (data^.cx >= data^.len[ln]) THEN
        i := data^.len[ln];
        WHILE i > data^.cx DO
            data^.line[ln][i] := data^.line[ln][i - 1];
            i := i - 1
        END;
        data^.line[ln][data^.cx] := CHR(cp);
        data^.len[ln] := data^.len[ln] + 1
    ELSE
        data^.line[ln][data^.cx] := CHR(cp)
    END;
    data^.cx := data^.cx + 1;
    data^.dirty := TRUE
END EdInsertChar;

PROCEDURE EdNewLine (data : EditorDataPtr);
    VAR ln, i, k, tail : INTEGER;
BEGIN
    EdEnsure(data);
    IF data^.count >= EDMAXLINES THEN RETURN END;
    ln := data^.cy;
    i := data^.count;
    WHILE i > ln + 1 DO
        FOR k := 0 TO EDMAXCOL - 1 DO data^.line[i][k] := data^.line[i - 1][k] END;
        data^.len[i] := data^.len[i - 1];
        i := i - 1
    END;
    tail := data^.len[ln] - data^.cx;
    FOR k := 0 TO tail - 1 DO data^.line[ln + 1][k] := data^.line[ln][data^.cx + k] END;
    data^.line[ln + 1][tail] := 0C;
    data^.len[ln + 1] := tail;
    FOR k := data^.cx TO EDMAXCOL - 1 DO data^.line[ln][k] := 0C END;
    data^.len[ln] := data^.cx;
    data^.count := data^.count + 1;
    data^.cy := data^.cy + 1;
    data^.cx := 0;
    data^.dirty := TRUE
END EdNewLine;

PROCEDURE EdBackspace (data : EditorDataPtr);
    VAR ln, i, plen, k : INTEGER;
BEGIN
    EdEnsure(data);
    ln := data^.cy;
    IF data^.cx > 0 THEN
        i := data^.cx - 1;
        WHILE i < data^.len[ln] - 1 DO
            data^.line[ln][i] := data^.line[ln][i + 1];
            i := i + 1
        END;
        data^.len[ln] := data^.len[ln] - 1;
        data^.line[ln][data^.len[ln]] := 0C;
        data^.cx := data^.cx - 1;
        data^.dirty := TRUE
    ELSIF ln > 0 THEN
        plen := data^.len[ln - 1];
        IF plen + data^.len[ln] < EDMAXCOL - 1 THEN
            FOR i := 0 TO data^.len[ln] - 1 DO
                data^.line[ln - 1][plen + i] := data^.line[ln][i]
            END;
            data^.len[ln - 1] := plen + data^.len[ln];
            data^.line[ln - 1][data^.len[ln - 1]] := 0C;
            FOR i := ln TO data^.count - 2 DO
                FOR k := 0 TO EDMAXCOL - 1 DO
                    data^.line[i][k] := data^.line[i + 1][k]
                END;
                data^.len[i] := data^.len[i + 1]
            END;
            data^.count := data^.count - 1;
            data^.cy := ln - 1;
            data^.cx := data^.len[data^.cy];
            data^.dirty := TRUE
        END
    END
END EdBackspace;

PROCEDURE EdDelete (data : EditorDataPtr);
    VAR ln, i, k : INTEGER;
BEGIN
    EdEnsure(data);
    ln := data^.cy;
    IF data^.cx < data^.len[ln] THEN
        i := data^.cx;
        WHILE i < data^.len[ln] - 1 DO
            data^.line[ln][i] := data^.line[ln][i + 1];
            i := i + 1
        END;
        data^.len[ln] := data^.len[ln] - 1;
        data^.line[ln][data^.len[ln]] := 0C;
        data^.dirty := TRUE
    ELSIF ln < data^.count - 1 THEN
        FOR i := 0 TO data^.len[ln + 1] - 1 DO
            IF data^.len[ln] < EDMAXCOL - 1 THEN
                data^.line[ln][data^.len[ln]] := data^.line[ln + 1][i];
                data^.len[ln] := data^.len[ln] + 1
            END
        END;
        data^.line[ln][data^.len[ln]] := 0C;
        FOR i := ln + 1 TO data^.count - 2 DO
            FOR k := 0 TO EDMAXCOL - 1 DO
                data^.line[i][k] := data^.line[i + 1][k]
            END;
            data^.len[i] := data^.len[i + 1]
        END;
        data^.count := data^.count - 1;
        data^.cx := data^.len[ln];
        data^.dirty := TRUE
    END
END EdDelete;

PROCEDURE EdMove (data : EditorDataPtr; v : ViewPtr; key : INTEGER);
    VAR step : INTEGER;
BEGIN
    EdEnsure(data);
    step := v^.rect.h - 3;
    IF step < 1 THEN step := 1 END;
    IF key = kLeft THEN
        IF data^.cx > 0 THEN data^.cx := data^.cx - 1
        ELSIF data^.cy > 0 THEN data^.cy := data^.cy - 1; data^.cx := data^.len[data^.cy] END
    ELSIF key = kRight THEN
        IF data^.cx < data^.len[data^.cy] THEN data^.cx := data^.cx + 1
        ELSIF data^.cy < data^.count - 1 THEN data^.cy := data^.cy + 1; data^.cx := 0 END
    ELSIF key = kUp THEN
        IF data^.cy > 0 THEN data^.cy := data^.cy - 1 END;
        IF data^.cx > data^.len[data^.cy] THEN data^.cx := data^.len[data^.cy] END
    ELSIF key = kDown THEN
        IF data^.cy < data^.count - 1 THEN data^.cy := data^.cy + 1 END;
        IF data^.cx > data^.len[data^.cy] THEN data^.cx := data^.len[data^.cy] END
    ELSIF key = kHome THEN data^.cx := 0
    ELSIF key = kEnd THEN data^.cx := data^.len[data^.cy]
    ELSIF key = kPgUp THEN
        data^.cy := data^.cy - step;
        IF data^.cy < 0 THEN data^.cy := 0 END;
        IF data^.cx > data^.len[data^.cy] THEN data^.cx := data^.len[data^.cy] END
    ELSIF key = kPgDn THEN
        data^.cy := data^.cy + step;
        IF data^.cy > data^.count - 1 THEN data^.cy := data^.count - 1 END;
        IF data^.cx > data^.len[data^.cy] THEN data^.cx := data^.len[data^.cy] END
    END
END EdMove;

(* --- syntax highlighting + keyword upcasing ---------------------------- *)

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

PROCEDURE IsIdentChar (c : CHAR) : BOOLEAN;
BEGIN
    RETURN ((c >= 'A') AND (c <= 'Z')) OR ((c >= 'a') AND (c <= 'z')) OR
           ((c >= '0') AND (c <= '9')) OR (c = '_')
END IsIdentChar;

PROCEDURE UpcaseCopy (VAR dest : ARRAY OF CHAR; s : ARRAY OF CHAR);
    VAR i : INTEGER; c : CHAR;
BEGIN
    i := 0;
    WHILE (i <= VAL(INTEGER, HIGH(s))) AND (i < VAL(INTEGER, HIGH(dest))) AND (s[i] # 0C) DO
        c := s[i];
        IF (c >= 'a') AND (c <= 'z') THEN c := CHR(ORD(c) - 32) END;
        dest[i] := c;
        i := i + 1
    END;
    dest[i] := 0C
END UpcaseCopy;

PROCEDURE IsKeywordM2 (w : ARRAY OF CHAR) : BOOLEAN;
BEGIN
    RETURN Eq(w,"AND") OR Eq(w,"ARRAY") OR Eq(w,"BEGIN") OR Eq(w,"BY") OR
           Eq(w,"CASE") OR Eq(w,"CONST") OR Eq(w,"DEFINITION") OR Eq(w,"DIV") OR
           Eq(w,"DO") OR Eq(w,"ELSE") OR Eq(w,"ELSIF") OR Eq(w,"END") OR
           Eq(w,"EXIT") OR Eq(w,"EXPORT") OR Eq(w,"FOR") OR Eq(w,"FROM") OR
           Eq(w,"IF") OR Eq(w,"IMPLEMENTATION") OR Eq(w,"IMPORT") OR Eq(w,"IN") OR
           Eq(w,"LOOP") OR Eq(w,"MOD") OR Eq(w,"MODULE") OR Eq(w,"NOT") OR
           Eq(w,"OF") OR Eq(w,"OR") OR Eq(w,"POINTER") OR Eq(w,"PROCEDURE") OR
           Eq(w,"QUALIFIED") OR Eq(w,"RECORD") OR Eq(w,"REPEAT") OR Eq(w,"RETURN") OR
           Eq(w,"SET") OR Eq(w,"THEN") OR Eq(w,"TO") OR Eq(w,"TYPE") OR
           Eq(w,"UNTIL") OR Eq(w,"VAR") OR Eq(w,"WHILE") OR Eq(w,"WITH")
END IsKeywordM2;

PROCEDURE IsKeywordOberon (w : ARRAY OF CHAR) : BOOLEAN;
BEGIN
    RETURN Eq(w,"ARRAY") OR Eq(w,"BEGIN") OR Eq(w,"BY") OR Eq(w,"CASE") OR
           Eq(w,"CONST") OR Eq(w,"DIV") OR Eq(w,"DO") OR Eq(w,"ELSE") OR
           Eq(w,"ELSIF") OR Eq(w,"END") OR Eq(w,"FALSE") OR Eq(w,"FOR") OR
           Eq(w,"IF") OR Eq(w,"IMPORT") OR Eq(w,"IN") OR Eq(w,"IS") OR
           Eq(w,"MOD") OR Eq(w,"MODULE") OR Eq(w,"NIL") OR Eq(w,"OF") OR
           Eq(w,"OR") OR Eq(w,"POINTER") OR Eq(w,"PROCEDURE") OR Eq(w,"RECORD") OR
           Eq(w,"REPEAT") OR Eq(w,"RETURN") OR Eq(w,"THEN") OR Eq(w,"TO") OR
           Eq(w,"TRUE") OR Eq(w,"TYPE") OR Eq(w,"UNTIL") OR Eq(w,"VAR") OR
           Eq(w,"WHILE") OR Eq(w,"WITH")
END IsKeywordOberon;

PROCEDURE IsKeywordPascal (w : ARRAY OF CHAR) : BOOLEAN;
BEGIN
    RETURN Eq(w,"AND") OR Eq(w,"ARRAY") OR Eq(w,"BEGIN") OR Eq(w,"CASE") OR
           Eq(w,"CONST") OR Eq(w,"DIV") OR Eq(w,"DO") OR Eq(w,"DOWNTO") OR
           Eq(w,"ELSE") OR Eq(w,"END") OR Eq(w,"FILE") OR Eq(w,"FOR") OR
           Eq(w,"FUNCTION") OR Eq(w,"GOTO") OR Eq(w,"IF") OR Eq(w,"IN") OR
           Eq(w,"LABEL") OR Eq(w,"MOD") OR Eq(w,"NIL") OR Eq(w,"NOT") OR
           Eq(w,"OF") OR Eq(w,"OR") OR Eq(w,"PACKED") OR Eq(w,"PROCEDURE") OR
           Eq(w,"PROGRAM") OR Eq(w,"RECORD") OR Eq(w,"REPEAT") OR Eq(w,"SET") OR
           Eq(w,"THEN") OR Eq(w,"TO") OR Eq(w,"TYPE") OR Eq(w,"UNTIL") OR
           Eq(w,"VAR") OR Eq(w,"WHILE") OR Eq(w,"WITH")
END IsKeywordPascal;

PROCEDURE IsKeywordLang (lang : INTEGER; w : ARRAY OF CHAR) : BOOLEAN;
BEGIN
    IF lang = langModula2 THEN RETURN IsKeywordM2(w) END;
    IF lang = langOberon THEN RETURN IsKeywordOberon(w) END;
    IF lang = langPascal THEN RETURN IsKeywordPascal(w) END;
    RETURN FALSE
END IsKeywordLang;

PROCEDURE HiPut (v : ViewPtr; c : INTEGER; ch : CHAR; attr : Attr;
                 x0, y0, w : INTEGER; draw : BOOLEAN);
BEGIN
    IF draw AND (c >= v^.ed^.left) AND (c - v^.ed^.left < w) THEN
        DrawCh(x0 + (c - v^.ed^.left), y0, VAL(CARDINAL, ORD(ch)), attr)
    END
END HiPut;

PROCEDURE DrawLineHi (v : ViewPtr; ln : INTEGER; x0, y0, w : INTEGER;
                      draw : BOOLEAN; VAR state : INTEGER);
    VAR ed : EditorDataPtr; lang, i, j, n : INTEGER; ch, q : CHAR; done : BOOLEAN;
        kw, str, com, num : Attr; word : ARRAY [0..63] OF CHAR;
BEGIN
    ed := v^.ed;
    lang := ed^.lang;
    kw  := A(White, Cyan, FALSE);
    str := A(Red, Cyan, FALSE);
    com := A(DarkGray, Cyan, FALSE);
    num := A(Red, Cyan, FALSE);
    i := 0;
    WHILE i < ed^.len[ln] DO
        ch := ed^.line[ln][i];
        IF state > 0 THEN
            (* inside a (* ... *) comment (nestable for M2/Oberon) *)
            IF (ch = '(') AND (i + 1 < ed^.len[ln]) AND
               (ed^.line[ln][i + 1] = '*') THEN
                HiPut(v, i, ch, com, x0, y0, w, draw);
                HiPut(v, i + 1, '*', com, x0, y0, w, draw);
                state := state + 1; i := i + 2
            ELSIF (ch = '*') AND (i + 1 < ed^.len[ln]) AND
                  (ed^.line[ln][i + 1] = ')') THEN
                HiPut(v, i, ch, com, x0, y0, w, draw);
                HiPut(v, i + 1, ')', com, x0, y0, w, draw);
                state := state - 1; i := i + 2
            ELSE
                HiPut(v, i, ch, com, x0, y0, w, draw); i := i + 1
            END
        ELSIF state < 0 THEN
            (* inside a Pascal { ... } comment *)
            HiPut(v, i, ch, com, x0, y0, w, draw);
            IF ch = '}' THEN state := 0 END;
            i := i + 1
        ELSIF (ch = '(') AND (i + 1 < ed^.len[ln]) AND
              (ed^.line[ln][i + 1] = '*') THEN
            HiPut(v, i, '(', com, x0, y0, w, draw);
            HiPut(v, i + 1, '*', com, x0, y0, w, draw);
            state := 1; i := i + 2
        ELSIF (lang = langPascal) AND (ch = '{') THEN
            HiPut(v, i, ch, com, x0, y0, w, draw);
            state := -1; i := i + 1
        ELSIF (ch = '/') AND (i + 1 < ed^.len[ln]) AND
              (ed^.line[ln][i + 1] = '/') AND (lang # langNone) THEN
            WHILE i < ed^.len[ln] DO
                HiPut(v, i, ed^.line[ln][i], com, x0, y0, w, draw); i := i + 1
            END
        ELSIF (ch = CHR(39)) OR (ch = CHR(34)) THEN
            q := ch;
            HiPut(v, i, ch, str, x0, y0, w, draw); i := i + 1;
            done := FALSE;
            WHILE (i < ed^.len[ln]) AND (NOT done) DO
                HiPut(v, i, ed^.line[ln][i], str, x0, y0, w, draw);
                IF ed^.line[ln][i] = q THEN
                    IF (i + 1 < ed^.len[ln]) AND (ed^.line[ln][i + 1] = q) THEN
                        i := i + 1;
                        HiPut(v, i, q, str, x0, y0, w, draw)
                    ELSE
                        done := TRUE
                    END
                END;
                i := i + 1
            END
        ELSIF (ch >= '0') AND (ch <= '9') THEN
            WHILE (i < ed^.len[ln]) AND (ed^.line[ln][i] >= '0') AND
                  (ed^.line[ln][i] <= '9') DO
                HiPut(v, i, ed^.line[ln][i], num, x0, y0, w, draw); i := i + 1
            END
        ELSIF IsIdentChar(ch) THEN
            n := 0;
            WHILE (i < ed^.len[ln]) AND IsIdentChar(ed^.line[ln][i]) AND (n < 63) DO
                word[n] := ed^.line[ln][i];
                n := n + 1; i := i + 1
            END;
            word[n] := 0C;
            UpcaseCopy(word, word);
            FOR j := i - n TO i - 1 DO
                IF IsKeywordLang(lang, word) THEN
                    HiPut(v, j, ed^.line[ln][j], kw, x0, y0, w, draw)
                ELSE
                    HiPut(v, j, ed^.line[ln][j], A(Black, Cyan, FALSE), x0, y0, w, draw)
                END
            END
        ELSE
            HiPut(v, i, ch, A(Black, Cyan, FALSE), x0, y0, w, draw);
            i := i + 1
        END
    END
END DrawLineHi;

PROCEDURE EdUpcaseWord (data : EditorDataPtr);
    VAR ln, i, n, k : INTEGER; w, up : ARRAY [0..63] OF CHAR;
BEGIN
    IF (data = NIL) OR ((data^.lang # langModula2) AND (data^.lang # langOberon)) THEN
        RETURN
    END;
    EdEnsure(data);
    ln := data^.cy;
    i := data^.cx;
    WHILE (i > 0) AND IsIdentChar(data^.line[ln][i - 1]) DO i := i - 1 END;
    n := data^.cx - i;
    IF (n <= 0) OR (n > 63) THEN RETURN END;
    FOR k := 0 TO n - 1 DO w[k] := data^.line[ln][i + k] END;
    w[n] := 0C;
    UpcaseCopy(up, w);
    IF IsKeywordLang(data^.lang, up) AND (NOT Eq(w, up)) THEN
        FOR k := 0 TO n - 1 DO data^.line[ln][i + k] := up[k] END;
        data^.dirty := TRUE
    END
END EdUpcaseWord;

PROCEDURE DrawEditor (v : ViewPtr);
    VAR x0, y0, w, h, vis, r, ln, c, hstate, l : INTEGER;
        ed : EditorDataPtr; s, t : ARRAY [0..95] OF CHAR;
BEGIN
    DrawBox(v^.rect, SingleFrame, A(White, Cyan, FALSE));
    x0 := v^.rect.x + 1; y0 := v^.rect.y + 1;
    w := v^.rect.w - 2; h := v^.rect.h - 2;
    IF (w <= 0) OR (h <= 0) THEN RETURN END;
    vis := h - 1;
    IF vis < 1 THEN vis := h END;
    ed := v^.ed;
    IF ed = NIL THEN RETURN END;
    EdEnsure(ed);
    IF ed^.cy < ed^.top THEN ed^.top := ed^.cy END;
    IF ed^.cy >= ed^.top + vis THEN ed^.top := ed^.cy - vis + 1 END;
    IF ed^.cx < ed^.left THEN ed^.left := ed^.cx END;
    IF ed^.cx >= ed^.left + w THEN ed^.left := ed^.cx - w + 1 END;
    IF ed^.top < 0 THEN ed^.top := 0 END;
    IF ed^.left < 0 THEN ed^.left := 0 END;
    hstate := 0;
    IF ed^.lang # langNone THEN
        FOR l := 0 TO ed^.top - 1 DO
            IF l < ed^.count THEN DrawLineHi(v, l, x0, y0, w, FALSE, hstate) END
        END
    END;
    FOR r := 0 TO vis - 1 DO
        Fill(x0, y0 + r, w, 1, VAL(CARDINAL, ORD(' ')), A(Black, Cyan, FALSE));
        ln := ed^.top + r;
        IF ln < ed^.count THEN
            IF ed^.lang = langNone THEN
                c := 0;
                WHILE (c < w) AND (ed^.left + c < ed^.len[ln]) DO
                    DrawCh(x0 + c, y0 + r,
                           VAL(CARDINAL, ORD(ed^.line[ln][ed^.left + c])),
                           A(Black, Cyan, FALSE));
                    c := c + 1
                END
            ELSE
                DrawLineHi(v, ln, x0, y0 + r, w, TRUE, hstate)
            END
        END
    END;
    Fill(x0, y0 + vis, w, 1, VAL(CARDINAL, ORD(' ')), A(Black, LightGray, FALSE));
    CopyText(s, " Ln ");
    IntToText(t, ed^.cy + 1, 0); AppendText(s, t);
    AppendText(s, " Col ");
    IntToText(t, ed^.cx + 1, 0); AppendText(s, t);
    IF ed^.ins THEN AppendText(s, "  Insert") ELSE AppendText(s, "  Overwrite") END;
    IF ed^.dirty THEN AppendText(s, "  Modified") END;
    DrawText(x0, y0 + vis, s, A(Black, LightGray, FALSE));
    IF IsFocused(v) THEN
        SetCursor(x0 + (ed^.cx - ed^.left), y0 + (ed^.cy - ed^.top))
    END
END DrawEditor;

PROCEDURE EditorAttach (v : ViewPtr; data : EditorDataPtr);
BEGIN
    IF v # NIL THEN v^.ed := data END
END EditorAttach;

PROCEDURE EditorInit (data : EditorDataPtr);
BEGIN
    IF data # NIL THEN
        data^.count := 1;
        EdClrLine(data^.line[0]);
        data^.len[0] := 0;
        data^.cx := 0; data^.cy := 0; data^.top := 0; data^.left := 0;
        data^.ins := TRUE; data^.dirty := FALSE; data^.lang := langNone
    END
END EditorInit;

PROCEDURE EditorAddLine (data : EditorDataPtr; s : ARRAY OF CHAR);
    VAR i, n : INTEGER;
BEGIN
    IF data = NIL THEN RETURN END;
    IF data^.count >= EDMAXLINES THEN RETURN END;
    IF (data^.count = 1) AND (data^.len[0] = 0) THEN
        i := 0; data^.count := 0
    ELSE
        i := data^.count
    END;
    n := TextLen(s);
    IF n > EDMAXCOL - 1 THEN n := EDMAXCOL - 1 END;
    CopyText(data^.line[i], s);
    data^.len[i] := n;
    data^.count := data^.count + 1
END EditorAddLine;

PROCEDURE EditorGetLine (data : EditorDataPtr; i : INTEGER; VAR s : ARRAY OF CHAR);
BEGIN
    IF (data # NIL) AND (i >= 0) AND (i < data^.count) THEN
        CopyText(s, data^.line[i])
    ELSE
        s[0] := 0C
    END
END EditorGetLine;

PROCEDURE EditorLoad (data : EditorDataPtr; path : ARRAY OF CHAR) : BOOLEAN;
    VAR f : ADDRESS; buf : ARRAY [0..EDMAXCOL] OF CHAR; n : INTEGER;
        discard : INTEGER;
BEGIN
    IF data = NIL THEN RETURN FALSE END;
    f := fopen(path, "r");
    IF f = NIL THEN RETURN FALSE END;
    data^.count := 0;
    WHILE fgets(ADR(buf), EDMAXCOL, f) # NIL DO
        n := TextLen(buf);
        WHILE (n > 0) AND ((buf[n - 1] = CHR(10)) OR (buf[n - 1] = CHR(13))) DO
            buf[n - 1] := 0C;
            n := n - 1
        END;
        EditorAddLine(data, buf)
    END;
    discard := fclose(f);
    IF data^.count = 0 THEN
        data^.count := 1;
        EdClrLine(data^.line[0]);
        data^.len[0] := 0
    END;
    data^.cx := 0; data^.cy := 0; data^.top := 0; data^.left := 0;
    data^.dirty := FALSE;
    RETURN TRUE
END EditorLoad;

PROCEDURE EditorSave (data : EditorDataPtr; path : ARRAY OF CHAR) : BOOLEAN;
    VAR f : ADDRESS; i : INTEGER; d1, d2 : INTEGER;
BEGIN
    IF data = NIL THEN RETURN FALSE END;
    f := fopen(path, "w");
    IF f = NIL THEN RETURN FALSE END;
    FOR i := 0 TO data^.count - 1 DO
        d1 := fputs(data^.line[i], f);
        d2 := fputc(10, f)
    END;
    d1 := fclose(f);
    data^.dirty := FALSE;
    RETURN TRUE
END EditorSave;

PROCEDURE EditorDirty (data : EditorDataPtr) : BOOLEAN;
BEGIN
    IF data = NIL THEN RETURN FALSE END;
    RETURN data^.dirty
END EditorDirty;

PROCEDURE EditorSetLanguage (data : EditorDataPtr; lang : INTEGER);
BEGIN
    IF data # NIL THEN data^.lang := lang END
END EditorSetLanguage;

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)
        |
        VEditor : DrawEditor(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
    ELSIF v^.kind = VEditor THEN
        IF v^.ed # NIL THEN
            IF e.key = kChar THEN
                IF NOT IsIdentChar(CHR(e.ch)) THEN EdUpcaseWord(v^.ed) END;
                EdInsertChar(v^.ed, e.ch)
            ELSIF e.key = kSpace THEN
                EdUpcaseWord(v^.ed);
                EdInsertChar(v^.ed, VAL(CARDINAL, ORD(' ')))
            ELSIF e.key = kEnter THEN
                EdUpcaseWord(v^.ed); EdNewLine(v^.ed)
            ELSIF e.key = kBack THEN EdBackspace(v^.ed)
            ELSIF e.key = kDel THEN EdDelete(v^.ed)
            ELSIF e.key = kIns THEN v^.ed^.ins := NOT v^.ed^.ins
            ELSIF e.key = kTab THEN
                EdUpcaseWord(v^.ed);
                EdInsertChar(v^.ed, VAL(CARDINAL, ORD(' ')));
                WHILE (v^.ed^.cx MOD 4) # 0 DO
                    EdInsertChar(v^.ed, VAL(CARDINAL, ORD(' ')))
                END
            ELSE EdMove(v^.ed, v, e.key)
            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, ln, col : 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
    ELSIF v^.kind = VEditor THEN
        IF v^.ed # NIL THEN
            IF e.mwheel # 0 THEN
                v^.ed^.top := v^.ed^.top + e.mwheel * 3;
                IF v^.ed^.top < 0 THEN v^.ed^.top := 0 END
            ELSIF e.mpressed THEN
                ln := v^.ed^.top + (e.my - (v^.rect.y + 1));
                IF (ln >= 0) AND (ln < v^.ed^.count) THEN
                    v^.ed^.cy := ln;
                    col := e.mx - (v^.rect.x + 1) + v^.ed^.left;
                    IF col < 0 THEN col := 0 END;
                    IF col > v^.ed^.len[ln] THEN col := v^.ed^.len[ln] END;
                    v^.ed^.cx := col
                END
            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.