home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / f88 / color.bak next >
Encoding:
Text File  |  1988-05-24  |  2.6 KB  |  91 lines
  1. \ COLOR.SEQ     Color board support for ZF              by Tom Zimmer
  2.  
  3. \ For Color boards, the following values may be used for background
  4. \ or forground.
  5.  
  6. hex prefix
  7. code border  ( n -- ) \ use: blue border
  8.     pop bx
  9.     mov ah, # 0b
  10.     int 10
  11.     next
  12. c;
  13.  
  14. 00 CONSTANT BLACK       \ black
  15. 01 CONSTANT BLUE        \ blue
  16. 02 CONSTANT GREEN       \ green
  17. 03 CONSTANT CYAN        \ cyan
  18. 04 CONSTANT RED         \ red
  19. 05 CONSTANT MAGENTA     \ magenta
  20. 06 CONSTANT BROWN       \ brown
  21. 07 CONSTANT LTGRAY      \ light gray
  22. 08 CONSTANT DKGRAY      \ dark gray   All following, blink in Background.
  23. 09 CONSTANT LTBLUE      \ light blue
  24. 0A CONSTANT LTGREEN     \ light green
  25. 0B CONSTANT LTCYAN      \ light cyan
  26. 0C CONSTANT LTRED       \ light red
  27. 0D CONSTANT LTMAGENTA   \ light magenta
  28. 0E CONSTANT YELLOW      \ yellow
  29. 0F CONSTANT WHITE       \ white
  30.  
  31. : >FG           ( N1 --- )
  32.                 attrib c@ F0 and + attrib c! ;
  33.  
  34. : >BG           ( N1 --- )
  35.                 10 * attrib c@ 0F and + attrib c! ;
  36.  
  37. : >RDYL         ( --- ) RED   >BG YELLOW  >FG ;
  38. : >YLBU         ( --- ) BLUE  >BG YELLOW  >FG ;
  39. : >BUGN         ( --- ) BLUE  >BG LTGREEN >FG ;
  40. : >RDWT         ( --- ) RED   >BG WHITE   >FG ;
  41. : >GRWT         ( --- ) GREEN >BG WHITE   >FG ;
  42. : >CNBK         ( --- ) BLACK >BG LTCYAN  >FG ;
  43. : >GNBK         ( --- ) BLACK >BG LTGREEN >FG ;
  44. : >RDBK         ( --- ) BLACK >BG LTRED   >FG ;
  45. : >MABK         ( --- ) BLACK >BG LTMAGENTA >FG ;
  46. : >BUBK         ( --- ) BLACK >BG LTBLUE  >FG ;
  47. : >YLBK         ( --- ) BLACK >BG YELLOW  >FG ;
  48. : >BKCN         ( --- ) CYAN  >BG BLACK   >FG ;
  49. : >LCBK         ( --- ) LTCYAN >BG BLACK  >FG ;  \ blinks, for cursor
  50.  
  51. : >COLOR        ( --- )         \ Select hilighting for color monitor.
  52.     BLACK BORDER
  53.     ['] >GNBK IS >NORM
  54.     ['] >CNBK IS >ATTRIB1
  55.     ['] >RDWT IS >ATTRIB2
  56.     ['] >BKCN IS >ATTRIB3
  57.     ['] >RDYL IS >ATTRIB4
  58.     ['] >YLBK IS >ATTRIB5
  59.     ['] >BUBK IS >ATTRIB6
  60.     ['] >YLBU IS >ATTRIB7
  61.     ['] >LCBK IS >ATTRIB8 ;
  62.  
  63. \ Use cursor-off and >attrib8 either 5f or dd qemit on cga pages 1..3
  64. \ cursor positioning only operates on page 0
  65.  
  66. HEX PREFIX
  67. CODE  ?COLOR   ( -- n ) \ are we on the cga card in color text mode?
  68.     SUB AX, AX
  69.     MOV AH, # 0F
  70.     INT 10
  71.     XOR AH, AH
  72.     CMP AX, # 3
  73.     0= IF MOV AX, # -1  1PUSH THEN
  74.     MOV AX, # 0
  75.     PUSH Ax
  76.     NEXT 
  77. C;
  78.  
  79. DECIMAL
  80.  
  81. : >COLOR? ?COLOR IF >COLOR THEN ;  >COLOR?
  82.  
  83. ' >COLOR IS INITCOLOR   \ Enable attributes according to video board.
  84.  
  85. VMODE.SET               \ RESET VIDEO MODE TO CURRENT VIDEO BOARD.
  86.  
  87. DECIMAL
  88.  
  89.  
  90. 
  91.