Category : Forth Source Code
Archive   : FPCHERC.ZIP
Filename : HERCVID.SEQ

 
Output of file : HERCVID.SEQ contained in archive : FPCHERC.ZIP
\ HERCVID.SEQ -- words to use graphics mode of Hercules card
\ Paul Snyder 8.28.89

POSTFIX
\ ES DI CX AX
CODE EWFILL ( SEGMENT OFFSET LENGTH FILLWORD--)
ES DX MOV AX POP CX POP DI POP ES POP
REP AX STOS
DX ES MOV
NEXT
END-CODE
PREFIX
CODE 8/ ( N--N/8)
POP AX SAR AX, # 1
SAR AX, # 1 SAR AX, # 1
1PUSH END-CODE
\ hercules: DATA STRUCTURES---------------------------------------------
hex
03B4 CONSTANT 6845INDEX 03B5 CONSTANT 6845DATA
03BF CONSTANT CONFIG 03B8 CONSTANT CNTRL
03 CONSTANT GALLOW 08 CONSTANT SCRN-ON
82 CONSTANT HMONO 20 CONSTANT HTEXT

HEX B000 CONSTANT PAGE0 B800 CONSTANT PAGE1
VARIABLE ACTIVE.PAGE PAGE1 ACTIVE.PAGE !
VARIABLE LASTX VARIABLE LASTY VARIABLE COLOR
1 COLOR !

CREATE GTABLE 35 C, 2D C, 2E C, 07 C, 5B C, 02 C,
57 C, 57 C, 02 C, 03 C, 00 C, 00 C,
CREATE TTABLE 61 C, 50 C, 52 C, 0F C, 19 C, 06 C,
19 C, 19 C, 02 C, 0D C, 0B C, 0C C,

DECIMAL
0 VALUE HGX.MIN 720 VALUE HGX.MAX
0 VALUE HGY.MIN 348 VALUE HGY.MAX

CREATE HGROW 350 2* ALLOT \ this table holds screen row addr's
CODE HGROW[] ( inx--n)
POP AX SHL AX, # 1
ADD AX, # HGROW MOV BX, AX
PUSH 0 [BX]
NEXT END-CODE

: FILL.HGROW ( --) \ fills up row table then disappears from dict.
348 0 DO 8192 I 4 MOD * 90 I 4 / * + HGROW I 2* + ! LOOP ;
FILL.HGROW FORGET FILL.HGROW

\ --------------------------------------------------------------------------
: calc.bos ( x y--offset)
\ calculate byte offset into screen given x & y in pixels
HGROW[] swap 8/ + \ ref. Hercules book p 78
;
\ HERCULES: TMODE GMODE TERASE GERASE
HEX
: TMODE
TTABLE HTEXT CNTRL P! 0C 0
DO I 6845INDEX P! DUP C@ 6845DATA P! 1+ LOOP
DROP HTEXT SCRN-ON OR CNTRL P!
;
: GMODE
GALLOW CONFIG P!
GTABLE HMONO CNTRL P! 0C 0
DO I 6845INDEX P! DUP C@ 6845DATA P! 1+ LOOP
DROP HMONO SCRN-ON OR CNTRL P!
;
: GERASE B800 0 4000 0 EWFILL ;
: TERASE B000 0 4000 0720 EWFILL ;
DECIMAL

\ HERCULES: TXT GR @SCRN.BYTE !SCRN.BYTE
POSTFIX
CODE @SCRN.BYTE ( OFFSET.BYTE SCRN.PAGE--C)
DS DX MOV SI CX MOV
DS POP SI POP 0 # AX MOV AL LODS
DX DS MOV CX SI MOV 1PUSH
END-CODE

CODE !SCRN.BYTE ( C OFFSET SCRN.PAGE--)
ES DX MOV ES POP DI POP AX POP AL STOS
DX ES MOV NEXT
END-CODE


\ HERCULES: PLOT SCRN
: PLOT ( x y--) \ 0 <= x<720 0<=Y<348
2DUP LASTY ! LASTX !
HGROW[] \ calc offset byte into scrn, puts you at beg of rast line
SWAP 8 /MOD SWAP NEGATE 7 + >R + \ & bit in offset byte
DUP ACTIVE.PAGE @ @SCRN.BYTE \ fetch byte from scrn mem
1 R> 0 ?DO 2* LOOP COLOR @ \ shift to proper bit & ck color
IF OR ELSE NOT AND THEN \ if color=1 setpix else clear pix
SWAP ACTIVE.PAGE @ !SCRN.BYTE \ store byte back in scrn mem
;

: TXT TMODE ;
: GR GMODE GERASE 1 color ! ;

: SCRN ( x y--bit) \ bit=1 or 0
HGROW[]
SWAP 8 /MOD SWAP NEGATE 7 + >R +
ACTIVE.PAGE @ @SCRN.BYTE
R> 0 ?DO 2/ LOOP 1 AND
;


\ HERCULES: HLIN VLIN PLOT.TO & TING'S DRAW
: HLIN ( x1 x2 y--)
-ROT 2DUP MAX 1+ -ROT MIN DO I OVER PLOT LOOP DROP
;
: VLIN ( y1 y2 x--)
-ROT 2DUP MAX 1+ -ROT MIN DO DUP I PLOT LOOP DROP
;
: DRAW ( x1 y1 x2 y2--)
2OVER 2OVER ROT - ABS >R - ABS R> MAX 2 <
IF 2DROP PLOT EXIT THEN
2OVER 2OVER ROT + 1+ 2/ >R + 1+ 2/ R>
2DUP 2ROT RECURSE RECURSE
;
: PLOT.TO ( x y--)
2DUP LASTX @ LASTY @ DRAW LASTY ! LASTX !
;

DECIMAL


\ HERCVID.SEQ -- words to use graphics mode of Hercules card


  3 Responses to “Category : Forth Source Code
Archive   : FPCHERC.ZIP
Filename : HERCVID.SEQ

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/