\ ansi.fs
\
\ ANSI Terminal words for gforth
\
\ Copyright (c) 1999--2004 Krishna Myneni
\ Creative Consulting for Research and Education
\
\ This software is provided under the terms of the GNU
\ General Public License.
\
\ ====> Requires that the file strings.fs be included first
\
\ Revisions:
\ 06-10-1999
\ 10-11-1999 force cursor to 0 0 on page; define at-xy KM
\ 01-23-2000 replaced char with [char] for ANS Forth compatibility KM
\ 08-29-2002 use 0,0 as top left for AT-XY in accord with ANS Forth KM
\ 09-08-2004 added console query words provided by Charley Shattuck:
\ AT-XY? ROWS COLS
\ Note that ROWS and COLS are also provided in gforth and PFE
\ 09-10-2004 added scrolling words -- CS
\ 09-17-2004 ported from kForth KM
\ Colors
0 constant BLACK
1 constant RED
2 constant GREEN
3 constant YELLOW
4 constant BLUE
5 constant MAGENTA
6 constant CYAN
7 constant WHITE
variable orig_base
: save_base ( -- | store current base and set to decimal )
base @ orig_base !
decimal ;
: restore_base ( -- | restore original base )
orig_base @ base ! ;
save_base
: ansi_escape ( -- | output escape code )
27 emit [char] [ emit ;
: clrtoeol ( -- | clear to end of line )
ansi_escape [char] K emit ;
: gotoxy ( x y -- | position cursor at col x row y, origin is 1,1 )
save_base
ansi_escape s>string count type [char] ; emit
s>string count type [char] H emit
restore_base ;
\ : at-xy ( x y -- | ANS compatible version of gotoxy, origin is 0,0 )
\ save_base
\ ansi_escape 1+ s>string count type [char] ; emit
\ 1+ s>string count type [char] H emit
\ restore_base ;
\ : page ( -- | clear the screen and put cursor at top left )
\ ansi_escape [char] 2 emit [char] J emit 0 0 at-xy ;
: cur_up ( n -- | move cursor up by n lines )
save_base
ansi_escape s>string count type [char] A emit
restore_base ;
: cur_down ( n -- | move cursor down by n lines )
save_base
ansi_escape s>string count type [char] B emit
restore_base ;
: cur_left ( n -- | move cursor left by n columns )
save_base
ansi_escape s>string count type [char] D emit
restore_base ;
: cur_right ( n -- | move cursor right by n columns )
save_base
ansi_escape s>string count type [char] C emit
restore_base ;
: save_cursor ( -- | save current cursor position )
ansi_escape [char] s emit ;
: restore_cursor ( -- | restore cursor to previously saved position )
ansi_escape [char] u emit ;
: foreground ( n -- | set foreground color to n )
save_base
ansi_escape 30 + s>string count type [char] m emit
restore_base ;
: background ( n -- | set background color to n )
save_base
ansi_escape 40 + s>string count type [char] m emit
restore_base ;
: text_normal ( -- | set normal text display )
ansi_escape [char] 0 emit [char] m emit ;
: text_bold ( -- | set bold text )
ansi_escape [char] 1 emit [char] m emit ;
: text_underline ( -- | set underlined text )
save_base
ansi_escape [char] 4 emit [char] m emit
restore_base ;
: text_blink ( -- | set blinking text )
save_base
ansi_escape [char] 5 emit [char] m emit
restore_base ;
: text_reverse ( -- | set reverse video text )
save_base
ansi_escape [char] 7 emit [char] m emit
restore_base ;
: read-cdnumber ( c - n | read a numeric entry delimited by character c)
>r 0 begin
key dup r@ - while
swap 10 * swap [char] 0 - +
repeat
r> 2drop ;
: at-xy? ( -- x y | return the current cursor coordinates)
ansi_escape ." 6n"
key drop key drop \ <esc> [
[char] ; read-cdnumber [char] R read-cdnumber
1- swap 1- ;
\ : rows ( -- n | return row size of console)
\ save_cursor 0 100 at-xy at-xy? nip restore_cursor ;
\ : cols ( -- n | return column size of console)
\ save_cursor 200 0 at-xy at-xy? drop restore_cursor ;
: reset-scrolling ( - )
ansi_escape [char] r emit ;
: scroll-window ( start end - )
ansi_escape swap u>string count type
[char] ; emit u>string count type
[char] r emit ;
: scroll-up ( - ) ansi_escape [char] M emit ;
: scroll-down ( - ) ansi_escape [char] D emit ;
restore_base
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>