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 = 16; (* 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; resizeWin : ViewPtr; resOX, resOY : INTEGER; 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; resizeWin := 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 WindowResize (w : ViewPtr; ww, hh : INTEGER); VAR c : ViewPtr; dw, dh, minw, minh : INTEGER; BEGIN IF w = NIL THEN RETURN END; minw := 12; minh := 4; IF ww < minw THEN ww := minw END; IF hh < minh THEN hh := minh END; IF w^.rect.x + ww > cols THEN ww := cols - w^.rect.x END; IF w^.rect.y + hh > rows THEN hh := rows - w^.rect.y END; IF ww < minw THEN ww := minw END; IF hh < minh THEN hh := minh END; dw := ww - w^.rect.w; dh := hh - w^.rect.h; w^.rect.w := ww; w^.rect.h := hh; c := w^.first; WHILE c # NIL DO IF (c^.flags DIV vfExpand) MOD 2 = 1 THEN c^.rect.w := c^.rect.w + dw; c^.rect.h := c^.rect.h + dh END; c := c^.next END END WindowResize; PROCEDURE InResizeHandle (v : ViewPtr; mx, my : INTEGER) : BOOLEAN; BEGIN RETURN (my >= v^.rect.y + v^.rect.h - 2) AND (my < v^.rect.y + v^.rect.h) AND (mx >= v^.rect.x + v^.rect.w - 3) AND (mx < v^.rect.x + v^.rect.w) END InResizeHandle; 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)); (* resize handle in the bottom-right corner *) DrawCh(v^.rect.x + v^.rect.w - 1, v^.rect.y + v^.rect.h - 1, 25A0H, A(White, Blue, 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 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 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 IsOpenKw (w : ARRAY OF CHAR) : BOOLEAN; BEGIN RETURN Eq(w,"BEGIN") OR Eq(w,"THEN") OR Eq(w,"ELSE") OR Eq(w,"ELSIF") OR Eq(w,"DO") OR Eq(w,"LOOP") OR Eq(w,"REPEAT") OR Eq(w,"RECORD") OR Eq(w,"CASE") OR Eq(w,"OF") END IsOpenKw; PROCEDURE IsCloseKw (w : ARRAY OF CHAR) : BOOLEAN; BEGIN RETURN Eq(w,"END") OR Eq(w,"UNTIL") OR Eq(w,"ELSE") OR Eq(w,"ELSIF") END IsCloseKw; PROCEDURE EdIndentSpaces (data : EditorDataPtr; ln : INTEGER) : INTEGER; VAR i : INTEGER; BEGIN i := 0; WHILE (i < data^.len[ln]) AND (data^.line[ln][i] = ' ') DO i := i + 1 END; RETURN i END EdIndentSpaces; PROCEDURE EdRtrim (data : EditorDataPtr; ln, upto : INTEGER) : INTEGER; BEGIN WHILE (upto > 0) AND (data^.line[ln][upto - 1] = ' ') DO upto := upto - 1 END; RETURN upto END EdRtrim; PROCEDURE EdLastWordOpen (data : EditorDataPtr; ln : INTEGER) : BOOLEAN; VAR n, i : INTEGER; w : ARRAY [0..63] OF CHAR; BEGIN IF data^.lang = langNone THEN RETURN FALSE END; n := EdRtrim(data, ln, data^.len[ln]); IF n = 0 THEN RETURN FALSE END; i := n; WHILE (i > 0) AND IsIdentChar(data^.line[ln][i - 1]) DO i := i - 1 END; n := 0; WHILE (i < data^.len[ln]) AND IsIdentChar(data^.line[ln][i]) AND (n < 63) DO w[n] := data^.line[ln][i]; n := n + 1; i := i + 1 END; w[n] := 0C; UpcaseCopy(w, w); RETURN IsOpenKw(w) END EdLastWordOpen; PROCEDURE EdDedent (data : EditorDataPtr); VAR lead, n, i : INTEGER; BEGIN IF (data = NIL) OR (data^.lang = langNone) OR (data^.indent <= 0) THEN RETURN END; lead := EdIndentSpaces(data, data^.cy); IF lead = 0 THEN RETURN END; n := data^.indent; IF n > lead THEN n := lead END; FOR i := 0 TO data^.len[data^.cy] - n - 1 DO data^.line[data^.cy][i] := data^.line[data^.cy][i + n] END; data^.len[data^.cy] := data^.len[data^.cy] - n; data^.line[data^.cy][data^.len[data^.cy]] := 0C; data^.cx := data^.cx - n; IF data^.cx < 0 THEN data^.cx := 0 END; data^.dirty := TRUE END EdDedent; PROCEDURE EdNewLine (data : EditorDataPtr); VAR ln, i, k, tail, ind : 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; (* auto-indent: copy the leading spaces, plus one level after an open keyword (BEGIN/THEN/DO/... ) *) ind := EdIndentSpaces(data, ln); IF EdLastWordOpen(data, ln) AND (data^.indent > 0) THEN ind := ind + data^.indent END; IF (ind > 0) AND (data^.len[ln + 1] + ind < EDMAXCOL - 1) THEN FOR k := data^.len[ln + 1] - 1 TO 0 BY -1 DO data^.line[ln + 1][k + ind] := data^.line[ln + 1][k] END; FOR k := 0 TO ind - 1 DO data^.line[ln + 1][k] := ' ' END; data^.len[ln + 1] := data^.len[ln + 1] + ind END; data^.count := data^.count + 1; data^.cy := data^.cy + 1; data^.cx := ind; 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 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; (* smart dedent: a close keyword at the start of the line moves it left *) IF IsCloseKw(up) AND (i = EdIndentSpaces(data, ln)) THEN EdDedent(data) 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; data^.indent := 2 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; IF data^.indent <= 0 THEN data^.indent := 2 END; 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 EditorSetIndent (data : EditorDataPtr; n : INTEGER); BEGIN IF data # NIL THEN data^.indent := n END END EditorSetIndent; 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 (* resize handle (bottom-right) ? *) IF InResizeHandle(v, e.mx, e.my) THEN resizeWin := v; resOX := e.mx - (v^.rect.x + v^.rect.w - 1); resOY := e.my - (v^.rect.y + v^.rect.h - 1); RETURN cmNone END; (* 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; resizeWin := NIL ELSIF (e.kind = evMouse) AND (e.mbtn > 0) AND (NOT e.mpressed) AND (NOT e.mreleased) THEN IF resizeWin # NIL THEN WindowResize(resizeWin, e.mx - resOX - resizeWin^.rect.x + 1, e.my - resOY - resizeWin^.rect.y + 1) ELSIF 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) ELSIF resizeWin # NIL THEN cmd := HandleWindow(resizeWin, 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.