64 lines
1.4 KiB
Forth
64 lines
1.4 KiB
Forth
\ Color Bars for TI-99 CAMEL99 Forth
|
|
|
|
NEEDS HCHAR FROM DSK1.GRAFIX \ TMS9918 control lexicon
|
|
NEEDS CHARSET FROM DSK1.CHARSET \ restores default character data
|
|
NEEDS ENUM FROM DSK1.ENUM \ add simple enumerator to Forth
|
|
|
|
\ Name TI-99 colors
|
|
1 ENUM CLR ENUM BLK ENUM MGRN ENUM LGRN
|
|
ENUM BLU ENUM LBLU ENUM RED ENUM CYAN
|
|
ENUM MRED ENUM LRED ENUM YEL ENUM LYEL
|
|
ENUM GRN ENUM MAG ENUM GRY ENUM WHT
|
|
DROP
|
|
|
|
\ square character data
|
|
HEX
|
|
CREATE SQUARE FFFF , FFFF , FFFF , FFFF ,
|
|
|
|
DECIMAL
|
|
: COLOR-BARS ( -- )
|
|
24 0 DO
|
|
\ col row char wid
|
|
\ --- --- ---- ---
|
|
2 I 88 4 HCHAR
|
|
6 I 96 4 HCHAR
|
|
10 I 104 4 HCHAR
|
|
14 I 112 4 HCHAR
|
|
18 I 120 4 HCHAR
|
|
22 I 128 4 HCHAR
|
|
26 I 136 4 HCHAR
|
|
LOOP ;
|
|
|
|
DECIMAL
|
|
: DEFCHARS ( pattern first last -- )
|
|
1+ SWAP ?DO DUP I CHARDEF 8 +LOOP DROP ;
|
|
|
|
: SET-COLORS ( -- )
|
|
\ charset fg bg
|
|
\ ------- -- --
|
|
88 SET# GRY CLR COLOR
|
|
96 SET# YEL CLR COLOR
|
|
104 SET# CYAN CLR COLOR
|
|
112 SET# GRN CLR COLOR
|
|
120 SET# MAG CLR COLOR
|
|
128 SET# RED CLR COLOR
|
|
136 SET# BLU CLR COLOR
|
|
144 SET# BLK CLR COLOR ;
|
|
|
|
\ restore characters and colors
|
|
: DEFAULTS
|
|
8 SCREEN
|
|
4 19 BLK CLR COLORS
|
|
CLEAR
|
|
CHARSET ;
|
|
|
|
: BARS
|
|
CLEAR BLK SCREEN
|
|
SET-COLORS
|
|
SQUARE 88 152 DEFCHARS
|
|
COLOR-BARS
|
|
BEGIN ?TERMINAL UNTIL
|
|
DEFAULTS
|
|
;
|
|
|
|
CR .( Done. Type BARS to run)
|