Return to ansi.fs CVS log

Up to [gforth] / gforth

* Added some files:
* ecvt.c provides some functions for DJGPP under DOS
* tt.fs is Tetris (from PFE)
* checkans.fs allows to check, which words of the ANSI wordsets are present
* the rest are other tools

    1: \ ANSI.STR      Define terminal attributes              20may93jaw
    2: 
    3: \ If you want another terminal you can redefine
    4: \ the colours.
    5: 
    6: \ But a better way is it only to redefine SET-ATTR
    7: \ to have compatible colours.
    8: 
    9: \ Attributes description:
   10: \ <A ( -- -1 )       Entry attributes description
   11: \ >B ( colour -- x ) Colour is Background colour
   12: \ >F ( colour -- x ) Colour is Foreground colour
   13: \                    Attributes may be used freely
   14: \ A> ( -1 x .. x -- attr )
   15: \                    Return over all attribute
   16: \                    only 12 Bits are used up to now!
   17: 
   18: \ SET-ATTR ( attr -- ) Send attributes to terminal
   19: 
   20: \ To do:        Make <A A> State smart and compile
   21: \               only literals!
   22: 
   23: include vt100.fs
   24: 
   25: decimal
   26: 
   27: 0 CONSTANT Black
   28: 1 CONSTANT Red
   29: 2 CONSTANT Green
   30: 3 CONSTANT Yellow
   31: 4 CONSTANT Blue
   32: 5 CONSTANT Brown
   33: 6 CONSTANT Cyan
   34: 7 CONSTANT White
   35: 
   36: 1 CONSTANT Bold
   37: 2 CONSTANT Underline
   38: 4 CONSTANT Blink
   39: 8 CONSTANT Invers
   40: 
   41: \ For portable programs don't use invers and underline
   42: 
   43: : >B    4 lshift ;
   44: : >F    >B >B ;
   45: 
   46: : B>    4 rshift 15 and ;
   47: : F>    8 rshift 15 and ;
   48: 
   49: : <A    -1 0 ;
   50: : A>    BEGIN over -1 <> WHILE or REPEAT nip ;
   51: 
   52: VARIABLE Attr   -1 Attr !
   53: 
   54: DEFER Attr!
   55: 
   56: : (Attr!)       ( attr -- ) dup Attr @ = IF drop EXIT THEN
   57:                 dup Attr !
   58:                 ESC[    0 pn
   59:                         dup F> ?dup IF 30 + ;pn THEN
   60:                         dup B> ?dup IF 40 + ;pn THEN
   61:                         dup Bold and IF 1 ;pn THEN
   62:                         dup Underline and IF 4 ;pn THEN
   63:                         dup Blink and IF 5 ;pn THEN
   64:                         Invers and IF 7 ;pn THEN
   65:                         [char] m emit ;
   66: 
   67: ' (Attr!) IS Attr!
   68: 
   69: : BlackSpace    Attr @ dup B> Black =
   70:                 IF drop space
   71:                 ELSE 0 attr! space attr! THEN ;
   72: