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