\ color 3/14/00 11:21 pm NAB
needs toolkit
0 enum mode
mode DisplayModeGetDefaults
mode DisplayModeGet
mode DisplayModeSetToDefaults
mode DisplayModeSet
mode DisplayModeGetSupportedDepths
mode DisplayModeSupportsColor
: color-depth ( bits -- )
0 sp@
0. 2swap
0.
0.
DisplayModeSet >byte
ScrDisplayMode throw 2drop ;
: grayscale ( -- ) 2 color-depth ;
: monochrome ( -- ) 1 color-depth ;
: >rgb ( r g b -- rgb. )
swap >byte or swap ;
: rgb> ( rgb. -- r g b )
swap dup 8 rshift swap 15 and ;
: gray ( gray -- rgb. )
dup dup ;
: color>gray ( r g b -- gray )
100 877 */ swap 100 170 */ +
swap 100 334 */ + ;
: set-colors ( fore-rgb. back-rgb. -- )
sp@ 0. 2swap 0. 2over 16 m+
WinSetColors 2drop 2drop ;
: get-colors ( -- fore-rgb. back-rgb. )
0. 0. sp@ 0. 2over 4 m+ 0.
WinSetColors ;
: foreground ( rgb. -- )
sp@ 2>r
0. 0. 0. 2r> WinSetColors 2drop ;
: background ( rgb. -- )
sp@ 2>r
0. 2r> 0. 0. WinSetColors 2drop ;
: color: ( r g b "name" -- )
>rgb 2constant ;
0 gray color: black
127 gray color: dark-gray
191 gray color: light-gray
255 gray color: white
\ Example:
\ grayscale
\ light-gray background
\ black foreground