Powered by ViewCVS 1.0-dev
| 1 : | pazsan | 1.1 | \ ANSI.STR Define terminal attributes 20may93jaw |
| 2 : | |||
| 3 : | anton | 1.4 | \ Copyright (C) 1995,1996,1997,1998 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 : | pazsan | 1.1 | \ If you want another terminal you can redefine |
| 23 : | \ the colours. | ||
| 24 : | |||
| 25 : | \ But a better way is it only to redefine SET-ATTR | ||
| 26 : | \ to have compatible colours. | ||
| 27 : | |||
| 28 : | \ Attributes description: | ||
| 29 : | \ <A ( -- -1 ) Entry attributes description | ||
| 30 : | \ >B ( colour -- x ) Colour is Background colour | ||
| 31 : | \ >F ( colour -- x ) Colour is Foreground colour | ||
| 32 : | \ Attributes may be used freely | ||
| 33 : | \ A> ( -1 x .. x -- attr ) | ||
| 34 : | \ Return over all attribute | ||
| 35 : | \ only 12 Bits are used up to now! | ||
| 36 : | |||
| 37 : | \ SET-ATTR ( attr -- ) Send attributes to terminal | ||
| 38 : | |||
| 39 : | \ To do: Make <A A> State smart and compile | ||
| 40 : | \ only literals! | ||
| 41 : | |||
| 42 : | anton | 1.3 | needs vt100.fs |
| 43 : | pazsan | 1.1 | |
| 44 : | decimal | ||
| 45 : | |||
| 46 : | 0 CONSTANT Black | ||
| 47 : | 1 CONSTANT Red | ||
| 48 : | 2 CONSTANT Green | ||
| 49 : | 3 CONSTANT Yellow | ||
| 50 : | 4 CONSTANT Blue | ||
| 51 : | 5 CONSTANT Brown | ||
| 52 : | 6 CONSTANT Cyan | ||
| 53 : | 7 CONSTANT White | ||
| 54 : | |||
| 55 : | 1 CONSTANT Bold | ||
| 56 : | 2 CONSTANT Underline | ||
| 57 : | 4 CONSTANT Blink | ||
| 58 : | 8 CONSTANT Invers | ||
| 59 : | |||
| 60 : | \ For portable programs don't use invers and underline | ||
| 61 : | |||
| 62 : | : >B 4 lshift ; | ||
| 63 : | : >F >B >B ; | ||
| 64 : | |||
| 65 : | : B> 4 rshift 15 and ; | ||
| 66 : | : F> 8 rshift 15 and ; | ||
| 67 : | |||
| 68 : | : <A -1 0 ; | ||
| 69 : | : A> BEGIN over -1 <> WHILE or REPEAT nip ; | ||
| 70 : | |||
| 71 : | VARIABLE Attr -1 Attr ! | ||
| 72 : | |||
| 73 : | DEFER Attr! | ||
| 74 : | |||
| 75 : | : (Attr!) ( attr -- ) dup Attr @ = IF drop EXIT THEN | ||
| 76 : | dup Attr ! | ||
| 77 : | ESC[ 0 pn | ||
| 78 : | dup F> ?dup IF 30 + ;pn THEN | ||
| 79 : | dup B> ?dup IF 40 + ;pn THEN | ||
| 80 : | dup Bold and IF 1 ;pn THEN | ||
| 81 : | dup Underline and IF 4 ;pn THEN | ||
| 82 : | dup Blink and IF 5 ;pn THEN | ||
| 83 : | Invers and IF 7 ;pn THEN | ||
| 84 : | [char] m emit ; | ||
| 85 : | |||
| 86 : | ' (Attr!) IS Attr! | ||
| 87 : | |||
| 88 : | : BlackSpace Attr @ dup B> Black = | ||
| 89 : | IF drop space | ||
| 90 : | ELSE 0 attr! space attr! THEN ; | ||
| 91 : |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |