DECLARE SUB THROWRINGS (AOR!)
DECLARE SUB LOADBK (O!)
DECLARE FUNCTION BOUNCY! (O!)
DECLARE SUB addtile (LAY!, SSP!)
DECLARE SUB getblxy (SSP%)
DECLARE SUB CHECKALL (CKX!, cKy!)
DECLARE SUB addnme (N!, F!)
DECLARE SUB getnmexy (SSP%)
DECLARE SUB ADDSPRITE (layer!, SP!)
DECLARE SUB GETSPXY (SP%)
DECLARE SUB loadpalette ()
DECLARE SUB bloodhurt (X!, Y!)
DECLARE SUB SHUFFLE (MMX!, mmy!)
DECLARE SUB cheat (b$)
DECLARE SUB bmppal (filename$)
DECLARE SUB loadbmp (filename$)
DECLARE SUB bleed (R!)
DECLARE SUB loadblood ()
DECLARE SUB putblood (X!, Y!)
DECLARE SUB drawblood (CHX!, CHY!)
DECLARE SUB MESSAGE (N$)
DECLARE SUB POINTS (N!)
DECLARE SUB WILDJUMP (R!)
DECLARE FUNCTION LEVL4! (X!, Y!)
DECLARE FUNCTION CLEVL! (X!, Y!)
DECLARE SUB SPRITE (X%, Y%, SP%)
DECLARE FUNCTION DLEVL! (X%, Y%)
DECLARE SUB MOVECOIN (X%, Y%)
DECLARE SUB shake ()
DECLARE SUB cARSFX (SPD!)
DECLARE FUNCTION WILD! (O!)
DECLARE SUB ZFLOOD (X%, Y%)
DECLARE SUB prnt (a$)
DECLARE SUB ndrum ()
DECLARE SUB sbsetup ()
DECLARE SUB playmusic (fx!)
DECLARE SUB effect (fx!)
DECLARE SUB REMOVEGATES (X!, Y!)
DECLARE FUNCTION isboss! (X!)
DECLARE SUB LOADBOSS ()
DECLARE SUB FULLCLS ()
DECLARE SUB picture (N$)
DECLARE SUB centre (aa$)
DECLARE SUB DECOMPRESS (N$)
DECLARE FUNCTION FALLER! (R!)
DECLARE FUNCTION JUMPER! (R!)
DECLARE SUB enme (XX!, YY!, Z!, AN!, R!)
DECLARE SUB JUMP (vx!, vy!)
DECLARE FUNCTION fish! (R!)
DECLARE FUNCTION afly! (R!)
DECLARE SUB playasenemy ()
DECLARE FUNCTION pan% (X!)
DECLARE SUB StereoFX (X!, LV%)
DECLARE FUNCTION FINDSPD! (F!)
DECLARE FUNCTION levl3! (X!, Y!)
DECLARE SUB dnmes ()
DECLARE SUB anim (X%, Y%)
DECLARE SUB man (X!, Y!, DIR!, AN!)
DECLARE FUNCTION COLABLE! (R!)
DECLARE SUB HIT (X!, Y!, Z!)
DECLARE SUB setuppal ()
DECLARE SUB save ()
DECLARE SUB music (fx!)
DECLARE SUB inpass ()
DECLARE SUB passwords ()
DECLARE FUNCTION FCD! ()
DECLARE SUB HURT ()
DECLARE SUB winsfx ()
DECLARE FUNCTION levl! (X!, Y!)
DECLARE FUNCTION WHICHDOOR! (X!, Y!)
DECLARE FUNCTION levl2! (X!, Y!)
DECLARE SUB loadbul ()
DECLARE SUB fire ()
DECLARE SUB entirefx (XX!)
DECLARE FUNCTION address! (X!, Y!)
DECLARE SUB palc (w!, Red!, Green!, Blue!)
DECLARE SUB loadlev (L!)
DECLARE SUB windw (D!)
DECLARE SUB killnme (X!, Y!)
DECLARE FUNCTION fly! (O!)
DECLARE SUB collect (X!, Y!)
DECLARE SUB SFX (X!)
DECLARE SUB trans (MX!, MY!)
DECLARE SUB chkp (R!)
DECLARE SUB check (R!)
DECLARE SUB loadnme (N!)
DECLARE SUB loadall (N$)
DECLARE SUB LOADPLAY (a$)
DECLARE SUB SLOW (CHY!)
DECLARE SUB GOVER ()
DECLARE SUB load (N$)
DECLARE SUB SMUDGE ()
DECLARE FUNCTION chk! (X!, Y!)
DECLARE SUB floor (X!, Y!)
DECLARE SUB scrn ()
DECLARE SUB generate (Z!)
DECLARE SUB GAME ()
DECLARE SUB playwav (a$, nw!)
DECLARE FUNCTION SpeakerStatus% ()
DECLARE FUNCTION ResetDSP% ()
DECLARE SUB WriteDSP (byte%)
DECLARE FUNCTION ReadDSP% ()
'$INCLUDE: 'DIRECTQB.BI'
COMMON SHARED layer AS INTEGER, lfps, FPS, fp, drum, ldrum, drum$, baseport%, n2$, chans&, DFREQ&, cfx&, FXLEN&, fxpos&, lwav%, wavptr&, BOSS, OK, stg, begx, begy, FALL, OSFX, trr, otrr, NFR, FRR, SCN, nwspd, frate, ply, tmr, X, Y, hurry, finsd,  _
freq%, channel%, FILE$, card, maxlen, PATH$, erro, rx, L2%, buf AS STRING * 2500, stm&, EDM&, BGM, ouch, crx, cry, anmes, tmx, tmy, SEE, ADULT, bok, olc, MS$, mst, score, roadsc, collide, walk, sprx%, spry%, jmpD, feet, manx, many, NMX, NMy, ly%, Hi _
, vs, vp, AN%, acc
E = DQBinit(1, 1, 1)
IF E THEN DQBclose: SYSTEM
DQBclose
walk = 0
SCREEN 9
LOCATE 10, 20
PRINT "THANX 2:"
PRINT
PRINT "    JOE.....   (Sonic sprites, and soon, the spring (SPRING.BMP)"
PRINT "                     CREATOR OF SONICX(treme)"
PRINT "    TOM MEESON (Yeah, Helped me build my imagination!!) ---- (RA DJ!)"
PRINT "    M.RAHMAN (Helped Out with graphics, ALOT) ---- (hu de man)"
PRINT "                 MEEEE (for proving i can do this...)"
PRINT
SLEEP
DIM SHARED FRM, afreq&, bmp$, blk, ly2%, ly3%, pointerx AS STRING * 320, pointerstr AS STRING * 1, sanimal, dontrep, ly, mc, TL
layer = 0
collide = 2
TL = 12
IF INSTR(COMMAND$, "ADULT") THEN ADULT = 1: BASE$ = "adult\" ELSE BASE$ = "kids\"
ADULT = 1: BASE$ = "Kids\"
page = 0
chans& = 5
channel% = 2: DFREQ& = 22000
afreq& = 11000
E = DQBinit(TL + 17, chans& + 2, 100)
IF E > 0 THEN CLS : DQBclose: PRINT DQBerror$: PRINT "(At last, This does not jam your system!)": SYSTEM
SCREEN 13
FOR O = 0 TO 255: palc O, 0, 0, 0: NEXT
bmppal "db3.bmp"
loadbmp "db3.bmp"
dqbcopylayer VIDEO, 3
SCREEN 13
E = DQBloadFont("small.fnt")
OPEN "SETUP.opt" FOR INPUT AS #2
INPUT #2, frate, otrr: CLOSE #2
CLS
COLOR 15
NOCARD:
'drum$ = "123456789"
DEF SEG = 0
DIM SHARED CNTR, RM%, WATER, dot(4), R, bkg, fi, ky, ocy, ocx, P$(100), DRS, rn, HIJUMP, TOTLGT, LGT, lsf, fir, dk, buggy, dance, LSTY, JJ, rc, tlx, tly, enlarge
tlx = 31: tly = 31
RANDOMIZE TIMER
dk = 1
OPEN "path.dat" FOR INPUT AS #1: INPUT #1, PATH$: CLOSE
 CLOSE
PATH$ = BASE$ + PATH$
erro = 1
'ON ERROR GOTO err1
FOR O = 1 TO 16: SFX O: NEXT:
erro = 2
SCREEN 1
DQBremoveSB
card = DQBinstallSB(FALSE, chans& + 1, afreq&, AUTO, AUTO, AUTO)
DQBsetVolume 9
IF card = 0 THEN card = 1 ELSE card = 0
SCREEN 13
setuppal
DRS = 100
DIM SHARED INVINC, TKO, ts, dx(DRS), dy(DRS), DZ(DRS), ani(5), rev, revy, ox, oy, EN, sen, LSX, LSY, nt, ht, DD, LEV, cx, play$, bk, LV, mnx, mny, C, cant, swim, splay$, sonic, CN
OPEN "SETUP.opt" FOR INPUT AS #2
INPUT #2, frate, otrr: CLOSE #2
play$ = "play"
'play$ = "ALT"
splay$ = play$
LV = 4
bk = 7
maxmem = 16000
rmps = 300
DIM SHARED CHSX, chsy, CHP1, CHP2, Style, boses, wing, Kd, BAK, lf, rt, maxy, RAIN, cht, CCX, CCY, WIN, DIE, NMES, ANME, mos, MRT, TT, CHX, CHY, D, olx, MXX, MXY, TOP, RGT, spx, spy, sgx, sgy, LEVX, levy
3 CLOSE
Style = BOLD
BAK = 0
wing = 0
MXX = 319: MXY = 199
FULLCLS
LOCATE 10: centre "LOADING CHARACHTERS"
DIE = 0
CHX = 32
CHY = MXY - 25
D = 0
spx = 31: spy = 31
sgx = spx + 1
sgy = spy + 1
manx = 32: many = 32
CHSX = 32: chsy = 32
NMX = 31: NMy = 31
TOP = MXY \ spy
TOP = TOP - 1
RGT = MXX / spx
MRT = (MXX) - spx
sgx = INT(sgx): sgy = INT(sgy)
mos = MRT / 2
LEVX = MXX * 1.25: levy = TOP * 12
levy = levy + 6
maxy = levy
begx = LEVX
begy = levy
rmps = INT(((spx + 1) + 7) / 8) * 4 * (spy + 1)
rmps = rmps / 2
rmps = DQBsize(0, 0, spx, spy) / 3
MS = DQBsize(0, 0, 32, 32)
nos = INT(maxmem / rmps) / 2
boses = 1
ANME = 110
NMES = 1: DO: F$ = PATH$ + "NME" + MID$(STR$(NMES), 2) + "-1.SPR": OPEN F$ FOR BINARY AS #1
E = LOF(1): CLOSE #1: IF E = 0 THEN KILL F$
IF E THEN NMES = NMES + 1
LOOP UNTIL E < 2
DIM SHARED GEAR, gears(20), UNDER, osf, spooksnd, tgx%, speed, VL%, KL, bx(10), BY(10), BC(10), bd(10), ANT, mv%(8), mv%, opl$
DIM SHARED DIR, AN, power, icy, xr, shg, rr, COIN, SPR, s
DIM SHARED blood(rmps), LV%(ANME), ck(ANME), E(ANME), AN%(ANME), M(ANME), X(ANME), Y(ANME), Z(ANME), C(ANME), D(ANME), AN(ANME), T(ANME), dw(ANME), ch(MS, 0), LEV%(-10 TO LEVX + 10, -10 TO levy + 10)
DIM SHARED nme(rmps * 4, 0), bul(rmps, 1), DIB, RAMPED, SHI
DIM SHARED SZ(NMES), SZ, vs2, vp2
vs = VARSEG(nme(0, 0))
vp = VARPTR(nme(0, 0))
DQBsetFrameRate (1)
mv%(1) = 2: mv%(2) = 4: mv%(3) = 5: mv%(4) = 6: mv%(5) = 5: mv%(6) = 4: mv%(7) = 2
FOR O = 1 TO 4: mv%(O) = O * 2: mv%(8 - O) = 8 - ((4 - O) * 2): NEXT
'FOR o = 1 TO 8: mv%(o) = mv%(o) / 2: NEXT
FOR O = 1 TO 11: gears(O) = O: NEXT
COIN = 1
SP = 1
RAIN = 50
DO: READ a$: IF a$ <> "" THEN SP = SP + 1
LOOP UNTIL a$ = "": SP = SP - 1
SPR = SP
rmpfs = rmps * ((tlx + tly) / 2) ^ 2
DIM SHARED s&(rmps * 4, 4)
vs2 = VARSEG(s&(0, 1))
vp2 = VARPTR(s&(0, 1))
generate 0
loadbul
LOADBOSS
loadblood
SPR = 1: E = (200 / (SP + NMES))
LINE (48, 181)-(270, 170), 25, BF
LINE (49, 180)-(269, 170), 17, BF
RESTORE: blk = 1: FOR O = 1 TO SP: LINE (50, 180)-(50 + (E * O), 170), 4, BF: READ a$: load a$
NEXT: blk = 0
EE = 10 + O * E
READ a$
REM @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
DATA floor2,floor1,brick1,coin1,tubebl
DATA tubetl,tube1,tube2,tubebr,tubetr
DATA coin2,coin3,finish,pole,poletop
DATA castle1,castle2,castle3,CASTLE5
DATA floor3,half1,half2,ice1,coin5
DATA coin4,door1,LAVA1,LAVA2,lava3
DATA heart1,heart2,fly,WATER1,arror-l
DATA arror-r, lock1, key1, FENCE1
DATA BACK1, BACK2, BACK3, BACK4, BACK5
DATA BRICK2, WINDOW1,GATE1,bstar1
DATA bstar2,bcloud1,bcloud2,bcloud3
DATA BTREE,LOG,GETBOX,cjeep,RAMP1,RAMP2
DATA log1,""
REM @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

DIM SHARED bld, stmr, DN, ls, BLDPTR, tb(2, 2), XX(RAIN), YY(RAIN), YLIN, mfinsd, LOADOK, place, cars
bld = 100
DIM SHARED blx(bld), bly(bld), bld(bld), blc(bld), bli(bld), blh(bld), C$, bhurt, ady
DATA 5,7,9,6,8,10
FOR O = 1 TO 2: FOR P = 0 TO 2: READ tb(P, O): NEXT: NEXT
'scrn
X = 0
Y = 0
FL = RND * levy
FOR O = 1 TO NMES
LINE (50, 180)-(50 + EE + (E * O), 170), 4, BF
loadnme O
NEXT
P = 0
K = 0
L = 1
passwords
begin:
SCREEN 13: FOR O = 16 TO 32: PALETTE O, 0: NEXT
FULLCLS
bmppal "db3.bmp"
layer = 1
score = 0
LOCATE 1, 1
bmppal "title.bmp"
DO: E$ = INKEY$: LOOP UNTIL E$ = ""
music 9
ps = 0
ss = Style
Style = 0
bmppal "db3.bmp"
palc 4, 63, 63, 0
DO:
palc 7, 0, 0, 0
LEV = 1
F = DQBloadFont("hitecH.FNT")
dqbcopylayer 3, 1
 palc 0, 0, 0, 0
LOCATE 1, 1
centre "D A M I E N   S T U R D Y   2 0 0 0"
LOCATE 3, 25: centre "TOTAL  SONIC"
COLOR 4
centre ""
centre "Guide Sonic Through the levels to win"
centre "BUT IT GETS HARDER THAN YOU THINK...."
PRINT
centre ""
LOCATE 23, 1
centre "now utilizes DIRECTQB"
F = DQBloadFont("SMALL.FNT")
LOCATE 11, 1
IF buggy THEN centre "BUGGY Enabled"
IF cant THEN centre "Unbeatable Enabled"
IF ouch THEN centre "Invincivility Enabled"
IF cht THEN centre "All Birds Enabled"
IF ADULT = 0 THEN centre "Bad Mode On"
IF dance THEN centre "Quake Mode On"
IF ply THEN centre "Play As Enemies ON (Use LEFT to change)"
IF swim THEN centre "SWIM in lava On."
IF HIJUMP THEN centre "Hijump On."
IF sonic THEN centre "Alternate Player Mode On"
PRINT
COLOR 6
centre ""
IF card = 2 THEN centre "Sound Card DMA invalid": PRINT "                     (Control panel -> System.)": card = 0
IF card = 0 THEN centre "No SB compatible card."
LOCATE 21, 1
P$ = "": IF LEN(O$) = 2 THEN P$ = MID$(O$, 2)
IF P$ = "H" OR P$ = "P" THEN ps = (1 - ps)
st$ = "   start": ps$ = "   password": IF ps = 0 THEN st$ = ">>>START" ELSE ps$ = ">>>PASSWORD"
ps = ps MOD 2
COLOR 3: LOCATE CSRLIN, 15: prnt st$
LOCATE CSRLIN, 15: prnt ps$
dqbcopylayer 1, 0
IF OK THEN GOTO ISOK
playwav "", 0
OK = 0: O$ = INKEY$: IF O$ <> "" THEN O$ = UCASE$(O$): cheat O$
prnt C$
IF O$ = " " OR O$ = "P" THEN OK = 1
LOOP UNTIL OK:
Style = ss
ISOK:
LV = 4
SCREEN 9: SCREEN 13
P = 0
FOR O = 248 TO 255: palc O, P, 0, 0: P = P + 9: NEXT
IF O$ = "P" OR ps = 1 THEN inpass
back: WIN = 0
RANDOMIZE (LEV * 6)
erro = 3
windw 1
COLOR 15
PALETTE 0, 0
scrn
LOCATE 10: FULLCLS: centre "LOADING LEVEL:"
windw 0
FOR L = 0 TO RAIN: XX(L) = RND * (LEVX * sgx): YY(L) = RND * (LEVX * sgy): NEXT
scrn
tmr = TIMER
loadlev LEV
IF LOADOK = 0 THEN GOSUB FINISH: GOTO begin
'PALETTE 0, 0
'IF NT > 2 THEN palc BAK, 50, 0, 50 ELSE palc BAK, 0, 0, 0
CLS : setuppal
PALETTE bk, 0
VIEW SCREEN (0, 0)-(MXX, MXY)
start:
IF nwspd THEN SCREEN 13: setuppal
GAME
IF WIN THEN LEV = LEV + 1: GOTO back
SCREEN 12
LOCATE 15, 30
PRINT "G A M E   O V E R !"
T = TIMER: DO: LOOP UNTIL TIMER - T > 5: CLS : IF LV > -10 THEN GOTO begin
SYSTEM
err1:
SCREEN 9
LOCATE 10, 30
P = 0
IF erro = 1 THEN PRINT "BOOT faliure."
IF erro = 2 THEN PRINT "No room to continue."
IF erro = 3 THEN PRINT "I hope you enjoyed this demo": P = 1: PRINT : PRINT " Email DAMIEN_STURDY@TALK21.COM": PRINT "     for further levels,demos,ect."
IF ERR = 53 THEN  ELSE ERROR ERR
tmr = TIMER: DO: LOOP UNTIL TIMER > tmr + 5
IF P = 1 THEN PRINT : PRINT "(SPACE to play again, Q quits.)": DO: a$ = INKEY$: LOOP UNTIL a$ = " " OR a$ = "Q": IF a$ = " " THEN  ELSE SYSTEM
RETURN
leverr:
K = 1: L = 1: RESUME
FINISH:
palc 0, 0, 0, 0
FULLCLS
prnt ""
prnt "       HERES THE CHEATS:"
prnt "SWIM            (Swim in lava!)"
prnt "THISISHARD:     (Infinity.)"
prnt "SHOOTTHEMOON    (You want to?)"
prnt "ILOVEBIRDS  #    (All Enemies fly and get you.)"
prnt "BORING          (Eat this if you can handle it!)"
prnt "DIE             (Y?)"
prnt "DANCE           Lets boogie."
prnt "BUMRA           Be A Buggy ALL THE TIME."
tmr = TIMER: DO: LOOP UNTIL TIMER > tmr + 5
IF P = 1 THEN PRINT : PRINT "(SPACE to play again, Q quits.)": DO: a$ = INKEY$: LOOP UNTIL a$ = " " OR a$ = "Q": IF a$ = " " THEN  ELSE SYSTEM
RETURN
'sammie_morgan@talk21.com

REM $DYNAMIC
SUB above (vx, vy, ocy)
EXIT SUB: END SUB

REM $STATIC
SUB addnme (N, F)
SSP = (N * 4) + F
vs = VARSEG(nme(0, 0))
vp = VARPTR(nme(0, 0))
DQBget TL, 0, 0, NMX, NMy, vs, vp
SP = SSP '+ (O1 * 4)
getnmexy (SP)
DQBmPut ly%, sprx%, spry% + 1, vs, vp, O1
'dqbcopylayer ly%, 0
'DO: LOOP UNTIL INKEY$ <> ""
END SUB

FUNCTION address (X, Y)
address = (320 * Y) + X
END FUNCTION

SUB ADDSPRITE (LAY, SSP) : LAY = INT(LAY): SSP = INT(SSP)
Hi = 0: WINDOW (0, 0)-(320, 200):
DQBget TL, 0, 0, CHSX, chsy, VARSEG(ch(0, 0)), VARPTR(ch(0, 0))
FOR O1 = 0 TO 1: SP = SSP + (O1 * 64)
GETSPXY (SP)
DQBmPut 4 + ly2%, sprx%, spry%, VARSEG(ch(0, 0)), VARPTR(ch(0, 0)), O1
NEXT
END SUB

SUB addtile (LAY, SSP) : LAY = INT(LAY): SSP = INT(SSP)
Hi = 0: WINDOW (0, 0)-(320, 200):
DQBget TL, 0, 0, CHSX, chsy, VARSEG(s&(0, 0)), VARPTR(s&(0, 0))
FOR O1 = 0 TO 1: SP = SSP + (O1 * 64)
getblxy (SP)
DQBmPut ly3%, sprx%, spry%, VARSEG(s&(0, 0)), VARPTR(s&(0, 0)), O1
NEXT
END SUB

REM $DYNAMIC
FUNCTION afly (R)
IF R = 5 THEN ff = 1
IF R = 4 THEN ff = 2
IF R = 10 THEN ff = 3
IF R = 13 OR R = 14 THEN ff = 4
afly = ff
END FUNCTION

SUB anim (X%, Y%)
IF FRM <> 0 THEN EXIT SUB
IF LEV%(X%, Y%) = 12 THEN LEV%(X%, Y%) = 19: EXIT SUB
IF LEV%(X%, Y%) = 19 THEN LEV%(X%, Y%) = 12: EXIT SUB
IF LEV%(X%, Y%) = 19 OR LEV%(X%, Y%) = 12 THEN EXIT SUB
LEV%(X%, Y%) = LEV%(X%, Y%) + 1: IF LEV%(X%, Y%) > 29 THEN LEV%(X%, Y%) = 27
IF INT(RND * 100) < 99 THEN EXIT SUB
IF LEV%(0 + X%, 0 + Y%) AND levl2(0 + X%, Y% + 1) = 0 THEN bhurt = 1: putblood X% * sgx, (Y% + 1.5) * sgy: SFX 17: bhurt = 0
EXIT SUB: END SUB

REM $STATIC
SUB bleed (R)
IF COLABLE(R) > 0 THEN EXIT SUB
IF E(R) < 0 THEN killnme X(R), Y(R): putblood X(R), Y(R): IF ADULT THEN Y(R) = -100
END SUB

REM $DYNAMIC
SUB BLOCKS (O)
st = RND * (levy - 2)
ED = st + RND * (levy - (st + 2))
se = se \ 1: ED = ED \ 1
IF O < LEVX - RGT THEN  ELSE GOTO noblock
FOR X = O TO O + RGT
LEV%(X, 0) = 1
FOR Y = st TO ED
LEV%(X, Y) = 3
NEXT
NEXT
FOR P = st TO ED STEP 2 + RND * 2
TM = 4: T = RND * 4
X = O - 1: Y = P
C = 0: D = 0
DO
IF C = 0 AND D = 0 OR T > TM THEN T = 0: DO: C = INT(RND * 1.1): D = -2 + RND * 3.5: LOOP UNTIL C OR D: C = SGN(C): D = SGN(D)
C = SGN(C): D = SGN(D)
IF C THEN X = X + C ELSE Y = Y + D
X = X \ 1: Y = Y \ 1
IF Y > levy OR Y < 1 THEN Y = Y - D: C = 0: D = 0
IF X > 0 AND X < LEVX AND Y > 0 AND Y < levy THEN IF LEV%(X, Y) = 3 THEN LEV%(X, Y) = 0: LEV%(X - 1, Y) = 0: LEV%(X, Y - 1) = 0: IF INT(RND * 10) > 3 THEN LEV%(X - 1, Y - 1) = 0
T = T + 1: LOOP UNTIL X > O + RGT
NEXT
FOR X = O TO O + RGT + 1
LEV%(X, 0) = 1
NEXT
noblock:
EXIT SUB: END SUB

REM $STATIC
SUB bloodhurt (X, Y)
IF X > CHX AND X < CHX + sgx AND Y > CHY AND Y < CHY + sgy THEN HURT
END SUB

SUB bmppal (filename$)
CLOSE #16
OPEN filename$ FOR BINARY AS #16
IF LOF(16) < 2 THEN EXIT SUB
GET #16, 54, pointerstr
'GET #1, 54, pointer
FOR Slot% = 0 TO 255

 GET #16, , pointerstr
 bl% = INT(ASC(pointerstr) / 4)
 GET #16, , pointerstr
 gr% = INT(ASC(pointerstr) / 4)
 GET #16, , pointerstr
 re% = INT(ASC(pointerstr) / 4)
  OUT &H3C8, Slot%
  OUT &H3C9, re%
  OUT &H3C9, gr%
  OUT &H3C9, bl%

 GET #16, , pointerstr
NEXT Slot%
CLOSE #16
END SUB

FUNCTION BOUNCY (O)
ff = 0:
zz = Z(O): IF zz = 20 THEN ff = 1
BOUNCY = ff
END FUNCTION

SUB cARSFX (SPD)
IF SPD < 2 THEN EXIT SUB
TSPD = 22050 / 14
TSPD = TSPD * SPD
cc = channel%: channel% = 2: freq% = TSPD + 10000 + INT(RND * 2000):
N$ = "waves\sfx20.wav": IF SPD = 0 THEN N$ = "waves\sfx200.wav"
playwav N$, 1: channel% = cc
END SUB

REM $DYNAMIC
SUB centre (aa$) : a$ = aa$
FOR OFX = -1 TO 1: FOR OFY = -1 TO 1
DQBprints layer, aa$, INT((150 + OFX) - (DQBlen(aa$) / 2)), OFY + CSRLIN * 8, 7, 0 + Style
NEXT: NEXT
OFX = 0: OFY = 0
DQBprints layer, aa$, INT((150 + OFX) - (DQBlen(aa$) / 2)), OFY + CSRLIN * 8, 4, 0 + Style
PRINT
EXIT SUB: END SUB

REM $STATIC
SUB cheat (b$)
C$ = RIGHT$(C$ + b$, 20)
C$ = RIGHT$(C$, 12)
a$ = RIGHT$(b$, 1)
cc$ = C$
IF C$ <> "" THEN C$ = LCASE$(C$)
IF RIGHT$(C$, 10) = "ilovebirds" THEN cht = 1 - cht: FOR O = 0 TO ANME: DO: Z(O) = INT(RND * ANME) + 1: LOOP UNTIL fly(O): NEXT: C$ = ""
IF RIGHT$(C$, 12) = "shootthemoon" THEN HIJUMP = 1 - HIJUMP: C$ = ""
IF RIGHT$(C$, 4) = "swim" THEN swim = 1 - swim: C$ = ""
IF RIGHT$(C$, 10) = "thisishard" THEN cant = 1 - cant: C$ = ""
IF RIGHT$(C$, 3) = "die" THEN CHY = -100: C$ = ""
IF RIGHT$(C$, 6) = "boring" THEN DQBsetFrameRate (60): speed = 1 - speed: C$ = ""
IF RIGHT$(C$, 7) = "enemies" THEN ply = 1 - ply: C$ = ""
IF RIGHT$(C$, 4) = "ouch" THEN ouch = (1 - ouch): C$ = ""
IF RIGHT$(C$, 5) = "sonic" THEN sonic = 1 - sonic: play$ = splay$: C$ = "sonic": IF sonic = 1 THEN play$ = "alt"
IF C$ = "sonic" THEN LOADPLAY play$: C$ = ""
IF RIGHT$(C$, 5) = "bumra" THEN buggy = 1 - buggy: play$ = splay$: C$ = "bumra": IF buggy = 1 THEN play$ = "JEEP"
IF C$ = "bumra" THEN LOADPLAY play$: C$ = ""
IF RIGHT$(C$, 5) = "dance" THEN dance = 1 - dance: C$ = ""
IF RIGHT$(C$, 5) = "adult" THEN ADULT = 1 - ADULT: C$ = ""
IF RIGHT$(C$, 6) = "woohoo" THEN wing = wing + 1: wings = wings + 1: C$ = "": cc$ = "jj"
IF RIGHT$(C$, 7) = "imskint" THEN COIN = 99: C$ = ""
IF C$ = "" AND cc$ <> "" THEN SFX 17
END SUB

REM $DYNAMIC
SUB check (R)
IF T(R) THEN GOTO NOCHK
IF ouch AND COLABLE(R) = 0 THEN EXIT SUB
FL = fly(R)
CL = COLABLE(R)
WD = WILD(Z(R)): IF WD = 2 AND buggy = 0 THEN EXIT SUB
'IF z(R) = ply THEN cl = 1
IF CL THEN POINTS 100
IF Z(R) = 3 THEN HURT: D = 14: GOTO NOCHK
IF BOUNCY(R) THEN D = 22: AN(R) = 101: IF jumpd THEN D = 30
IF BOUNCY(R) THEN GOTO NOCHK
IF CL = 1 THEN power = power + 3: SFX 4: T(R) = 1: D = 0: GOTO NOCHK
IF CL = 2 THEN SFX 8: T(R) = 1: LV = LV + 1: GOTO NOCHK
IF CL = 3 THEN SFX 4: T(R) = 1: wing = wing + 1: GOTO NOCHK
IF CL = 4 THEN T(R) = 1: D = 0: LOADPLAY "jeep": C = 0: GOTO NOCHK
IF CL = 5 AND INVINC > 0 THEN GOTO NOCHK
IF CL = 5 THEN SFX 2: COIN = COIN + 1: T(R) = 1: GOTO NOCHK
IF FL = 2 THEN HURT: C = -SGN(C) * 7: LOADPLAY play$: D = 24: GOTO NOCHK
IF FALLER(R) > 0 THEN DD = 0
OKL = KL: IF (DD < 0 AND T(R) = 0) OR buggy THEN D = 15: D(R) = 15: Y(R) = Y(R) + D(R): T(R) = 1: StereoFX 3, pan%(CHX - X(R)): KL = KL + 1 ELSE HURT: D(R) = 15 * (SZ(Z(R)) / 16): Y(R) = Y(R) + D(R) / 15: T(R) = 1: IF E(R) > 0 THEN E(R) = E(R) + 1
IF buggy THEN D = D / 8: IF T(R) THEN X(R) = X(R) + C(R) / 2: putblood X(R), Y(R): IF E(R) < 0 THEN IF ADULT THEN Y(R) = -100
IF buggy AND WILD(Z(R)) = 2 THEN C(R) = C(R) / 30: D(R) = 4
IF E(R) < 1 THEN POINTS (10 * (roadsc + 1)): IF roadsc = 0 THEN IF buggy AND ADULT THEN rc = rc + 1: IF rc > 20 THEN MESSAGE "ROAD KILL": roadsc = 10: rc = 0
IF E(R) > 0 THEN KL = OKL
IF DIE = 1 THEN D = 10: IF C = 0 THEN C = 1
NOCHK:
IF Z(R) = ply THEN T(R) = 0
IF KL > 10 THEN EN = 9: LV = LV + 1: KL = 0
EXIT SUB: END SUB

REM $STATIC
SUB CHECKALL (CKKX, cKy) : CKX = CKKX - (sgx)
cmx = ((CHX \ sgx) * sgx) \ 2: cMy = ((CHY \ sgy) * sgy) \ 2
FOR O = 1 TO ANME: IF Z(O) < 1 THEN GOTO noway
MX = ((X(O) \ sgx) * sgx) \ 2: MY = ((Y(O) \ sgy) * sgy) \ 2
IF (cmx = MX AND cMy = MY) THEN check (O)
noway:
NEXT
END SUB

REM $DYNAMIC
FUNCTION chk (X, Y)
IF POINT(CHX + (X * sgx), CHY + (X * sgy)) THEN chk = levl(CHX + (X * sgx) / sgx, (CHY + (Y * sgy) / sgy))
chk = 0
END FUNCTION

SUB chkp (R)
IF levl(X(R) \ sgx, (Y(R) \ sgy) + 1) THEN D(R) = -1
IF Y(R) > levy * sgy THEN D(R) = D(R) / 2
IF cht OR fly(R) = 2 OR fly(R) = 3 THEN C(R) = C(R) + SGN(CHX - X(R)) / 12
IF X(R) < 0 OR X(R) > LEVX * sgx THEN D(R) = 4: IF Y(R) > levy * sgy THEN X(R) = RND(LEVX): Y(R) = TOP + (INT(RND * levy) - TOP) * sgy
IF ABS(C(R)) > 6 THEN C(R) = SGN(C(R)) * 6
EXIT SUB: END SUB

REM $STATIC
FUNCTION CLEVL (X, Y) : X = X \ 1: Y = Y \ 1
IF X < 0 OR X > LEVX OR Y < 0 OR Y > levy - 1 THEN LL% = 0: GOTO nxtC
LL% = LEV%(X, Y) MOD 256
IF (LL% > 25 AND LL% < 30) OR (LL% > 33 AND LL% < 53 AND LL% <> 46 AND LL% <> 36) OR LL% = 33 OR LL% > SPR OR (LL% = 33 AND fi) THEN LL% = 0
nxtC:
CLEVL = LL%
END FUNCTION

REM $DYNAMIC
FUNCTION COLABLE (R)
CD = 0
IF Z(R) = 8 THEN CD = 1
IF Z(R) = 9 THEN CD = 2
IF Z(R) = 10 THEN CD = 3
IF Z(R) = 24 THEN CD = 5
IF Z(R) = 22 THEN CD = 4
COLABLE = CD
END FUNCTION

SUB collect (X, Y)
IF levl3(X, Y) = 12 THEN LEV%(X, Y) = 0: COIN = COIN + 1: SFX 2
EXIT SUB: END SUB

SUB DECOMPRESS (N$)
CLOSE
LOADOK = 1: OPEN PATH$ + N$ FOR BINARY AS #1
E = LOF(1): CLOSE : IF E = 0 THEN LOADOK = 0: EXIT SUB
OPEN PATH$ + "TMP" FOR OUTPUT AS #1
OPEN PATH$ + N$ FOR INPUT AS #2
NO = 1
ox = -1
INPUT #2, X
PX = 0: PY = 0
DO:
INPUT #2, X$: X = VAL(X$): XX = VAL(MID$(X$, INSTR(2, X$, ":") + 1)): FOR O = 1 TO X: PRINT #1, XX - 1: NEXT
'PRINT X, XX: DO: LOOP UNTIL INKEY$ = " "
LOOP UNTIL EOF(2)
PRINT #1, 0
CLOSE 1: CLOSE 2
EXIT SUB: END SUB

REM $STATIC
FUNCTION DLEVL (X%, Y%) : X% = X% \ 1: Y% = Y% \ 1
IF X% < 0 OR X% > LEVX OR Y% < 0 OR Y% > levy - 1 THEN LL% = 0: GOTO Dnxt
LL% = LEV%(0 + X%, 0 + Y%): L2% = LEV%(X%, Y% + 1)
IF LL% = 0 AND L2% = 0 THEN DLEVL = bkg: EXIT FUNCTION
IF L2% = 33 THEN ZFLOOD X%, Y%
IF LL% = 25 THEN LL% = LEV%(X%, Y% + 1)
IF LL% = 0 THEN LL% = bkg
mv% = (LL% \ 256): IF mv% OR dance THEN MOVECOIN X%, Y%
LL% = LL% MOD 256: L2% = L2% MOD 256: IF LL% > 26 AND LL% < 30 OR (LL% = 19 OR LL% = 12) THEN anim X%, Y%
Dnxt:
DLEVL = LL%
END FUNCTION

REM $DYNAMIC
SUB dnmes
FOR R = 1 TO ANME
IF Z(R) = 24 THEN NN = 0
IF Z(R) = 0 OR X(R) < crx - 200 OR X(R) > crx + 200 THEN GOTO NODW
IF Y(R) < 0 OR Z(R) < 1 THEN Z(R) = 0: GOTO NODW
rx = 0: NN = AN(R) / 100: IF C(R) < 0 THEN rx = 1
IF T(R) = 0 AND Z(R) = 24 THEN NN = 0
ht = 0: IF Z(R) = 6 THEN ht = 1
tmp = DLEVL(0 + X(R) \ sgx, Y(R) \ sgy - 1)
IF tmp THEN tmp = levl(X(R) \ sgx, Y(R) \ sgy - 1)
IF tmp AND mv% > 0 THEN : killnme X(R), Y(R)
'IF tmp THEN MV% = 0
enme X(R), Y(R), Z(R), NN, R
NODW:
IF R = anmes THEN R = ANME - 10
NEXT
'dqbcopylayer collide, 0:DO: LOOP UNTIL INKEY$ = " "
DN = 0: EXIT SUB: END SUB

REM $STATIC
SUB drawblood (CHX, CHY)
IF ADULT = 0 THEN EXIT SUB
FOR O% = 0 TO bld: IF bli(O%) = 0 THEN GOTO nxta
XX = blx(O%) - CCX: YY = bly(O%) - CCY
IF XX > -8 AND XX < 340 THEN  ELSE bly(O%) = 0: GOTO nxta
DQBmPut layer, XX, (200 - YY), VARSEG(blood(0)), VARPTR(blood(0)), 0
IF bli(O%) < 10 THEN DQBmPut collide, XX, (200 - YY), VARSEG(blood(0)), VARPTR(blood(0)), 0
bli(O%) = bli(O) - 1
IF bly(O%) < 0 OR bld(O%) < -4 THEN bly(O%) = -25: bli(O%) = 0
blx(O%) = blx(O%) + blc(O%): bly(O%) = bly(O%) + bld(O%): bld(O%) = bld(O%) - 2: IF blh(O%) > 0 THEN bloodhurt blx(O%), bly(O%)
nxta:
NEXT
END SUB

SUB effect (fx)
freq% = 22000
DQBplaySound channel%, INT(fx), freq%, ONCE
EXIT SUB: END SUB

SUB enme (XX, YY, Z, AN, R) : ck(R) = 0: IF Z < 1 THEN GOTO NOE2
bx = XX: BY = YY
XX = XX - CCX
YY = YY - CCY
IF levl3(XX / sgx, (YY / sgy)) = 0 THEN Y(R) = Y(R) - 2
'IF xx < -NMX OR xx > MRT + NMX OR yy < -NMy OR yy > mxy + NMy THEN dw(R) = 0: GOTO noe
IF T(R) AND E(R) > 0 THEN T(R) = 0: E(R) = E(R) - 1
YY = 200 - (YY + sgy): YY = YY - mv%(mv%)
SSP = INT(Z * 4) + AN
IF T(R) OR (WILD(Z(R)) AND LV%(R) = 0) THEN SSP = SSP + 2
IF C(R) > 0 THEN CD = 0 ELSE IF C(R) < 0 THEN CD = 1
getnmexy (SSP)
IF BOUNCY(R) > 0 THEN YY = YY + 4
IF SZ(Z(R)) = 16 THEN tpy = 0 ELSE tpy = sgy / 2
IF SZ(Z(R)) < 31 THEN
IF C(R) > 0 THEN SP = 0 ELSE SP = sgx
x1 = XX - sgx: IF SZ(Z(R)) = 32 THEN x1 = x1 + sgx
DQBget ly%, sprx% - 1, spry%, sprx% + SZ(Z(R)), spry% + SZ(Z(R)), vs, vp
DQBmPut layer, x1 + sgx, (YY - tpy) + 16, vs, vp, CD
ELSE
x1 = XX - (sgx / 2): DQBget ly%, sprx%, spry% + 1, sprx% + SZ(Z(R)), spry% + SZ(Z(R)), vs, vp
DQBmPut layer, x1 + sgx / 2, (YY + tpy) - 16, vs, vp, CD
END IF
EE = 0
IF BOUNCY(R) THEN x1 = x1 - sgx
IF SZ(Z(R)) > 16 THEN x1 = x1 - sgx
EE = DQBcollideOnLayer(collide, x1, YY - tpy, vs, vp)
DQBmPut collide, x1, YY - tpy, vs, vp, CD
dw(R) = 1
FL = fly(R): IF FL = 2 AND nt = 0 AND INT((RND * 200)) = 20 THEN StereoFX 11, pan%(X(R)): spooksnd = R
IF FL = 2 AND spooksnd = R THEN tgx% = pan%(X(R))
noe:
XX = bx
YY = BY
NOE2:
EXIT SUB: END SUB

REM $DYNAMIC
SUB entirefx (XX)
music 0
playmusic XX
tmr = TIMER: DO: playwav "", 0: floor tmx, tmy
LOOP UNTIL mfinsd OR TIMER > tmr + 8
EXIT SUB: END SUB

SUB fade
FOR O = 63 TO 0 STEP -4
FOR OO = 0 TO 255
palc OO, O, (O + 1) \ 2, (O + 1) / 2
'tm = TIMER: DO: LOOP UNTIL tm > TIMER + .1
NEXT
NEXT

EXIT SUB: END SUB

FUNCTION FALLER (R)
ff = 0:
zz = Z(R):
IF zz = 16 THEN ff = 1
FALLER = ff
END FUNCTION

FUNCTION FCD
cx = CHX \ sgx: CY = CHY \ sgy
IF levl(cx, CY - 1) = 0 THEN mv = -1 ELSE IF levl(cx, CY + 1) = 0 THEN mv = 1
FCD = mv
END FUNCTION

FUNCTION FINDSPD (F)
s = 0: TM = TIMER: DO: s = s + 8: LOOP UNTIL TIMER > TM + (.9)
FINDSPD = s / F
END FUNCTION

SUB fire
fir = power: IF fir > 10 THEN fir = 10
FOR fr = 0 TO 10: IF power = 0 THEN fr = 10: GOTO nx
IF BC(fr) = 0 THEN bx(fr) = CHX - 8: BY(fr) = CHY + 52: BC(fr) = C - SGN(DIR - 2) * 9: bd(fr) = -4: fr = 11: SFX 1
nx:
NEXT
nof:
EXIT SUB: END SUB

FUNCTION fish (R)
ff = 0
IF R = 13 THEN ff = 1
fish = ff
END FUNCTION

SUB floor (X, Y) : X = X \ 1: Y = Y \ 1
IF X > (LEVX - 5) * spx THEN X = (LEVX - 5) * spx
IF X < 0 THEN X = 0
IF Y < 0 THEN Y = 0
IF Y > (levy - 1) * sgy THEN Y = (levy - 1) * sgy
CCX = X: CCY = Y
mi% = INT(X \ sgx)
ac% = INT(X MOD sgx)
miy% = INT(Y \ sgy)
acy% = INT(Y MOD sgy)
SX = 0: EX = RGT
sy = 0: eY = TOP + 1
J% = SX
IF J% + mi% < 0 THEN J% = J% - (mi% + 1)
SX = J%
J% = EX
IF J% + mi% > LEVX THEN posn = (J% + (mi% - 1) - LEVX) * sgx: J% = J% + ((J% + mi%) - LEVX)
EX = J% - 1
sgx% = sgx: sgy% = sgy
sc = 4
scrn
SX = SX - 1: EX = EX + 1
IF sy < 0 THEN sy = 0 ELSE IF eY > levy THEN eY = levy
IF SX < 0 THEN SX = 0 ELSE IF SX > LEVX THEN SX = LEVX
'    floor drawer:
DN = 0: mv% = 0
crx = X
cry = Y
crx = crx + 160: cry = cry + 100
FOR J% = SX TO EX
FOR K% = eY + 1 TO sy STEP -1: E% = DLEVL(J% + mi%, K% + miy%): SPRITE -ac% + (J% * sgx%), -acy% + (K% * sgy%), E%: mv% = 0: NEXT
NEXT
'IF CHY < Y + ((top - 1) * SGY) AND CHY - Y > -SGY THEN IF CHX - x > -8 AND CHX - x < MRT THEN
COLOR 15
LOCATE 1, 12: prnt STRING$(ABS(ts), 16)
IF nwspd THEN GOTO nolabels
IF ts > 13 THEN TKO = 1
LOCATE 2, 4
le$ = RIGHT$(STR$(((LEV - 1) \ 4) + 1), 1)
le$ = le$ + "-" + RIGHT$(STR$((((LEV - 1) MOD 4) + 1)), 1)
prnt "WORLD  " + le$
LOCATE 2, 26
prnt "LIVES X" + STR$(LV)
LOCATE 3, 4
prnt "COINS X" + STR$(COIN)
IF COIN > 99 THEN COIN = COIN - 100: LV = LV + 1
LOCATE 2, 16: prnt P$(LEV)
LOCATE 2, 30: prnt STR$(anmes)
IF TIMER > fp + 1 THEN lfps = FPS: FPS = 0: fp = TIMER
LOCATE 1, 1: prnt STR$(lfps) + " FPS"
IF cars THEN LOCATE 3, 16: prnt "Position:" + STR$(place) + "/" + STR$(cars)
LOCATE 1, 30
E$ = MID$(STR$(score), 2): IF LEN(E$) < 8 THEN DO: E$ = "0" + E$: LOOP UNTIL LEN(E$) = 8
prnt E$
dw = 0: IF (TIMER * 100) MOD 50 > 25 THEN dw = 1
IF MS$ <> "" AND dw THEN EE = DQBloadFont("hitech.fnt"): LOCATE 13, 1: centre MS$: EE = DQBloadFont("small.fnt")
IF TIMER > mst THEN MS$ = "": roadsc = 0
nolabels:
drawblood crx, cry
dnmes
man ((CHX - X) - 8), CHY - Y, DIR, AN:
FPS = FPS + 1
FOR fr = 1 TO fir: bx = bx(fr): BY = BY(fr): BC = BC(fr): bd = bd(fr): IF BC = 0 THEN GOTO nobul
IF BC THEN bx = bx + BC / 1.6
BY = BY + bd: bd = bd - 3
IF levl(bx \ sgx, (BY \ sgy) - 1) THEN bd = 2
IF levl((bx \ sgx) + SGN(C), (BY / sgy) - 1) THEN BC = 0
BY = BY - (sgy / 1.3): K = (bx - X) > 0 AND (bx - X) < MRT AND (BY - Y) > 0 AND (BY - Y) < MXY - sgy
IF K THEN DQBmPut layer, bx - X, 232 - (BY - Y) - sgy, VARSEG(bul(0, 0)), VARPTR(bul(0, 0)), 0
IF K THEN IF DQBcollideOnLayer(3, (bx - X), 200 - ((BY - Y) - 6), VARSEG(bul(0, 0)), VARPTR(bul(0, 0))) THEN killnme bx, BY: IF Kd THEN BC = 0
BY = BY + (sgy / 1.2)
IF K = 0 THEN BC = 0
nobul:
bx(fr) = bx: BY(fr) = BY: BC(fr) = BC: bd(fr) = bd: NEXT

IF nt MOD 3 <> 2 THEN GOTO nt1
sm = 1.2: st = 0
FOR O = 0 TO RAIN: XX(O) = XX(O) + st + (X - ox) / sm: YY(O) = YY(O) + st * 4 + (Y - oy) / sm
XX = (XX(O) - X) MOD MXX
YY = (YY(O) - Y) MOD MXY
pp% = POINT(XX, YY): IF pp% = 0 OR pp% = 247 THEN DQBpset layer, XX, 200 - YY, 15
NEXT
nt1:
IF nt MOD 3 <> 1 THEN GOTO dont
FOR O = 0 TO RAIN: X7 = (XX(O) - X) MOD MXX: Y7 = 200 - (YY(O) - Y) MOD MXY
DQBline layer, X7, Y7, X7 - 4, Y7 + 14, 15: YY(O) = YY(O) - 14: XX(O) = XX(O) - 4

IF YY(O) < 0 THEN YY(O) = levy * sgy
IF XX(O) < 0 THEN XX(O) = LEVX * sgx
NEXT
dont:
playwav "", 0
stg = stg + 50
IF stg > ANME - 1 THEN stg = 0
IF ANME = 0 THEN GOTO NONM
IF BOSS > 0 THEN BOSS = 0
FOR R = 1 TO ANME: FL = fly(R): JMPR = JUMPER(R): IF Y(R) < 0 OR Z(R) < 1 THEN Z(R) = 0: GOTO ED
IF BOUNCY(R) THEN C(R) = 0
IF Z(R) = 3 THEN X8 = X(R): C(R) = 2
IF Z(R) = 8 OR Z(R) = 9 THEN C(R) = 0: X8 = X(R): Y8 = Y(R)
IF COLABLE(R) = 5 THEN : X8 = X(R): Y8 = Y(R)
wld = WILD(Z(R)): FALL = FALLER(R): IF dw(R) = 0 THEN IF FALL = 0 AND WILD(Z(R)) = 0 THEN IF fly(R) <> 3 THEN IF T(R) = 0 THEN IF JMPR = 0 THEN GOTO PED
'IF WLD = 0 THEN IF FALL = 0 THEN IF DW(R) = 0 THEN IF (fl <> 3 AND JMPR <> 1) THEN IF X(R) < CRX - 180 OR X(R) > CRX + 180 OR Y(R) < CRY - 150 OR Y(R) > CRY + 150 THEN GOTO ED
IF JMPR THEN dw(R) = 1
IF FALL THEN IF M(R) = 0 THEN IF X(R) \ sgx = (CHX + (C * 10)) \ sgx THEN M(R) = 1: D(R) = -1
IF FALL > 0 THEN IF M(R) = 0 THEN T(R) = 0: AN(R) = 101: C(R) = -.1: dw(R) = 1: GOTO ned
IF FALL > 0 THEN Y(R) = Y(R) + D(R): IF ABS(D(R)) > 8 THEN D(R) = SGN(D(R)) * 8
IF FL = 0 THEN D(R) = D(R) - 1
fi = 1: FG = 1: IF T(R) THEN Y(R) = Y(R) + D(R): GOTO ED
ann = ABS(C(R) + SGN(JMPR)) * 13
IF BOUNCY(R) THEN IF AN(R) > 100 THEN ANr2 = AN(R) + 10
IF BOUNCY(R) THEN AN(R) = ANr2: ann = 0: ANr2 = 100
IF ann > 99 THEN ann = 99
AN(R) = AN(R) + ann: IF AN(R) > 200 OR AN(R) < 100 THEN AN(R) = 100
IF FL = 2 OR Z(R) = 12 THEN C(R) = C(R) + SGN(C): IF ABS(C(R)) > 7 THEN C(R) = SGN(C(7)) * 7
IF FL = 1 THEN C(R) = C(R) + SGN(CHX - X(R)) / 10: D(R) = D(R) + SGN(CHY - Y(R)) / 10
IF JMPR THEN C(R) = 0: FG = 0: GOTO ned
MX = INT(X(R) \ sgx): MY = INT(Y(R) \ sgy)
LV%(R) = levl(MX, MY - 1)
IF COLABLE(R) = 5 THEN D(R) = D(R) + 1
IF levl3(MX, MY - 1) = 0 AND Z(R) = 8 THEN Y8 = Y8 - 1
IF T(R) = 0 THEN IF levl(MX, MY - 1) <> 0 AND Z(R) = 24 THEN D(R) = 4
IF levl3(MX, MY - 1) AND BOUNCY(R) THEN GOTO ned
IF levl3(MX, MY - 1) AND FALL > 0 THEN T(R) = 1
IF levl3(MX, MY) <> 33 AND FL = 4 THEN D(R) = D(R) - 1
IF levl3(MX, MY) = 38 THEN D(R) = 0: AN%(R) = 0
G = levl2(MX + SGN(C(R)), MY)
IF G = 56 OR G = 57 THEN G = 0: D(R) = 10: Y(R) = Y(R) + sgy: X(R) = X(R) + SGN(C(R)) * sgx: G = 0: GOTO ED
IF wld = 2 THEN IF G = 14 OR G = 15 THEN G = 0: C(R) = 0: IF WIN = 0 THEN place = place + 1: IF place > cars / 2 THEN EN = -1: HURT
IF G = 54 AND wld = 1 THEN sanimal = sanimal - 1: SHUFFLE MX + SGN(C(R)), MY: Z(R) = -100: POINTS 5000: MESSAGE "SAVED MONKEY!"
IF G AND G <> 38 THEN C(R) = -C(R)
IF FL THEN E = levl2(MX, MY) ELSE E = levl2(MX, MY - 1)
IF wld = 1 AND E = 0 THEN FG = 2: AN(R) = 150
IF wld = 1 AND D(R) < -100 THEN D(R) = -10
IF wld = 2 THEN FG = 1: IF ABS(C(R)) < 14 THEN C(R) = C(R) + (SGN(C(R)) / 6) * buggy
IF wld = 1 THEN IF levl3(MX, MY - 1) > 0 THEN C(R) = C(R) + SGN(INT(CHX - X(R))) / (4 + RND * 1): IF ABS(C(R)) > 4 THEN C(R) = SGN(C(R)) * 4
IF E AND D(R) < 1 THEN D(R) = 0: AN%(R) = 0: IF FL = 0 AND D(R) < .1 THEN Y(R) = MY * sgy
IF FL THEN IF Y(R) < levy * sgy THEN D(R) = D(R) + RND * 2: chkp (R)
JJ = 0: IF levl2(MX + SGN(C(R)), MY - 1) = 0 AND E AND FL = 0 AND D(R) < 1 AND (Z(R) <> 3 AND Z(R) <> 8) THEN C(R) = -C(R): IF wld THEN IF ABS(C(R)) > 2 THEN C(R) = -C(R): WILDJUMP R
'IF jj THEN Y(r) = Y(r) + D(r): 'X(R) = X(R) + C(R)
IF levl(MX, MY) AND Z(R) = 24 THEN IF D(R) < 0 THEN D(R) = 9

CNT:
IF wld = 3 THEN IF levl(MX + SGN(C(R) * 2), 0 + MY) = 2 AND levl(MX + SGN(C(R) * 2), MY + 1) = 0 THEN D(R) = 10: C(R) = -SGN(C(R)) * 8
'if dlevl(mx + SGN(c(r)) * 2, my)>0 and dlevl(mx + SGN(c(r)) * 2, my+1) =0
IF wld = 3 THEN E = LEVL4(MX + SGN(C(R)) * 2, MY): IF E > 0 AND mv% = 0 THEN LEV%(MX + SGN(C(R)) * 2, MY) = LEV%(MX + SGN(C(R)) * 2, MY) + 256: IF levl(MX + SGN(C(R)) * 2, MY + 1) = 0 THEN D(R) = 15
IF D(R) < 0 OR levl2(MX, MY + 1) = 0 THEN Y(R) = Y(R) + D(R) ELSE D(R) = -D(R)
IF wld = 2 AND WIN THEN C(R) = INT(C(R) - SGN(C(R)))
IF wld = 2 AND buggy = 0 THEN GOTO NOMV
G = levl((X(R) \ sgx) + SGN(C(R)), Y(R) \ sgy)
IF G = 56 OR G = 57 THEN G = 0: D(R) = 10: Y(R) = Y(R) + sgy: X(R) = X(R) + SGN(C(R)) * sgx: G = 0: GOTO ED
IF G = 0 THEN X(R) = X(R) + C(R) * FG / 2 ELSE C(R) = -C(R)
IF G = 0 THEN X(R) = X(R) + C(R) * FG / 2 ELSE C(R) = -C(R)
NOMV:
IF Y(R) < 0 AND (FL = 0 OR T(R)) THEN Z(R) = 0 ELSE IF Y(R) < 0 THEN Y(R) = 0: D(R) = 0
ned:
cmx = INT(CHX \ sgx): cMy = INT(CHY \ sgy)
MX = INT((X(R)) \ sgx): MY = INT(Y(R) \ sgy)
IF ck(R) = 1 THEN check R: bleed R
IF JMPR THEN Y(R) = Y(R) + D(R): IF levl3(MX, MY) = 33 THEN D(R) = D(R) + 3: T(R) = 0
IF JMPR AND ABS(D(R)) > 14 THEN D(R) = SGN(D(R)) * 14
IF Z(R) = 24 AND INT(C(R) * 4) = 0 THEN T(R) = 0: Y(R) = -100: Z(R) = 0
ED:
IF D(R) > 0 AND AN%(R) = 0 THEN AN%(R) = 1
'IF AN%(r) > 0 THEN AN%(r) = AN%(r) + SGN(C(r)) * 10
IF JMPR = 0 THEN D(R) = D(R) - 1
IF ABS(D(R)) > SZ(Z(R)) THEN D(R) = SGN(D(R)) * SZ(Z(R))
PED:
IF BOSS > -1 THEN IF isboss(Z(R)) > 0 AND T(R) AND dw(R) = 0 THEN Z(R) = 0 ELSE IF isboss(Z(R)) > 0 THEN BOSS = BOSS + 1
IF Z(R) = 8 OR Z(R) = 9 THEN X(R) = X8: Y(R) = Y8
IF Z(R) = 3 THEN X(R) = X8
IF Z(R) = 24 THEN X(R) = X(R) + C(R)
NEXT
IF BOSS = 0 THEN BOSS = -1: REMOVEGATES X, Y: SFX 15
IF R = anmes THEN R = ANME - 10
NONM:
fi = 0
ox = X: oy = Y: EXIT SUB: END SUB

FUNCTION fly (O)
ff = 0:
zz = Z(O): ff = afly(zz)
fly = ff
END FUNCTION

SUB FULLCLS
picture "backg3"
layer = VIDEO
palc 7, 0, 0, 0
EXIT SUB
FOR O = 1 TO 22
LOCATE O
centre ""
NEXT
save
EXIT SUB: END SUB

SUB GAME
DQBsetClipBox 0, 0, 319, 200
loadpalette
kpt = 0
stl = Style: Style = 0
'dqbmouseshow
music 0: IF BGM THEN music BGM
DEF SEG = 0
IF nt MOD 3 = 1 THEN SFX 8
IF wing > 6 THEN wing = 1
HIJUMP = 0
rn = 0
EN = 7
ky = 0
sen = EN
CHX = LSX
CHY = LSY
ani = 1
'CHX = 120 * SGX: CHY = 10 * SGY
'POWER = 1
mms = 0
WIN = 0
lhs = 0
rhs = MXX - 100
fol = 0
X = CHX - (MXX / 2)
Y = CHY - (MXY / 2)
DQBsetFrameRate (32)
DO
lf = 0: rt = 0: UP = 0: DN = 0
FOR KkY = 0 TO 32: E$ = EE$: EE$ = INKEY$: IF EE$ = "" THEN KkY = 33
NEXT
b$ = E$
IF b$ <> "" THEN b$ = UCASE$(b$)
a$ = "": IF LEN(b$) = 2 THEN a$ = MID$(b$, 2)
OK = 0: cheat b$
IF a$ = "K" AND ply THEN playasenemy
IF a$ = "H" THEN UP = 1: DIB = 0
IF a$ = "P" THEN DN = 1: DIB = 1: IF AN% = 0 THEN AN% = 1
DIB = 0
IF b$ = "F" AND fol THEN fol = 0 ELSE IF b$ = "F" THEN TM = TIMER: DO: O = INT(RND * ANME): LOOP UNTIL fly(O) = 3 OR TIMER > TM + .1: IF TIMER < TM + .1 THEN fol = O
IF b$ = "Q" THEN SMUDGE
IF b$ = "S" THEN save
IF b$ = " " THEN fire ELSE ls = 10
IF DIE OR shg > 1 THEN JP = 0: GOTO NOCNT
DEF SEG = 0
IF (PEEK(1047) AND 4) = 4 THEN lf = 1
IF (PEEK(1047) AND 8) = 8 THEN rt = 1
JP = (PEEK(1047) AND 1): IF (PEEK(1047) AND 2) = 2 THEN JP = 1
IF rt THEN DIR = 0 ELSE IF lf THEN DIR = 4
fok = 1: IF JP = 0 THEN fok = 1
NOCNT:
IF EN > 0 OR COIN > 0 THEN EN = 1
IF cant AND LV < 3 THEN LV = 3
IF cant THEN EN = 1
ocx = CHX: ocy = CHY
olc = C
IF ABS(C) > 1 THEN IF levl(CHX \ sgx, CHY \ sgy - 1) = 23 THEN lf = lf / 4: rt = rt / 4
IF ABS(C) < 1 THEN OO = 1 ELSE OO = .4
C = C - (-rt + lf)
skid = 0
IF buggy THEN IF D = 0 THEN IF (SGN(C) <> -SGN(DIR - 2) AND SGN(C) <> 0) THEN IF ABS(C) > 4 THEN skid = 1
IF buggy THEN IF (lf - rt) = 0 AND INT(C \ 4) <> 0 AND ABS(C) < 11 THEN IF D = 0 THEN skid = 1
IF skid THEN SFX 15
IF buggy THEN cARSFX ABS(gears(INT(GEAR)))
IF lf OR rt THEN TT = 10
IF (buggy = 0 AND sonic = 0) THEN mxc = 7 ELSE mxc = 12: IF RAMPED THEN mxc = 15
mxc = mxc * 2
'IF sonic THEN buggy = 0: IF ABS(c) > mxc / 1.2 THEN buggy = 1
IF ABS(C) > mxc THEN C = SGN(C) * mxc: IF levl(CHX \ sgx, (CHY \ sgy) - 1) THEN ts = ts + .4: IF ts < 1 THEN ts = 1
IF ABS(C) < mxc THEN ts = ts - .1
IF ts < 1 THEN ts = 0: TKO = 0
IF ts > 14 THEN ts = 14
cx = X
IF (C <> 0 AND ABS(C) >= ABS(olc)) THEN dr = ABS(C) - ABS(olc) + ABS(C) / 50
IF SGN(C) <> SGN(olc) THEN GEAR = 1
IF SGN((lf - rt)) = -SGN(C) = 0 THEN dr = -.5
'IF dr > 0 THEN dr = (dr * ABS(c)) / (22 + RND * 3)
IF INT(GEAR) = 12 THEN dr = SGN(dr) * .1
GEAR = GEAR + dr: IF GEAR > 12.9 THEN GEAR = 1 + RND * 3
IF GEAR < 1 THEN GEAR = 1
mvx = (CHX - X)
CHX = CHX + C / 2
vx = CHX / sgx
vy = (CHY \ sgy)
ch = levl(vx + SGN(C), vy)
IF levl3(vx, vy) = 55 THEN LEV%(vx, vy) = 0: LOADPLAY "JEEP"
IF ch = 21 THEN LSX = CHX: LSY = CHY: LEV%(vx + SGN(C), vy) = 0
'IF vx MOD (levx \ 3) < 2 AND die = 0 THEN lsx = chx: lsy = chy
'FD = levl(VX + SGN(c) / 2, VY)
FD = levl(-.5 + (vx + SGN(C) * .5), vy)
IF FD AND (FD <> 56 AND FD <> 57) THEN CHX = ocx: C = 0
IF FD = 14 OR FD = 15 AND WIN = 0 THEN WIN = 1
fx = levl(vx + SGN(C), vy)
vvx = (vx - 1) + SGN(C) * 2
vvy = vy + SGN(D)
EE = levl(vvx, vvy)
IF ky THEN IF EE = 36 AND vvx > 0 AND vvx < LEVX AND vvy > 0 AND vvy < levy THEN LEV%(vvx, vvy) = 0: ky = ky - 1
bl = levl(vx, vy - 1)
IF ABS(D) > 30 THEN D = SGN(D) * 30
IF levl(CHX \ sgx, (CHY \ sgy) + SGN(D)) = 0 THEN CHY = CHY + D
IF CHY < 0 THEN CHY = -100: GOVER
DD = SGN(D): IF D > 0 THEN DD = 0
IF RAMPED = 0 AND DIE = 0 THEN IF D = 0 THEN D = -4
IF DIE THEN D = D + .5
od = D
D = D - .5
IF wing AND D < 0 AND D > -1.4 THEN D = D / 3
vx = CHX \ sgx
IF levl2(vx, vy) = 26 AND UP THEN WD = DZ(WHICHDOOR(vx, vy)): IF WD THEN CHX = (dx(WD) * sgx) + 8: CHY = dy(WD) * sgy: X = CHX - MXX / 2: Y = CHY - MXY / 2: SFX 14
IF HIJUMP = 0 THEN IF ABS(D) < 1 AND ABS(C) > 6 AND levl(vx, vy - 1) AND levl(vx, vy + 1) = 0 AND levl(vx + SGN(C), vy - 1) = 0 AND levl(vx + SGN(C) * 2, vy - 1) AND levl(vx + SGN(C) * 2, vy) = 0 THEN D = 3: JP = 1: CHX = CHX + SGN(C) * 3:  AN = AN  _
+ 1
IF JP = 0 OR DIE THEN D = D - 2
IF HIJUMP THEN D = od - .1: IF D > 0 THEN D = D - .3
IF RAMPED THEN D = D - 1
IF levl(vx, vy + 1) THEN dk = 0: killnme vx * sgx, (vy + 2) * sgy: dk = 1
AB = levl(vx, vy + SGN(ABS(D + .1)))
IF AB = 4 THEN LEV%(vx, vy + 1) = 11 + 256: SFX 13: LEV%(vx, vy + 2) = 12
IF AB = 24 OR AB = 25 THEN HIT vx, vy + 1, 8
IF AB = 30 OR AB = 31 THEN HIT vx, vy + 1, 9
IF AB = 32 THEN HIT vx, vy + 1, 10
IF levl2(vx, vy) = 37 THEN ky = ky + 1: LEV%(vx, vy) = 0
IF levl2(vx + SGN(C), vy + SGN(D)) = 36 AND ky = 0 THEN D = 0: CHY = CHY - 1
IF levl2(vx + SGN(C), vy + SGN(D)) = 36 AND ky THEN ky = ky - 1: LEV%(vx + SGN(C), vy + SGN(D)) = 0
IF levl3(vx, vy) = 38 AND D < 0 THEN D = 0
IF levl3(vx, (CHY \ sgx) + 1) = 38 AND D > -4 THEN CHY = CHY + sgy: D = -ABS(D): CHY = CHY + D
gg = levl(vx, vy + 1)
IF gg = 0 AND levl3(vx, vy + 1) = 38 THEN gg = 38
IF gg THEN IF D > 0 AND levl(vx + SGN(C), vy - 1) AND levl(vx + SGN(C), vy) = 0 THEN D = -(D / 3): gg = 0: CHX = CHX + SGN(C) * sgx / 3: D = 0
D2 = 0: IF gg AND D > 0 THEN D2 = 1: D = -D: StereoFX 13, ((vx + .5) * sgx) - CHX: CHY = ocy + D: : LEV%(vx, vy + 1) = (LEV%(vx, vy + 1) MOD 256) + 256
'IF d2 THEN IF D > 0 AND levl(VX + SGN(C), VY + 1) THEN CHX = ocx + C * 2: chy = (VY + 1) * SGY: D = -D: StereoFX 13, ((VX + .5) * SGX) - CHX: IF levl(CHX \ SGX, chy \ SGY) THEN CHX = ocx: chy = ocy
vx = CHX \ sgx
vy = ((CHY) \ sgy)
IF levl(vx, vy) AND WIN = 0 THEN CHY = CHY + FCD * sgy: D = 0
IF levl3(vx, vy) = 12 THEN collect vx, vy
J = 1: cc = C: gg = levl(vx, vy - 1)
IF C = 0 THEN  ELSE mc = SGN(C)
IF AN% <> 0 THEN AN% = AN% + 15 * mc: IF AN% > 359 THEN AN% = 1
IF gg AND ABS(D) > 14 THEN shake
ww = wing: IF ply THEN wing = SGN(afly(ply)) * 12: IF wing = 0 THEN wing = ww
IF gg = 0 AND fok = 1 AND JP AND wing > 0 THEN D2 = -3 + (wing / 1.5) * TKO: fok = 0: IF D2 > D THEN D = D2
wing = ww
ld = D: IF gg = 0 AND levl3(vx, vy) = 38 THEN gg = 38: IF D < 0 THEN D = 0
IF gg AND D < .1 THEN J = 0: CHY = (CHY \ sgy) * sgy: SLOW CHY: D = 0: IF JP THEN JUMP vx, vy: AN% = 1
IF gg = 8 AND DN THEN trans vx, vy:
bl = levl2(vx, vy): IF bl > 26 AND bl < 30 THEN IF swim = 0 THEN HURT: EN = -1
IF DIE = 0 AND ((bl > 26 AND bl < 30 AND swim) OR bl = 33) THEN wtr = 1: IF JP THEN D = D + 6: IF levl(vx, vy + 1) = 0 THEN D = D * 3
IF DIE = 0 THEN IF wtr THEN IF ABS(D) > 6 THEN D = D / 2: IF ABS(D) > 8 THEN D = SGN(D) * 8
'under = (wtr * 9):if wtr then jumpd=1
IF levl(vx, vy - 1) THEN UNDER = 0
jmpD = 0
wtr = 0
a = 0
IF feet THEN walk = 0
IF a = 0 THEN a = (ABS((ocx - CHX)) / 3) / (buggy + 1)
IF a > 1 THEN a = 1 ELSE a = SGN(a) * (buggy + 1)
IF icy AND (lf + rt) = 0 THEN a = 0
IF a > 2 THEN a = 3
IF a > 1 AND a <> 3 THEN a = 1
IF D <> 0 THEN a = 1
IF DN THEN a = 1
OAN = AN: AN = AN + a
IF AN < 0 THEN AN = 3
IF AN > 3 THEN AN = 0
acc = SGN(DIR - 2)
IF UNDER THEN AN = 1
IF UNDER THEN AN% = (SGN(D \ 3) * 15) * acc
walk = 10: IF DIE = 0 THEN IF ABS(C) < mxc THEN walk = 0
IF levl(vx, vy) = 18 AND levl(vx + 2, vy) <> 18 THEN OK = 1: winsfx
IF C > 0 THEN mms = 50 ELSE IF C < 0 THEN mms = -50
IF (J AND UNDER = 0) OR (sonic AND buggy) OR slp > 0 THEN jmpD = 1: walk = 0: IF C = 0 THEN IF AN = OAN THEN AN = AN + 1: IF AN > 3 THEN AN = 0
IF J = 0 AND ABS(C) < 1 THEN C = 0: walk = 0: AN = 4
IF JJ AND WIN THEN walk = 1
IF C = 0 AND D = 0 THEN AN = 0
IF DN AND ABS(C) > 0 THEN UNDER = 1
vx = CHX / sgx
vy = (CHY + 8) / sgy
IF DIR = 4 THEN mms = -50 ELSE mms = 50
IF fol THEN mms = SGN(C(fol)) * 50
IF fol THEN tx = X(fol) ELSE tx = CHX
X = X + mos - (mms / 4)
mv = (tx - X) / 4: IF ABS(mv) > spx * 7 THEN mv = (SGN(mv) * spx * 7)

X = X + mv
X = X - mos + (mms / 2)
cx = X
Y = Y + MXY / 3

mvy = (CHY - Y) / 2: IF fol THEN mvy = (Y(fol) - Y)
Y = Y - MXY / 3
Y = Y + mvy
CCX = X: CCY = Y
IF CHX = ocx AND CHY = ocy AND WIN = 1 AND OK = 0 THEN IF levl(vx, vy - 1) AND TIMER > tmm + 2 THEN OK = 1
IF levl(CHX \ sgx, (CHY \ sgy) + .4) AND levl(CHX \ sgx, ocy \ sgy) = 0 THEN CHY = ocy
IF slp THEN CHY = CHY - sgy
mnx = CHX \ sgx: mny = CHY \ sgy
odie = DIE: floor X, Y: tmx = X: tmy = Y
ld = D
IF EN < 0 AND COIN = 0 THEN GOVER
DIE = 0
playwav "", 0
IF finsd THEN StereoFX 0, 0: spooksnd = 0: tgx% = 0
IF WIN THEN CNTR = CNTR + 1
LOOP UNTIL LV < 0 OR (WIN = 1 AND CNTR > 2)
CNTR = 0
music 0
FOR O = 0 TO LEVX: FOR P = 0 TO levy - 1: LEV%(O, P) = 0: NEXT: NEXT
FOR O = 0 TO ANME: T(O) = 0: X(O) = 0: C(O) = 0: D(O) = 0: Y(O) = 0: NEXT
Style = stl
EXIT SUB: END SUB

SUB generate (Z)
DQBboxf TL, 0, 0, 32, 32, 0
DQBget TL, 0, 0, sgx, sgx, VARSEG(s&(0, Z)), VARPTR(s&(0, Z))
addtile 0, Z
EXIT SUB: END SUB

SUB GetBLASTER (DMA%, baseport%, IRQ%)
' This subroutine parses the BLASTER environment string and returns settings.
 IF LEN(ENVIRON$("BLASTER")) = 0 THEN PRINT "BLASTER environment variable not set.": EXIT SUB
 FOR Length% = 1 TO LEN(ENVIRON$("BLASTER"))
  SELECT CASE MID$(ENVIRON$("BLASTER"), Length%, 1)
   CASE "A"
    baseport% = VAL("&H" + MID$(ENVIRON$("BLASTER"), Length% + 1, 3))
   CASE "I"
    IRQ% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1))
   CASE "D"
    DMA% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1))
  END SELECT
 NEXT
EXIT SUB: END SUB

REM $STATIC
SUB getblxy (SSP%)
SP% = SSP%: ly3% = (TL + 1) + (SP% \ 48): SP% = SP% MOD 49
sprx% = (SP% MOD 8) * (sgx + 1)
spry% = (SP% \ 8) * (sgy + 1)
END SUB

SUB getnmexy (SSP%)
SP% = SSP%: IF SP% / 4 > 23 THEN SP% = SP% + 1
ly% = 7 + INT(SP% \ 48): SP% = SP% MOD 49: sprx% = (SP% MOD 8) * (CHSX + 1): spry% = (SP% \ 8) * (chsy + 1)
END SUB

SUB GETSPXY (SSP%) : SP% = SSP%: ly2% = (SP% \ 48): SP% = SP% MOD 49
sprx% = (SP% MOD 8) * (CHSX + 1)
spry% = (SP% \ 8) * (chsy + 1)
END SUB

REM $DYNAMIC
SUB GOVER
'DIE = 0: chy = chy + 500: d = 0: c = -100: EXIT SUB
AN = 5: walk = 0
XX = 0: YY = 0: DO: DQBsetClipBox XX, YY, 319 - XX, 200 - YY
XX = XX + 3: YY = YY + 3: floor tmx, tmy
tmx = tmx + C: tmy = tmy + D
LOOP UNTIL YY > 200 - YY
SFX 4
lx = LSX: ly = LSY
tmer = TIMER
DO: playwav "", 0: LOOP UNTIL finsd OR TIMER > tmer + 4
sbsetup
CLS
dontrep = 1: loadlev LEV: dontrep = 0
LSX = lx: LSY = ly
EN = sen
LV = LV - 1
CHX = LSX
CHY = LSY
X = (CHX - MXX / 2)
Y = (CHY - (MXY / 2))
D = 0: C = 0: power = 0: wing = 0
DIE = 0: INVINC = 100
IF nt MOD 3 = 1 THEN SFX 8
IF WIN THEN OK = 1: LV = LV + 1
DQBsetClipBox 0, 0, 319, 200
LSTY = -100
buggy = 0:
LOADPLAY play$
EXIT SUB: END SUB

SUB HIT (X, Y, Z)
IF ANME = 0 THEN EXIT SUB
O = ANME: DO: O = O - 1: LOOP UNTIL O = 0 OR Z(O) = 0
IF O = 0 THEN O = ANME
X(O) = (X * sgx) + sgx / 2: T(O) = 0: D(O) = 6: Z(O) = Z: C(O) = -SGN((DIR - 2)) * 2
Y(O) = (Y + 1) * sgy: Y(O) = Y(O) + D(O)
LEV%(X, Y) = 11
EXIT SUB: END SUB

SUB HURT
IF WIN OR EN < 0 OR INVINC OR ouch THEN GOTO noht
cx = CHX: CY = CHY
INVINC = 50: DIE = 1: EN = EN - 1: D = 25: CHY = CHY + D: SFX 5: wing = wing - 1: IF wing < 0 THEN wing = 0: power = power - 1: IF power < 0 THEN power = 0
IF FALL > 0 THEN C = C * 8: INVINC = 0
IF levl(CHX \ sgx, CHY \ sgy) THEN CHX = cx: CHY = CY: D = 0
THROWRINGS (COIN): COIN = 0
noht:
EXIT SUB: END SUB

SUB inpass
CLOSE
music 12
SCREEN 13
retype:
nt = 3
loadpalette
setuppal
DEF SEG = &HA000
BLOAD PATH$ + "scrn.sht", 0
LOCATE 5, 6: prnt "Please Enter Your Password."
LOCATE 10, 16
PRINT SPC(8);
COLOR 15
sc = 0
DO: LOCATE 10, 16
: PRINT P$; : IF LEN(P$) < 8 THEN PRINT ; " ";
E$ = INKEY$: IF E$ <> "" THEN E$ = UCASE$(E$)
E = 0: IF MID$(E$, 2) = "S" THEN E$ = "": E = 8
IF E$ <> "" THEN E = ASC(E$)
IF E > 64 AND E < 91 THEN P$ = P$ + E$
IF E = 8 AND LEN(P$) > 0 THEN P$ = LEFT$(P$, LEN(P$) - 1)
IF LEN(P$) > 8 THEN P$ = MID$(P$, 1, 8)
playwav "", 0
LOOP UNTIL E$ = CHR$(13)
IF P$ = "" THEN LEV = 1: GOTO nopass
LEV = 0: FOR O = 1 TO 100: IF P$ = P$(O) THEN LEV = O
NEXT
IF LEV = 0 THEN LOCATE 6, 8: PRINT "Incorrect Password": DO: music 12: LOOP UNTIL INKEY$ <> "": GOTO retype
nopass:
EXIT SUB: END SUB

SUB InputSource (InputSrc%, GetSrc%)
OUT baseport% + 4, &HC
IF GetSrc% THEN
InputSrc% = INP(baseport% + 5) AND 2 + INP(baseport% + 5) AND 4
ELSE
OUT baseport% + 5, InputSrc% AND 7
END IF
EXIT SUB: END SUB

FUNCTION isboss (X)
ff = 0
IF X = 18 THEN ff = 1
IF X = 19 THEN ff = 2
IF X = 23 THEN ff = 3
isboss = ff
END FUNCTION

SUB JUMP (vx, vy)
D = 13: SFX 7: fok = 0: IF levl(vx, vy + 1) THEN D = 1
'IF levl(VX, VY) = 33 THEN D = 6
EXIT SUB: END SUB

FUNCTION JUMPER (R)
ff = 0
IF Z(R) = 15 THEN ff = 1
JUMPER = ff
END FUNCTION

SUB killnme (X, Y)
Kd = 0: FOR O = 1 TO ANME
IF BOUNCY(O) > 0 THEN GOTO NOPE
'IF o <> r THEN
IF FALLER(O) = 0 AND T(O) = 0 THEN
IF (X(O) \ sgx) = (X \ sgx) AND (Y(O) \ sgy) = (Y \ sgy) THEN
        IF E(O) > -1 THEN E(O) = E(O) - 1: GOTO edif
        IF E(O) < 1 THEN T(O) = 1
        D(O) = 20: StereoFX 6, pan%(X(O)): Y(O) = Y(O) + D(O): Kd = 1: IF dk = 0 THEN T(O) = 0
        IF COLABLE(O) THEN T(O) = 0: D(O) = 6
edif:
END IF
END IF
'END IF
'IF t(o) AND e(o) > 0 THEN t(o) = 0
NOPE:
NEXT
EXIT SUB: END SUB

FUNCTION levl (X, Y) : X = X \ 1: Y = Y \ 1
IF X < 0 OR X > LEVX OR Y < 0 OR Y > levy - 1 THEN LL = 0: GOTO nxt
LL% = LEV%(X, Y) MOD 256: IF LL% = 1 AND D > 0 THEN LL% = 0
IF (LL% > 25 AND LL% < 30) OR (LL% > 33 AND LL% <> 36 AND LL% < 53 AND LL% <> 46 AND LL% <> 36) OR LL% = 12 OR LL% = 19 OR LL% = 33 OR LL% > SPR OR (LL% = 33 AND fi) THEN LL% = 0
nxt:
levl = LL%
END FUNCTION

FUNCTION levl2 (X, Y) : X = X \ 1: Y = Y \ 1
IF X < 0 OR X > LEVX OR Y < 0 OR Y > levy - 1 THEN LL% = 0: GOTO nxt2
LL% = LEV%(X, Y) MOD 256: IF LL% = 46 THEN LL% = 2
IF LL% = 25 THEN LL% = LEV%(X, Y + 1)
IF LL% = 12 OR LL% = 19 OR LL% > SPR OR (LL% = 33 AND fi) OR (LL% > 37 AND LL% < 53) THEN LL% = 0
nxt2:
levl2 = LL%
END FUNCTION

FUNCTION levl3 (X, Y) : X = X \ 1: Y = Y \ 1
IF X < 0 OR X > LEVX OR Y < 0 OR Y > levy - 1 THEN LL% = 0: GOTO nxt3
LL% = LEV%(X, Y) MOD 256
IF LL% = 19 THEN LL% = 12
IF LL% = 25 THEN LL% = LEV%(X, Y + 1)
nxt3:
levl3 = LL%
END FUNCTION

REM $STATIC
FUNCTION LEVL4 (X, Y) : X = X \ 1: Y = Y \ 1
IF X < 0 OR X > LEVX OR Y < 0 OR Y > levy - 1 THEN LL% = 0: mv% = 0: GOTO NXT4
LL% = LEV%(X, Y)
mv% = LL% \ 256
LL% = LL% MOD 256
IF LL% = 12 OR LL% = 19 THEN LL% = 1: GOTO NXT4
IF (LL% > 25 AND LL% < 30) OR (LL% > 33 AND LL% < 53 AND LL% <> 46 AND LL% <> 36) OR LL% = 33 OR LL% > SPR OR (LL% = 33 AND fi) THEN LL% = 0
NXT4:
LEVL4 = LL%
END FUNCTION

REM $DYNAMIC
SUB load (N$)
loadall N$
DQBget TL, 0, 0, spx, spy, VARSEG(s&(0, 0)), VARPTR(s&(0, 0))
addtile 0, SPR
SPR = SPR + 1
EXIT SUB: END SUB

SUB loadall (N$)
N$ = N$ + ".spr"
CLOSE #2
ct:
COLOR 7
OPEN PATH$ + N$ FOR BINARY AS #2
DQBboxf TL, 0, 0, 64, 64, 0
IF LOF(2) = 0 THEN CLOSE : KILL PATH$ + N$: EXIT SUB
TP = 1
GET #2, , MM: GET #2, , M1: GET #2, , m2
SZ = (M1 + m2) / 2
IF SZ < 17 THEN Hi = 0
bs = 0
IF Hi AND m2 < 32 THEN bs = 16
bx = 0: IF Hi THEN IF m2 < 32 THEN bx = 8
IF MM = 255 THEN TP = 2
SZ = 1: IF M1 < 31 THEN IF blk = 1 THEN SZ = 2
FOR O = 0 TO M1: OA = -1: FOR P = m2 TO 0 STEP -1:
GET #2, , a: ' IF SEE = 0 THEN IF A = 0 THEN A = 247
pp = P: OO = O: IF rev THEN OO = (M1 - O)
IF revy THEN pp = (m2 - 1) - P
'IF WATER = 1 THEN A = A XOR 1
IF blk = 1 THEN EE = m2 - (bs + pp) ELSE EE = (bs + pp)
ee1 = bx + OO
FOR o9 = 0 TO SZ: FOR p9 = -1 TO SZ - 1: DQBpset TL, (ee1 * SZ) + o9, ((EE * SZ) + p9) + 1, a
NEXT: NEXT
NEXT: NEXT
CLOSE #2
SPR = INT(SPR)
SZ = M1
EXIT SUB: END SUB

REM $STATIC
SUB LOADBK (O) : O = ABS(O): bkg = -O
IF O = 0 THEN CLS : dqbcopylayer 0, TL + 17: EXIT SUB
DEF SEG = &HA000
BLOAD PATH$ + "BACKG" + MID$(STR$(O), 2) + ".sht", 0
DEF SEG = 0
dqbcopylayer 0, TL + 17
END SUB

SUB loadblood
loadall "blood1"
DQBget TL, 0, 0, sgx, sgy, VARSEG(blood(0)), VARPTR(blood(0))
END SUB

SUB loadbmp (filename$)
OPEN filename$ FOR BINARY AS #16
IF LOF(16) < 2 THEN EXIT SUB
GET #16, 1078, pointerstr
'FOR Slot% = 0 TO 255
' GET #16, , pointerstr
' GET #16, , pointerstr
' GET #16, , pointerstr
' GET #16, , pointerstr
'NEXT Slot%
yi% = 198
DO
GET #16, , pointerx
GOSUB pointset
yi% = yi% - 1
LOOP UNTIL yi% = 0
EXIT SUB
pointset:
xi% = 0
DO
DQBpset 0, xi%, yi%, ASC(MID$(pointerx, xi% + 1, 1))
 xi% = xi% + 1
LOOP UNTIL xi% >= 319
RETURN
END SUB

REM $DYNAMIC
SUB LOADBOSS
EXIT SUB: END SUB

REM $STATIC
SUB loadbul
SEE = 1: loadall "bullet1": SEE = 0
DQBget TL, 0, 0, spx, spy, VARSEG(bul(0, 0)), VARPTR(bul(0, 0))
EXIT SUB: END SUB

REM $DYNAMIC
SUB loadlev (L)
FOR OO = 0 TO chans& + 1: dqbstopvoice OO: NEXT
FOR ol = 0 TO 5: scrn: NEXT
DQBremoveSB
FOR ol = 0 TO 5: scrn: NEXT
card = DQBinstallSB(FALSE, chans& + 1, afreq&, AUTO, AUTO, AUTO)
DQBsetVolume 9
IF card = 0 THEN card = 1 ELSE card = 0
bmp$ = ""
LOADBK (0)
LOADPLAY play$: IF play$ <> "jeep" THEN buggy = 0
opl$ = ""
N$ = MID$(STR$(L), 2)
COMP = 1
COMPR:
CLOSE
IF COMP THEN DECOMPRESS N$ + ".LEV": IF LOADOK = 0 THEN EXIT SUB
IF COMP THEN OPEN PATH$ + "TMP" FOR INPUT AS #1: ' INPUT #1, X
IF COMP = 0 THEN OPEN PATH$ + N$ + ".LEV" FOR INPUT AS #1
bkg = 0
BGM = 0
'FOR o = 0 TO begx: FOR p = 0 TO begy: lev%(o, p) = 0: NEXT: NEXT
FOR O = 0 TO 100: Z(O) = 0: X(O) = 0: NEXT
INPUT #1, LEVX
IF LEVX < 2 AND COMP = 0 THEN COMP = 1: CLOSE #1: GOTO COMPR
IF LEVX < 2 THEN INPUT #1, LEVX
INPUT #1, levy
INPUT #1, anmes
INPUT #1, LSX
INPUT #1, LSY
FOR O = 0 TO LEVX: FOR P = 0 TO levy
INPUT #1, LEV%
IF P < begy + 1 AND LEV% < SPR + 1 THEN
lvb = 0: IF LEV% = 30 OR LEV% = 31 THEN lvb = 12
IF (LEV% <> 30 AND LEV% <> 31 AND LEV% <> 36) THEN lvb = LEV%
IF dontrep AND LEV%(O, P) <> LEV% THEN LEV%(O, P) = lvb ELSE LEV%(O, P) = LEV%
END IF
NEXT
NEXT: LEV = VAL(N$)
INPUT #1, E2: IF E2 = 255 THEN E2 = 100
anmes = E
'IF E < ANMES THEN E = ANMES
FOR O = 0 TO E2: INPUT #1, Z(O): INPUT #1, X(O): INPUT #1, Y(O): X(O) = X(O) * (31 / 16): Y(O) = Y(O) * 2
NEXT
INPUT #1, E
EE = E
E = 255 - E
IF E = 0 THEN GOTO DONTE
IF E THEN INPUT #1, nt
IF EE > 253 THEN GOTO DONTE
INPUT #1, DRS
FOR O = 0 TO DRS
INPUT #1, dx(O): INPUT #1, dy(O): INPUT #1, DZ(O)
NEXT
IF EE > 252 THEN GOTO DONTE
INPUT #1, bkg
IF bkg > 1000 THEN bkg = bkg - 1000: bkg = -bkg
IF bkg < 0 THEN LOADBK (bkg)
IF EE > 251 THEN GOTO DONTE
INPUT #1, BGM
DONTE:
CLOSE #1
IF LEVX > begx THEN LEVX = begx
IF levy > begy THEN levy = begy
LL = LEVX: DO: E = 0: FOR P = 0 TO levy: E = E + LEV%(LL, P): NEXT
LL = LL - 1: LOOP UNTIL E: LEVX = LL + 1
LL = levy: DO: E = 0: FOR P = 0 TO LEVX: E = E + LEV%(P, LL): NEXT
LL = LL - 1: LOOP UNTIL E: levy = LL + 1
KILL PATH$ + "TMP"
NOLD:
LSX = LSX * sgx
LSY = LSY * sgy
levy = levy + 1
BOSS = 0
buggy = 0
sanimal = 0: cars = 0
FOR O = 1 TO ANME: T(O) = 0
AN(O) = RND * 200
D(O) = 0
M(O) = 0
E(O) = -1
IF cht = 1 THEN DO: Z(O) = INT(RND * NMES): LOOP UNTIL fly(O) AND COLABLE(O) = 0
IF isboss(Z(O)) > 0 THEN BOSS = BOSS + 1: E(O) = 4
IF Z(O) > NMES THEN Z(O) = 0
DO:
C(O) = SGN(-2 + RND * 3) * RND * 3: C(O) = INT(C(O))
LOOP UNTIL C(O) <> 0
X(O) = X(O) * (31 / 32): X(O) = X(O) + sgx / 2
Y(O) = Y(O) - Y(O) / 62
Y(O) = Y(O) * (31 / 32)
X(O) = X(O) \ sgx: Y(O) = Y(O) \ sgy: X(O) = X(O) * sgx: Y(O) = Y(O) * sgy
Y(O) = Y(O) + 2
IF COLABLE(O) = 5 THEN IF ABS(C(O)) < 10 THEN C(O) = C(O) * 3
IF WILD(Z(O)) THEN E(O) = 10: IF ABS(C(O)) < 6 THEN C(O) = SGN(C(O)) * 6
IF WILD(Z(O)) = 2 THEN cars = cars + 1: E(O) = 1000: C(O) = INT(-10 + RND * 20) / 100: buggy = 0: ' IF BUGGY = 0 THEN loadplay ("JEEP")
IF WILD(Z(O)) = 1 THEN sanimal = sanimal + 1
IF WILD(Z(O)) = 3 THEN E(O) = 10: C(O) = C(O) * 1.2
IF X(O) \ sgx < 0 OR X(O) \ sgx > LEVX OR Y(O) \ sgy < 0 OR Y(O) \ sgy > levy THEN Z(O) = 0: E(O) = -1
NEXT
IF BOSS = 0 THEN BOSS = -1
play$ = UCASE$(play$)
IF play$ = "JEEP" THEN buggy = 1
place = 1
EXIT SUB: END SUB

REM $STATIC
SUB loadnme (N)
SEE = 1
Hi = 1
WATER = 0: IF afly(N) = 4 THEN WATER = 1
NN = 1: revy = 1
O = 1: 'FOR o = 1 TO 2
FOR P = 1 TO 2: a$ = "-" + MID$(STR$(P), 2)
N$ = "nme" + MID$(STR$(N), 2) + a$
rev = 0: IF O = 1 THEN rev = 1
loadall N$
addnme N, P
SZ(N) = SZ
NEXT
'NEXT
FOR P = 1 TO 2:
N$ = "nme" + MID$(STR$(N), 2) + "-d": IF P > 1 THEN N$ = N$ + MID$(STR$(P), 2)
loadall N$
addnme N, P + 2
NEXT
SEE = 0
revy = 0: Hi = 0
DQBget TL, 0, 0, NMX, NMy, vs, vp
EXIT SUB: END SUB

SUB loadpalette
OPEN "palette.dat" FOR BINARY AS #10
FOR O = 180 TO 180 + 66
GET #10, , re: GET #10, , bl: GET #10, , gn: IF re < 63 OR gn < 63 OR bl < 63 THEN palc O, re, gn, bl
NEXT
CLOSE #10
END SUB

REM $DYNAMIC
SUB LOADPLAY (a$)
a$ = UCASE$(a$)
IF a$ = opl$ THEN EXIT SUB
opl$ = a$
buggy = 0: sonic = 0
IF sonic THEN buggy = bb
IF a$ = "JEEP" OR sonic > 0 THEN buggy = 1 ELSE buggy = 0
IF a$ = "JEEP" THEN buggy = 1: a$ = play$
aa$ = a$:
SEE = 1
DQBclearLayer 4
DQBclearLayer 5
rev = 0: revy = 1
cc = 0
aa$ = a$: FOR rr = 0 TO 1: IF rr = 1 THEN a$ = aa$ + "s"
cc = (rr * 32)
FOR cp = 1 TO 32
N$ = a$ + MID$(STR$(cp), 2)
loadall N$
ADDSPRITE 4, cc
cc = cc + 1
NEXT
NEXT
rev = 0: revy = 0: a$ = aa$
'DO: LOOP UNTIL INKEY$ = " "
SEE = 0: EXIT SUB: END SUB

SUB man (X, Y, dr, AN)
AN = INT(AN)
IF UNDER THEN walk = 0
UNDER = SGN(UNDER) * 6
IF bas < 1 THEN bas = 1
IF dr = 0 THEN bas = 2 ELSE IF dr = 4 THEN bas = 3
DIR = dr
sh = (INVINC MOD 4)
IF sh > 1 THEN GOTO now
bx = X: X = X + (SGN(DIR - 2)) * 7: IF UNDER THEN X = bx:
BY = Y: TM = (LEVL4(mnx, mny - 1) \ 256)
Y = Y + mv%(mv%): IF mv% > 3 THEN IF DIE = 0 AND D = 0 THEN D = 10
IF wing > 0 THEN
   VEC = fok: VEC = VEC MOD 2
'IF sh THEN DQBmPut Layer, INT(x), 200 - (y + sgy), VARSEG(nme(0, 10, VEC)), VARPTR(nme(0, 10, VEC)), (bas - 1) + rot
END IF
X = bx
bas = 0
IF dr = 4 THEN bas = 64
lim = 0
IF UNDER THEN lim = lim + 32
IF walk THEN lim = lim + 4
IF DIE OR feet THEN lim = 16
IF jmpD AND DIE = 0 THEN lim = 8
lim = lim + bas
'lim = INT((under + an + walk + bas))
'PRINT lim, an
lim = lim + AN
X = INT(X): Y = INT(Y)
vsc = VARSEG(ch(0, 0))
vpc = VARPTR(ch(0, 0))
IF sh > -10 THEN
 GETSPXY (lim)
 'DQBxPut 4+LY2%, sprx%, spry%, (sprx% + CHSx), (spry% + CHSy), layer, x, 200 - (y + SGY)
  DQBget 4 + ly2%, sprx%, spry%, sprx% + CHSX, spry% + chsy, vsc, vpc
  DQBrPut layer, X, 200 - (Y + chsy), vsc, vpc, AN% * (360 / 255), 100
END IF
  DQBput collide, X - (CHSX / 2), 200 - (Y + chsy), vsc, vpc
  IF DQBcollideOnLayer(collide, X - (CHSX / 2), 200 - (Y + chsy), vsc, vpc) THEN CHECKALL X - CHSX, 200 - (Y + chsy)
 'DQBxPut 4+LY2%, sprx%, spry%, (sprx% + CHSx), (spry% + CHSy), collide, x, 200 - (y + CHSy)
X = bx
Y = BY
now:
IF INVINC THEN INVINC = INVINC - 1
EXIT SUB: END SUB

REM $STATIC
SUB MESSAGE (N$)
mst = TIMER + 5
MS$ = N$
END SUB

SUB MOVECOIN (X%, Y%) : X% = X%: Y% = Y%: sn = 256
IF CLEVL(0 + X%, 0 + Y%) = 0 THEN EXIT SUB
LEV%(X%, Y%) = (LEV%(X%, Y%) + 256) MOD 2048
IF CLEVL(0 + X%, Y% + 1) THEN IF LEV%(X%, Y% + 1) > 0 THEN IF LEV%(X%, Y% + 1) \ 256 = 0 THEN LEV%(X%, Y% + 1) = (LEV%(X%, Y% + 1) + (256 * INT(mv% \ 2))) MOD 2048: IF LEV%(X%, Y% + 1) \ 256 = 1 THEN SFX 13
END SUB

REM $DYNAMIC
SUB movexy (X, Y, CHX, CHY)
tx = CHX
X = X + mos - (mms / 3)
mv = (tx - X) / 5: IF ABS(mv) > spy * 7 THEN mv = (SGN(mv) * spy * 7)
X = X + mv
X = X - mos + (mms / 3)
cx = X
Y = Y + MXY / 3
mvy = (CHY - Y) / 4: IF fol THEN mvy = (Y(fol) - Y)
Y = Y - MXY / 3
EXIT SUB: END SUB

REM $STATIC
SUB music (fx)
IF card = 0 THEN EXIT SUB
IF fx = 0 THEN DQBplaySound 1, 1, 0, 0
playmusic fx
EXIT SUB: END SUB

SUB ndrum
drum = drum + 1: IF drum > LEN(drum$) THEN drum = 1
E$ = MID$(drum$, drum, 1): IF E$ <> "" AND E$ <> " " THEN E = VAL(E$) + 10
ch = channel%: channel% = 1: SFX E: channel% = ch
EXIT SUB: END SUB

REM $DYNAMIC
SUB palc (w, Red, Green, Blue)
  OUT &H3C8, w
  OUT &H3C9, Red
  OUT &H3C9, Green
  OUT &H3C9, Blue
'PALETTE w, 65536 * blue + 256 * green + Red
EXIT SUB: END SUB

FUNCTION pan% (X)
pan = (X - CHX) / 10
END FUNCTION

SUB passwords
OPEN "levels.pdt" FOR INPUT AS #2
INPUT #2, levs
O = 1: DO: INPUT #2, P$: P$(O) = UCASE$(MID$(P$, 3))
O = O + 1: LOOP UNTIL P$ = "END OF LIST"
CLS
CLOSE #2
EXIT SUB: END SUB

SUB picture (N$)
DEF SEG = &HA000
BLOAD PATH$ + N$ + ".sht", 4
DEF SEG = 0
EXIT SUB: END SUB

SUB playasenemy
EXIT SUB: END SUB

REM $STATIC
SUB playmusic (fx)
'IF fx = 0 AND cfx& = 0 THEN EXIT SUB
IF DQBinUse(1) AND fx = 0 THEN EXIT SUB
IF fx <> 0 THEN n2$ = "waves\sfx" + MID$(STR$(fx), 2) + ".wav"
IF n2$ = "" THEN EXIT SUB
IF fx = 0 THEN GOTO okloaded
CLOSE #1: OPEN n2$ FOR BINARY AS #1: EE = LOF(1): IF EE THEN GET #1, , buf$: stm& = INSTR(buf$, "data") + 4: GET #1, EE - 5000, buf$: EDM& = EE - INSTR(buf$, "LIST") - 4
CLOSE #1: IF EE = 0 THEN KILL n2$
FXLEN& = EDM&: fxpos& = stm& + 1
cfx& = fx
okloaded:
PLL& = 64000: APL& = PLL&: IF PLL& + fxpos& > FXLEN& THEN PLL& = FXLEN& - fxpos&
'mfinsd = 0: IF APL& = 0 THEN mfinsd = 1: fxpos& = stm&: EXIT SUB
E2 = DQBloadRawSound(1, n2$, fxpos&, PLL&)
freq% = DFREQ&: ' IF cfx& = 16 THEN Freq% = Freq% / 2
plt = ONCE: IF FXLEN& < 64001 THEN plt = LOOPED
DQBplaySound 1, 1, INT(freq%), plt
freq% = DFREQ&
mfinsd = 0: fxpos& = fxpos& + PLL&: IF fxpos& > FXLEN& - 1 THEN fxpos& = stm&: mfinsd = 1
EXIT SUB: END SUB

SUB playwav (a$, nw)
IF card = 0 THEN EXIT SUB
IF TIMER > ldrum THEN ldrum = TIMER + .2: ndrum
IF nw = 0 AND DQBinUse(channel%) THEN EXIT SUB
IF a$ = "" THEN nw = 0
IF freq% = 0 THEN freq% = DFREQ&
IF nw THEN CLOSE #2: OPEN a$ FOR BINARY AS #2: E = LOF(2): CLOSE #2: wavptr& = 0: IF E = 0 THEN KILL a$: EXIT SUB
IF nw THEN finsd = 0: channel% = channel% + 1: IF channel% > chans& THEN channel% = 2: IF buggy THEN channel% = 3
IF nw = 0 THEN IF E > 64000 THEN E = 64000
wave = DQBloadRawSound(channel%, a$, wavptr& + 60, INT(E))
IF wave THEN finsd = 1: GOTO nosnd ELSE wavptr& = wavptr& + 64000
effect INT(channel%)
lwav = TIMER
nosnd:
playmusic 0
EXIT SUB: END SUB

SUB POINTS (N)
score = score + N
END SUB

SUB prnt (a$)
DQBprints layer, a$, (POS(0) * 8) - 1, ((CSRLIN - 1) * 8) - 1, 7, INT(Style)
DQBprints layer, a$, 1 + (POS(0) * 8), 1 + ((CSRLIN - 1) * 8), 7, INT(Style)
DQBprints layer, a$, POS(0) * 8, (CSRLIN - 1) * 8, 15, INT(Style)
PRINT
EXIT SUB: END SUB

REM $DYNAMIC
SUB PUT2 (x2%, y2%)
FOR X% = 0 TO spx: FOR Y% = 0 TO spx: E% = POINT(X%, Y%): IF E% THEN PSET (x2% + X%, y2% + Y%), E%
NEXT: NEXT
EXIT SUB: END SUB

REM $STATIC
SUB putblood (X, Y)
'EXIT SUB
RTE = R
adc = ABS(C) * SGN(DIR - 2) / 2
R = BLDPTR: FOR E = 1 TO bld / 5: blx(R) = X: bly(R) = Y: bld(R) = 10 + (RND * 7): blc(R) = (-5 + RND * 10) + adc
blh(R) = bhurt: bli(R) = 200 + RND * 20: R = R + 1: R = R MOD bld: NEXT
BLDPTR = R
R = RTE
END SUB

REM $DYNAMIC
FUNCTION ReadDSP%
' Reads a byte from the DSP
tmr = TIMER: DO: LOOP UNTIL INP(baseport% + 14) AND &H80 OR TIMER > tmr + 2
 ReadDSP% = INP(baseport% + 10)
END FUNCTION

SUB REMOVEGATES (X, Y)
FOR P = 0 TO levy: FOR O = 0 TO LEVX:
IF LEV%(O, P) = 46 THEN LEV%(O, P) = 0
NEXT
'FLOOR X, Y
NEXT
EXIT SUB: END SUB

FUNCTION ResetDSP%
' Resets the DSP
 OUT baseport% + 6, 1
 FOR Count% = 1 TO 4
  junk% = INP(baseport% + 6)
 NEXT
 OUT baseport% + 6, 0
 IF INP(baseport% + 14) AND &H80 = &H80 AND INP(baseport% + 10) = &HAA THEN
  ResetDSP% = -1
 ELSE
  ResetDSP% = 0
 END IF
END FUNCTION

REM $STATIC
SUB save
GOTO nos
DEF SEG = &HA000
BSAVE PATH$ + "scrn.sht", 0, 64000
DEF SEG = 0
nos:
EXIT SUB: END SUB

SUB sbsetup
basead% = &H220
iq% = 0
da% = 0
DO:
card = DQBinstallSB(FALSE, chans&, DFREQ&, basead%, da%, iq%)
IF basead% > 0 THEN baseport% = basead%: DMA% = da%: IRQ% = iq%
IF card THEN basead% = basead% + &H10: IF basead% > &H280 THEN basead% = &H220: da% = da% + 1: IF da% > 3 THEN da% = 0: iq% = iq% + 1: IF iq% > 15 THEN card = -1
IF card > 0 THEN DQBremoveSB
LOOP UNTIL card <> 4
IF card = -1 THEN card = 1
EXIT SUB: END SUB

SUB scrn
dqbcopylayer layer, VIDEO
layer = 1
IF bkg < 0 THEN dqbcopylayer TL + 17, layer ELSE DQBclearLayer layer
DQBclearLayer collide
DO: LOOP UNTIL DQBframeReady
FRM = FRM + 1: IF FRM > 10 THEN FRM = 0
EXIT SUB: END SUB

REM $DYNAMIC
SUB setuppal
PALETTE bk, 0
NN = nt \ 3: IF NN = 1 THEN NN = 50
palc 0, (NN * 2) MOD 64, 0, NN
palc 247, (NN * 2) MOD 64, 0, NN
EXIT SUB: END SUB

SUB SFX (X) : IF X = 1 THEN freq% = DFREQ& + RND * 1600 ELSE freq% = DFREQ&
IF X = 2 THEN freq% = freq% + (INT(RND * 4) * (freq% / 12))
IF X = 15 THEN freq% = (freq% / 2) + (RND * 1) * 9000: freq& = freq% + (10000 - (ABS(C * (olc - C)) * 1000)): IF freq& > 32000 THEN freq& = 32000
IF X = 15 THEN freq% = freq&: GEAR = 0
N$ = "waves\sfx" + MID$(STR$(X), 2) + ".wav"
playwav N$, 1: OSFX = X
NOFX:
EXIT SUB: END SUB

REM $STATIC
SUB shake
IF (buggy = 0 AND bok = 0) THEN EXIT SUB
EXIT SUB
bok = 0
SX = CHX \ sgx: SX = SX - 3
IF SX < 0 THEN SX = 0
EX = SX + 6
IF EX > LEVX THEN EX = LEVX
sy = (CHY \ sgy) - 1
IF sy < 0 THEN sy = 0
eY = sy + 2
IF eY > levy THEN eY = levy
II = 0: FOR O% = SX TO EX
FOR P% = sy TO eY
IF levl(0 + O%, 0 + P%) > 0 THEN IF LEV%(O%, P%) < 256 THEN LEV%(O%, P%) = LEV%(O%, P%) + (256 * II) MOD 2048: II = II + 1: II = (II + 1) MOD 5
NEXT
NEXT
END SUB

SUB SHUFFLE (MMX, mmy)
MX = MMX: MY = mmy - 1: DO: MY = MY + 1
IF LEV%(MX, MY) = 54 THEN LEV%(MX, MY) = LEV%(MX, MY + 1):
LOOP UNTIL LEV%(MX, MY) <> 54
END SUB

REM $DYNAMIC
SUB SLOW (CHY)
AN% = 0
IF RAMPED THEN RAMPED = 0: HIJUMP = SHI
IF LSTY - CHY > 200 THEN bok = 1: shake
LSTY = CHY: sl = 1.5: icy = 0
feet = 0: IF SGN(rt - lf) <> SGN(C) THEN IF INT(ABS(C / 2)) <> 0 THEN feet = 1: IF C > 0 THEN DIR = 0
IF feet AND C < 0 THEN DIR = 4
IF buggy THEN slw = 3 ELSE slw = 5: IF icy = 0 THEN slw = 1.5
IF buggy OR (ABS(C) > 1 AND levl(CHX \ sgx, (CHY \ sgy) - 1) = 23) THEN sl = 1.02: icy = 1
IF (rt AND C < 0) OR (lf AND C > 0) OR (lf = 0 AND rt = 0) THEN
  'IF sl > 1.1 THEN c = c / sl ELSE
  C = C - SGN(C) / slw
END IF
IF DIE THEN DIE = 0: IF EN < 1 THEN GOVER
EXIT SUB: END SUB

SUB SMUDGE
LV = -10
EXIT SUB: END SUB

FUNCTION SpeakerStatus%
OUT baseport% + 4, &HD8
IF INP(baseport% + 5) = &HFF THEN SpeakerStatus% = -1 ELSE SpeakerStatus% = 0
END FUNCTION

REM $STATIC
SUB SPRITE (X%, Y%, SP%) : IF SP% < 0 THEN Y% = 200 - (Y% + sgy): EXIT SUB
IF SP% > SPR THEN SP% = 0
layer = 1
IF bkg <> 0 THEN IF SP% > 0 AND SP% <> bkg THEN GOTO p2
Y% = 200 - (Y% + sgy)
P3:
IF mv% AND SP% <> bkg THEN Y% = Y% - mv%(mv%) * 2
getblxy (SP%): DQBget ly3%, sprx%, spry%, sprx% + sgx, spry% + sgy, vs2, vp2: DQBmPut layer, X%, Y% - tpy, vs2, vp2, CD
EXIT SUB
p2:
SPRITE X%, Y%, 0 + bkg
GOTO P3
EXIT SUB: END SUB

REM $DYNAMIC
SUB StereoFX (X, LV%)
IF nt MOD 3 = 1 THEN GOTO forget
SFX X
forget:
EXIT SUB: END SUB

REM $STATIC
SUB THROWRINGS (AOR)
EEK = 5 / AOR
STC = -EEK
CTT = AOR: FOR O7 = 0 TO ANME: IF T(O7) = 1 OR Z(O7) = 0 THEN IF CTT > 0 THEN Z(O7) = 24: X(O7) = CHX: Y(O7) = CHY + 16: CTT = CTT - 1: C(O7) = STC: STC = STC + EEK: D(O7) = 10 + RND * 10: T(O7) = 0: AN(O7) = 0
NEXT
END SUB

REM $DYNAMIC
SUB trans (MX, MY)
adoor = DZ(WHICHDOOR(MX, MY - 1))
IF adoor THEN CHX = dx(adoor) * sgx: CHY = (dy(adoor) + 1) * sgy: GOTO itsadoor
O = MX
OK = 0
pp = MY: DO
IF O = LEVX THEN O = 0
TT = levl(O, pp) = 8: tt2 = levl(O, pp + 1): IF TT AND (tt2 = 0 OR tt2 = 12) THEN CHX = 8 + (O * sgx): CHY = (pp + 1) * sgy: D = 0: C = 0: pp = levy + 1: OK = 1:
pp = pp + 1: IF pp > levy THEN pp = 0
LOOP UNTIL OK = 1
itsadoor:
LSTY = -100
EXIT SUB: END SUB

SUB tube (X, Y)
IF Y > 1 THEN Y = Y - 1
IF X < 24 THEN GOTO notube
ht = Y + INT(RND * 4)
DO: ht = ht - 1: LOOP UNTIL ht < levy - 1
IF ht < Y THEN GOTO notube
IF levl(X, Y + ht) THEN GOTO notube
XX = 0: FOR O = X - 1 TO X + 1
IF O > LEVX OR O < 0 THEN  ELSE LEV%(O, Y - 1) = 1
FOR P = Y TO ht
IF P = ht THEN YY = 2 ELSE YY = 1
IF O > 0 AND P < LEVX AND P > 0 AND P < levy THEN LEV%(O, P) = tb(XX, YY)
NEXT: XX = XX + 1
IF levl(O, Y - 1) = 0 THEN LEV%(O, Y - 1) = 1
NEXT
notube:
EXIT SUB: END SUB

FUNCTION WHICHDOOR (X, Y)
dr = 0
FOR O = 0 TO DRS: IF X = dx(O) AND Y = dy(O) THEN dr = O
NEXT
WHICHDOOR = dr
END FUNCTION

REM $STATIC
FUNCTION WILD (O)
IF O = 20 THEN WILD = 1
IF O = 21 THEN WILD = 2
IF O = 18 THEN WILD = 3
IF O = 24 THEN WILD = 4
END FUNCTION

SUB WILDJUMP (R) : wld = WILD(Z(R))
IF wld = 1 THEN IF (CHY + (sgy * 3) > Y(R)) THEN D(R) = ((CHY - Y(R)) + sgy * 3) / 2.6: JJ = 1: IF WILD(Z(R)) = 2 THEN D(R) = 8
D(R) = D(R) + 5
IF wld = 2 THEN D(R) = 10: IF ABS(C(R)) < 8 THEN C(R) = SGN(C(R)) * 8
END SUB

REM $DYNAMIC
SUB windw (D)
'EXIT SUB
IF D = 0 THEN WINDOW (MXX, 0)-(0, MXY)
IF D = 1 THEN WINDOW SCREEN (0, 0)-(MXX, MXY)

EXIT SUB: END SUB

SUB winsfx
music 0
entirefx 9
EXIT SUB: END SUB

REM $STATIC
SUB ZFLOOD (X%, Y%)
IF levl2(0 + X%, 0 + Y%) = 0 OR LEV%(X%, Y%) = 0 THEN LEV%(X%, Y%) = L2%
EXIT SUB: END SUB

REM $DYNAMIC
SUB zort
frate = frate - (50 * (trr - NFR))
EXIT SUB: END SUB

