File:  [gforth] / gforth / contrib / ansi.fs
Revision 1.1: download - view: text, annotated - select for diffs
Fri Nov 5 14:27:32 2004 UTC (19 years, 5 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
added Krishna Myneni's serial.fs, terminal.fs, and support stuff to contrib

    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>