Annotation of gforth/ansi.fs, revision 1.2

1.1       pazsan      1: \ ANSI.STR      Define terminal attributes              20may93jaw
                      2: 
1.2     ! anton       3: \ Copyright (C) 1995 Free Software Foundation, Inc.
        !             4: 
        !             5: \ This file is part of Gforth.
        !             6: 
        !             7: \ Gforth is free software; you can redistribute it and/or
        !             8: \ modify it under the terms of the GNU General Public License
        !             9: \ as published by the Free Software Foundation; either version 2
        !            10: \ of the License, or (at your option) any later version.
        !            11: 
        !            12: \ This program is distributed in the hope that it will be useful,
        !            13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            15: \ GNU General Public License for more details.
        !            16: 
        !            17: \ You should have received a copy of the GNU General Public License
        !            18: \ along with this program; if not, write to the Free Software
        !            19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
        !            20: 
        !            21: 
1.1       pazsan     22: \ If you want another terminal you can redefine
                     23: \ the colours.
                     24: 
                     25: \ But a better way is it only to redefine SET-ATTR
                     26: \ to have compatible colours.
                     27: 
                     28: \ Attributes description:
                     29: \ <A ( -- -1 )       Entry attributes description
                     30: \ >B ( colour -- x ) Colour is Background colour
                     31: \ >F ( colour -- x ) Colour is Foreground colour
                     32: \                    Attributes may be used freely
                     33: \ A> ( -1 x .. x -- attr )
                     34: \                    Return over all attribute
                     35: \                    only 12 Bits are used up to now!
                     36: 
                     37: \ SET-ATTR ( attr -- ) Send attributes to terminal
                     38: 
                     39: \ To do:        Make <A A> State smart and compile
                     40: \               only literals!
                     41: 
                     42: include vt100.fs
                     43: 
                     44: decimal
                     45: 
                     46: 0 CONSTANT Black
                     47: 1 CONSTANT Red
                     48: 2 CONSTANT Green
                     49: 3 CONSTANT Yellow
                     50: 4 CONSTANT Blue
                     51: 5 CONSTANT Brown
                     52: 6 CONSTANT Cyan
                     53: 7 CONSTANT White
                     54: 
                     55: 1 CONSTANT Bold
                     56: 2 CONSTANT Underline
                     57: 4 CONSTANT Blink
                     58: 8 CONSTANT Invers
                     59: 
                     60: \ For portable programs don't use invers and underline
                     61: 
                     62: : >B    4 lshift ;
                     63: : >F    >B >B ;
                     64: 
                     65: : B>    4 rshift 15 and ;
                     66: : F>    8 rshift 15 and ;
                     67: 
                     68: : <A    -1 0 ;
                     69: : A>    BEGIN over -1 <> WHILE or REPEAT nip ;
                     70: 
                     71: VARIABLE Attr   -1 Attr !
                     72: 
                     73: DEFER Attr!
                     74: 
                     75: : (Attr!)       ( attr -- ) dup Attr @ = IF drop EXIT THEN
                     76:                 dup Attr !
                     77:                 ESC[    0 pn
                     78:                         dup F> ?dup IF 30 + ;pn THEN
                     79:                         dup B> ?dup IF 40 + ;pn THEN
                     80:                         dup Bold and IF 1 ;pn THEN
                     81:                         dup Underline and IF 4 ;pn THEN
                     82:                         dup Blink and IF 5 ;pn THEN
                     83:                         Invers and IF 7 ;pn THEN
                     84:                         [char] m emit ;
                     85: 
                     86: ' (Attr!) IS Attr!
                     87: 
                     88: : BlackSpace    Attr @ dup B> Black =
                     89:                 IF drop space
                     90:                 ELSE 0 attr! space attr! THEN ;
                     91: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>