Alright... here's my screen 13 lib, VIDEO13h v1.5...
Please don't distribute since this is not the official public release :lol:
Feel free to beta this version, and this should be my last non-public release, so I suspect version 1.6 will be the official public release 8) And it will include all source, ofcourse, and also a .QLB version too!
Anyways check out the PUT routine which still doesn't include roto-zooming but, I did optimize it a bit, and it should be able to handle those large sprites, up to 320X200 in size even.
I also squashed some minor bugs here and there, so check it out!!!
Let me know what you think, and if you want to talk :barf:
about it and tell me something like this should've been released like 5+ yrs. ago, then go ahead, let it out :cry:
(Then in another 5 years when I finish some games with it you can
appologize, hehhh!!!)
Cya!
Nemesis
:::EDIT #1:::
'''
' VIDEO13h v1.5, QuicKBASIC 4.5; SCREEN 13 manipulation routines.
'
' (C)opyright 2005, Pure QB Innovations
'
' Email any questions, comments, or suggestions to...
' Nemesis2473@yahoo.com
'
' THIS PROGRAM IS BEING RELEASED AS FREEWARE SOFTWARE AND MAY BE DISTRIBUTED
' FREELY AS LONG AS ANY PART OF THIS FILE IS NOT ALTERED IN ANY WAY.
' THE AUTHOR OF THIS PROGRAM IS BY NO MEANS RESPONSIBLE FOR ANY DAMMAGES
' THAT HAVE EITHER OCCURED OR MAY OCCUR WHILE USING ANY PART OF THIS PROGRAM.
' 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 PUTcolour, PUTscale, PUTrotate
COMMON SHARED WXL, WYT, WXR, WYB
COMMON SHARED SYS&
'
DECLARE FUNCTION V13hKEY (scan)
DECLARE FUNCTION V13hLOF& (FILE$)
'
DECLARE SUB INTERRUPTX (INTNUM AS INTEGER, INREG AS REGXdata, OUTREG AS REGXdata)
'
DECLARE SUB V13hCLS (colour)
DECLARE SUB V13hWIN (xxLEFT, yyTOP, xxRIGHT, yyBOTTOM)
DECLARE SUB V13hCPY (Tsegm&, Toffs, Dsegm&, Doffs, BYTES&, Blits$)
DECLARE SUB V13hGRD (colour, gradient)
DECLARE SUB V13hPAL (FILE$)
DECLARE SUB V13hBLN (FILE$)
DECLARE SUB V13hBLD (ARRAY(), FILE$)
DECLARE SUB V13hBND (ARRAY(), FILE$)
DECLARE SUB V13hBSV (ARRAY(), FILE$)
DECLARE SUB V13hDLY (seconds!)
DECLARE SUB V13hFDE (fadeOUT, fadeINN, fadeSEC!)
DECLARE SUB V13hPNT (ARRAY(), FRAME, colour, SKIN$)
DECLARE SUB V13hPUT (ARRAY(), xxLEFT, yyTOP, FRAME, SKIN$)
DECLARE SUB V13hSEE ()
DECLARE SUB V13hSET ()
DECLARE SUB V13hTXT (ARRAY(), XXcenter, xxLEFT, yyTOP, colour, text$, SKIN$)
'
DECLARE SUB DEMO ()
'
DIM SHARED PAL(255) AS PALdata
'
DIM SHARED BLN&(255)
'
DIM SHARED VIDEO(32007)
DIM SHARED BLEND(16447)
DIM SHARED FONTS(3263)
DIM SHARED MOUSE(129)
DIM SHARED MASK(129)
DIM SHARED BOARD(127)
'
V13hSET
'
DEMO
'
SYSTEM
'
REM $STATIC
SUB DEMO
'
'DRAW AND GET, (-1- 64*64) TILE. (DEMO)...
'
DIM BALL(2049)
FOR S = 31 TO 1 STEP -1
CIRCLE (32, 32), S, 31 - S \ 2
PAINT (32, 32), 31 - S \ 2
NEXT S
GET (0, 0)-(63, 63), BALL(0)
'
CLS
'
' DRAW AND GET, (-3- 20*20) TILES. (DEMO)...
'
DIM TILES(605)
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
'
'Scaling test demo...
'
'CLS
'PUTscale = 25
'V13hPUT TILES(), 0, 0, 1, "SCALE"
'
'Gradient search test demo...
'
'CLS
'FOR c = 1 TO 15
' FOR x = 0 TO 0
' V13hGRD c, x
' LINE (20, x)-(120, x)
' V13hSEE
' SLEEP
' NEXT
'NEXT
'
'SCROLLING FONT DEMO...
'
FOR y = (WYB + 1) TO (WYT - (32 * 8)) STEP -1
V13hCLS 0
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 0), 15, "-WELCOME-", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 2), 7, "VIDEO13h v1.5, (Pure QB v4.5),", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 4), 7, "SCREEN 13; manipulation routines.", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 8), 15, "-FEATURES-", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 10), 7, "320X200X256 resolution (VGA),", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 12), 7, "page/sprite/font buffering,", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 14), 7, "mouse/keyboard handlers,", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 16), 7, "file i/o, and memory routines.", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 18), 7, "All while still supporting QB's", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 20), 7, "original graphical commands too!", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 24), 15, "-REQUIREMENTS-", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 26), 7, "100+ Mhz PC processor, VGA monitor,", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 28), 7, "keyboard or mouse, and QuickBASIC v4.5", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 32), 15, "-CREDITS-", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 34), 15, "...Programmer...", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 36), 7, "Nemesis@qbasicnews.com", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 40), 15, "...Special Thanks...", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 42), 7, "Jonkirwan@aol.com", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 44), 7, "Eclipzer@aol.com", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 46), 7, "KingJayIII@aol.com", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 48), 7, "Barok@qbasicnews.com", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 50), 7, "Spotted Cheetah@qbasicnews.com", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 52), 7, "Adigun A. Polack@qbasicnews.com", "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, y + (8 * 54), 7, "na_th_an@qbasicnews.com", "TRANSPARENT"
V13hTXT FONTS(), FALSE, 0, (8 * 24), 15, "(C)opyright 2005,", "BLEND"
V13hTXT FONTS(), FALSE, (8 * 18), (8 * 24), 12, "Pure", "BLEND"
V13hTXT FONTS(), FALSE, (8 * 23), (8 * 24), 10, "QB", "BLEND"
V13hTXT FONTS(), FALSE, (8 * 26), (8 * 24), 9, "Innovations", "BLEND"
V13hSEE
'WAIT &H3DA, 8
IF LEN(INKEY$) THEN EXIT FOR
'
NEXT
'
'FADE OUT/IN DEMO...
'
V13hFDE NOT FALSE, NOT FALSE, 1 / 32
'
DO: LOOP UNTIL LEN(INKEY$)
'
'''
'''MOUSE MASKING DEMO...
'''
'
DO
'
V13hPNT MOUSE(), 1, 15, "MASK"
'
V13hSEE
'
V13hPUT MASK(), PNT.xx, PNT.yy, PNT.FRAME, "PSET"
'
LOOP UNTIL LEN(INKEY$)
'
'''
'''NO-MASK MOUSE DEMO...
'''
'
DO
'
V13hCLS 0
'
V13hTXT FONTS(), NOT FALSE, 0, 14, 2, "PNT.xx = " + STR$(PNT.xx), "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, 22, 2, "PNT.yy = " + STR$(PNT.yy), "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, 169, 4, "PNT.lb = " + STR$(PNT.LB), "TRANSPARENT"
V13hTXT FONTS(), NOT FALSE, 0, 177, 4, "PNT.rb = " + STR$(PNT.rb), "TRANSPARENT"
'
V13hPNT MOUSE(), 1, 15, "TRANSPARENT"
'
V13hSEE
'
LOOP UNTIL LEN(INKEY$)
'
'DELAY DEMO...
'
CLS
LOCATE 1, 1: PRINT "V13hDLY 1/4 seconds..."
PRINT
DO: LOOP UNTIL TIMER <> TIMER
DO
t! = TIMER
V13hDLY 1 / 4
PRINT TIMER - t!
LOOP UNTIL LEN(INKEY$)
'
CLS
LOCATE 1, 1: PRINT "V13hDLY 1/8 seconds..."
PRINT
DO: LOOP UNTIL TIMER <> TIMER
DO
t! = TIMER
V13hDLY 1 / 8
PRINT TIMER - t!
LOOP UNTIL LEN(INKEY$)
'
CLS
LOCATE 1, 1: PRINT "V13hDLY 1/32 seconds..."
PRINT
DO: LOOP UNTIL TIMER <> TIMER
DO
t! = TIMER
V13hDLY 1 / 32
PRINT TIMER - t!
LOOP UNTIL LEN(INKEY$)
'
'''
''' CLEAR SCREEN (256X) DEMO...
'''
'
DO: LOOP UNTIL TIMER <> TIMER
t! = TIMER
FOR c = 0 TO 255
V13hCLS c
V13hSEE
NEXT
t! = TIMER - t!
LOCATE 1, 1: PRINT "V13hCLS (256X):"; t!
DO: LOOP UNTIL LEN(INKEY$)
'
'''
''' MEMORY COPY DEMO...
'''
'
DO: LOOP UNTIL TIMER <> TIMER
FOR y = 0 TO 255
IF y > 127 THEN
z = ((-256 + y) * 256) + y
ELSE
z = (y * 256) + y
END IF
FOR x = 8 TO 32007
VIDEO(x) = z
NEXT
c! = TIMER
V13hCPY VARSEG(VIDEO(0)), 16, &HA000, 0, 64000, "SOLID"
t! = t! + ABS(TIMER - c!)
NEXT
B& = (y - 1) * 64000
CLS : COLOR 7
PRINT B&; "bytes in..."; t!; "sec."
PRINT
PRINT "That was SOLID copy, which copies data"
PRINT "from one point in memory to another."
PRINT "TRANSPARENT copy, copies data from"
PRINT "one point in memory to another,"
PRINT "except for all 0 (null bytes)."
DO: LOOP UNTIL LEN(INKEY$)
'
'''
''' (1O,OOO) RANDOM PIXELS DEMO...
'''
V13hCLS 0
DO: LOOP UNTIL TIMER <> TIMER
t! = TIMER
FOR x = 1 TO 10000
PSET (INT(RND(1) * 319 + 1), INT(RND(1) * 199 + 1)), INT(RND(1) * 255 + 1)
NEXT
t! = TIMER - t!
V13hSEE
LOCATE 1, 1: PRINT "PSET (1O,OOOX):"; t!
DO: LOOP UNTIL LEN(INKEY$)
'
'''
''' (1O,OOO) RANDOM LINES DEMO...
'''
'
V13hCLS 0
DO: LOOP UNTIL TIMER <> TIMER
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
t! = TIMER - t!
V13hSEE
LOCATE 1, 1: PRINT "LINE (1O,OOOX):"; t!
DO: LOOP UNTIL LEN(INKEY$)
'
'''
''' (1O,OOO) RANDOM TILES DEMO...
'''
'
kind$ = "ANDXOR"
DO
V13hCLS 0
DO: LOOP UNTIL TIMER <> TIMER
t! = TIMER
FOR x = 1 TO 2500
xx = -63 + INT(RND(1) * 383 + 1)
yy = -63 + INT(RND(1) * 263 + 1)
V13hPUT BALL(), xx, yy, 1, kind$
'
'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
t! = TIMER - t!
V13hSEE
K$ = "V13hPUT " + kind$ + " (2,5OOX):"
LOCATE 1, 1: PRINT K$; t!
DO: LOOP UNTIL LEN(INKEY$)
SELECT CASE kind$
CASE "ANDXOR"
kind$ = "TRANSPARENT"
CASE "TRANSPARENT"
kind$ = "BLEND"
CASE "BLEND"
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
CASE ELSE
END SELECT
LOOP
'
'''
'''KEYBOARD & SCROLLING DEMO
'''
'
t! = TIMER
DO
S = S + 1
IF ABS(TIMER - t!) >= 1 THEN FPS = S: S = 0: t! = TIMER
FOR yy = -20 TO 200 STEP 20
FOR xx = -20 TO 320 STEP 20
V13hPUT TILES(), (xx + ZX), (yy + ZY), 1, "PSET"
NEXT
NEXT
'
V13hPUT TILES(), 149, 89, 2, "TRANSPARENT"
'
IF V13hKEY(80) THEN ZY = ZY - 1: AD = NOT FALSE ELSE AD = FALSE
IF V13hKEY(75) THEN ZX = ZX + 1: AL = NOT FALSE ELSE AL = FALSE
IF V13hKEY(77) THEN ZX = ZX - 1: AR = NOT FALSE ELSE AR = FALSE
IF V13hKEY(72) THEN ZY = ZY + 1: AU = NOT FALSE ELSE AU = FALSE
IF ZY > 19 OR ZY < -19 THEN ZY = 0
IF ZX > 19 OR ZX < -19 THEN ZX = 0
V13hTXT FONTS(), FALSE, 0, 0, 10, "FPS:" + STR$(FPS), "TRANSPARENT"
V13hTXT FONTS(), FALSE, 0, 16, 11, "Arrow up: " + STR$(AU), "TRANSPARENT"
V13hTXT FONTS(), FALSE, 0, 24, 11, "Arrow down: " + STR$(AD), "TRANSPARENT"
V13hTXT FONTS(), FALSE, 0, 32, 11, "Arrow right:" + STR$(AR), "TRANSPARENT"
V13hTXT FONTS(), FALSE, 0, 40, 11, "Arrow left: " + STR$(AL), "TRANSPARENT"
V13hTXT FONTS(), FALSE, 0, 56, 12, "Esc to exit.", "TRANSPARENT"
V13hSEE
LOOP UNTIL INKEY$ = CHR$(27)
'
EXIT SUB
'
END SUB
SUB V13hBLD (ARRAY(), FILE$)
'
LENGTH& = V13hLOF&(FILE$)
IF LENGTH& THEN
Words = ((LENGTH& + 1) \ 2) - 1
REDIM ARRAY(Words)
DEF SEG = VARSEG(ARRAY(0))
BLOAD FILE$, 0
END IF
'
END SUB
SUB V13hBLN (FILE$)
'
DEF SEG = VARSEG(BLEND(0))
'
IF V13hLOF&(FILE$) > 0 THEN
BLOAD FILE$, 0
ELSE
FOR P = 0 TO 254
FOR B = P TO 255
'
max = 11907
'
rt = (PAL(P).Red + PAL(B).Red) \ 2
gt = (PAL(P).Grn + PAL(B).Grn) \ 2
BT = (PAL(P).Blu + PAL(B).Blu) \ 2
'
FOR c = 0 TO 255
rd = rt - PAL(c).Red
gd = gt - PAL(c).Grn
BD = BT - PAL(c).Blu
v = (rd * rd) + (gd * gd) + (BD * BD)
IF v < max THEN
max = v
tag = c
IF v THEN ELSE EXIT FOR
END IF
NEXT
POKE incb&, tag
incb& = incb& + 1
NEXT
NEXT
'
BSAVE FILE$, 0, (incb& + 1)
'
END IF
'
END SUB
SUB V13hBND (ARRAY(), FILE$)
'
LENGTH& = V13hLOF&(FILE$)
IF LENGTH& THEN
Words = (LENGTH& \ 2)
U = UBOUND(ARRAY)
IF U THEN
V13hBSV ARRAY(), "buffer.tmp"
REDIM ARRAY(U + Words)
DEF SEG = VARSEG(ARRAY(0)): BLOAD "buffer.tmp", 0
KILL "buffer.tmp"
BLOAD FILE$, (U + 1) * 2
ELSE
REDIM ARRAY(Words - 1)
DEF SEG = VARSEG(ARRAY(0))
BLOAD FILE$, 0
END IF
END IF
'
END SUB
SUB V13hBSV (ARRAY(), FILE$)
'
DEF SEG = VARSEG(ARRAY(0)): BSAVE FILE$, 0, (UBOUND(ARRAY) + 1) * 2
'
END SUB
SUB V13hCLS (colour)
'
LINE (WXL, WYT)-(WXR, WYB), colour, BF
'
END SUB
SUB V13hCPY (Tsegm&, Toffs, Dsegm&, Doffs, BYTES&, Blits$)
'
TS& = Tsegm&
DS& = Dsegm&
'
DIM BT(&HF)
DIM BD(&HF)
'
FOR x = &H0 TO &HF
BT(x) = (x + Toffs)
BD(x) = (x + Doffs)
NEXT
'
SELECT CASE Blits$
'
CASE "SOLID"
'
FOR x = &H1 TO (BYTES& \ &H10)
DEF SEG = TS&
'
tBF: BF = PEEK(BT(&HF))
tBE: BE = PEEK(BT(&HE))
tBD: BD = PEEK(BT(&HD))
tBC: BC = PEEK(BT(&HC))
tBB: BB = PEEK(BT(&HB))
tBA: BA = PEEK(BT(&HA))
tB9: B9 = PEEK(BT(&H9))
tB8: B8 = PEEK(BT(&H8))
tB7: B7 = PEEK(BT(&H7))
tB6: B6 = PEEK(BT(&H6))
tB5: B5 = PEEK(BT(&H5))
tB4: B4 = PEEK(BT(&H4))
tB3: B3 = PEEK(BT(&H3))
tB2: B2 = PEEK(BT(&H2))
tB1: B1 = PEEK(BT(&H1))
tB0: B0 = PEEK(BT(&H0))
'
IF GSR THEN RETURN
'
DEF SEG = DS&
'
dBF: POKE BD(&HF), BF
dBE: POKE BD(&HE), BE
dBD: POKE BD(&HD), BD
dBC: POKE BD(&HC), BC
dBB: POKE BD(&HB), BB
dBA: POKE BD(&HA), BA
dB9: POKE BD(&H9), B9
dB8: POKE BD(&H8), B8
dB7: POKE BD(&H7), B7
dB6: POKE BD(&H6), B6
dB5: POKE BD(&H5), B5
dB4: POKE BD(&H4), B4
dB3: POKE BD(&H3), B3
dB2: POKE BD(&H2), B2
dB1: POKE BD(&H1), B1
dB0: POKE BD(&H0), B0
'
IF GSR THEN RETURN
'
TS& = TS& + &H1
DS& = DS& + &H1
NEXT
'
GSR = NOT FALSE
'
SELECT CASE (BYTES& MOD &H10)
CASE &H1
DEF SEG = TS&
GOSUB tB0
DEF SEG = DS&
GOSUB dB0
CASE &H2
DEF SEG = TS&
GOSUB tB1
DEF SEG = DS&
GOSUB dB1
CASE &H3
DEF SEG = TS&
GOSUB tB2
DEF SEG = DS&
GOSUB dB2
CASE &H4
DEF SEG = TS&
GOSUB tB3
DEF SEG = DS&
GOSUB dB3
CASE &H5
DEF SEG = TS&
GOSUB tB4
DEF SEG = DS&
GOSUB dB4
CASE &H6
DEF SEG = TS&
GOSUB tB5
DEF SEG = DS&
GOSUB dB5
CASE &H7
DEF SEG = TS&
GOSUB tB6
DEF SEG = DS&
GOSUB dB6
CASE &H8
DEF SEG = TS&
GOSUB tB7
DEF SEG = DS&
GOSUB dB7
CASE &H9
DEF SEG = TS&
GOSUB tB8
DEF SEG = DS&
GOSUB dB8
CASE &HA
DEF SEG = TS&
GOSUB tB9
DEF SEG = DS&
GOSUB dB9
CASE &HB
DEF SEG = TS&
GOSUB tBA
DEF SEG = DS&
GOSUB dBA
CASE &HC
DEF SEG = TS&
GOSUB tBB
DEF SEG = DS&
GOSUB dBB
CASE &HD
DEF SEG = TS&
GOSUB tBC
DEF SEG = DS&
GOSUB dBC
CASE &HE
DEF SEG = TS&
GOSUB tBD
DEF SEG = DS&
GOSUB dBD
CASE &HF
DEF SEG = TS&
GOSUB tBE
DEF SEG = DS&
GOSUB dBE
END SELECT
'
CASE "TRANSPARENT"
'
FOR x = &H1 TO (BYTES& \ &H10)
DEF SEG = TS&
'
BF = PEEK(BT(&HF))
BE = PEEK(BT(&HE))
BD = PEEK(BT(&HD))
BC = PEEK(BT(&HC))
BB = PEEK(BT(&HB))
BA = PEEK(BT(&HA))
B9 = PEEK(BT(&H9))
B8 = PEEK(BT(&H8))
B7 = PEEK(BT(&H7))
B6 = PEEK(BT(&H6))
B5 = PEEK(BT(&H5))
B4 = PEEK(BT(&H4))
B3 = PEEK(BT(&H3))
B2 = PEEK(BT(&H2))
B1 = PEEK(BT(&H1))
B0 = PEEK(BT(&H0))
'
DEF SEG = DS&
'
dTF: IF BF THEN POKE BD(&HF), BF
dTE: IF BE THEN POKE BD(&HE), BE
dTD: IF BD THEN POKE BD(&HD), BD
dTC: IF BC THEN POKE BD(&HC), BC
dTB: IF BB THEN POKE BD(&HB), BB
dTA: IF BA THEN POKE BD(&HA), BA
dT9: IF B9 THEN POKE BD(&H9), B9
dT8: IF B8 THEN POKE BD(&H8), B8
dT7: IF B7 THEN POKE BD(&H7), B7
dT6: IF B6 THEN POKE BD(&H6), B6
dT5: IF B5 THEN POKE BD(&H5), B5
dT4: IF B4 THEN POKE BD(&H4), B4
dT3: IF B3 THEN POKE BD(&H3), B3
dT2: IF B2 THEN POKE BD(&H2), B2
dT1: IF B1 THEN POKE BD(&H1), B1
dT0: IF B0 THEN POKE BD(&H0), B0
'
IF GSR THEN RETURN
'
TS& = TS& + &H1
DS& = DS& + &H1
'
NEXT
'
GSR = NOT FALSE
'
SELECT CASE (BYTES& MOD &H10)
CASE &H1
DEF SEG = TS&
GOSUB tB0
DEF SEG = DS&
GOSUB dT0
CASE &H2
DEF SEG = TS&
GOSUB tB1
DEF SEG = DS&
GOSUB dT1
CASE &H3
DEF SEG = TS&
GOSUB tB2
DEF SEG = DS&
GOSUB dT2
CASE &H4
DEF SEG = TS&
GOSUB tB3
DEF SEG = DS&
GOSUB dT3
CASE &H5
DEF SEG = TS&
GOSUB tB4
DEF SEG = DS&
GOSUB dT4
CASE &H6
DEF SEG = TS&
GOSUB tB5
DEF SEG = DS&
GOSUB dT5
CASE &H7
DEF SEG = TS&
GOSUB tB6
DEF SEG = DS&
GOSUB dT6
CASE &H8
DEF SEG = TS&
GOSUB tB7
DEF SEG = DS&
GOSUB dT7
CASE &H9
DEF SEG = TS&
GOSUB tB8
DEF SEG = DS&
GOSUB dT8
CASE &HA
DEF SEG = TS&
GOSUB tB9
DEF SEG = DS&
GOSUB dT9
CASE &HB
DEF SEG = TS&
GOSUB tBA
DEF SEG = DS&
GOSUB dTA
CASE &HC
DEF SEG = TS&
GOSUB tBB
DEF SEG = DS&
GOSUB dTB
CASE &HD
DEF SEG = TS&
GOSUB tBC
DEF SEG = DS&
GOSUB dTC
CASE &HE
DEF SEG = TS&
GOSUB tBD
DEF SEG = DS&
GOSUB dTD
CASE &HF
DEF SEG = TS&
GOSUB tBE
DEF SEG = DS&
GOSUB dTE
END SELECT
'
END SELECT
'
END SUB
SUB V13hDLY (seconds!) STATIC
'
IF seconds! THEN
FOR inc& = 1 TO (SYS& * (seconds! * 18.2065)): 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
IF fadeSEC! <> 0 THEN V13hDLY 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
IF faseSEC! <> 0 THEN V13hDLY fadeSEC!
NEXT
END IF
'
END SUB
SUB V13hGRD (colour, gradient)
'
RGB = colour
GSG = 15 + gradient
'
DEF SEG = VARSEG(BLEND(0))
'
IF RGB > GSG THEN
GSC = PEEK(BLN&(GSG) + (RGB - GSG))
ELSE
GSC = PEEK(BLN&(RGB) + (GSG - RGB))
END IF
'
COLOR GSC
'
END SUB
FUNCTION V13hKEY (scan)
'
DEF SEG = &H0
POKE &H41C, PEEK(&H41A)
POKE &H417, 0
'
I = INP(&H60)
'
IF (I AND &H80) THEN
BOARD(I XOR &H80) = FALSE
ELSE
BOARD(I) = NOT FALSE
END IF
'
IF BOARD(scan) THEN
V13hKEY = NOT FALSE
ELSE
V13hKEY = FALSE
END IF
'
END FUNCTION
FUNCTION V13hLOF& (FILE$)
'
FileNum = FREEFILE
OPEN FILE$ FOR BINARY ACCESS READ AS FileNum
V13hLOF& = LOF(FileNum) - 7
CLOSE FileNum
'
END FUNCTION
SUB V13hPAL (FILE$)
'
DEF SEG = VARSEG(PAL(0))
'
IF V13hLOF&(FILE$) > 0 THEN
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
ELSE
OUT &H3C7, 0
FOR x = 0 TO 255
PAL(x).Red = INP(&H3C9)
PAL(x).Grn = INP(&H3C9)
PAL(x).Blu = INP(&H3C9)
NEXT
BSAVE FILE$, 0, 1536
END IF
'
END SUB
SUB V13hPNT (ARRAY(), FRAME, colour, SKIN$)
'
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
'
IF SKIN$ = "MASK" THEN
'
TEXTURE$ = "TRANSPARENT"
'
MR = (PNT.xx + MOUSE(0) \ 8) - 1
MB = (PNT.yy + MOUSE(1)) - 1
'
IF MR > 319 THEN MR = 319
IF MB > 199 THEN MB = 199
'
GET (PNT.xx, PNT.yy)-(MR, MB), MASK
'
ELSE
'
TEXTURE$ = SKIN$
'
END IF
'
PUTcolour = -1 + colour
'
V13hPUT ARRAY(), PNT.xx, PNT.yy, PNT.FRAME, TEXTURE$
'
PUTcolour = FALSE
'
END IF
'
END SUB
SUB V13hPUT (ARRAY(), xxLEFT, yyTOP, FRAME, SKIN$)
'
IF FRAME THEN
'
segVIDEO& = 1& + VARSEG(VIDEO(0))
segARRAY& = VARSEG(ARRAY(0))
'
TW = ARRAY(0) \ 8
TH = ARRAY(1)
TP& = TW * TH
TI = ((5 + TP&) \ 2) * (FRAME - 1)
'
XR = (xxLEFT + TW) - 1
YB = (yyTOP + TH) - 1
'
IF xxLEFT < WXL THEN
IF XR < WXL THEN EXIT SUB
CLIP = NOT FALSE
LD = (WXL - xxLEFT): XD = LD
XL = WXL
ELSE
XL = xxLEFT
END IF
'
IF yyTOP < WYT THEN
IF YB < WYT THEN EXIT SUB
CLIP = NOT FALSE
YD = WYT - yyTOP
YT = WYT
ELSE
YT = yyTOP
END IF
'
IF XR > WXR THEN
IF XL > WXR THEN EXIT SUB
CLIP = NOT FALSE
XD = XD + (XR - WXR)
XR = WXR
END IF
'
IF YB > WYB THEN
IF YT > WYB THEN EXIT SUB
CLIP = NOT FALSE
YB = WYB
END IF
'
AB& = (4 + (TI * 2&)) + ((YD * TW) + LD)
'
DIM AC(XL TO XR)
'
SELECT CASE SKIN$
'
CASE "ANDXOR"
'
B = TW - XD
R = TW - DR
'
DIM BT(&H0 TO &HF)
DIM BD(&H0 TO &HF)
'
FOR x = &H0 TO &HF
BD(x) = (x + XL)
NEXT
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
'
TS& = segARRAY&
DS& = segVIDEO& + VY
'
FOR x = &H0 TO &HF
BT(x) = (x + AB&)
NEXT
'
GSR = FALSE
'
FOR x = &H1 TO (B \ &H10)
'
DEF SEG = TS&
'
aBF: BF = PEEK(BT(&HF))
aBE: BE = PEEK(BT(&HE))
aBD: BD = PEEK(BT(&HD))
aBC: BC = PEEK(BT(&HC))
aBB: BB = PEEK(BT(&HB))
aBA: BA = PEEK(BT(&HA))
aB9: B9 = PEEK(BT(&H9))
aB8: B8 = PEEK(BT(&H8))
aB7: B7 = PEEK(BT(&H7))
aB6: B6 = PEEK(BT(&H6))
aB5: B5 = PEEK(BT(&H5))
aB4: B4 = PEEK(BT(&H4))
aB3: B3 = PEEK(BT(&H3))
aB2: B2 = PEEK(BT(&H2))
aB1: B1 = PEEK(BT(&H1))
aB0: B0 = PEEK(BT(&H0))
'
IF GSR THEN RETURN
'
DEF SEG = DS&
'
aTF: IF BF THEN POKE BD(&HF), BF + PUTcolour
aTE: IF BE THEN POKE BD(&HE), BE + PUTcolour
aTD: IF BD THEN POKE BD(&HD), BD + PUTcolour
aTC: IF BC THEN POKE BD(&HC), BC + PUTcolour
aTB: IF BB THEN POKE BD(&HB), BB + PUTcolour
aTA: IF BA THEN POKE BD(&HA), BA + PUTcolour
aT9: IF B9 THEN POKE BD(&H9), B9 + PUTcolour
aT8: IF B8 THEN POKE BD(&H8), B8 + PUTcolour
aT7: IF B7 THEN POKE BD(&H7), B7 + PUTcolour
aT6: IF B6 THEN POKE BD(&H6), B6 + PUTcolour
aT5: IF B5 THEN POKE BD(&H5), B5 + PUTcolour
aT4: IF B4 THEN POKE BD(&H4), B4 + PUTcolour
aT3: IF B3 THEN POKE BD(&H3), B3 + PUTcolour
aT2: IF B2 THEN POKE BD(&H2), B2 + PUTcolour
aT1: IF B1 THEN POKE BD(&H1), B1 + PUTcolour
aT0: IF B0 THEN POKE BD(&H0), B0 + PUTcolour
'
IF GSR THEN RETURN
'
TS& = TS& + &H1
DS& = DS& + &H1
'
NEXT
'
GSR = NOT FALSE
'
SELECT CASE (B MOD &H10)
CASE &H1
DEF SEG = TS&
GOSUB aB0
DEF SEG = DS&
GOSUB aT0
CASE &H2
DEF SEG = TS&
GOSUB aB1
DEF SEG = DS&
GOSUB aT1
CASE &H3
DEF SEG = TS&
GOSUB aB2
DEF SEG = DS&
GOSUB aT2
CASE &H4
DEF SEG = TS&
GOSUB aB3
DEF SEG = DS&
GOSUB aT3
CASE &H5
DEF SEG = TS&
GOSUB aB4
DEF SEG = DS&
GOSUB aT4
CASE &H6
DEF SEG = TS&
GOSUB aB5
DEF SEG = DS&
GOSUB aT5
CASE &H7
DEF SEG = TS&
GOSUB aB6
DEF SEG = DS&
GOSUB aT6
CASE &H8
DEF SEG = TS&
GOSUB aB7
DEF SEG = DS&
GOSUB aT7
CASE &H9
DEF SEG = TS&
GOSUB aB8
DEF SEG = DS&
GOSUB aT8
CASE &HA
DEF SEG = TS&
GOSUB aB9
DEF SEG = DS&
GOSUB aT9
CASE &HB
DEF SEG = TS&
GOSUB aBA
DEF SEG = DS&
GOSUB aTA
CASE &HC
DEF SEG = TS&
GOSUB aBB
DEF SEG = DS&
GOSUB aTB
CASE &HD
DEF SEG = TS&
GOSUB aBC
DEF SEG = DS&
GOSUB aTC
CASE &HE
DEF SEG = TS&
GOSUB aBD
DEF SEG = DS&
GOSUB aTD
CASE &HF
DEF SEG = TS&
GOSUB aBE
DEF SEG = DS&
GOSUB aTE
END SELECT
'
AB& = AB& + R
'
NEXT
'
CASE "TRANSPARENT"
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
DEF SEG = segARRAY&
FOR HX = XL TO XR
AC(HX) = PEEK(AB&)
AB& = AB& + 1
NEXT
AB& = AB& + XD
DEF SEG = segVIDEO& + VY
IF PUTcolour THEN
FOR HX = XL TO XR
IF AC(HX) THEN POKE HX, AC(HX) + PUTcolour
NEXT
ELSE
FOR HX = XL TO XR
IF AC(HX) THEN POKE HX, AC(HX)
NEXT
END IF
NEXT
'
CASE "BLEND"
'
segBLEND& = VARSEG(BLEND(0))
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
DEF SEG = segARRAY&
FOR HX = XL TO XR
AC(HX) = PEEK(AB&)
AB& = AB& + 1
NEXT
AB& = AB& + XD
DEF SEG = segVIDEO& + VY
FOR HX = XL TO XR
IF AC(HX) THEN
IF PUTcolour THEN AC(HX) = AC(HX) + PUTcolour
VC = PEEK(HX)
DEF SEG = segBLEND&
IF VC > AC(HX) THEN
BC = PEEK(BLN&(AC(HX)) + (VC - AC(HX)))
ELSE
BC = PEEK(BLN&(VC) + (AC(HX) - VC))
END IF
DEF SEG = segVIDEO& + VY
POKE HX, BC
END IF
NEXT
NEXT
'
CASE "BEHIND"
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
DEF SEG = segARRAY&
FOR HX = XL TO XR
AC(HX) = PEEK(AB&)
AB& = AB& + 1
NEXT
AB& = AB& + XD
DEF SEG = segVIDEO& + VY
IF PUTcolour THEN
FOR HX = XL TO XR
IF PEEK(HX) THEN ELSE POKE HX, AC(HX) + PUTcolour
NEXT
ELSE
FOR HX = XL TO XR
IF PEEK(HX) THEN ELSE POKE HX, AC(HX)
NEXT
END IF
NEXT
'
CASE "SCALE"
'
'SW = (TW * PUTscale) \ 100
'SH = (TH * PUTscale) \ 100
'DW = TW - SW
'DH = TH - SH
'
'PRINT "TW: "; TW
'PRINT "TH: "; TH
'PRINT "SW: "; SW
'PRINT "SH: "; SH
'PRINT "DW: "; DW
'PRINT "DH: "; DH
'
'SLEEP: STOP
'
CASE "PSET"
'
IF CLIP THEN
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
DEF SEG = segARRAY&
FOR HX = XL TO XR
AC(HX) = PEEK(AB&)
AB& = AB& + 1
NEXT
AB& = AB& + XD
DEF SEG = segVIDEO& + VY
FOR HX = XL TO XR
POKE HX, AC(HX)
NEXT
NEXT
ELSE
PUT (xxLEFT, yyTOP), ARRAY(TI), PSET
END IF
'
CASE "PRESET"
'
IF CLIP THEN
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
DEF SEG = segARRAY&
FOR HX = XL TO XR
AC(HX) = PEEK(AB&)
AB& = AB& + 1
NEXT
AB& = AB& + XD
DEF SEG = segVIDEO& + VY
FOR HX = XL TO XR
POKE HX, NOT AC(HX)
NEXT
NEXT
ELSE
PUT (xxLEFT, yyTOP), ARRAY(TI), PRESET
END IF
'
CASE "AND"
'
IF CLIP THEN
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
DEF SEG = segARRAY&
FOR HX = XL TO XR
AC(HX) = PEEK(AB&)
AB& = AB& + 1
NEXT
AB& = AB& + XD
DEF SEG = segVIDEO& + VY
FOR HX = XL TO XR
POKE HX, AC(HX) AND PEEK(HX)
NEXT
NEXT
ELSE
PUT (xxLEFT, yyTOP), ARRAY(TI), AND
END IF
'
CASE "OR"
'
IF CLIP THEN
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
DEF SEG = segARRAY&
FOR HX = XL TO XR
AC(HX) = PEEK(AB&)
AB& = AB& + 1
NEXT
AB& = AB& + XD
DEF SEG = segVIDEO& + VY
FOR HX = XL TO XR
POKE HX, AC(HX) OR PEEK(HX)
NEXT
NEXT
ELSE
PUT (xxLEFT, yyTOP), ARRAY(TI), OR
END IF
'
CASE "XOR"
'
IF CLIP THEN
'
FOR VY = (YT * 20) TO (YB * 20) STEP 20
DEF SEG = segARRAY&
FOR HX = XL TO XR
AC(HX) = PEEK(AB&)
AB& = AB& + 1
NEXT
AB& = AB& + XD
DEF SEG = segVIDEO& + VY
FOR HX = XL TO XR
POKE HX, AC(HX) XOR PEEK(HX)
NEXT
NEXT
ELSE
PUT (xxLEFT, yyTOP), ARRAY(TI), XOR
END IF
'
END SELECT
'
END IF
'
END SUB
SUB V13hSEE
'
DEF SEG
POKE VIDEO(0), VIDEO(2)
POKE VIDEO(1), VIDEO(3)
PUT (0, 0), VIDEO(6), PSET
POKE VIDEO(0), VIDEO(4)
POKE VIDEO(1), VIDEO(5)
'
END SUB
SUB V13hSET
'
SCREEN 13: CLS
'
FOR x = 0 TO 254
BLN&(x + 1) = (BLN&(x) + (256 - x))
NEXT
'
V13hPAL "palette.pal"
V13hBLN "palette.bln"
'
REGX.AX = 0: INTERRUPTX &H33, REGX, REGX 'check mouse
IF REGX.AX THEN
PNT.switch = NOT FALSE
REGX.AX = 1: INTERRUPTX &H33, REGX, REGX 'show mouse
REGX.AX = 4: INTERRUPTX &H33, REGX, REGX 'put mouse
GET (1, 1)-(16, 16), MOUSE 'get mouse
REGX.AX = 2: INTERRUPTX &H33, REGX, REGX 'hide mouse
DEF SEG = VARSEG(MOUSE(0)) 'color mouse
FOR x = 4 TO 258
IF PEEK(x) = 15 THEN
POKE x, 1
IF PEEK(x - 1) THEN ELSE POKE x, 250 'shade mouse
END IF
NEXT
PNT.minXX = 0 'bound mouse
PNT.minYY = 0
PNT.maxXX = 319
PNT.maxYY = 199
END IF
'
COLOR 1
'
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
VIDEOseg& = 1 + VARSEG(VIDEO(0))
DEF SEG : BSAVE "buffer.tmp", &H0, &HFA00
DEF SEG = VIDEOseg&: BLOAD "buffer.tmp", 0
KILL "buffer.tmp"
FOR I = 8 TO 32007 - 1
IF VIDEO(I) = &H7DA0 AND VIDEO(I + 1) = &HA000 THEN
VIDEO(0) = ((I + 1) * 2) - 16
VIDEO(1) = VIDEO(0) + 1
VIDEO(4) = VIDEOseg& AND &HFF
IF (VIDEOseg& AND &H8000) THEN
VIDEO(5) = ((VIDEOseg& AND &HFF00) \ &HFF) + &H100
ELSE
VIDEO(5) = (VIDEOseg& AND &HFF00) \ &HFF
END IF
DEF SEG
VIDEO(2) = PEEK(VIDEO(0)): VIDEO(3) = PEEK(VIDEO(1))
POKE VIDEO(0), VIDEO(4): POKE VIDEO(1), VIDEO(5)
EXIT FOR
END IF
NEXT
'
VIDEO(6) = 2560
VIDEO(7) = 200
'
V13hWIN 0, 0, 319, 199
V13hDLY calibrate!
V13hCLS 0
COLOR 15
'
END SUB
SUB V13hTXT (ARRAY(), XXcenter, xxLEFT, yyTOP, colour, text$, SKIN$)
'
FONTwidth = ARRAY(0) \ 8
PUTcolour = -1 + colour
FONTyy = yyTOP
'
TL = LEN(text$)
'
IF XXcenter THEN
cx = (WXL + ((WXR - WXL) + 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, SKIN$
NEXT
'
PUTcolour = FALSE
'
END SUB
SUB V13hWIN (xxLEFT, yyTOP, xxRIGHT, yyBOTTOM)
'
WXL = xxLEFT
WYT = yyTOP
WXR = xxRIGHT
WYB = yyBOTTOM
'
IF WXL < 0 THEN WXL = 0
IF WXR > 319 THEN WXR = 319
IF WYT < 0 THEN WYT = 0
IF WYB > 199 THEN WYB = 199
'
END SUB
