home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
f88
/
monocrom.bak
< prev
next >
Wrap
Text File
|
1988-05-24
|
2KB
|
59 lines
\ MONOCROM.SEQ Monochrome support words by Tom Zimmer
\ Video attribute control mechanism for monochrome by Tom Zimmer
HEX
: >NONE ( --- ) 07 ATTRIB C! ; \ NORMAL
: >UL ( --- ) 01 ATTRIB C! ; \ UNDERLINE
: >REV ( --- ) 78 ATTRIB C! ; \ REVERSE
: >BOLD ( --- ) 7F ATTRIB C! ; \ BRIGHT
: >BOLDUL ( --- ) 79 ATTRIB C! ; \ BOLD UNDERLINE
: >BOLDBLNK ( --- ) 8F ATTRIB C! ; \ BOLD BLINK
: >REVBLNK ( --- ) F0 ATTRIB C! ; \ REVERSE BLINK
\ Some extra words, not loaded for now.
\ : >BOLDBLNKUL ( --- ) 89 ATTRIB C! ; \ BOLD BLINK & UNDERLINE
\ : >BLINK ( --- ) 87 ATTRIB C! ; \ BLINK
\ : >BLANK ( --- ) 00 ATTRIB C! ; \ BLANK, NO DISPLAY
' >NONE IS >NORM
>NORM \ Default to Normal video.
: >MONO ( --- ) \ Select hilighting for monochrome monitor.
['] >NONE IS >NORM
['] >BOLD IS >ATTRIB1
['] >BOLDUL IS >ATTRIB2
['] >REV IS >ATTRIB3
['] >REV IS >ATTRIB4
['] >REV IS >ATTRIB5
['] >BOLD IS >ATTRIB6
['] >BOLD IS >ATTRIB7
['] >REV IS >ATTRIB8 ;
HEX PREFIX
CODE ?MONOCHROME ( -- n ) \ are we on the monochrome card?
SUB AX, AX
MOV AH, # 0F
INT 10
XOR AH, AH
CMP AX, # 7
0= IF MOV AX, # -1 1PUSH THEN
MOV AX, # 0
PUSH Ax
NEXT
C;
DECIMAL
: >MONO? ?MONOCHROME IF >MONO THEN ; >MONO?
' >MONO IS INITMONO \ Enable attributes according to video board.
' >MONO IS INITCOLOR \ Enable attributes SAME AS MONO FOR NOW.
DECIMAL