home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_4.ZIP / TCOMSRC.ZIP / TVIDEO.SEQ < prev    next >
Encoding:
Text File  |  1990-12-13  |  3.8 KB  |  118 lines
  1. \ TVIDEO.SEQ                                            by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   Direct video screen write display routine.
  6.  
  7.   This is not the fastest possible display routine, but it is much better
  8. than the normal DOS output routine. Be sure to call VMODE.SET before using
  9. VTYPE or VIDEO-TYPE, then use VAT to position the cursor instead of AT.
  10.  
  11. comment;
  12.  
  13. FORTH DECIMAL TARGET >LIBRARY       \ A Library file
  14.  
  15. 80 VALUE COLS
  16. 25 VALUE ROWS
  17. VARIABLE VIDEO-SEG
  18. VARIABLE VSPCS-PTR
  19.  
  20. CODE VIDEO-TYPE ( string length x y -- )
  21.                 [ASSEMBLER]
  22.                 PUSH BX
  23.                 MOV AX, BX
  24.                 MOV DX, 0 [SI]
  25.                 MOV BX, 2 [SI]
  26.                 ADD DX, BX      MOV DH, AL
  27.                 SUB BX, BX
  28.                 MOV AH, # 2
  29.                 INT $10
  30.                 POP BX
  31.                 MOV AX, # 160
  32.                 MUL BX
  33.                 MOV DI, AX
  34.                 LODSW           SHL AX
  35.                 ADD DI, AX
  36.                 LODSW           MOV CX, AX
  37.                 LODSW           MOV BX, AX
  38.                 XCHG DI, BX
  39.           CX<>0 IF      MOV DX, ES
  40.                         MOV ES, VIDEO-SEG       \ destination address
  41.                         MOV AH, ATTRIB          \ load attribute into AH
  42.                         0 $:    MOV AL, 0 [DI]
  43.                                 MOV ES: 0 [BX], AX
  44.                                 INC DI
  45.                                 INC BX
  46.                                 INC BX
  47.                         LOOP    0 $
  48.                         MOV ES, DX
  49.                 THEN
  50.                 LODSW
  51.                 MOV BX, AX
  52.                 RET             END-CODE
  53.  
  54. : %VTYPE        ( addr len -- )
  55.                 PRINTING @
  56.                 IF      %TYPE
  57.                 ELSE    TUCK #OUT @ #LINE @ VIDEO-TYPE #OUT +!
  58.                 THEN    ;
  59.  
  60. : %VSPACES      ( n1 -- )       \ Display n1 spaces up to 80
  61.                 VSPCS-PTR @ SWAP 0MAX 80 MIN %VTYPE ;
  62.  
  63. : %VEMIT        ( c1 -- )
  64.                 PRINTING @
  65.                 IF      (EMIT)
  66.                 ELSE    SP@ 1 %VTYPE DROP
  67.                 THEN    ;
  68.  
  69. : NORM-DARK     ( --- )
  70.                 VIDEO-SEG @ 0 ROWS COLS 2* *
  71.                 ATTRIB C@ FLIP $20 OR LFILLW
  72.                 0 0 AT ;
  73.  
  74. : VMODE.SET     ( --- )         \ must be done during initialization
  75.                 ?VMODE 7 =
  76.                 IF      $0B000
  77.                 ELSE    $0B800
  78.                 THEN    VIDEO-SEG !
  79.                 7 ATTRIB !
  80.                 80 DS:ALLOC VSPCS-PTR !         \ allocate a 80 char buffer
  81.                 VSPCS-PTR @ 80 $20 FILL         \ for 80 space characters
  82.                 ['] CRLF      !> CR
  83.                 ['] IBM-AT?   !> AT?
  84.                 ['] IBM-AT    !> AT
  85.                 ['] %KEY      !> KEY
  86.                 ['] %VEMIT    !> EMIT
  87.                 ['] %VTYPE    !> TYPE
  88.                 ['] %VSPACES  !> SPACES
  89.                 ['] NORM-DARK !> DARK
  90.                 AT? AT ;
  91.  
  92. : >NORM         ( --- ) $07 ATTRIB ! ;          \ NORMAL
  93. : >REV          ( --- ) $78 ATTRIB ! ;          \ REVERSE
  94. : >UL           ( --- ) $01 ATTRIB ! ;          \ UNDERLINE
  95. : >BOLD         ( --- ) $7F ATTRIB ! ;          \ BRIGHT
  96. : >BOLDUL       ( --- ) $79 ATTRIB ! ;          \ BOLD UNDERLINE
  97. : >BOLDBLNK     ( --- ) $8F ATTRIB ! ;          \ BOLD BLINK
  98. : >REVBLNK      ( --- ) $F0 ATTRIB ! ;          \ REVERSE BLINK
  99.  
  100. CODE BLINK_OFF  ( -- )
  101.                 SAVE_BX
  102.                 MOV AX, # $1003
  103.                 MOV BL, # $00           \ DISABLE BLINK
  104.                 INT $10
  105.                 LOAD_BX
  106.                 RET     END-CODE
  107.  
  108. CODE BLINK_ON   ( -- )
  109.                 SAVE_BX
  110.                 MOV AX, # $1003
  111.                 MOV BL, # $01           \ ENABLE BLINK
  112.                 INT $10
  113.                 LOAD_BX
  114.                 RET     END-CODE
  115.  
  116. FORTH TARGET >TARGET
  117.  
  118.