Annotation of gforth/contrib/ansi.fs, revision 1.1
1.1 ! anton 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>