[gforth] / gforth / ansi.fs  

gforth: gforth/ansi.fs


1 : crook 1.6 \ ansi.fs Define terminal attributes 20may93jaw
2 : pazsan 1.1
3 : anton 1.7 \ Copyright (C) 1995,1996,1997,1998,2001 Free Software Foundation, Inc.
4 : anton 1.2
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 : anton 1.5 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20 : anton 1.2
21 :    
22 : crook 1.6 \ If you want another terminal you can redefine the colours.
23 : pazsan 1.1
24 :     \ But a better way is it only to redefine SET-ATTR
25 :     \ to have compatible colours.
26 :    
27 :     \ Attributes description:
28 : crook 1.6 \ <A ( -- -1 0 ) Start attributes description
29 :     \ A> ( -1 x .. x -- attr ) Terminate an attributes description and
30 :     \ return overall attribute; currently only
31 :     \ 12 bits are used.
32 :     \
33 :     \ >BG ( colour -- x ) x is attribute with colour as Background colour
34 :     \ >FG ( colour -- x ) x is attribute with colour as Foreground colour
35 :     \
36 :     \ SET-ATTR ( attr -- ) Send attributes to terminal
37 :     \
38 :     \ BG> ( attr -- colour) extract colour of Background from attr
39 :     \ FG> ( attr -- colour) extract colour of Foreground from attr
40 :     \
41 :     \ See colorize.fs for an example of usage.
42 : pazsan 1.1
43 : crook 1.6 \ To do: Make <A A> State smart and only compile literals!
44 : pazsan 1.1
45 : anton 1.3 needs vt100.fs
46 : pazsan 1.1
47 :     decimal
48 :    
49 :     0 CONSTANT Black
50 :     1 CONSTANT Red
51 :     2 CONSTANT Green
52 :     3 CONSTANT Yellow
53 :     4 CONSTANT Blue
54 :     5 CONSTANT Brown
55 :     6 CONSTANT Cyan
56 :     7 CONSTANT White
57 :    
58 :     1 CONSTANT Bold
59 :     2 CONSTANT Underline
60 :     4 CONSTANT Blink
61 :     8 CONSTANT Invers
62 :    
63 :     \ For portable programs don't use invers and underline
64 :    
65 : crook 1.6 : >BG 4 lshift ;
66 :     : >FG >BG >BG ;
67 : pazsan 1.1
68 : crook 1.6 : BG> 4 rshift 15 and ;
69 :     : FG> 8 rshift 15 and ;
70 : pazsan 1.1
71 :     : <A -1 0 ;
72 :     : A> BEGIN over -1 <> WHILE or REPEAT nip ;
73 :    
74 :     VARIABLE Attr -1 Attr !
75 :    
76 :     DEFER Attr!
77 :    
78 :     : (Attr!) ( attr -- ) dup Attr @ = IF drop EXIT THEN
79 :     dup Attr !
80 :     ESC[ 0 pn
81 : crook 1.6 dup FG> ?dup IF 30 + ;pn THEN
82 :     dup BG> ?dup IF 40 + ;pn THEN
83 : pazsan 1.1 dup Bold and IF 1 ;pn THEN
84 :     dup Underline and IF 4 ;pn THEN
85 :     dup Blink and IF 5 ;pn THEN
86 :     Invers and IF 7 ;pn THEN
87 :     [char] m emit ;
88 :    
89 :     ' (Attr!) IS Attr!
90 :    
91 : crook 1.6 : BlackSpace Attr @ dup BG> Black =
92 : pazsan 1.1 IF drop space
93 :     ELSE 0 attr! space attr! THEN ;
94 :    

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help