1: \ ansi.fs
2: \
3: \ ANSI Terminal words for gforth
4: \
5: \ Copyright (c) 1999--2004 Krishna Myneni
6: \ Creative Consulting for Research and Education
7: \
8: \ This software is provided under the terms of the GNU
9: \ General Public License.
10: \
11: \ ====> Requires that the file strings.fs be included first
12: \
13: \ Revisions:
14: \ 06-10-1999
15: \ 10-11-1999 force cursor to 0 0 on page; define at-xy KM
16: \ 01-23-2000 replaced char with [char] for ANS Forth compatibility KM
17: \ 08-29-2002 use 0,0 as top left for AT-XY in accord with ANS Forth KM
18: \ 09-08-2004 added console query words provided by Charley Shattuck:
19: \ AT-XY? ROWS COLS
20: \ Note that ROWS and COLS are also provided in gforth and PFE
21: \ 09-10-2004 added scrolling words -- CS
22: \ 09-17-2004 ported from kForth KM
23:
24: \ Colors
25:
26: 0 constant BLACK
27: 1 constant RED
28: 2 constant GREEN
29: 3 constant YELLOW
30: 4 constant BLUE
31: 5 constant MAGENTA
32: 6 constant CYAN
33: 7 constant WHITE
34:
35:
36: variable orig_base
37:
38: : save_base ( -- | store current base and set to decimal )
39: base @ orig_base !
40: decimal ;
41:
42: : restore_base ( -- | restore original base )
43: orig_base @ base ! ;
44:
45: save_base
46:
47: : ansi_escape ( -- | output escape code )
48: 27 emit [char] [ emit ;
49:
50:
51: : clrtoeol ( -- | clear to end of line )
52: ansi_escape [char] K emit ;
53:
54: : gotoxy ( x y -- | position cursor at col x row y, origin is 1,1 )
55: save_base
56: ansi_escape s>string count type [char] ; emit
57: s>string count type [char] H emit
58: restore_base ;
59:
60: \ : at-xy ( x y -- | ANS compatible version of gotoxy, origin is 0,0 )
61: \ save_base
62: \ ansi_escape 1+ s>string count type [char] ; emit
63: \ 1+ s>string count type [char] H emit
64: \ restore_base ;
65:
66: \ : page ( -- | clear the screen and put cursor at top left )
67: \ ansi_escape [char] 2 emit [char] J emit 0 0 at-xy ;
68:
69: : cur_up ( n -- | move cursor up by n lines )
70: save_base
71: ansi_escape s>string count type [char] A emit
72: restore_base ;
73:
74: : cur_down ( n -- | move cursor down by n lines )
75: save_base
76: ansi_escape s>string count type [char] B emit
77: restore_base ;
78:
79: : cur_left ( n -- | move cursor left by n columns )
80: save_base
81: ansi_escape s>string count type [char] D emit
82: restore_base ;
83:
84: : cur_right ( n -- | move cursor right by n columns )
85: save_base
86: ansi_escape s>string count type [char] C emit
87: restore_base ;
88:
89: : save_cursor ( -- | save current cursor position )
90: ansi_escape [char] s emit ;
91:
92: : restore_cursor ( -- | restore cursor to previously saved position )
93: ansi_escape [char] u emit ;
94:
95: : foreground ( n -- | set foreground color to n )
96: save_base
97: ansi_escape 30 + s>string count type [char] m emit
98: restore_base ;
99:
100: : background ( n -- | set background color to n )
101: save_base
102: ansi_escape 40 + s>string count type [char] m emit
103: restore_base ;
104:
105: : text_normal ( -- | set normal text display )
106: ansi_escape [char] 0 emit [char] m emit ;
107:
108: : text_bold ( -- | set bold text )
109: ansi_escape [char] 1 emit [char] m emit ;
110:
111: : text_underline ( -- | set underlined text )
112: save_base
113: ansi_escape [char] 4 emit [char] m emit
114: restore_base ;
115:
116: : text_blink ( -- | set blinking text )
117: save_base
118: ansi_escape [char] 5 emit [char] m emit
119: restore_base ;
120:
121: : text_reverse ( -- | set reverse video text )
122: save_base
123: ansi_escape [char] 7 emit [char] m emit
124: restore_base ;
125:
126: : read-cdnumber ( c - n | read a numeric entry delimited by character c)
127: >r 0 begin
128: key dup r@ - while
129: swap 10 * swap [char] 0 - +
130: repeat
131: r> 2drop ;
132:
133: : at-xy? ( -- x y | return the current cursor coordinates)
134: ansi_escape ." 6n"
135: key drop key drop \ <esc> [
136: [char] ; read-cdnumber [char] R read-cdnumber
137: 1- swap 1- ;
138:
139: \ : rows ( -- n | return row size of console)
140: \ save_cursor 0 100 at-xy at-xy? nip restore_cursor ;
141:
142: \ : cols ( -- n | return column size of console)
143: \ save_cursor 200 0 at-xy at-xy? drop restore_cursor ;
144:
145: : reset-scrolling ( - )
146: ansi_escape [char] r emit ;
147:
148: : scroll-window ( start end - )
149: ansi_escape swap u>string count type
150: [char] ; emit u>string count type
151: [char] r emit ;
152:
153: : scroll-up ( - ) ansi_escape [char] M emit ;
154:
155: : scroll-down ( - ) ansi_escape [char] D emit ;
156:
157:
158: restore_base
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>