Power-Programmierung/CD1.mdf/forth/compiler/f88/video.bak

Text File | 1988-06-07 | 6KB | 183 lines

\ VIDEO.SEQ     Direct VIDEO Screen output              by Tom Zimmer

FILES DEFINITIONS

VARIABLE VIDEO.SEQ

FORTH DEFINITIONS

0 CONSTANT SVSEG                \ screen save segment

VARIABLE ATTRIB   7 ATTRIB !-T          \ display attribute value
VARIABLE VIDEO-SEG                      \ Segment of display
VARIABLE TYPESEG          \ video type segment, the segment we are typing from.
VARIABLE ENABLE_VAL     \ to turn on color screen
VARIABLE PAGE#          \ 0 - 3 in color mode (if videoseg <> b000)

HEX

CODE ?VMODE     ( --- N1 )
    MOV AH, # 0F     \ get video status
    INT 10
    MOV AH, # 0      \ enable byte = 0 for mode 7
    PUSH AX
    CMP AL, # 7      \ is mode 7 ?
    0<>               \ skip this if yes
    IF
\        MOV AH, # 2D \ enable byte for mode 2
\        CMP AL, # 2  \ is the mode 2 ?
\        0<> IF        \ if so, skip to then
        MOV AH, # 29   \ enable byte for mode 3
\        THEN
    THEN
    SUB AL, AL
    XCHG AH, AL
    MOV #) ENABLE_VAL AX \ store val to re-enable screen
    NEXT
C;

CODE VMODE.OK    ( --- N1 )
    MOV AH, # 0F     \ get video status
    INT 10
    CMP AL, # 7      \ is mode 7 ?
 0= IF NEXT THEN     \ skip this if yes
    CMP AL, # 3  \ is the mode < 3 ?
0<> IF        \ if so, skip to then
    MOV AH, # 0   \ enable mode 3
    MOV AL, # 3
    INT 10
    THEN
    NEXT
C;

DEFER INITMONO  ' NOOP IS INITMONO      \ INITIALIZATION VECTOR AVAILABLE
DEFER INITCOLOR ' NOOP IS INITCOLOR     \ FOR MONOCHROME AND COLOR

: VMODE.SET     ( --- )
    0 PAGE# !    \ start with page 0
    VMODE.OK
    ?VMODE 7 =
    IF    0B000   INITMONO
    ELSE  0B800   INITCOLOR
    THEN  VIDEO-SEG ! ;

DECIMAL

CODE VTYPE      ( string length x y -- )
    POP AX          \ Y
    POP DX          \ X
    POP BX          \ LENGTH
    PUSH BX  PUSH DX  PUSH AX        \ Save them back again
    ADD DX, BX      \ Set length + X position to DL
    MOV DH, AL      \ Move Y to DH
    MOV BX, PAGE#   \ mps
    MOV AH, # 2
    INT 16          \ Move cursor to end of typed string
    MOV AX, # 160
    POP BX          \ y
    MUL BX
    MOV DI, AX      \ line on page 0
    MOV AX, # 4096    \ offset per page
    MOV BX, #) PAGE#
    MUL BX
    ADD DI, AX      \ offset to the active page
    POP AX          \ x
    SHL AX, # 1     \ make it words
    ADD DI, AX      \ location on page
    POP CX          \ length
    POP BX          \ $addr
    XCHG SI, BX     \ SI is the source
    PUSH BX         \ Save SI == IP
    PUSH ES         \ save ES == list segment
    MOV BX, # 1     \ mask - bit 1
    MOV ES, #) VIDEO-SEG  \ destination segment
    MOV DS, #) typeseg      \ source segment
    MOV AX, CS: #) ENABLE_VAL   \ fetch enable val
    CMP AL, # 0     \ monochrome? (test)
    0<>
    IF              \ if so, do nothing
    MOV DX, # 986   \ address cga status port
    BEGIN
        IN AL, DX   \ fetch status
        TEST AL, BX \ mask vertical retrace bit (test)
    0<> UNTIL       \ until retrace seen
    MOV DL, # 216   \ address control reg
    MOV AL, # 37    \ this val disables the crt
    OUT DX, AL      \ display is disabled
    THEN
    MOV AX, CS: #) ATTRIB     \ display attributes
    XCHG AH, AL
LABEL VTYPE1
    LODSB
    STOSW           \ write the attribute byte
    LOOP VTYPE1
    MOV AX, CS: #) ENABLE_VAL   \ fetch enable val
    CMP AL, # 0          \ monochrome? (test)
    0<> IF                \ we didn't disable scr \ jz ret
    MOV DX, # 984        \ adress cga mode control reg
    OUT DX, AL           \ send the enable value
    THEN
    POP ES                          \ restore ES
    POP SI                          \ Restore IP
    MOV BX, CS      MOV DS, BX      \ restore DS
    NEXT
END-CODE

DECIMAL PREFIX

LABEL VMOVE2
    WORD LODS
    WORD STOS       \ write the attribute and char
    LOOP VMOVE2       \ loop till cx is zero
    MOV AX, # 41    \ enable val 29H for mode 3
    MOV DX, # 984   \ adress cga mode control reg
    OUT DX, AL      \ send the enable value
    POP ES          \ restore ES
    POP SI          \ Restore IP
    MOV BX, CS      MOV DS, BX      \ restore DS
    NEXT
LABEL VMOVE1
    CLD
    MOV BX, # 1     \ mask - bit 3
    MOV DX, # 986   \ address cga status port
    BEGIN
        IN AL, DX   \ fetch status
        TEST AL, BX \ mask vertical retrace bit (test)
    0<> UNTIL       \ until retrace seen
    MOV DL, # 216   \ address control reg
    MOV AL, # 37    \ this val disables the crt
    OUT DX, AL      \ display is disabled
    JMP VMOVE2
CODE VMOVEL>      ( -- ) \ from video-seg to savseg
    PUSH SI         \ save SI == IP
    PUSH ES         \ save ES == list segment
    MOV CX, # 2000   \ length
    MOV SI, # 0
    MOV DI, # 0
    MOV AX, # 4096    \ offset per page
    MOV BX, #) PAGE#
    MUL BX
    ADD SI, AX      \ offset to the active page
    MOV BX, # ' SVSEG
    MOV ES, 3 [BX]      \ destination segment
    MOV DS, #) VIDEO-SEG   \ source segment
    JMP VMOVE1
END-CODE

CODE >VMOVEL      ( -- ) \ from savseg to video-seg
    PUSH SI         \ save SI == IP
    PUSH ES         \ save ES == list segment
    MOV CX, # 2000   \ length
    MOV SI, # 0
    MOV DI, # 0
    MOV AX, # 4096    \ offset per page
    MOV BX, #) PAGE#
    MUL BX
    ADD DI, AX      \ offset to the active page
    MOV ES, #) VIDEO-SEG   \ destination segment
    MOV BX, # ' SVSEG
    MOV DS, 3 [BX]      \ destination segment
    JMP VMOVE1
END-CODE