home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / f88 / monocrom.bak < prev    next >
Text File  |  1988-05-24  |  2KB  |  59 lines
  1. \ MONOCROM.SEQ  Monochrome support words                by Tom Zimmer
  2.  
  3. \ Video attribute control mechanism for monochrome by Tom Zimmer
  4.  
  5. HEX
  6.  
  7. : >NONE         ( --- ) 07 ATTRIB C! ;          \ NORMAL
  8. : >UL           ( --- ) 01 ATTRIB C! ;          \ UNDERLINE
  9. : >REV          ( --- ) 78 ATTRIB C! ;          \ REVERSE
  10. : >BOLD         ( --- ) 7F ATTRIB C! ;          \ BRIGHT
  11. : >BOLDUL       ( --- ) 79 ATTRIB C! ;          \ BOLD UNDERLINE
  12. : >BOLDBLNK     ( --- ) 8F ATTRIB C! ;          \ BOLD BLINK
  13. : >REVBLNK      ( --- ) F0 ATTRIB C! ;          \ REVERSE BLINK
  14.  
  15. \       Some extra words, not loaded for now.
  16.  
  17. \ : >BOLDBLNKUL   ( --- ) 89 ATTRIB C! ;          \ BOLD BLINK & UNDERLINE
  18. \ : >BLINK        ( --- ) 87 ATTRIB C! ;          \ BLINK
  19. \ : >BLANK        ( --- ) 00 ATTRIB C! ;          \ BLANK, NO DISPLAY
  20.  
  21. ' >NONE IS >NORM
  22.  
  23. >NORM           \ Default to Normal video.
  24.  
  25. : >MONO         ( --- )         \ Select hilighting for monochrome monitor.
  26.     ['] >NONE   IS >NORM
  27.     ['] >BOLD   IS >ATTRIB1
  28.     ['] >BOLDUL IS >ATTRIB2
  29.     ['] >REV    IS >ATTRIB3
  30.     ['] >REV    IS >ATTRIB4
  31.     ['] >REV    IS >ATTRIB5
  32.     ['] >BOLD   IS >ATTRIB6
  33.     ['] >BOLD   IS >ATTRIB7
  34.     ['] >REV    IS >ATTRIB8 ;
  35.  
  36. HEX PREFIX
  37. CODE ?MONOCHROME   ( -- n ) \ are we on the monochrome card?
  38.     SUB AX, AX
  39.     MOV AH, # 0F
  40.     INT 10
  41.     XOR AH, AH
  42.     CMP AX, # 7
  43.     0= IF MOV AX, # -1  1PUSH THEN
  44.     MOV AX, # 0
  45.     PUSH Ax
  46.     NEXT 
  47. C;
  48.  
  49. DECIMAL
  50.  
  51. : >MONO? ?MONOCHROME IF >MONO THEN ;  >MONO?
  52.  
  53. ' >MONO IS INITMONO     \ Enable attributes according to video board.
  54.  
  55. ' >MONO IS INITCOLOR    \ Enable attributes SAME AS MONO FOR NOW.
  56.  
  57. DECIMAL
  58. 
  59.