| \ ANSI.STR Define terminal attributes 20may93jaw |
\ ansi.fs Define terminal attributes 20may93jaw |
| |
|
| \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
| |
|
| \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
| |
|
| |
|
| \ If you want another terminal you can redefine |
\ If you want another terminal you can redefine the colours. |
| \ the colours. |
|
| |
|
| \ But a better way is it only to redefine SET-ATTR |
\ But a better way is it only to redefine SET-ATTR |
| \ to have compatible colours. |
\ to have compatible colours. |
| |
|
| \ Attributes description: |
\ Attributes description: |
| \ <A ( -- -1 ) Entry attributes description |
\ <A ( -- -1 0 ) Start attributes description |
| \ >B ( colour -- x ) Colour is Background colour |
\ A> ( -1 x .. x -- attr ) Terminate an attributes description and |
| \ >F ( colour -- x ) Colour is Foreground colour |
\ return overall attribute; currently only |
| \ Attributes may be used freely |
\ 12 bits are used. |
| \ A> ( -1 x .. x -- attr ) |
\ |
| \ Return over all attribute |
\ >BG ( colour -- x ) x is attribute with colour as Background colour |
| \ only 12 Bits are used up to now! |
\ >FG ( colour -- x ) x is attribute with colour as Foreground colour |
| |
\ |
| \ SET-ATTR ( attr -- ) Send attributes to terminal |
\ SET-ATTR ( attr -- ) Send attributes to terminal |
| |
\ |
| |
\ BG> ( attr -- colour) extract colour of Background from attr |
| |
\ FG> ( attr -- colour) extract colour of Foreground from attr |
| |
\ |
| |
\ See colorize.fs for an example of usage. |
| |
|
| \ To do: Make <A A> State smart and compile |
\ To do: Make <A A> State smart and only compile literals! |
| \ only literals! |
|
| |
|
| needs vt100.fs |
needs vt100.fs |
| |
|
| |
|
| \ For portable programs don't use invers and underline |
\ For portable programs don't use invers and underline |
| |
|
| : >B 4 lshift ; |
: >BG 4 lshift ; |
| : >F >B >B ; |
: >FG >BG >BG ; |
| |
|
| : B> 4 rshift 15 and ; |
: BG> 4 rshift 15 and ; |
| : F> 8 rshift 15 and ; |
: FG> 8 rshift 15 and ; |
| |
|
| : <A -1 0 ; |
: <A -1 0 ; |
| : A> BEGIN over -1 <> WHILE or REPEAT nip ; |
: A> BEGIN over -1 <> WHILE or REPEAT nip ; |
| : (Attr!) ( attr -- ) dup Attr @ = IF drop EXIT THEN |
: (Attr!) ( attr -- ) dup Attr @ = IF drop EXIT THEN |
| dup Attr ! |
dup Attr ! |
| ESC[ 0 pn |
ESC[ 0 pn |
| dup F> ?dup IF 30 + ;pn THEN |
dup FG> ?dup IF 30 + ;pn THEN |
| dup B> ?dup IF 40 + ;pn THEN |
dup BG> ?dup IF 40 + ;pn THEN |
| dup Bold and IF 1 ;pn THEN |
dup Bold and IF 1 ;pn THEN |
| dup Underline and IF 4 ;pn THEN |
dup Underline and IF 4 ;pn THEN |
| dup Blink and IF 5 ;pn THEN |
dup Blink and IF 5 ;pn THEN |
| |
|
| ' (Attr!) IS Attr! |
' (Attr!) IS Attr! |
| |
|
| : BlackSpace Attr @ dup B> Black = |
: BlackSpace Attr @ dup BG> Black = |
| IF drop space |
IF drop space |
| ELSE 0 attr! space attr! THEN ; |
ELSE 0 attr! space attr! THEN ; |
| |
|