home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / video2.seq < prev    next >
Text File  |  1990-07-02  |  7KB  |  143 lines
  1. \ VIDEO2.SEQ    Actual video output routine             By Tom Zimmer
  2. \ Modified by Robert Berkey to perform LONG operations. 07/03/89 RB
  3.  
  4.  
  5. FILES DEFINITIONS
  6.  
  7. VARIABLE VIDEO2.SEQ
  8.  
  9. FORTH DEFINITIONS
  10.  
  11. VARIABLE NOSETCUR       \ When this is on, VIDEO-TYPEL doesn't bother to
  12.                         \ adjust the cursor position for performance reasons
  13.  
  14. DECIMAL
  15.  
  16. CODE VIDEO-TYPEL   ( seg string length -- )
  17.                 MOV AX, #LINE
  18.                 MOV DX, #OUT
  19.                 POP BX
  20.                 cmp bx, # 0             \ if length = 0 then exit
  21.              <= if
  22.                         add sp, # 4
  23.                         next
  24.                 then
  25.                 PUSH BX                 \ Put length and #OUT on stack
  26.                 PUSH DX
  27.                 cmp ax, ' rows >body    \ Clip #LINE to ROWS
  28.             u>= if
  29.                         mov ax, ' rows >body
  30.                         dec ax
  31.                 then
  32.                 mov #line ax
  33.                 PUSH AX
  34.                 ADD DX, BX              \ Set length + X position to DL
  35.                 cmp dx, ' cols >body    \ Clip #OUT to 80 characters
  36.             u>= if
  37.                         mov dx, ' cols >body
  38.                         dec dx
  39.                 then
  40.                 mov #out dx
  41.                 cmp nosetcur # 0        \ Do we want to spend time setting
  42.              0= if                      \ the cursor position?
  43.                         MOV DH, AL      \ Move Y to DH
  44.                         XOR BX, BX      \ Clear BX
  45.                         MOV AH, # 2
  46.                         PUSH SI         PUSH BP
  47.                         INT $10         \ Move cursor to end of typed string
  48.                         POP BP          POP SI
  49.                 then
  50.                 MOV AX, ' cols >body    \ calculate actual cursor position
  51.                 ADD AX, AX              \ 2 bytes per character
  52.                 POP BX          MUL BX          MOV DI, AX
  53.                 POP AX          SHL AX, # 1     ADD DI, AX
  54.                 POP CX          POP BX
  55.                 POP DX  ( ds seg )
  56.                 XCHG SI, BX                     \ SI is the source
  57.                 PUSH BX                         \ Save SI for later restoral
  58.                 PUSH ES                         \ save ES
  59.                 PUSH DX ( ds seg )
  60.                 MOV BX, # 1                     \ Bit mask for retrace
  61.                 MOV AX, VMODE-VAR
  62.                 CMP AX, # 7                     \ If video mode <> 7 (mono)
  63.         0<> IF          MOV AX, BLANKING
  64.                         OR AX, AX
  65.             0<> IF      MOV DX, # 986           \ CGA status port
  66.                         BEGIN   IN AL, DX       \ Wait for retrace
  67.                                 TEST AL, BX
  68.                     0<> UNTIL
  69.                         MOV DL, # 216           \ Address control reg
  70.                         MOV AL, # 37            \ Disable the CRT
  71.                         OUT DX, AL
  72.                 THEN
  73.             THEN
  74.                 MOV AH, ATTRIB                  \ display attributes
  75.                 MOV ES, VIDEO-SEG               \ destination segment
  76.                 cmp cx, ' cols >body
  77.             u>= if                              \ Clip line to COL chars
  78.                         mov cx, ' cols >body
  79.                 then
  80.                 mov dx, # 132                   \ ABSOLUTE limit of output
  81.                 sub dx, cx
  82.                 xchg dx, cx
  83.                 shl cx, # 1
  84.                 POP DS
  85.                 add cx, # here $06 +             \ Add base addr of array
  86.                 \ add cx, # here $0A +             \ Add base addr of array
  87.                 \ MOV DS, TYPESEG                 \ source segment
  88.                 jmp cx                          \ JUMP to the right instruction
  89.  
  90. \ we are blowing out the loop here for speed, it only cost 264 bytes.
  91.  
  92.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  93.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  94.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  95.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  96.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  97.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  98.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  99.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  100.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  101.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  102.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  103.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  104.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  105.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  106.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  107.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  108.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  109.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  110.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  111.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  112.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  113.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  114.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  115.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  116.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  117.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  118.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  119.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  120.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  121.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  122.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  123.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  124.         LODSB   STOSW   LODSB   STOSW   LODSB   STOSW   LODSB   STOSW
  125.                 POP ES                          \ restore ES
  126.                 POP SI                          \ Restore IP
  127.                 MOV BX, CS      MOV DS, BX      \ restore DS
  128.                 MOV AX, VMODE-VAR
  129.                 CMP AX, # 7
  130.         0<> IF          MOV AX, BLANKING
  131.                         OR AX, AX
  132.             0<> IF      MOV DX, # 984           \ CGA mode control reg
  133.                         MOV AL, # $2D           \ Enable byte for mode 3
  134.                         OUT DX, AL
  135.                 THEN
  136.             THEN
  137.                 NEXT            END-CODE
  138.  
  139. CODE VIDEO-TYPE ( string length -- )
  140.    POP AX   POP BX   PUSH CS   PUSH BX   PUSH AX   JMP ' VIDEO-TYPEL
  141.    END-CODE
  142.  
  143.