Return to ansi.fs CVS log

Up to [gforth] / gforth / contrib

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