home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / color.seq < prev    next >
Encoding:
Text File  |  1991-04-23  |  3.3 KB  |  94 lines
  1. \ COLOR.SEQ     Color board support for F-PC            by Tom Zimmer
  2.  
  3. \ For Color boards, the following values may be used for background
  4. \ or forground.
  5.  
  6. $00 CONSTANT BLACK       \ black
  7. $01 CONSTANT BLUE        \ blue
  8. $02 CONSTANT GREEN       \ green
  9. $03 CONSTANT CYAN        \ cyan
  10. $04 CONSTANT RED         \ red
  11. $05 CONSTANT MAGENTA     \ magenta
  12. $06 CONSTANT BROWN       \ brown
  13. $07 CONSTANT LTGRAY      \ light gray
  14.  
  15. $08 CONSTANT DKGRAY      \ dark gray   All following, blink in Background.
  16. $09 CONSTANT LTBLUE      \ light blue
  17. $0A CONSTANT LTGREEN     \ light green
  18. $0B CONSTANT LTCYAN      \ light cyan
  19. $0C CONSTANT LTRED       \ light red
  20. $0D CONSTANT LTMAGENTA   \ light magenta
  21. $0E CONSTANT YELLOW      \ yellow
  22. $0F CONSTANT WHITE       \ white
  23.  
  24. 16 ARRAY COLORS         \ an array of colors for F-PC to use
  25.  
  26. : BG!   ( n1 n2 -- )    \ set color n1 into attribute position n2 background
  27.         1- 0MAX 2* COLORS + C! ;
  28.  
  29. : BG@   ( n1 -- n2 )    \ get the color n2 of attribute position n1 background
  30.         1- 0MAX 2* COLORS + C@ ;
  31.  
  32. : FG!   ( n1 n2 -- )    \ set color n1 into attribute position n2 forground
  33.         1- 0MAX 2* COLORS + 1+ C! ;
  34.  
  35. : FG@   ( n1 -- n2 )    \ get the color n2 of attribute position n1 forground
  36.         1- 0MAX 2* COLORS + 1+ C@ ;
  37.  
  38. BLUE    1 BG!   GREEN   1 FG!   \ set the default attribute forground and
  39. RED     2 BG!   WHITE   2 FG!   \ background colors.
  40. GREEN   3 BG!   WHITE   3 FG!
  41. RED     4 BG!   WHITE   4 FG!
  42. BLUE    5 BG!   GREEN   5 FG!
  43. RED     6 BG!   WHITE   6 FG!
  44. GREEN   7 BG!   WHITE   7 FG!
  45. RED     8 BG!   WHITE   8 FG!
  46.  
  47.  
  48. : >FG           ( n1 --- )      \ set the actual forground color to n1 NOW!
  49.                 attrib c@ $F0 and + attrib c! ;
  50.  
  51. : >BG           ( n1 --- )      \ set the actual background color to n1 NOW!
  52.                 $10 * attrib c@ $0F and + attrib c! ;
  53.  
  54. : COLORSET      ( -- )          \ set the current screen colors to be the
  55.                                 \ default normal color combination
  56.                 attrib c@ =: normval ;
  57.  
  58. : >1BGFG        ( --- ) 1 BG@ >BG 1 FG@ >FG ;
  59. : >2BGFG        ( --- ) 2 BG@ >BG 2 FG@ >FG ;
  60. : >3BGFG        ( --- ) 3 BG@ >BG 3 FG@ >FG ;
  61. : >4BGFG        ( --- ) 4 BG@ >BG 4 FG@ >FG ;
  62. : >5BGFG        ( --- ) 5 BG@ >BG 5 FG@ >FG ;
  63. : >6BGFG        ( --- ) 6 BG@ >BG 6 FG@ >FG ;
  64. : >7BGFG        ( --- ) 7 BG@ >BG 7 FG@ >FG ;
  65. : >8BGFG        ( --- ) 8 BG@ >BG 8 FG@ >FG ;
  66.  
  67. : >COLOR        ( --- )         \ Select hilighting for color monitor.
  68.                 ['] >1BGFG IS >ATTRIB1
  69.                 ['] >2BGFG IS >ATTRIB2
  70.                 ['] >3BGFG IS >ATTRIB3
  71.                 ['] >4BGFG IS >ATTRIB4
  72.                 ['] >5BGFG IS >ATTRIB5
  73.                 ['] >6BGFG IS >ATTRIB6
  74.                 ['] >7BGFG IS >ATTRIB7
  75.                 ['] >8BGFG IS >ATTRIB8
  76.                 >NORM ;
  77.  
  78. ' >COLOR IS INITCOLOR   \ Enable attributes according to video board.
  79.  
  80. VMODE.SET               \ RESET VIDEO MODE TO CURRENT VIDEO BOARD.
  81.  
  82. \ Liquid Crystal Display, or Least Common Denominator.   Your choice.
  83.  
  84. : >LCD          ( --- )
  85.                 ['] >REV  DUP IS >ATTRIB1 DUP IS >ATTRIB5
  86.                           DUP IS >ATTRIB2 DUP IS >ATTRIB6
  87.                           DUP IS >ATTRIB3     IS >ATTRIB7
  88.                 ['] >NORM DUP IS >ATTRIB4     IS >ATTRIB8
  89.                 >NORM ;
  90.  
  91. DECIMAL
  92.  
  93.  
  94.