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