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
walk = 0
CLEAR , , 1100
DIM SHARED 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\"
SCREEN 1
SCREEN 0
WIDTH 80
PRINT "DAMIEN STURDY APPOLOGISES FOR PROBLEMS IN V3.0 ON THE INTERNET"
PRINT
PRINT
PRINT "THIS GAME WAS WRITTEN WITHOUT DQB, THEN DIRECTQB WAS INCORPORATED"
PRINT "THIS VERSION IS PROTECTED."
PRINT "DIRECT QB HAS BEEN USED FOR SOUND ,FPS and now, SPRITES."
PRINT "The conversion took literaly 2 minuits; Sow HOW GOOD IS DQB?...."
PRINT
PRINT "(DAMIEN STURDY IS NOT RESPONSIBLE FOR ANY DAMAGE CAUSED BY THIS PROGRAM."
LOCATE 18, 1:
PRINT "Den Bros was my attempt at Mario on an old computer."
PRINT "Den Bros was Single screen, Mario lookalike. I thought it was kool! (1995)"
PRINT "Den Bros II was a side scroller (Right 2 Left) I even had enemies "
PRINT "And Heres the THIRD!"
LOCATE 23, 1
PRINT "Den Bros III by DAMIEN STURDY 1995-2001."
PRINT DQBid$;
SLEEP
page = 0
chans& = 5
channel% = 2: DFREQ& = 22000
AFREQ& = 22004
dqbclose
e = DQBinit(tl + 16, chans& + 2, 100)
FOR o = 0 TO tl + 16: dqbclearlayer o: NEXT
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 1: SCREEN 13
card = DQBinstallSB(FALSE, chans& + 1, AFREQ&, AUTO, AUTO, AUTO)
sbsetup
DQBsetVolume 5
e = DQBloadFont("small.fnt")
IF card = 0 THEN card = 1 ELSE card = 0
OPEN "SETUP.opt" FOR INPUT AS #2
INPUT #2, frate, otrr: CLOSE #2
CLS
COLOR 15
NOCARD:
'drum$ = "123456789"

DEF SEG = 0
REM memory for spr: =4 + INT(((x2 - x1 + 1) * (bits-per-pixel-per-plane) + 7)/8)* planes * ((y2 - y1) + 1)
DIM SHARED 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 13
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: LEVY = TOP * 12
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 = 23
IF nmes > nos / 4 THEN nmes = nos / 4
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 ""
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 "D E N  B R O S  III"
COLOR 4
centre "Guide Skops 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 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
'FOR O1 = 0 TO 1:
sp = SsP '+ (O1 * 4)
getnmexy (sp)
dqbmput ly%, sprx%, spry% + 1, vs, vp, O1
'dqbcopylayer ly%, 0
'DO: LOOP UNTIL INKEY$ <> ""
'NEXT
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%)
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

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 C$ = "" AND cc$ <> "" THEN sfx 17
END SUB

REM $DYNAMIC
SUB check (R)
IF t(R) THEN GOTO nochk
'IF X(R) \ sgx <> CHX \ sgx AND Y(R) \ SGY <> CHY \ SGY THEN GOTO nochk
'IF INT(X(R) \ SGX) * SGX = INT(CHX \ SGX) * SGX AND INT(Y(R) \ SGY) * SGY = INT(CHY \ SGY) * SGY THEN  ELSE EXIT SUB
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 CL = 1 THEN power = power + 3: sfx 4: t(R) = 1: D = 0: GOTO nochk
IF CL = 2 THEN sfx 8: t(R) = 1: D = 0: LV = LV + 1: GOTO nochk
IF CL = 3 THEN sfx 4: t(R) = 1: D = 0: WING = WING + 1: GOTO nochk
IF CL = 4 THEN t(R) = 1: D = 0: LOADPLAY "jeep": C = 0: 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) = 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 THEN ANIM x%, y%
Dnxt:
DLEVL = LL%
END FUNCTION

REM $DYNAMIC
SUB dnmes
FOR R = 1 TO anme
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
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)
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 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 sz(z(R)) = 16 THEN tpy = 0 ELSE tpy = sgy
IF sz(z(R)) < 31 THEN
IF C(R) > 0 THEN sp = 0 ELSE sp = sgx
X1 = xx - sgx
dqbget ly%, sprx% - 1, spry%, sprx% + sz(z(R)), spry% + sz(z(R)), vs, vp
dqbmput layer, X1 + sgx, yy - tpy, vs, vp, CD
ELSE
X1 = xx - sgx: dqbget ly%, sprx%, spry% + 1, sprx% + sz(z(R)), spry% + sz(z(R)), vs, vp
dqbmput layer, X1, yy - tpy, vs, vp, CD
END IF
ee = 0
ee = DQBcollideOnLayer(collide, X1, yy - tpy, vs, vp)
dqbmput collide, X1 + sgx, 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 + sgy * 1.2: 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 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 3, 26: IF EN > 0 THEN prnt "NRG:" + STRING$(EN, CHR$(3))
LOCATE 2, 16: prnt p$(lev)
IF TIMER > fp + 1 THEN lfps = FPS: FPS = 0: fp = TIMER
LOCATE 1, 1: prnt STR$(lfps) + " FPS"
IF sanimal > 0 THEN LOCATE 3, 16: prnt "To save:" + STR$(sanimal)
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, 208 - (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: LINE ((xx(o) - x) MOD mxx, (yy(o) - y) MOD mxy)-STEP(4, 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): jmp = JUMPER(R): IF y(R) < 0 OR z(R) < 1 THEN z(R) = 0: GOTO ED
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 jmp = 0 THEN GOTO PED
'IF WLD = 0 THEN IF FALL = 0 THEN IF DW(R) = 0 THEN IF (fl <> 3 AND JMP <> 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 jmp 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(jmp)) * 13
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 jmp 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 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)
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 jmp THEN y(R) = y(R) + D(R): IF levl3(mx, my) = 33 THEN D(R) = D(R) + 3: t(R) = 0
IF jmp AND ABS(D(R)) > 14 THEN D(R) = SGN(D(R)) * 14
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 jmp = 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
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 "strtscrn"
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 (24)
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
IF WIN THEN lf = 0: rt = 0: 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 WIN AND levl(CHX \ sgx, (CHY \ sgy) - 1) THEN rt = 1
IF cant AND LV < 5 THEN LV = 5
IF cant THEN EN = 5
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 * 1.5
'IF sonic THEN buggy = 0: IF ABS(c) > mxc / 2 THEN buggy = 1
IF ABS(C) > mxc THEN C = SGN(C) * mxc: IF levl(CHX \ sgx, (CHY \ sgy) - 1) THEN ts = ts + 2: IF ts < 1 THEN ts = 1
IF ABS(C) < mxc THEN ts = ts - .5
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
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 WIN = 1 THEN IF BL THEN D = 0: C = 4 ELSE IF WIN THEN D = -8
IF ABS(D) > 15 THEN D = SGN(D) * 15
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 + 2
od = D
D = D - 1
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 + 4: 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) > 7 THEN D = SGN(D) * 7
under = (wtr * 9)
IF WING > 0 AND jp AND D < D2 + .1 THEN under = 9: AN = 2
IF levl(vx, vy - 1) THEN under = 0
wtr = 0
a = 0
jmpD = 0
IF gg AND WIN THEN C = 0: CHX = CHX + 4
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
AN = AN + a
IF AN < 0 THEN AN = 3
IF AN > 3 THEN AN = 0
acc = SGN(dir - 2)
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 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
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 / 4)
cx = x
y = y + mxy / 3
mvy = (CHY - y) / 4: IF fol THEN mvy = (y(fol) - y)
y = y - mxy / 3
y = y + mvy
CCX = x: CCY = y
IF WIN THEN IF CHX <> ocx OR CHY <> ocy THEN tmm = TIMER ELSE IF WIN THEN CHX = CHX + 4
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 WIN AND levl(CHX \ sgx, CHY \ sgy) AND levl(CHX \ sgx, CHY \ sgy) < 3 THEN CHY = CHY + sgy
'IF levl(chx \ sgx, chy \ sgy + 1) = 18 AND win THEN chy = chy + sgy
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 THEN GOVER
playwav "", 0
IF finsd THEN StereoFX 0, 0: spooksnd = 0: tgx% = 0
LOOP UNTIL LV < 0 OR (WIN = 1 AND OK = 1)
music 0
'IF win THEN entirefx 9
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%: ly% = 7 + (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 + 1: yy = yy + 1: floor tmx, tmy
tmx = tmx + C: tmy = tmy + D
'd = d - 1: c = c / 1.1
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
noht:
EXIT SUB: END SUB

SUB inpass
CLOSE
music 12
SCREEN 13
retype:
nt = 3
setuppal
windw 0
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 = 25: 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 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
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% > 25 AND LL% < 30) OR (LL% > 33 AND LL% <> 36 AND LL% < 53 AND LL% <> 46 AND LL% <> 36) OR LL% = 12 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% > 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% = 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 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
IF LOF(2) = 0 THEN CLOSE : KILL path$ + N$: EXIT SUB
TP = 1
GET #2, , MM: GET #2, , m1: GET #2, , m2
Dqbboxf tl, 0, 0, 64, 64, 0
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 = -1 TO sz - 1: FOR p9 = -1 TO sz - 1: dqbpset tl, (ee1 * sz) + o9, (ee * sz) + p9, a
NEXT: NEXT
NEXT: NEXT
CLOSE #2
spr = INT(spr)
EXIT SUB: END SUB

REM $STATIC
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)
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%
'IF dontrep = 0 OR lev%(o, p) = lev% THEN lvb = lev%
'THEN lev%(o, p) = lvb
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)
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 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
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
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 2) = 0
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
dqbclearlayer layer
dqbclearlayer collide
DO: LOOP UNTIL DQBframeReady
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
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%)
layer = 1
y% = 200 - (y% + sgy)
IF BKG <> 0 THEN IF sp% > 0 AND sp% <> BKG THEN GOTO p2
IF MV% 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
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

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
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

