home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
PROGRAM
/
FORTHCMP.ZIP
/
DISPLAY2.4TH
< prev
next >
Wrap
Text File
|
1992-03-30
|
4KB
|
116 lines
\ FORTH COMPILER DISPLAY LIBRARY 18:35 11/30/91
0 #IF
COPYRIGHT 1985 (C) BY THOMAS ALMY. ALL RIGHTS RESERVED
Permission is granted to registered users of ForthCMP to sell or distribute
computer programs incorporating the compiled contents of this file.
Fast Terminal output for IBM pc or compatibles.
Works with monochrome or color monitors, 80 column text only!
EMIT generates all 256 characters -- no control functions.
Include file DISPLAY1 at start of program.
Include this file before FORTHLIB
Define constant VID-DELAY non-zero for vertical retrace blanking
Execute SETUP-VID at program start, and UNSETUP-VID at finish
This library defines EMIT, TYPE, CS:TYPE, CLS, GOTOXY, FOREGROUND,
BACKGROUND, INTENSITY, -INTENSITY, BLINK, -BLINK, as in
PC/Forth. DO NOT use CONSOLE PRINTER and/or MESSAGES!
#THEN
10 HEX
1 0 IN/OUT
: setcursor ( DISPL -- ) DUP cursor ! crtstart +
2/ DUP 0F crtport @ PC! crtport @ 1+ PC!
>< 0E crtport @ PC! crtport @ 1+ PC! ;
2 0 IN/OUT
: GOTOXY ( X Y -- ) c/l * + 2* setcursor ;
FIND VID-DELAY #IF DROP #ELSE 0 CONSTANT VID-DELAY #THEN
0 0 IN/OUT
: SETUP-VID
40 49 C@L 7 = IF 3B4 crtport ! B000 vidseg ! ELSE \ MONOCHROME
40 84 C@L ?DUP IF 1+ EQU l/s THEN THEN
c/l l/s * EQU c/s c/l l/s 1- * 2* EQU c/sm1
40 4E @L EQU crtstart
40 50 C@L 40 51 C@L GOTOXY
vidseg @ c/sm1 1+ crtstart + C@L style ! ;
0 0 IN/OUT
CODE UNSETUP-VID cursor [] AX MOV c/l # BX MOV DX DX XOR
AX 1 SAR BX IDIV
AL DH MOV 2 # AH MOV BH BH XOR 10 INT RET END-CODE
CODE scrmove ( source dest wordCount -- )
BX POP CX POP DI POP SI POP
' crtstart [] SI ADD
' crtstart [] DI ADD
LOOP IF, DS PUSHSEG
VID-DELAY #IF B800 # vidseg [] CMP =0 IF, 3DA # DX MOV
BEGIN, BYTE [DX] IN 8 # AL TEST =0 ~ UNTIL,
DX DEC DX DEC 21 # AL MOV BYTE [DX] OUT THEN, #THEN
vidseg [] AX MOV AX DS >SEG AX ES >SEG
REPZ MOVS DS POPSEG
VID-DELAY #IF B800 # vidseg [] CMP =0 IF, 3D8 # DX MOV
29 # AL MOV BYTE [DX] OUT THEN, #THEN
THEN, BX JMPI END-CODE
2 0 IN/OUT
CODE scrfill ( source wordCount -- )
vidseg [] ES >SEG
BX PUSH ' crtstart [] BX ADD
20 # BYTE ES: [BX] MOV
style [] CL MOV CL ES: 1 +[BX] MOV
BX POP
BX PUSH BX INC BX INC BX PUSH AX DEC AX PUSH
CALL' scrmove RET END-CODE
0 0 IN/OUT
: scrollup c/l 2* 0 c/sm1 2/ scrmove
c/sm1 c/l scrfill
c/sm1 cursor ! ;
U: CLS 0 c/s scrfill 0 setcursor ;
U: FOREGROUND 0F AND style @ F0 AND OR style ! ;
U: BACKGROUND 7 AND 4 << style @ 0F AND OR style ! ;
U: BLINK 80 style CSET ;
U: -BLINK 80 style CRESET ;
U: INTENSITY 8 style CSET ;
U: -INTENSITY 8 style CRESET ;
: EMIT cursor @ c/s 2* >= IF scrollup THEN
vidseg @ cursor @ crtstart + C!L
style @ vidseg @ cursor @ 1+ crtstart + C!L
cursor @ 2+ setcursor ;
: CR cursor @ c/l 2* U/ 1+ c/l 2* *
DUP c/s 2* = IF DROP scrollup cursor @ THEN
setcursor ;
VID-DELAY 0= #IF
2 1 IN/OUT
CODE (type) ( AX has count, BX has string )
cursor [] DI MOV AX CX MOV style [] AH MOV BX SI MOV
' crtstart [] DI ADD
vidseg [] ES >SEG LOOP IF, BEGIN, BYTE LODS
STOS LOOP ~ UNTIL, THEN,
DI AX MOV ' crtstart [] AX SUB
RET END-CODE
SEPDSEG? NOT #IF CODE CS:TYPE END-CODE #THEN
: TYPE c/s cursor @ - OVER 2* < IF ( too big )
0 ?DO COUNT EMIT LOOP DROP
ELSE (type) setcursor THEN ;
#THEN
VID-DELAY 0= #IF
SEPDSEG? #IF
2 1 IN/OUT
CODE (cs:type) ( AX has count, BX has string )
cursor [] DI MOV AX CX MOV style [] AH MOV BX SI MOV
' crtstart [] DI ADD
vidseg [] ES >SEG LOOP IF, BEGIN, CS: BYTE LODS STOS
LOOP ~ UNTIL, THEN,
DI AX MOV ' crtstart [] AX SUB
RET END-CODE
: CS:TYPE c/s 2* cursor @ - OVER 2* < IF ( too big )
0 ?DO CS: COUNT EMIT LOOP DROP
ELSE (cs:type) setcursor THEN ;
#THEN #THEN
0A = #IF DECIMAL #THEN