DECLARE SUB addsprite (N!, F!)
DECLARE SUB getnmexy (ssp%)
DECLARE SUB LOADPALETTE ()
TYPE WAVETYPE
                RiffID           AS STRING * 4 'should be 'RIFF'
                RIFFLENGTH       AS LONG
                'rept. chunk id and size then chunk data
                WAVID            AS STRING * 4 'should be 'WAVE'
                FmtID            AS STRING * 4
                FMTLENGTH        AS LONG
                wavformattag     AS INTEGER ' word - format category: 0x0001=PCM
                Channels         AS INTEGER ' word - number of Channels 1=mono 2=stereo
                FREQUENCY        AS LONG    'dword - sampling rate e.g. 44100Hz
                avgBytesPerSec   AS LONG    'dword - to estimate buffer size
                BLOCKALIGN       AS INTEGER ' word - buffer size must be int. multiple of this
                FmtSpecific      AS INTEGER ' word
                DataID           AS STRING * 4
                DATALENGTH       AS LONG
END TYPE
DECLARE SUB setmusic ()
DECLARE SUB PLAYMUSIC (fx!)
DECLARE SUB prnt (N$, x!, Y!)
DECLARE SUB CENTRE (N$, Y!)
DECLARE FUNCTION boss! (x!)
DECLARE SUB LOADBOSS ()
DECLARE SUB MPX (PX!, PY!, xx!)
DECLARE SUB COMPRESS (N$)
DECLARE SUB DECOMPRESS (N$)
DECLARE FUNCTION QOK$ (N$, O$)
DECLARE SUB RESIZE ()
DECLARE SUB pal (w!, Red!, green!, blue!)
DECLARE SUB box (x1!, t1!, sz!, TP!)
DECLARE FUNCTION inkey! ()
DECLARE SUB pass ()
DECLARE SUB backgd ()
DECLARE SUB door (VX!, VY!, P!, BLC!)
DECLARE FUNCTION levl2! (x!, Y!)
DECLARE FUNCTION WHICHDOOR! (x!, Y!)
DECLARE SUB SAVELEV ()
DECLARE SUB LOADLEV ()
DECLARE SUB save (E!)
DECLARE SUB windw (D!)
DECLARE SUB killnme (x!, Y!)
DECLARE FUNCTION fly! (O!)
DECLARE SUB COLLECT (x!, Y!)
DECLARE SUB sprite (x!, Y!, sp!)
DECLARE SUB enme (xx!, yy!, z!, an!, r!)
DECLARE SUB sfx (x!)
DECLARE SUB addnme (TP!, x!, Y!)
DECLARE SUB BLOCKS (O!)
DECLARE SUB trans (mx!, my!)
DECLARE SUB chkp (r!)
DECLARE SUB check (r!)
DECLARE SUB loadnme (N!)
DECLARE SUB loadall (N$)
DECLARE SUB tube (x!, Y!, P!)
DECLARE SUB loadplay (a$)
DECLARE SUB above (VX, VY, ocy)
DECLARE SUB slow ()
DECLARE SUB gover ()
DECLARE SUB LOAD (N$)
DECLARE SUB SMUDGE ()
DECLARE FUNCTION levl! (x!, Y!)
DECLARE FUNCTION chk! (x!, Y!)
DECLARE SUB FLOOR (x!, Y!)
DECLARE SUB SCRN ()
DECLARE SUB generate (z!)
DECLARE SUB GAME ()
'$INCLUDE: 'levmake.bi'
CLEAR , , 500
DIM SHARED chans&, dfreq&, MVX, MVY, BASE$, SPRX%, SPRY%, HI
IF INSTR(COMMAND$, "ADULT") THEN ADULT = 1: BASE$ = "adult\" ELSE BASE$ = "kids\"
dfreq& = 22050
chans& = 2
DQBCLOSE
E = DQBinit(32, chans&, 0)
IF E THEN PRINT DQBerror$: DQBCLOSE: SYSTEM
card = DQBinstallSB(FALSE, chans&, dfreq&, AUTO, AUTO, AUTO)
E = DQBloadFont("SMALL.FNT")
REM memory for spr: =4 + INT(((x2 - x1 + 1) * (bits-per-pixel-per-plane) + 7)/8)* planes * ((y2 - y1) + 1)
DIM SHARED DIR$, MDE, nmx, nmy, LY%
OPEN "path.dat" FOR INPUT AS #1: INPUT #1, DIR$: CLOSE
DIR$ = DIR$
RANDOMIZE TIMER
SCREEN 13
DIM SHARED WAVE AS WAVETYPE, BX1, SEE, Layer AS INTEGER, BKG, SEL, FRN, nos, P$, DRS, LEV$, rev, revy, OX, oy, en, sen, lsx, lsy, nt, ht, dd, LEV, cx, play$, bk, lv, STM&, edm&, FXPOS&, FXLEN&, BGM, N2$, PLL&, ANM, DONEFLOOR
SEE = 0
SEE = 1
BKG = 0
play$ = "play"
LEV$ = " 0123456789)!" + CHR$(34) + "œ$%^&*("
LEV$ = LEV$ + "zxcvbnm/,.ZXCVBNM?<>"
'FOR O = 0 TO 9: LEV$ = LEV$ + CHR$(ASC("w") + O): NEXT
lv = 4
bk = 7
maxmem = 32000
RMPS = 300
DRS = 100
DIM SHARED LEVT, sz, TP, BX, DX(DRS), DY(DRS), DZ(DRS), MAXY, rain, CHT, CCX, CCY, win, die, NMES, ANME, mos, MRT, TT, CHX, CHY, D, TMR, olx, mxx, mxy, TOP, rgt, spx, spy, sgx, sgy, LEVX, LEVY
mxx = 319: mxy = 199
windw 0
TMR = TIMER: DO
IF (PEEK(1047) AND 4) = 4 THEN IF (PEEK(1047) AND 8) = 8 THEN mxx = 200
LOOP UNTIL TIMER > TMR + 1
die = 0
CHX = 32
CHY = mxy - 25
D = 0
spx = 16: spy = 16
sgx = spx + 1
sgy = spy + 1
TOP = mxy \ spy
TOP = TOP - 1
rgt = mxx / spx
MRT = (mxx) - sgx
sgx = INT(sgx): sgy = INT(sgy)
nmx = 32: nmy = 32
mos = MRT / 2
LEVX = mxx: LEVY = TOP * 6
MAXY = LEVY
RMPS = INT(((spx + 1) + 7) / 8) * 4 * (spy + 1) / 2
RMPS = DQBsize(0, 0, sgx, sgy) / 3
nos = INT(maxmem / RMPS) / 2
'END
ANME = 100
NMES = 23
IF NMES > nos / 4 THEN NMES = nos / 4
DIM SHARED NM, BEGX, BEGY, COIN, C, spr, s
DIM SHARED x(ANME), Y(ANME), z(ANME), C(ANME), D(ANME), an(ANME), t(ANME), BS(ANME), LEV%(LEVX, LEVY), nme(0, RMPS * 4)
loadplay (play$)
COIN = 1
spr = 1
rain = 50
RESTORE FLOORTILES
spr = 0: DO: READ a$: IF a$ <> "" THEN spr = spr + 1
LOOP UNTIL a$ = "":
DIM SHARED s(RMPS, spr): ss = spr
RESTORE FLOORTILES: FOR spr = 1 TO ss + 1: READ a$:
IF a$ <> "" THEN LOAD (a$)
NEXT
FLOORTILES:
DATA floor2,floor1,brick1,coin1,tubebl,tubetl,tube1,tube2,tubebr,tubetr,coin2,coin3,finish,pole,poletop,castle1,castle2,castle3,CASTLE5,floor3,half1,half2,ice1,MUSH1,coin6,door1,LAVA1,LAVA2,LAVA3,heart1,heart3,fly,water1,arror-l,arror-r,lock1,key1,FENCE1,back1,back2,back3,back4,back5,BRICK2,WINDOW1,GATE1,BSTAR1,BSTAR2,BCLOUD1,BCLOUD2,BCLOUD3,BTREE,LOG,getbox,bjeep,ramp1,ramp2,""
DIM SHARED TB(2, 2), xx(rain), yy(rain), cc(rain)
DATA 5,7,9,6,8,10
FOR O = 0 TO 50: xx(O) = RND * (LEVX * sgx): yy(O) = RND * (LEVY * sgy): NEXT
FOR O = 1 TO 2: FOR P = 0 TO 2: READ TB(P, O): NEXT: NEXT
SCRN
x = 0
Y = 0
generate 0
FL = RND * LEVY
LEV = 0
FOR O = 1 TO NMES
loadnme O
NEXT
back: win = 0
LEV = LEV + 1
RANDOMIZE (LEV * 6)
PALETTE 0, 0
DO: nt = INT(RND * 2.9): LOOP UNTIL nt: IF INT(RND * 10) > 2 THEN PRINT : PALETTE 0, 9: IF nt = 2 THEN nt = 0
SCRN
LOCATE 10, 12
FOR O = 1 TO ANME
z(O) = 0: NEXT
'ON ERROR GOTO ERRLINE
BEGX = LEVX: BEGY = LEVY
GAME
IF win THEN 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 RUN

ERRLINE:
DR$ = ""
RESUME

SUB above (VX, VY, ocy)
END SUB

SUB addnme (t, x, Y) : xa = x: xb = Y: x = x * sgx: Y = Y * sgy
IF t > 0 AND FRN = 0 THEN GOTO NO
IF t > 0 AND FRN THEN z(FRN) = t: x(FRN) = x: Y(FRN) = Y: GOTO NO
FOR O = 1 TO ANME
IF z(O) > 0 AND x(O) \ sgx = xa AND Y(O) \ sgy = xb THEN z(O) = 0: Y(O) = -1: x(O) = -1
NEXT
NO:
x = x / sgx: Y = Y / sgy
END SUB

SUB addsprite (N, F)
ssp = (N * 8) + F
GET (0, 0)-(nmx, nmy), nme(0, 0)
FOR O1 = 0 TO 1: sp = ssp + (O1 * 4)
getnmexy (sp)
DQBmPut LY%, SPRX%, SPRY% + 1, VARSEG(nme(0, 0)), VARPTR(nme(0, 0)), O1
NEXT
END SUB

SUB backgd
OK = 1
LOCATE 1, 1
a$ = QOK$("CHANGE BACKGROUND?", "YN"): IF a$ = "N" THEN EXIT SUB
CENTRE "(p) means PERMANENT.", 8
a$ = QOK$("Water(p)/Block(p)/bRick\bLank,Tree", "WBRCLT")
IF a$ = "W" THEN BKG = 33: EXIT SUB
IF a$ = "B" THEN BKG = 2
IF a$ = "R" THEN BKG = 44: EXIT SUB
IF a$ = "L" THEN BKG = 0: EXIT SUB
IF a$ = "T" THEN BKG = 39: EXIT SUB
IF a$ = "C" THEN EXIT SUB

JD = 0: IF BKG = 44 OR BKG = 33 THEN JD = 1
GOTO ISOK
FOR O = 0 TO LEVX
FOR P = 0 TO LEVY
IF LEV%(O, P) THEN OK = 0
IF JD THEN IF LEV%(O, P) = 0 THEN LEV%(O, P) = BKG
NEXT
NEXT
ISOK:
IF OK = 0 THEN EXIT SUB
FOR O = 0 TO LEVX: FOR P = 0 TO LEVY
IF LEV%(O, P) = 0 THEN LEV%(O, P) = BKG
NEXT: NEXT
IF BKG <> 44 AND BKG <> 33 THEN BKG = 0

END SUB

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:
END SUB

FUNCTION boss (x)
ff = 0
IF x = 18 THEN ff = 1
END FUNCTION

SUB box (x1, y1, sz, TP)
IF BX = 0 THEN GOTO nobx
EE = LEV%(x1, y1)
FOR O = x1 - sz TO x1 + sz
FOR P = y1 - sz TO y1 + sz
IF O > -1 AND O < LEVX AND P > -1 AND P < LEVY + 1 THEN IF LEV%(O, P) = EE OR LEV%(O, P) = 0 THEN LEV%(O, P) = TP
NEXT: NEXT
nobx:
LEV%(x1, y1) = TP
END SUB

SUB CENTRE (N$, Y)
LC = 160 - (DQBlen(N$) / 2)
IF LC < 1 THEN LC = 1
LOCATE Y
BB = BX1: BX1 = 1: prnt N$, LC, (CSRLIN - 1) * 8: BX1 = BB
END SUB

SUB check (r)
IF t(r) THEN GOTO nochk
IF dd < 0 AND ht = 0 THEN D(r) = 15: Y(r) = Y(r) + D(r): t(r) = 1 ELSE die = 1: en = en - 1: D(r) = 15: Y(r) = Y(r) + D(r): t(r) = 1
IF die = 1 THEN IF C = 0 THEN C = 1
nochk:
END SUB

FUNCTION chk (x, Y)
IF POINT(CHX + (x * sgx), CHY + (x * sgy)) THEN chk = LEV%(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 THEN C(r) = C(r) + SGN(CHX - x(r)) / 6
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
END SUB

SUB COLLECT (x, Y)
IF levl(x, Y) = 12 THEN LEV%(x, Y) = 0: COIN = COIN + 1
END SUB

SUB COMPRESS (N$)
PRINT "Compressing to "; N$
OPEN BASE$ + DIR$ + "TMP" FOR INPUT AS #1
OPEN BASE$ + DIR$ + N$ FOR OUTPUT AS #2
NO = 1
PRINT #2, 1
OX = 0: x = -1
DO:
INPUT #1, x
x = x + 1
IF x = OX THEN NO = NO + 1
IF x <> OX THEN PRINT #2, MID$(STR$(NO), 2) + ":" + MID$(STR$(OX), 2): NO = 1: OX = x
LOOP UNTIL EOF(1)
PRINT #2, MID$(STR$(NO), 2) + ":" + MID$(STR$(x), 2): NO = 1: OX = x
CLOSE 1: CLOSE 2
END SUB

SUB DECOMPRESS (N$)
PRINT "Decompressing "; N$
OPEN BASE$ + DIR$ + "TMP" FOR OUTPUT AS #1
OPEN BASE$ + DIR$ + 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: MPX PX, PY, xx: NEXT
'PRINT X, XX: DO: LOOP UNTIL INKEY$ = " "
LOOP UNTIL EOF(2)
PRINT #1, 0
CLOSE 1: CLOSE 2
END SUB

SUB door (VX, VY, P, BLC)
FOR O = 1 TO DRS
IF (DX(O) = VX AND DY(O) = VY) OR (levl2(DX(O), DY(O)) <> 26 AND levl2(DX(O), DY(O)) <> 8) THEN DX(O) = VX: DY(O) = VY: DZ(O) = 0: LEV%(VX, VY) = BLC: SEL = O: O = DRS + 1
'IF (DX(O) = VX OR DY(O) = VY) THEN
NEXT
IF P = 0 THEN GOTO NOP
xx = x: yy = Y
DO: FLOOR x, Y: LINE (0, mxy)-(mxx, mxy - sgy), bk, BF
LOCATE 1, 3: INPUT "TO DOOR:"; DR$: IF DR$ = "" THEN x = xx: Y = yy: GOTO EOL
DR = VAL(DR$)
IF DR$ = "" THEN DR = DRS + 1
IF DR > 0 AND DR < DRS THEN IF levl2(DX(DR), DY(DR)) = 26 OR levl2(DX(DR), DY(DR)) = 8 THEN x = (DX(DR) * sgx) - mxx / 2: Y = (DY(DR) * sgy) - mxy / 2: FLOOR x, Y: DZ(SEL) = DR: SCRN
EOL:
LOOP UNTIL DR$ = ""
NOP:
LEV%(VX, VY) = BLC
END SUB

SUB enme (xx, yy, z, an, r) : miy = -sgy
BX = xx: BY = yy
xx = xx - CCX
yy = yy - CCY
yy = 200 - (yy + sgy):
ssp = INT(z * 8) + an
IF C(r) > 0 THEN cd = 0 ELSE IF C(r) < 0 THEN cd = 4
getnmexy (ssp + cd)
DQBxPut LY%, SPRX%, SPRY%, (SPRX% + nmx), (SPRY% + nmy), Layer, xx - spx, yy - spy
noe:
xx = BX
yy = BY
NOE2:
END SUB

SUB FLOOR (x, Y) : x = x \ 1: Y = Y \ 1
IF x < 0 THEN x = 0 ELSE IF x > LEVX * sgx THEN x = LEVX * sgx
IF Y < 0 THEN Y = 0
IF Y > LEVY * sgy THEN Y = LEVY * sgy
CCX = x: CCY = Y
IF nt MOD 3 <> 2 THEN GOTO nt1
sm = 1.2
FOR O = 0 TO rain: xx(O) = xx(O) + ((x - OX) / sm): yy(O) = yy(O) + ((Y - oy) / sm)
xx = (xx(O) - x) MOD mxx
yy = (yy(O) - Y) MOD mxy
IF POINT(xx, yy) = 247 THEN PSET (xx, yy), 15
NEXT
O = 0:
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:

mi% = INT(x \ sgx)
ac% = INT(x MOD sgx)
miy% = INT(Y \ sgy)
acy% = INT(Y MOD sgy)
SX = 0: EX = rgt
SY = -1: EY = TOP + 1
J% = SX
IF J% + mi% < 0 THEN J% = J% - (mi% + 1): LINE (sgx, 0)-STEP(-ac% + (J% * sgx), TOP * sgy), 7, BF
SX = J% - 1
J% = EX
IF J% + mi% > LEVX THEN posn = (J% + (mi% - 1) - LEVX) * sgx: LINE (rgt * sgx, 0)-STEP(-posn - ac%, TOP * sgy), 7, BF: J% = J% + ((J% + mi%) - LEVX)
EX = J% + 1
FOR J% = SX TO EX
FOR K% = SY TO EY: XP = (J% + mi%): YP = (K% + miy%): sp = levl2(XP, YP)
sprite -ac% + (J% * sgx), -acy% + (K% * sgy), sp
NEXT
NEXT
ANM = 0
FRN = 0
FOR r = 1 TO ANME: IF Y(r) < 1 OR x(r) < 1 OR z(r) < 1 THEN FRN = r: GOTO ED
ANM = ANM + 1
NN = 1
IF z(r) < NMES + 1 THEN enme x(r), Y(r), z(r), NN, r
ED:
NEXT
sc = 4
'LINE (0, MXY)-(mxx, MXY - (spy + 8)), sc, BF
'LINE (0, 0)-(SGX, MXY), sc, BF
'LINE (mrt, 0)-(mxx, MXY), sc, BF
m = mxx - sgx
m = m / LEVX
m = m / sgx: m = m * x
IF m > MRT - sgx THEN m = MRT - sgx
LINE (0, 0)-(rgt + m, 0), 15
max = (mxy / (LEVY * sgy))
LINE (0, 0)-(0, max * CCY), 1
COLOR 15
LOCATE 1, 2
IF LEVT < 50 THEN prnt "LEVEL" + STR$(LEV), POS(0) * 8, CSRLIN * 8
IF LEVT > 50 THEN prnt "WORLD " + STR$(((LEV - 1) \ 4) + 1) + "-" + STR$(((LEV - 1) MOD 4) + 1), POS(0) * 8, CSRLIN * 8
LEVT = LEVT + 4: IF LEVT > 100 THEN LEVT = 0
LOCATE 1, 30
prnt "NMES X" + STR$(ANM), POS(0) * 8, CSRLIN * 8
LOCATE 2, 25
IF NM = 0 THEN prnt "Floors ,bricks, coins", POS(0) * 8, CSRLIN * 8
IF NM = 1 THEN prnt "Enemies + collectables", POS(0) * 8, CSRLIN * 8
IF NM = 2 THEN prnt "Castles", POS(0) * 8, CSRLIN * 8
IF NM = 3 THEN prnt "Extras, Backgrounds", POS(0) * 8, CSRLIN * 8
prnt "directory: " + BASE$ + DIR$, 8, 22 * 8
OX = x: oy = Y: END SUB

FUNCTION fly (O)
ff = 0: IF z(O) = 5 THEN ff = 1
IF CHT AND z(O) = 7 THEN ff = 1
fly = ff
END FUNCTION

SUB GAME
nt = 3
en = 7
sen = en
CHX = sgx * 9
CHY = sgy * 4
mms = 0
lsx = CHX
lsy = CHY
win = 0
lhs = 100
rhs = mxx - 100
fol = 0
PLAYMUSIC BGM
MD = 13: LOADPALETTE
DO
LF = 0: RT = 0: UP = 0: dn = 0
FOR KY = 0 TO 32: E$ = EE$: EE$ = INKEY$: IF EE$ = "" THEN KY = 33
NEXT
B$ = E$
IF B$ = " " THEN sc = 1
IF B$ = "L" THEN MD = 0: LOADLEV: CHX = lsx * sgx: CHY = lsy * sgy
IF B$ = "S" THEN MD = 0: SAVELEV
IF B$ = "E" THEN NM = NM + 1: IF NM > 3 THEN NM = 0
IF B$ = "F" AND (LEVX = BEGX AND LEVY = BEGY) THEN RESIZE
IF B$ = "F" AND (LEVX <> BEGX OR LEVY <> BEGY) THEN LEVX = BEGX: LEVY = BEGY ELSE
IF B$ = "P" AND BX THEN BX = 0: GOTO nobp
IF B$ = "P" THEN DO: E = inkey - 48: LOOP UNTIL E > 0 AND E < 5: sz = E: BX = 1
IF UCASE$(B$) = "A" THEN BASE$ = "adult\"
IF UCASE$(B$) = "K" THEN BASE$ = "kids\"
nobp:
C$ = C$ + B$
C$ = RIGHT$(C$, 12)
a$ = "": IF LEN(B$) = 2 THEN a$ = MID$(B$, 2, 1): B$ = ""
IF B$ = "P" THEN a$ = ""
jp = (PEEK(1047) AND 1): IF (PEEK(1047) AND 2) = 2 THEN jp = 1
MV = 2
IF B$ = "H" THEN backgd
IF a$ = "M" THEN CHX = CHX + 8 * MV
IF a$ = "K" THEN CHX = CHX - 8 * MV
IF a$ = "H" THEN CHY = CHY + 8 * MV
IF a$ = "P" THEN CHY = CHY - 8 * MV
IF B$ = "R" THEN nt = nt + 1
IF B$ = "r" THEN nt = nt + 3
IF nt > (63 * 3) THEN nt = 0
IF B$ = "D" THEN door CHX \ sgx, CHY \ sgy, 0, 26
IF B$ = "d" THEN door CHX \ sgx, CHY \ sgy, 1, 26
IF B$ = "J" THEN setmusic
PLAYMUSIC 0
IF sc = 0 THEN GOTO NOMV
x9 = x
y9 = Y
x = x + mos
MV = (CHX - x) / 2
x = x + MV
x = x - mos
Y = Y + mxy / 3
MVY = (CHY - Y) / 2
Y = Y + MVY
Y = Y - mxy / 3
cx = x
cy = Y
NOMV:
IF cx \ 1 = x9 \ 1 AND cy \ 1 = y9 \ 1 THEN sc = 0
VX = (CHX + 9) \ sgx
VY = ((CHY + 9) \ sgy)
oo = 0
IF VX < 0 THEN VX = 0: oo = 1
IF VX > LEVX THEN VX = LEVX: oo = 1
IF VY > LEVY THEN VY = LEVY: oo = 2
IF VY < 0 THEN VY = 0: oo = 2
a$ = B$
AA = INSTR(LEV$, a$): IF AA AND a$ <> "" THEN  ELSE GOTO nodo
IF B$ = " " THEN GOTO nodo
AA = AA - 2
IF AA > 13 AND NM < 1 THEN AA = AA + 6
IF NM = 0 AND AA = 39 THEN AA = 46
IF NM = 0 AND AA > 39 AND AA < 42 THEN AA = AA - 39: AA = AA + 51
IF AA < 1 AND NM <> 1 THEN AA = 0: GOTO DOIT
IF NM = 2 THEN AA = AA + 13
IF NM = 3 THEN AA = AA + 38
IF (PEEK(1047) AND 1) = 1 THEN AA = AA + 10
IF NM = 0 THEN IF AA < spr + 1 THEN  ELSE GOTO nodo:
IF NM = 1 THEN IF AA < NMES + 1 THEN addnme AA, VX, VY: GOTO nodo ELSE GOTO nodo
DOIT:
IF AA > 4 AND AA < 11 THEN AA = AA + 20: IF AA > 27 AND AA < 30 THEN AA = AA + 2
IF AA > -1 AND AA < spr + 1 THEN box VX, VY, sz, AA

nodo:
CHX = VX * sgx
CHY = VY * sgy
IF B$ = "s" THEN lsx = VX: lsy = VY
mms = SGN(C(fol)) * 50
IF Y < 0 THEN Y = 0
IF x > (LEVX - (rgt - 3)) * sgx THEN x = (LEVX - (rgt - 3)) * sgx
IF Y > (LEVY - (TOP - 1)) * sgy THEN Y = (LEVY - (TOP - 1)) * sgy
IF x < -sgx AND x > -sgx - (rgt * 2) THEN x = -sgx

IF B$ = "T" THEN tube VX, VY, 0
IF B$ = "t" THEN tube VX, VY, 1
FLOOR x, Y
VX = CHX \ sgx: VY = CHY \ sgy
DQBmPut Layer, (CHX - x), (200 - sgy) - (CHY - Y), VARSEG(s(0, 13)), VARPTR(s(0, 13)), 2
LOCATE 2, 13: prnt "BLOCK:" + STR$(levl(VX, VY)), POS(0) * 8, CSRLIN * 8
IF levl(VX, VY) = 26 OR levl(VX, VY) = 8 THEN LOCATE 1, 13: WD = WHICHDOOR(VX, VY): prnt "DOOR:" + STR$(WD), POS(0) * 8, CSRLIN * 8: IF DZ(WD) > 0 THEN LOCATE 3, 13: prnt "TO DR:" + STR$(DZ(WD)), POS(0) * 8, CSRLIN * 8
SCRN
LOOP UNTIL lv < 0 OR win = 1
FOR O = 0 TO LEVX: FOR P = 0 TO LEVY: LEV%(O, P) = 0: NEXT: NEXT
END SUB

SUB generate (z)
LINE (0, 0)-(spx, spy), 247, BF
GET (0, 0)-(spx, spy), s(0, z)
END SUB

SUB getnmexy (ssp%) : sp% = ssp%
LY% = 5 + (sp% \ 54): sp% = sp% - (54 * (LY% - 5))
SPRX% = (sp% MOD 9) * (nmx + 1): SPRY% = (sp% \ 9) * (nmy + 1)
END SUB

SUB gover
en = sen
lv = lv - 1
CHX = lsx
CHY = lsy
D = 0: C = 0
END SUB

FUNCTION inkey
E = -1: E$ = INKEY$: IF E$ <> "" THEN E = ASC(E$)
inkey = E
END FUNCTION

SUB ISBOSS (x)

END SUB

SUB killnme (x, Y)
FOR O = 0 TO ANME: IF (x(O) \ sgx) = (x \ sgx) AND (Y(O) \ sgy) = (Y \ sgy) THEN t(O) = 1: D(O) = 20: Y(O) = Y(O) + D(O): C(O) = 0
NEXT
END SUB

FUNCTION levl (x, Y)
IF x < 0 OR x > LEVX OR Y < 0 OR Y > LEVY THEN LL = 0: GOTO nxt
LL = LEV%(INT(x), INT(Y)) MOD 256
nxt:
IF LL = 255 OR LL = 2 OR LL = BKG THEN LL = 0
levl = LL
END FUNCTION

FUNCTION levl2 (x, Y)
IF x < 0 OR x > LEVX OR Y < 0 OR Y > LEVY THEN LL = 0: GOTO nxt2
LL = LEV%(INT(x), INT(Y)) MOD 255
nxt2:
IF LL = 255 THEN LL = 0
IF LL = 0 THEN LL = BKG
levl2 = LL
END FUNCTION

SUB LOAD (N$)
loadall N$
GET (0, 0)-(spx, spy), s(0, spr)
END SUB

SUB loadall (N$)
N$ = N$ + ".spr"
CLOSE #2
ct:
COLOR 7
OPEN BASE$ + DIR$ + N$ FOR BINARY AS #2
IF LOF(2) = 0 THEN CLOSE : KILL BASE$ + DIR$ + N$: EXIT SUB
TP = 1
GET #2, , MM: GET #2, , m1: GET #2, , M2
BS = 0
BX = 0: IF HI AND M2 < 32 THEN BX = 16
IF HI AND M2 < 32 THEN BS = 16
LINE (0, 0)-(32, 34 + BS), 0, BF
IF MM = 255 THEN TP = 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
PSET (BX + oo, BS + PP), a:
NEXT: NEXT
CLOSE #2
spr = INT(spr)
END SUB

SUB LOADBOSS
END SUB

SUB LOADLEV
SCREEN 9
CLS
PRINT "LOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOAD"
PRINT "Level files in current:"
PRINT "Path:";
FILES BASE$ + DIR$ + "*.lev"
DO: INPUT "Enter load Filename: "; N$: IF INSTR(N$, ".") = 0 THEN ff = 9 ELSE ff = 13
LOOP UNTIL LEN(N$) < ff
IF N$ = "" THEN GOTO NOLD
PRINT
COMP = 0
COMPR:
IF COMP THEN DECOMPRESS N$ + ".LEV"
IF COMP THEN OPEN BASE$ + DIR$ + "TMP" FOR INPUT AS #1: ' INPUT #1, X
IF COMP = 0 THEN OPEN BASE$ + DIR$ + 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: Y(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, ANM
INPUT #1, lsx
INPUT #1, lsy
FOR O = 0 TO LEVX: FOR P = 0 TO LEVY
INPUT #1, LEV%: IF P < BEGY + 1 THEN LEV%(O, P) = LEV%
NEXT
NEXT: LEV = VAL(N$)
INPUT #1, ANM2: IF ANM2 = 255 THEN ANM2 = ANME
FOR O = 0 TO ANM2: 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
DQBSTOPVOICE 0: PLAYMUSIC BGM
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)
NOLD:
LOADPALETTE
END SUB

SUB loadnme (N)
SEE = 1
HI = 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$
addsprite N, P
NEXT
'NEXT
N$ = "nme" + MID$(STR$(N), 2) + "-d"
loadall N$
addsprite N, 0
DQBCOPYLAYER LY%, 0
'GET (0, 0)-(Spx, Spy), nme(0, n, 0)
SEE = 0
revy = 0: HI = 0
END SUB

SUB LOADPALETTE
RR = RE: GG = GN: BB = BL
OPEN "palette.dat" FOR BINARY AS #10
FOR O = 180 TO 180 + 66
GET #10, , RE: GET #10, , BL: GET #10, , GN: pal O, RE, GN, BL
NEXT
CLOSE #10
RE = RR: GN = GG: BL = BB
END SUB

SUB loadplay (a$)
END SUB

SUB MPX (PX, PY, xx)
PY = PY + 1: IF PY > LEVY THEN PX = PX + 1: PY = 0
'IF XX > 0 THEN PSET (PX, PY), XX
END SUB

SUB pal (w, Red, green, blue)
  OUT &H3C8, w
  OUT &H3C9, Red
  OUT &H3C9, green
  OUT &H3C9, blue
END SUB

SUB pass
SCREEN 9
DO
CLS
LOCATE 20, 10
INPUT "level password:"; P$
LOOP UNTIL LEN(P$) = 8: P$ = UCASE$(P$)
MD = 0: SCRN
END SUB

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 GOTO okloaded
IF fx <> 0 THEN N2$ = "waves\sfx" + MID$(STR$(fx), 2) + ".wav"
IF N2$ = "" THEN EXIT SUB
BUF$ = STRING$(2500, " ")
CLOSE #1: OPEN N2$ FOR BINARY AS #1: EE = LOF(1): IF EE > 0 THEN GET #1, 10, BUF$: STM& = INSTR(BUF$, "data") + 15
CLOSE #1: IF EE = 0 THEN KILL N2$: N2$ = "": EXIT SUB
FXLEN& = EE - ST&: FXPOS& = STM&
cfx& = fx
okloaded:
PLL& = 64000: IF PLL& + FXPOS& > FXLEN& THEN PLL& = FXLEN& - FXPOS&: PLL& = PLL& + 1
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& THEN FXPOS& = STM&: mfinsd = 1
END SUB

SUB prnt (N$, x, Y)
N$ = UCASE$(N$)
IF BX1 THEN PSET (x, (200 - 8) - Y), 7: LINE STEP(0, 0)-STEP(DQBlen(N$), 8), 7: LINE STEP(0, 0)-STEP(-DQBlen(N$), -8), 7, BF
DQBprint Layer, N$, 0 + x, 0 + Y, 15
DQBprint Layer, N$, 0 + x, 1 + Y, 4
END SUB

FUNCTION QOK$ (N$, O$)
m$ = "": FOR O = 1 TO LEN(O$): m$ = m$ + MID$(O$, O, 1): IF O < LEN(O$) THEN m$ = m$ + "/"
NEXT
N$ = N$ + "(" + m$ + ")"
CENTRE N$, 7
SCRN
DO: a$ = INKEY$: LOOP UNTIL INSTR(O$, a$) > 0 AND a$ <> ""
QOK$ = UCASE$(a$)
END FUNCTION

SUB rand
END SUB

SUB RESIZE
a$ = QOK$("CUT LEVEL TO THIS SIZE?", "YN")
IF a$ = "N" THEN EXIT SUB

LEVX = CHX \ sgx: LEVY = CHY \ sgy
FOR O = LEVX + 1 TO BEGX: FOR P = 0 TO BEGY: LEV%(O, P) = 0: NEXT: NEXT
FOR O = 0 TO BEGX: FOR P = LEVY + 1 TO BEGY: LEV%(O, P) = 0: NEXT: NEXT
END SUB

SUB save (E)
E = E \ 1: E = E MOD 256: PUT #1, E
END SUB

SUB SAVELEV
SCREEN 9
CLS
PRINT "SAVESAVESAVESAVESAVESAVESAVESAVESAVESAVESAVESAVESAVESAVESAVE"
PRINT ANM
PRINT "Level files in current:"
PRINT "Path:";
FILES BASE$ + DIR$ + "*.lev"
DO: INPUT "Enter SAVE Filename: "; N$: IF INSTR(N$, ".") = 0 THEN ff = 9 ELSE ff = 13
LOOP UNTIL LEN(N$) < ff
IF N$ = "" THEN GOTO nosv
PRINT
OPEN BASE$ + DIR$ + "TMP" FOR OUTPUT AS #1
LEV = VAL(N$)
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)
PRINT #1, LEVX, LEVY, ANM, lsx, lsy
FOR O = 0 TO LEVX: FOR P = 0 TO LEVY
PRINT #1, LEV%(O, P)
NEXT
NEXT
PRINT #1, ANME
FOR O = 0 TO ANME: PRINT #1, z(O), x(O), Y(O)
NEXT
PRINT #1, 251
PRINT #1, nt
PRINT #1, 100
FOR O = 0 TO 100
PRINT #1, DX(O), DY(O), DZ(O)
NEXT
PRINT #1, BKG
PRINT #1, BGM
CLOSE #1
nosv:
MD = 0: SCRN
COMPRESS N$ + ".LEV"
LOADPALETTE
END SUB

SUB SCRN
DQBCOPYLAYER Layer, VIDEO
Layer = Layer + 1: IF Layer > 2 THEN Layer = 1
DQBCLEARLAYER Layer
IF MDE <> 13 OR POINT(400, 400) = -1 THEN SCREEN 13: MDE = 13 ELSE EXIT SUB
windw 0
NN = nt \ 3: IF NN = 1 THEN NN = 50
IF nt > 2 THEN pal 247, (NN * 2) MOD 64, 0, NN ELSE PALETTE 247, 0
PALETTE bk, 0
P = 0
FOR O = 248 TO 255
PALETTE O, P: P = P + 9: NEXT
LOADPALETTE
END SUB

SUB setmusic
OK = 1
LOCATE 1, 1
MXB = 0
DQBPAUSESOUND: DO: MXB = MXB + 1: PLAYMUSIC MXB
LOOP UNTIL N2$ = "": MXB = MXB - 1
DQBRESUMESOUND
DO:
CENTRE "Up and Down arrows change, Space selects", 8
IF BGM < 0 THEN BGM = 0
a$ = INKEY$: IF a$ <> "" THEN a$ = UCASE$(a$)
AA$ = MID$(a$, 2)
IF AA$ = "M" OR AA$ = "H" THEN BGM = BGM + 1
IF AA$ = "K" OR AA$ = "P" THEN BGM = BGM - 1
N3$ = "waves\sfx" + MID$(STR$(BGM), 2) + ".wav"
CLOSE #1: OPEN N3$ FOR BINARY AS #1: E = LOF(1): CLOSE
IF E = 0 AND BGM > 1 THEN MXB = BGM - 1: KILL N3$: BGM = 1
IF a$ = CHR$(13) THEN PLAYMUSIC BGM
PLAYMUSIC 0
IF BGM < 0 THEN BGM = MXB
CENTRE "Background music:" + STR$(BGM), 9
SCRN
DQBCLEARLAYER Layer
LOOP UNTIL a$ = " "
END SUB

SUB slow
C = C / 1.5
IF die THEN die = 0: IF en < 1 THEN gover
END SUB

SUB SMUDGE
lv = -10
END SUB

SUB sprite (x, Y, sp)
IF MDE <> 13 THEN sp = -1
IF sp <> BKG THEN DQBmPut Layer, x, (200 - sgy) - Y, VARSEG(s(0, BKG)), VARPTR(s(0, BKG)), 2
IF sp > -1 AND sp < spr + 1 THEN DQBmPut Layer, x, (200 - sgy) - Y, VARSEG(s(0, sp)), VARPTR(s(0, sp)), 2
END SUB

SUB trans (mx, my)
PP = Y
O = mx
OK = 0
P = my: DO
IF O = LEVX THEN O = 0
IF levl(O, P) = 8 AND levl(O, P + 1) = 0 THEN CHX = 8 + (O * sgx): CHX = O * sgx: CHY = P * sgy: D = 0: C = 0: P = LEVY + 1: OK = 1
P = P + 1: IF P > LEVY THEN P = 0
LOOP UNTIL OK = 1
END SUB

SUB tube (x, Y, P)
BLC = 8
oo = 0
LEV%(x, Y) = 0: door x, Y, P, BLC
FOR O = x - 1 TO x + 1
IF levl(O, Y - 1) > 4 AND levl(O, Y - 1) < 11 THEN LEV%(O, Y - 1) = TB(oo, 1)
IF levl(O, Y) = 0 OR levl(O, Y) = BKG THEN LEV%(O, Y) = TB(oo, 2)
oo = oo + 1: NEXT
notube:
END SUB

FUNCTION WHICHDOOR (x, Y)
DR = 0
FOR O = 0 TO DRS: IF x \ 1 = DX(O) AND Y \ 1 = DY(O) THEN DR = O
NEXT
WHICHDOOR = DR
END FUNCTION

SUB windw (D)
IF D = 0 THEN WINDOW (0, 0)-(mxx, mxy)
IF D = 1 THEN WINDOW SCREEN (0, 0)-(mxx, mxy)
PALETTE 0, 3
END SUB

