version 1.5, 2000/09/23 15:46:51
|
version 1.10, 2007/12/31 19:02:24
|
Line 1
|
Line 1
|
\ 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,2001,2003,2007 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ 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 |
|
\ |
|
\ 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. |
|
|
\ SET-ATTR ( attr -- ) Send attributes to terminal |
\ To do: Make <A A> State smart and only compile literals! |
|
|
\ To do: Make <A A> State smart and compile |
|
\ only literals! |
|
|
|
needs vt100.fs |
needs vt100.fs |
|
|
Line 59 decimal
|
Line 61 decimal
|
|
|
\ 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 ; |
Line 75 DEFER Attr!
|
Line 77 DEFER Attr!
|
: (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 |
Line 85 DEFER Attr!
|
Line 87 DEFER Attr!
|
|
|
' (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 ; |
|
|