07-30-2004, 10:05 AM
Quote:If it works fine with pure QB code, and won't need GHzs, You can do it... This is like FFIX.
But if You can not do it without using external routines, You can not say that it is 100% QB...
I thought that the QB included in DOS was first, and only that was improved later... Thanks for the info. But anyway, interrupt handling is built in at a version of QB - so I think it can be used.
Ummm...
A .qlb (QuickBASIC4.5 library) can be coded with pure QB,
just because it's a library doesn't mean it wasn't coded in pure QB.
(In my opinion a pure QB program can be anything programed in QB, a .QLb, an .EXE or a .BAS which doesn't use any ASM calls, or uses any other languages called from QB, eg... CALL ABSOLUTE.
Also QB.QLB is legal in my opinion too.)
Anyways, one day if I happen to run across this challenge thread and have finished a GREAT pure QB game, I'll upload it.
But for now I've only been messing around with pure QB coded tools to help make pure QB games, like grahic libs, key handlers, fast bit operations, ect...
Here's a pure QB library soon will be a .QLB library for screen 13.
I'm currently working on v1.2, which isn't finished yet, I've still yet to add a few things like translucency, palette manipulation, rotozoomers, etc... and maybe some 3-D routines too.
VIDEO13h v1.2 also uses a routine similar to SUPERPUT, so the library can use fast PUT/GET and all of QB's original graphic commands for screen 13.
Plus it has some custom PUT routines too. (Very fast for PUREQB)
Check it out...
Code:
'''
' VIDEO13h v1.2, Pure QuickBASIC 4.5; SCREEN 13 manipulation routines.
'
' (C)opyright 2004, Pure QB Innovations
'
' Email any questions, comments, or suggestions to...
' ESmemberNEMESIS@aol.com
'
' Visit the Pure QB Innovations web site at...
' http://members.aol.com/esmembernemesis/index.htm
'
' THIS PROGRAM MAY BE DISTRIBUTED FREELY AS PUBLIC DOMAIN SOFTWARE
' AS LONG AS ANY PART OF THIS FILE IS NOT ALTERED IN ANY WAY.
' IF YOU DO WISH TO USE THESE ROUTINES IN YOUR OWN PROGRAMS
' THEN PLEASE GIVE CREDIT TO THE AUTHOR... Mario LaRosa.
'
'
''
'
'$DYNAMIC
'
DEFINT A-Z
'
TYPE REGXdata
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FL AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
'
TYPE PNTdata
switch AS INTEGER
frame AS INTEGER
lb AS INTEGER
rb AS INTEGER
xx AS INTEGER
yy AS INTEGER
minXX AS INTEGER
minYY AS INTEGER
maxXX AS INTEGER
maxYY AS INTEGER
END TYPE
'
TYPE PALdata
RED AS INTEGER
GRN AS INTEGER
BLU AS INTEGER
END TYPE
'
COMMON SHARED PAL() AS PALdata
'
COMMON SHARED REGX AS REGXdata
COMMON SHARED PNT AS PNTdata
COMMON SHARED SYS&
COMMON SHARED Vtarget, VGAlo, VGAhi, V13lo, V13hi
COMMON SHARED FONTScolour
COMMON SHARED clipXXleft, clipYYtop, clipXXright, clipYYbottom
'
DECLARE SUB DEMO ()
'
DECLARE SUB INTERRUPTX (INTNUM AS INTEGER, INREG AS REGXdata, OUTREG AS REGXdata)
'
DECLARE SUB V13hCLS (colour)
DECLARE SUB V13hCLP (XXleft, YYtop, XXright, YYbottom)
DECLARE SUB V13hPAL (file$)
DECLARE SUB V13hBLD (ARRAY(), file$)
DECLARE SUB V13hBSV (ARRAY(), file$)
DECLARE SUB V13hDEL (seconds!)
DECLARE SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
DECLARE SUB V13hKEY ()
DECLARE SUB V13hPAN (direction, increment, wrap)
DECLARE SUB V13hPNT (ARRAY(), frame)
DECLARE SUB V13hPUT (ARRAY(), XXleft, YYtop, frame, mode$)
DECLARE SUB V13hSEE ()
DECLARE SUB V13hSET ()
DECLARE SUB V13hTXT (ARRAY(), XXcenter, XXleft, YYtop, colour, text$)
'
DECLARE FUNCTION V13hLOF& (file$)
'
DIM SHARED PAL(0 TO 255) AS PALdata
'
DIM SHARED VIDEO(0 TO 31999)
DIM SHARED FONTS(0 TO 3263)
DIM SHARED MOUSE(0 TO 129)
DIM SHARED BOARD(0 TO 127)
'
V13hSET
'
DEMO
'
KILL "video.tmp"
'
SYSTEM
'
SUB DEMO
'
' DRAW AND GET, (-3- 20*20) TILES. (DEMO)...
'
DIM TILES(0 TO 606)
V13hCLS 0
FOR x = 0 TO 40 STEP 20
col = col + 1
LINE (x, 0)-(x + 19, 19), col, BF
LINE (x, 0)-(x + 19, 19), 15, B
LINE (x + 5, 5)-(x + 14, 14), 0, BF
GET (x, 0)-(x + 19, 19), TILES(stp)
stp = stp + 202
NEXT
'
'GOTO PAN
'
'SCROLLING FONT DEMO...
'
FOR y = (clipYYbottom + 1) TO (clipYYtop - (34 * 8)) STEP -1
V13hCLS 0
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 0), 15, "-WELCOME-"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 2), 7, "VIDEO13h v1.2, pure QuickBASIC 4.5,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 4), 7, "SCREEN 13 manipulation routines."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 8), 15, "-FEATURES-"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 10), 7, "320X200X256 resolution (VGA),"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 12), 7, "page flipping, sprite animation,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 14), 7, "sprite clipping, font routines,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 16), 7, "mouse and keyboard handlers."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 18), 7, "Also supports most of QB's,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 20), 7, "original graphic commands too!"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 24), 15, "-REQUIREMENTS-"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 26), 7, "100+ Mhz PC processor, a VGA monitor,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 28), 7, "keyboard and mouse, QuickBASIC v4.5,"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 30), 7, "and a disk cache active."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 34), 15, "-CREDITS-"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 36), 15, "...Programmer..."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 38), 7, "Mario LaRosa, ESmemberNEMESIS@aol.com"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 42), 15, "...Special Thanks..."
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 44), 7, "Jonathan Dale Kirwan, JonKirwan@aol.com"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 46), 7, "Quinton Roberts, Eclipzer@aol.com"
V13hTXT FONTS(), FALSE, 0, (8 * 24), 15, "(C)opyright 2004,"
V13hTXT FONTS(), FALSE, (8 * 18), (8 * 24), 12, "Pure"
V13hTXT FONTS(), FALSE, (8 * 23), (8 * 24), 10, "QB"
V13hTXT FONTS(), FALSE, (8 * 26), (8 * 24), 9, "Innovations"
V13hSEE
'
'WAIT &H3DA, 8
'
IF LEN(INKEY$) THEN EXIT FOR
NEXT
SLEEP
'
'FADE OUT/IN DEMO...
'
'
V13hFDE NOT FALSE, NOT FALSE, 1 / 32
'
'DELAY (1/2 SECONDS) DEMO...
'
DO: LOOP UNTIL TIMER <> TIMER
DO
t! = TIMER
V13hDEL 1 / 2
PRINT TIMER - t!
LOOP UNTIL LEN(INKEY$)
'
'''
''' CLEAR SCREEN (256X) DEMO...
'''
'
t! = TIMER
FOR c = 0 TO 255
V13hCLS c
V13hSEE
NEXT
LOCATE 1, 1: PRINT "CLS, (256X):"; TIMER - t!
SLEEP
'
'''
''' (1O,OOO) RANDOM PIXELS DEMO...
'''
V13hCLS 0
t! = TIMER
FOR x = 1 TO 10000
PSET (INT(RND(1) * 319 + 1), INT(RND(1) * 199 + 1)), INT(RND(1) * 255 + 1)
NEXT
V13hSEE
LOCATE 1, 1: PRINT "PSET, (1O,OOOX):"; TIMER - t!
SLEEP
'
'''
''' (1O,OOO) RANDOM LINES DEMO...
'''
'
V13hCLS 0
t! = TIMER
FOR x = 1 TO 10000
x1 = INT(RND * 340) - 10: x2 = INT(RND * 340) - 10
y1 = INT(RND * 220) - 10: y2 = INT(RND * 220) - 10
LINE (x1, y1)-(x2, y2), INT(RND * 15) + 1
NEXT
V13hSEE
LOCATE 1, 1: PRINT "LINE, (1O,OOOX):"; TIMER - t!
SLEEP
'
'''
''' (1,OOO) RANDOM TILES DEMO...
'''
'
kind$ = "TRANSPARENT"
DO
V13hCLS 0
t! = TIMER
FOR t = 1 TO 1000
xx = INT(RND(1) * 341 + -20)
yy = INT(RND(1) * 221 + -20)
frame = INT(RND(1) * 3 + 1)
V13hPUT TILES(), xx, yy, frame, kind$
NEXT
V13hSEE
k$ = "PUT " + kind$ + ", (1,OOOX):"
LOCATE 1, 1: PRINT k$; TIMER - t!
SLEEP
SELECT CASE kind$
CASE "TRANSPARENT"
kind$ = "BEHIND"
CASE "BEHIND"
kind$ = "PSET"
CASE "PSET"
kind$ = "PRESET"
CASE "PRESET"
kind$ = "AND"
CASE "AND"
kind$ = "OR"
CASE "OR"
kind$ = "XOR"
CASE "XOR"
EXIT DO
END SELECT
LOOP
'
'PAN:
'
'''
'''PANNING SETUP...
'''
'
'FOR c = 1 TO 2
' IF c = 2 THEN V13hCLP 30, 20, 289, 179
' FOR yy = 0 TO 180 STEP 20
' FOR xx = -20 TO 300 STEP 20
' V13hPUT TILES(), xx, yy, c, "PSET"
' NEXT
' NEXT
' V13hPUT TILES(), 150, 90, c + 1, "TRANSPARENT"
' V13hSEE
'NEXT
'
'V13hCLP 0, 0, 319, 199
'
'''
'''KEYBOARD (ARROWS) DEMO
'''
'
CLS
DO
V13hKEY
LOCATE 1, 1: PRINT "Arrow up: "; BOARD(72); " "
LOCATE 2, 1: PRINT "Arrow down: "; BOARD(80); " "
LOCATE 3, 1: PRINT "Arrow right: "; BOARD(77); " "
LOCATE 4, 1: PRINT "Arrow left: "; BOARD(75); " "
LOCATE 6, 1: PRINT "Esc to exit."
LOOP UNTIL BOARD(1)
'
'''
'''KEYBOARD & PANNING DEMO
'''
'
'DO
'V13hKEY
'IF BOARD(80) THEN V13hPAN 8, 1, NOT FALSE
'IF BOARD(75) THEN V13hPAN 6, 1, NOT FALSE
'IF BOARD(77) THEN V13hPAN 4, 1, NOT FALSE
'IF BOARD(72) THEN V13hPAN 2, 1, NOT FALSE
'V13hTXT FONTS(), FALSE, 0, 0, 15, "Arrow up: " + STR$(BOARD(80))
'V13hTXT FONTS(), FALSE, 0, 8, 15, "Arrow down: " + STR$(BOARD(72))
'V13hTXT FONTS(), FALSE, 0, 16, 15, "Arrow right: " + STR$(BOARD(75))
'V13hTXT FONTS(), FALSE, 0, 24, 15, "Arrow left: " + STR$(BOARD(77))
'V13hSEE
'V13hCLS 0
'LOOP UNTIL BOARD(1)
'
END SUB
REM $STATIC
SUB V13hBLD (ARRAY(), file$)
'
length& = V13hLOF&(file$)
IF length& THEN
Words = (length& \ 2) - 1
REDIM ARRAY(0 TO Words)
DEF SEG = VARSEG(ARRAY(0))
BLOAD file$, 0
END IF
'
END SUB
SUB V13hBSV (ARRAY(), file$)
'
DEF SEG = VARSEG(ARRAY(0)): BSAVE file$, 0, (UBOUND(ARRAY) + 1) * 2
'
END SUB
SUB V13hCLP (XXleft, YYtop, XXright, YYbottom)
'
clipXXleft = XXleft
clipYYtop = YYtop
clipXXright = XXright
clipYYbottom = YYbottom
'
IF clipXXleft < 0 THEN clipXXleft = 0
IF clipXXright > 319 THEN clipXXright = 319
IF clipYYtop < 0 THEN clipYYtop = 0
IF clipYYbottom > 199 THEN clipYYbottom = 199
'
END SUB
SUB V13hCLS (colour)
'
IF colour THEN
LINE (clipXXleft, clipYYtop)-(clipXXright, clipYYbottom), colour, BF
ELSE
REDIM VIDEO(0 TO 31999)
END IF
'
END SUB
SUB V13hDEL (seconds!)
'
IF seconds! THEN
'
FOR inc& = 1 TO (SYS& * (seconds! * 18.6245)): NEXT
'
ELSE
'
DEF SEG = &H40
'
DO: LOOP UNTIL PEEK(&H6C) <> PEEK(&H6C)
'
t = PEEK(&H6C)
'
DO
FOR clc& = clc& TO clc& * 2: NEXT
LOOP UNTIL t <> PEEK(&H6C)
'
SYS& = clc&
'
I& = 1
'
DO
'
I& = I& * 2
d& = clc& \ I&
'
DO: LOOP UNTIL PEEK(&H6C) <> PEEK(&H6C)
'
t = PEEK(&H6C)
'
FOR inc& = 1 TO SYS&: NEXT
'
IF t <> PEEK(&H6C) THEN
'
SYS& = SYS& - d&
'
ELSE
'
SYS& = SYS& + d&
'
END IF
'
LOOP UNTIL I& >= clc&
'
END IF
'
END SUB
SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
'
OUT &H3C8, 0
'
IF fadeOUT THEN
FOR y = 0 TO 63
FOR x = 0 TO 255
r = PAL(x).RED - y
g = PAL(x).GRN - y
b = PAL(x).BLU - y
IF r < 0 THEN r = 0
IF g < 0 THEN g = 0
IF b < 0 THEN b = 0
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, b
NEXT
V13hDEL fadeSEC!
NEXT
END IF
'
IF fadeINN THEN
FOR y = 0 TO 63
FOR x = 0 TO 255
r = PAL(x).RED
g = PAL(x).GRN
b = PAL(x).BLU
IF y < r THEN r = y
IF y < g THEN g = y
IF y < b THEN b = y
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, b
NEXT
V13hDEL fadeSEC!
NEXT
END IF
'
END SUB
SUB V13hKEY STATIC
'
I = INP(&H60)
IF (I AND &H80) THEN
BOARD(I XOR &H80) = FALSE
ELSE
BOARD(I) = NOT FALSE
END IF
DEF SEG = &H40: POKE &H1C, PEEK(&H1A)
'
END SUB
REM $DYNAMIC
FUNCTION V13hLOF& (file$)
'
FileNum = FREEFILE
OPEN file$ FOR BINARY ACCESS READ AS FileNum
V13hLOF& = LOF(FileNum) - 7
CLOSE FileNum
'
END FUNCTION
REM $STATIC
SUB V13hPAL (file$)
'
DEF SEG = VARSEG(PAL(0))
BLOAD file$, 0
OUT &H3C8, 0
FOR x = 0 TO 255
OUT &H3C9, PAL(x).RED
OUT &H3C9, PAL(x).GRN
OUT &H3C9, PAL(x).BLU
NEXT
'
END SUB
SUB V13hPAN (direction, increment, wrap)
'
incw1 = increment - 1
DIM bufferX(0 TO incw1, clipXXleft TO clipXXright) AS INTEGER
DIM bufferY(0 TO incw1, clipYYtop TO clipYYbottom) AS INTEGER
segVIDEO = VARSEG(VIDEO(0))
SELECT CASE direction
CASE 1
IF wrap THEN
FOR z = 0 TO incw1
DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
FOR x = clipXXleft TO clipXXright
bufferX(z, x) = PEEK(x)
NEXT
NEXT
FOR z = 0 TO incw1
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
bufferY(z, y) = PEEK(clipXXleft + z)
NEXT
NEXT
END IF
inc1 = clipYYbottom - increment
inc2 = clipXXleft + increment
inc3 = 319 * increment
FOR y = inc1 TO clipYYtop STEP -1
DEF SEG = segVIDEO + (y * 20)
FOR x = inc2 TO clipXXright
POKE (x + inc3), PEEK(x)
NEXT
NEXT
IF wrap THEN
FOR z = 0 TO incw1
incw2 = incw1 - z
DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
FOR x = clipXXleft TO (clipXXright - increment)
POKE x, bufferX(incw2, (x + increment))
NEXT
ninc = clipXXleft
FOR x = (clipXXright - incw1) TO clipXXright
POKE x, bufferX(incw2, ninc)
ninc = ninc + 1
NEXT
NEXT
FOR z = 0 TO incw1
inc1 = (clipXXright - incw1) + z
FOR y = (clipYYtop + increment) TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
POKE inc1, bufferY(z, (y - increment))
NEXT
NEXT
END IF
CASE 2
IF wrap THEN
FOR y = 0 TO incw1
DEF SEG = segVIDEO + ((clipYYbottom - y) * 20)
FOR x = clipXXleft TO clipXXright
bufferX(y, x) = PEEK(x)
NEXT
NEXT
END IF
inc1 = clipYYbottom - increment
inc2 = 320 * increment
FOR y = inc1 TO clipYYtop STEP -1
DEF SEG = segVIDEO + (y * 20)
FOR x = clipXXleft TO clipXXright
POKE (x + inc2), PEEK(x)
NEXT
NEXT
IF wrap THEN
FOR y = 0 TO incw1
incw2 = incw1 - y
DEF SEG = segVIDEO + ((clipYYtop + y) * 20)
FOR x = clipXXleft TO clipXXright
POKE x, bufferX(incw2, x)
NEXT
NEXT
END IF
CASE 3
IF wrap THEN
FOR z = 0 TO incw1
DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
FOR x = clipXXleft TO clipXXright
bufferX(z, x) = PEEK(x)
NEXT
NEXT
FOR z = 0 TO incw1
inc1 = clipXXright - z
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
bufferY(z, y) = PEEK(inc1)
NEXT
NEXT
END IF
inc1 = clipYYbottom - increment
inc2 = clipXXright - increment
inc3 = 321 * increment
FOR y = inc1 TO clipYYtop STEP -1
DEF SEG = segVIDEO + (y * 20)
FOR x = inc2 TO clipXXleft STEP -1
POKE (x + inc3), PEEK(x)
NEXT
NEXT
IF wrap THEN
FOR z = 0 TO incw1
incw2 = incw1 - z
DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
FOR x = (clipXXleft + increment) TO clipXXright
POKE x, bufferX(incw2, (x - increment))
NEXT
ninc = clipXXright - incw1
FOR x = clipXXleft TO clipXXleft + incw1
POKE x, bufferX(incw2, ninc)
ninc = ninc + 1
NEXT
NEXT
FOR z = 0 TO incw1
inc1 = (clipXXleft + incw1) - z
FOR y = (clipYYtop + increment) TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
POKE inc1, bufferY(z, (y - increment))
NEXT
NEXT
END IF
CASE 4
IF wrap THEN
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
FOR x = 0 TO incw1
bufferY(x, y) = PEEK(clipXXleft + x)
NEXT
NEXT
END IF
inc1 = clipXXright - increment
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
FOR x = clipXXleft TO inc1
POKE x, PEEK(x + increment)
NEXT
NEXT
IF wrap THEN
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
inc1 = (clipXXright - incw1)
FOR x = 0 TO incw1
POKE inc1 + x, bufferY(x, y)
NEXT
NEXT
END IF
CASE 6
IF wrap THEN
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
inc1 = (clipXXright - incw1)
FOR x = 0 TO incw1
bufferY(x, y) = PEEK(inc1 + x)
NEXT
NEXT
END IF
inc1 = clipXXleft + increment
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
FOR x = clipXXright TO inc1 STEP -1
POKE x, PEEK(x - increment)
NEXT
NEXT
IF wrap THEN
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
FOR x = 0 TO incw1
POKE (clipXXleft + x), bufferY(x, y)
NEXT
NEXT
END IF
CASE 7
IF wrap THEN
FOR z = 0 TO incw1
DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
FOR x = clipXXleft TO clipXXright
bufferX(z, x) = PEEK(x)
NEXT
NEXT
FOR z = 0 TO incw1
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
bufferY(z, y) = PEEK(clipXXleft + z)
NEXT
NEXT
END IF
inc1 = clipYYbottom - increment
inc2 = clipXXright - increment
inc3 = (321 * increment)
FOR y = clipYYtop TO inc1
DEF SEG = segVIDEO + (y * 20)
FOR x = clipXXleft TO inc2
POKE x, PEEK(x + inc3)
NEXT
NEXT
IF wrap THEN
FOR z = 0 TO incw1
incw2 = incw1 - z
DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
FOR x = clipXXleft TO (clipXXright - increment)
POKE x, bufferX(incw2, (x + increment))
NEXT
ninc = 0
FOR x = (clipXXright - incw1) TO clipXXright
POKE x, bufferX(incw2, (clipXXleft + ninc))
ninc = ninc + 1
NEXT
NEXT
FOR z = 0 TO incw1
inc1 = (clipXXright - incw1) + z
FOR y = clipYYtop TO (clipYYbottom - increment)
DEF SEG = segVIDEO + (y * 20)
POKE inc1, bufferY(z, (y + increment))
NEXT
NEXT
END IF
CASE 8
IF wrap THEN
FOR y = 0 TO incw1
DEF SEG = segVIDEO + ((clipYYtop + y) * 20)
FOR x = clipXXleft TO clipXXright
bufferX(y, x) = PEEK(x)
NEXT
NEXT
END IF
inc1 = clipYYbottom - increment
inc2 = 320 * increment
FOR y = clipYYtop TO inc1
DEF SEG = segVIDEO + (y * 20)
FOR x = clipXXleft TO clipXXright
POKE x, PEEK(x + inc2)
NEXT
NEXT
IF wrap THEN
FOR y = incw1 TO 0 STEP -1
incw2 = incw1 - y
DEF SEG = segVIDEO + ((clipYYbottom - y) * 20)
FOR x = clipXXleft TO clipXXright
POKE x, bufferX(incw2, x)
NEXT
NEXT
END IF
'
CASE 9
'
IF wrap THEN
FOR z = 0 TO incw1
DEF SEG = segVIDEO + ((clipYYtop + z) * 20)
FOR x = clipXXleft TO clipXXright
bufferX(z, x) = PEEK(x)
NEXT
NEXT
FOR z = 0 TO incw1
inc1 = (clipXXright - z)
FOR y = clipYYtop TO clipYYbottom
DEF SEG = segVIDEO + (y * 20)
bufferY(z, y) = PEEK(inc1)
NEXT
NEXT
END IF
inc1 = clipYYbottom - increment
inc2 = clipXXleft + increment
inc3 = (319 * increment)
FOR y = clipYYtop TO inc1
DEF SEG = segVIDEO + (y * 20)
FOR x = clipXXright TO inc2 STEP -1
POKE x, PEEK(x + inc3)
NEXT
NEXT
IF wrap THEN
FOR z = 0 TO incw1
incw2 = incw1 - z
DEF SEG = segVIDEO + ((clipYYbottom - z) * 20)
FOR x = (clipXXleft + increment) TO clipXXright
POKE x, bufferX(incw2, (x - increment))
NEXT
ninc = incw1
FOR x = clipXXleft TO clipXXleft + incw1
POKE x, bufferX(incw2, (clipXXright - ninc))
ninc = ninc - 1
NEXT
NEXT
FOR z = 0 TO incw1
inc1 = (clipXXleft + incw1) - z
FOR y = clipYYtop TO (clipYYbottom - increment)
DEF SEG = segVIDEO + (y * 20)
POKE inc1, bufferY(z, (y + increment))
NEXT
NEXT
END IF
END SELECT
'
END SUB
SUB V13hPNT (ARRAY(), frame)
'
IF PNT.switch THEN
REGX.AX = 3
INTERRUPTX &H33, REGX, REGX
PNT.lb = ((REGX.BX AND 1) <> 0)
PNT.rb = ((REGX.BX AND 2) <> 0)
PNT.xx = REGX.CX \ 2
PNT.yy = REGX.DX
PNT.frame = frame
IF PNT.xx < PNT.minXX THEN PNT.xx = PNT.minXX
IF PNT.xx > PNT.maxXX THEN PNT.xx = PNT.maxXX
IF PNT.yy < PNT.minYY THEN PNT.yy = PNT.minYY
IF PNT.yy > PNT.maxYY THEN PNT.yy = PNT.maxYY
'
V13hPUT ARRAY(), PNT.xx, PNT.yy, PNT.frame, "TRANSPARENT"
'
END IF
'
END SUB
SUB V13hPUT (ARRAY(), XXleft, YYtop, frame, mode$)
'
IF frame THEN
'
VIDEOseg = VARSEG(VIDEO(0))
TILESseg = VARSEG(ARRAY(0))
'
TILESwidth = ARRAY(0) \ 8
'
TH = ARRAY(1) - 1
TW = TILESwidth - 1
TP = (TILESwidth * ARRAY(1)) + 4
TF = frame - 1
TL = XXleft + TW
TT = YYtop + TH
'
'TI = (TP \ 2) * TF: IF TI > UBOUND(ARRAY) THEN EXIT SUB
'
IF XXleft < clipXXleft THEN
CLIP = NOT FALSE
XL = clipXXleft
CLIPadd = clipXXleft - XXleft
IF CLIPadd > TW THEN EXIT SUB
IF CLIPadd < 0 THEN CLIPadd = -CLIPadd
CL = CLIPadd
ELSE
XL = XXleft
END IF
'
IF TL > clipXXright THEN
CLIP = NOT FALSE
XR = clipXXright
CLIPadd = TL - clipXXright
IF CLIPadd > TW THEN EXIT SUB
ELSE
XR = TL
END IF
'
IF YYtop < clipYYtop THEN
CLIP = NOT FALSE
YT = VIDEOseg + (clipYYtop * 20)
CT = clipYYtop - YYtop
IF CT > TH THEN EXIT SUB
IF CT < 0 THEN CT = -CT
CT = CT * TILESwidth
ELSE
YT = VIDEOseg + (YYtop * 20)
END IF
'
IF TT > clipYYbottom THEN
CLIP = NOT FALSE
YB = VIDEOseg + (clipYYbottom * 20)
IF (TT - clipYYbottom) > TH THEN EXIT SUB
ELSE
YB = VIDEOseg + (TT * 20)
END IF
'
t = ((TP * TF) + (CL + CT)) + 4
'
DIM c(XL TO XR)
'
SELECT CASE mode$
'
CASE "SOLID"
'
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x)
NEXT
NEXT
'
CASE "TRANSPARENT"
'
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
IF c(x) THEN POKE x, c(x)
NEXT
NEXT
'
CASE "BEHIND"
'
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
IF PEEK(x) THEN ELSE POKE x, c(x)
NEXT
NEXT
'
CASE "PSET"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), PSET
END IF
'
CASE "PRESET"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, NOT c(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), PRESET
END IF
'
CASE "AND"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x) AND PEEK(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), AND
END IF
'
CASE "OR"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x) OR PEEK(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), OR
END IF
'
CASE "XOR"
'
IF CLIP THEN
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
POKE x, c(x) XOR PEEK(x)
NEXT
NEXT
ELSE
PUT (XXleft, YYtop), ARRAY((TP \ 2) * TF), XOR
END IF
'
CASE "FONT"
'
FOR y = YT TO YB STEP 20
DEF SEG = TILESseg
FOR x = XL TO XR
c(x) = PEEK(t)
t = t + 1
NEXT
t = t + CLIPadd
DEF SEG = y
FOR x = XL TO XR
IF c(x) THEN POKE x, c(x) + FONTScolour
NEXT
NEXT
'
END SELECT
'
END IF
'
END SUB
SUB V13hSEE
'
DEF SEG = VARSEG(VIDEO(0)): BSAVE "video.tmp", 0, &HFA00
DEF SEG = &HA000: BLOAD "video.tmp", 0
'
END SUB
SUB V13hSET
'
SCREEN 13: CLS : COLOR 255
'
'Capture current palette
'
OUT &H3C7, 0
'
FOR x = 0 TO 255
PAL(x).RED = INP(&H3C9)
PAL(x).GRN = INP(&H3C9)
PAL(x).BLU = INP(&H3C9)
NEXT
'
REG.AX = 0
INTERRUPTX &H33, REGX, REGX
IF REGX.AX THEN PNT.switch = NOT FALSE
'
'put MOUSE
'
REGX.AX = 4
REGX.CX = 0
REGX.DX = 0
INTERRUPTX &H33, REGX, REGX
'
'show MOUSE
'
REGX.AX = 1
INTERRUPTX &H33, REGX, REGX
'
'capture MOUSE
'
GET (0, 0)-(15, 15), MOUSE
'
'hide MOUSE
'
REGX.AX = 2
INTERRUPTX &H33, REGX, REGX
'
PNT.minXX = 0
PNT.minYY = 0
PNT.maxXX = 319
PNT.maxYY = 199
'
FOR x = 1 TO 32
LOCATE 1, x: PRINT CHR$(x + 31)
LOCATE 2, x: PRINT CHR$(x + 63)
LOCATE 3, x: PRINT CHR$(x + 95)
NEXT
'
FOR y = 0 TO 23 STEP 8
FOR x = 0 TO 255 STEP 8
GET (x, y)-(x + 7, y + 7), FONTS(e)
e = e + 34
NEXT
NEXT
'
CLS : PRESET (160, 100), 0
'
VIDEOseg = VARSEG(VIDEO(0))
DEF SEG : BSAVE "video.tmp", &H0, &HFA00
DEF SEG = VIDEOseg: BLOAD "video.tmp", 0
FOR I = LBOUND(VIDEO) TO (UBOUND(VIDEO) - 1)
IF VIDEO(I) = &H7DA0 AND VIDEO(I + 1) = &HA000 THEN
Vtarget = ((I + 1) * 2)
V13lo = VIDEOseg AND &HFF
IF (VIDEOseg AND &H8000) THEN
V13hi = ((VIDEOseg AND &HFF00) \ &HFF) + &H100
ELSE
V13hi = (VIDEOseg AND &HFF00) \ &HFF
END IF
DEF SEG
VGAlo = PEEK(Vtarget): VGAhi = PEEK(Vtarget + 1)
POKE Vtarget, V13lo: POKE (Vtarget + 1), V13hi
END IF
NEXT
'
V13hCLP 0, 0, 319, 199
'
COLOR 15
'
V13hDEL calibrate!
'
END SUB
SUB V13hTXT (ARRAY(), XXcenter, XXleft, YYtop, colour, text$)
'
FONTwidth = ARRAY(0) \ 8
FONTScolour = -255 + colour
FONTyy = YYtop
'
TL = LEN(text$)
'
IF XXcenter THEN
CX = (clipXXleft + ((clipXXright - clipXXleft) + 1) \ 2)
xx = CX - ((TL * FONTwidth) \ 2)
ELSE
xx = XXleft
END IF
'
FOR x = 1 TO TL
frame = (ASC(MID$(text$, x, 1)) - 31)
FONTxx = xx + ((x - 1) * FONTwidth)
V13hPUT ARRAY(), FONTxx, FONTyy, frame, "FONT"
NEXT
'
END SUBPlease don't distribute this program, I need to finish it first ;)
P.s...
let me know what you think, my goal here is to create the fastest pure QB screen 13 library on the internet!
Cya.