|
|
@@ -0,0 +1,1360 @@
|
|
|
+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.
|
