DECLARE SUB LOADBKG (O!)
DECLARE SUB MOUSEWAIT ()
DECLARE SUB ADNME (X!, Y!, R!)
DECLARE FUNCTION EXIST! (F$)
DECLARE SUB FIND (HEAD$, EXT$, MSG$)
DECLARE SUB SETUP ()
DECLARE FUNCTION RB! ()
DECLARE FUNCTION LB! ()
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!, 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: 'DIRECTQB.bi'
CLEAR , , 5000
DIM SHARED BMP$, chans&, dfreq&, MVX, MVY, BASE$, SPRX%, SPRY%, HI, MENU, BAS, MAX, TSZ
IF INSTR(COMMAND$, "ADULT") THEN ADULT = 1: BASE$ = "adult\" ELSE BASE$ = "kids\"
dfreq& = 22050
chans& = 2
DQBclose
E = DQBinit(9, 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%, crs
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 / SGX) - 1
MRT = (mxx) - SGX
SGX = INT(SGX): SGY = INT(SGY)
NMX = 32: NMY = 31
'NMX = 16: NMY = 16
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 = 1: DO: F$ = BASE$ + DIR$ + "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
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), SZ(NMES)
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 + 5): SS = SPR
RESTORE FLOORTILES: FOR SPR = 1 TO SS + 1: READ A$:
IF A$ <> "" THEN LOAD (A$)
NEXT
SPR = SS
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,log1,""
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 : 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: IF SZ(T) > 16 THEN XA = XA - 1: XB = XB + 1
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
MOUSEWAIT
END SUB

SUB addsprite (N, F)
ssp = N
GET (0, 0)-(NMX, NMY), NME(0, 0)
SP = ssp
getnmexy (SP)
DQBmPut LY%, SPRX%, SPRY% + 1, VARSEG(NME(0, 0)), VARPTR(NME(0, 0)), 0
END SUB

SUB ADNME (XP, YP, R)
getnmexy (R)
IF SZ(R) < 31 AND R <> 20 AND R <> 8 AND R <> 9 AND R <> 24 THEN YP = YP - SGY: XP = XP - SGX / 2
DQBxPut LY%, SPRX%, SPRY% + 1, (SPRX% + NMX), (SPRY% + NMY), LAYER, XP + ((SGX / 2) - 2) * (SZ(R) < 32), YP
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$("Wtr(p)/Blk(p)/bRk/bLnk/Tr/", "WBRCLTP,0123456789")
LOADBKG (0)
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
A = ASC(A$) - 48: IF A > 0 AND A < 10 THEN BKG = -A: LOADBKG (A): 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, R2) : miy = -SGY
BX = XX: BY = YY
XX = XX - CCX
YY = YY - CCY
YY = 200 - (YY + SGY):
YY = YY + NMY
XX = XX + NMX: AN = 1
getnmexy (R2)
YY = YY + 2
'IF R2 = 20 OR R2 = 8 OR R2 = 9 THEN XX = XX - SGX: YY = YY - SGY
IF SZ(R2) > 16 THEN XX = XX + (NMX / 2) - 1: YY = YY + (NMY / 2) + 1
XX = XX - NMX: YY = YY - NMY
IF SZ(R2) = 16 THEN XX = XX + SGX: YY = YY + SGY
DQBxPut LY%, SPRX%, SPRY% + 1, (SPRX% + NMX), (SPRY% + NMY), LAYER, XX - SpX, YY - SPY
noe:
XX = BX
YY = BY
NOE2:
END SUB

FUNCTION EXIST (F$)
OPEN F$ FOR BINARY AS #254: E = LOF(254): CLOSE : IF E = 0 THEN KILL F$
EXIST = E
END FUNCTION

SUB FIND (HEAD$, EXT$, MSG$)
COLY = CSRLIN
PRINT
N1$ = HEAD$: N2$ = EXT$: N3$ = MSG$
OO = 0
FOR O = 1 TO 100
E$ = N1$ + MID$(STR$(O), 2)
IF LEN(E$) > 8 THEN E$ = "": O = 101: GOTO NOTONE
E$ = E$ + N2$
F$ = BASE$ + DIR$ + E$: OPEN F$ FOR BINARY AS #254: E = LOF(254): CLOSE : IF E = 0 THEN KILL F$
IF E > 0 THEN LOCATE COLY + ((OO \ 6) + 1), ((OO MOD 6) + 1) * 10: PRINT N3$ + STR$(O): OO = OO + 1
NOTONE:
NEXT
PRINT
END SUB

SUB FLOOR (X, Y) : X = X \ 1: Y = Y \ 1
IF X < 0 THEN X = 0 ELSE IF X > (LEVX - RGT) * SGX THEN X = (LEVX - RGT) * SGX
IF Y < -(MENU * 3) * SGY THEN Y = -(MENU * 3) * SGY
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
DQBBOXF LAYER, 0, (199 - SGY), 320, 200, 23
IF MENU = 0 THEN GOTO DNOMEN
DQBBOXF LAYER, 0, (199 - SGY) - 32, 320, 200, 23
DQBBOXF LAYER, 0, (199 - SGY) - SGY, 320, 200 - SGY, 7
CCX = 0: CCY = 0
TG = 19: st = 1: IF nm = 1 THEN TG = 19: st = 2
FOR O3 = 0 TO TG STEP st: O = O3 / st
IF nm <> 1 THEN MAX = SPR + 1 ELSE MAX = NMES
crs = crs MOD MAX
OO = BAS + O: IF OO < 0 THEN OO = MAX
OO = OO MOD (MAX)
IF OO = crs THEN Y8 = 0: X8 = 160 - (SGX / 2):  ELSE Y8 = 16: X8 = O * SGX * st
IF nm <> 1 THEN SPRITE X8, Y8, OO
IF OO = 20 OR OO = 8 OR OO = 9 THEN Y8 = Y8 - SGY * 0: X8 = X8 + SGX
IF nm = 1 THEN ADNME X8, (200 - Y8) - 16, OO
'IF NM = 1 AND X8 > AMX AND X8 < AMX + SGX THEN CRS = NM
NEXT
CCX = X: CCY = Y
DNOMEN:
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
IF Z(R) < NMES + 1 THEN ENME X(R), Y(R), Z(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, 200 - ((MENU * 32) + 12)
PRINT BKG
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
SZ = 0
DQBRESETMOUSE
SETUP
MENU = 1
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$ = "L" THEN MD = 0: LOADLEV: CHX = lsx * SGX: CHY = lsy * SGY: X = (CHX - 160): Y = (CHY - 100)
IF B$ = "S" THEN MD = 0: SAVELEV
IF B$ = "E" THEN nm = nm + 1: IF nm > 1 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 > 0 THEN BX = 0: SZ = 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\"
OAMX = AMX: AMX = DQBmouseX
OAMY = AMY: AMY = DQBmouseY
SC = 0: ' IF OAMX <> AMX OR OAMY <> AMY THEN  ELSE GOTO NOMOUSE
DON = 0: IF SCY < (200 - (MENU * 32)) THEN DON = 1
MVD = 0: CCX = CHX: CCY = CHY
IF DON = 0 THEN  ELSE GOTO NXTP
IF (AMX < 10 OR AMX > 310) THEN  ELSE GOTO NXTP
IF AMX < 10 THEN BAS = BAS - 1: IF BAS < 0 THEN BAS = SPR
IF AMX > 310 THEN BAS = BAS + 1: IF BAS > SPR THEN BAS = 0
GOTO NOMOUSE
NXTP:
MVX2 = OAMX
MVY2 = OAMY
IF AMX < 1 THEN CHX = CHX - (10 - AMX) * SGX: MVX2 = SGX + 10
IF AMX > 318 THEN CHX = CHX + (320 - AMX) * SGX: MVX2 = 310 - SGX
IF AMY > 198 THEN CHY = CHY - (200 - AMY) * SGY: MVY2 = 190 - SGY
IF AMY < 1 THEN CHY = CHY + (10 - AMY) * SGY: MVY2 = SGY + 10
IF CHX <> CCX OR CHY <> CCY THEN MVD = 1
IF CHX < 0 THEN CHX = 0
IF CHX > LEVX * SGX THEN CHX = LEVX * SGX
IF CHY > LEVY * SGY THEN CHY = LEVY * SGY
IF CHY < 0 THEN CHY = 0
CHX = X + ((AMX \ SGX) * SGX)
CHY = Y + (200 - (AMY \ SGY) * SGY) - 16
CHX = CHX \ SGX: CHX = CHX * SGX
CHY = CHY \ SGY: CHY = CHY * SGY
IF MVD THEN SC = 1: DQBSETMOUSEPOS MVX2, MVY2

NOMOUSE:

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: SETUP
IF B$ = "r" THEN nt = nt + 3: SETUP
IF nt > (63 * 3) THEN nt = 0
IF B$ = "D" THEN door CHX \ SGX, (CHY \ SGY) + 1, 0, 26
IF B$ = "d" THEN door CHX \ SGX, (CHY \ SGY) + 1, 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 / 2
X = X - mos
Y = Y + mxy / 3
MVY = (CHY - Y) / 2
Y = Y + MVY / 2
Y = Y - mxy / 3
CX = X
CY = Y
NOMV:
SCX = (CHX - X)
SCY = (CHY - Y)
IF MENU = 0 THEN GOTO NOMENU
IF CX \ 200 = x9 \ 200 AND CY \ 200 = y9 \ 200 THEN SC = 0
NOMENU:
VX = ((CHX + 9) \ SGX)
VY = ((CHY + 8) \ SGY) + 1
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$
SCX = AMX
SCY = (200 - SCY)
'IF LB THEN AA = 0: GOTO DOIT
DON = 0: IF SCY < (184 - (MENU * 32)) THEN DON = 1
RBOK = SCY > (200 - SGY) '- 32
MN = MENU: IF RB AND RBOK THEN MENU = (1 - MENU): RBOK = 0 ELSE RBOK = 1
IF MN <> MENU THEN IF MENU THEN CHY = CHY - (3 * SGY): Y = Y - (3 * SGY)
IF RB AND DON = 1 THEN MT = 0 ELSE MT = 0
IF RB = 0 THEN RBOK = 0: IF LB THEN MT = 1
IF DON AND (LB OR RBOK) THEN AA = (BOS + crs) * MT: GOTO DOIT
AA = INSTR(LEV$, A$): IF AA AND A$ <> "" THEN  ELSE GOTO nodo
IF B$ = " " THEN GOTO nodo
AA = AA - 2
IF A$ = "b" OR A$ = "B" THEN IF nm = 0 THEN AA = 39: GOTO DOIT
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:
DOIT:
IF nm = 1 THEN IF AA < NMES + 1 THEN addnme AA, VX, VY: GOTO nodo
'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:
IF B$ = "s" THEN lsx = VX: lsy = VY
mms = SGN(C(fol)) * 50
IF B$ = "T" THEN tube VX, VY, 0
IF B$ = "t" THEN tube VX, VY, 1
FLOOR X, Y
SCY = (200 - (AMY)) - 12
IF nm <> 1 THEN MAX = SPR ELSE MAX = NMES
IF nm = 1 THEN CST = 1: SGB = NMX ELSE CST = 1: SGB = SGX
IF SCY < SGY * 2 AND SCY > 0 AND LB THEN IF MENU > 0 THEN SCX = SCX - SGX: crs = ((((SCX + SGB - 1) / CST) \ SGB) + BAS) MOD (MAX + 1): SCX = SCX + SGX
IF nm = 1 THEN IF SCY < SGY * 2 AND SCY > 0 AND LB THEN IF MENU > 0 THEN crs = BAS + (AMX \ (SGX * 2)):
IF nm <> 1 AND crs = 0 THEN crs = MAX
SCX = AMX
SCY = (200 - SCY) - 12
IF DON = 0 THEN DQBLINE LAYER, SCX - (SGX / 2), SCY, SCX + (SGY / 2), SCY, 31
IF DON = 0 THEN DQBLINE LAYER, SCX, SCY - (SGY / 2), SCX, SCY + (SGY / 2), 31
VX = CHX \ SGX: VY = CHY \ SGY
IF crs < 0 THEN crs = 0
IF nm <> 1 THEN VSG = VARSEG(S(0, crs)): VPT = VARPTR(S(0, crs))
IF SCY < (200 - SGY) - (MENU * 32) THEN  ELSE GOTO NODWPT
IF nm <> 1 THEN DQBmPut LAYER, (CHX - X), (200 - (SGY * 2)) - (CHY - Y), VARSEG(S(0, 13)), VARPTR(S(0, crs)), 2
IF nm = 1 THEN ADNME 0 + (SCX \ SGX) * SGX, ((DQBmouseY \ SGY) * SGY) - 4, crs
NODWPT:
VY = VY + 1
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
VY = VY - 1
TMX = SGX * 7
TMY = SGY * 3.5
CCHY = CHY
CHY = 200 - CHY
CHX = AMX
CHY = AMY

DQBLINE LAYER, CHX - TMX, CHY - TMY, CHX + TMX, CHY - TMY, 15
DQBLINE LAYER, CHX + TMX, CHY - TMY, CHX + TMX, CHY + TMY, 15
DQBLINE LAYER, CHX + TMX, CHY + TMY, CHX - TMX, CHY + TMY, 15
DQBLINE LAYER, CHX - TMX, CHY + TMY, CHX + -TMX, CHY - TMY, 15
CHY = CCHY
SCRN
X = (X \ SGX) * SGX
Y = (Y \ SGY) * SGY
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% \ 208): SP% = SP% - (208 * (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 LB
LB = DQBmouseLB
END FUNCTION

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
BX = 0: BS = 0
SZ = 1: IF M2 > SGX THEN SZ = (M2 / SGX): '(IF HI = 0 THEN) USUALLY BEFORE "SZ="
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 / SZ), BS + (PP / SZ)), A:
NEXT: NEXT
CLOSE #2
SPR = INT(SPR)
IF M2 > SGX THEN SZ = .5
TSZ = SZ
SZ = 1
END SUB

SUB LOADBKG (O)
IF O = 0 THEN CLS : BMP$ = "": GOTO NOBK
DEF SEG = &HA000
BLOAD BASE$ + DIR$ + "BACKG" + MID$(STR$(O), 2) + ".sht", 0
BMP$ = MID$(STR$(O), 2)
DEF SEG = 0
NOBK: BKG = -O
DQBCOPYLAYER 0, 9
END SUB

SUB LOADBOSS
END SUB

SUB LOADLEV
SCREEN 9
CLS
PRINT "LOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOADLOAD"
PRINT "Level files in current:"
PRINT "Path:";
FIND "", ".LEV", "LEVEL"
'FILES BASE$ + DIR$ + "*.lev"
DO: INPUT "Enter load LEVEL NO: "; N
N$ = MID$(STR$(N), 2)
IF EXIST(BASE$ + DIR$ + N$ + ".LEV") THEN  ELSE N$ = "": GOTO chk
IF N > 0 THEN  ELSE GOTO chk
chk:
LOOP UNTIL LEN(N$) < 9
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 BKG > 1000 THEN BKG = BKG - 1000: BKG = -BKG
BMP$ = "": IF BKG < 0 THEN LOADBKG (ABS(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
SETUP
END SUB

SUB loadnme (N)
SEE = 1
HI = 1
IF N = 20 OR N = 8 OR N = 9 OR N = 24 THEN HI = 0
NN = 1: revy = 1
O = 1: 'FOR o = 1 TO 2
FOR P = 1 TO 1: A$ = "-" + MID$(STR$(P), 2)
N$ = "nme" + MID$(STR$(N), 2) + A$
rev = 0: IF O = 1 THEN rev = 1
loadall N$
IF TSZ <> 1 THEN PRNT "BIG", 0, 192
addsprite N, P
SZ(N) = SZ * 32
NEXT
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: IF RE < 63 OR BL < 63 OR GN < 63 THEN PAL O, RE, GN, BL
NEXT
CLOSE #10
RE = RR: GN = GG: BL = BB
END SUB

SUB loadplay (A$)
END SUB

SUB MOUSEWAIT
MMX = DQBmouseX \ SGX: MMY = DQBmouseY \ SGY
DO: LOOP UNTIL LB = 0 AND RB = 0 OR (MMX <> (DQBmouseX \ SGX) OR MMY <> (DQBmouseY \ SGY))
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, 18
DQBPRINT LAYER, N$, X - 1, Y + 1, 18
DQBPRINT LAYER, N$, 0 + X, 1 + Y, 25
END SUB

FUNCTION QOK$ (N$, O$) : M$ = 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

FUNCTION RB
RB = DQBmouseRB
END FUNCTION

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:";
FIND "", ".LEV", "LEVEL"
'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
IF BKG < 0 THEN BKG = 1000 + ABS(BKG)
PRINT #1, BKG
IF BKG > 1000 THEN BKG = BKG - 1000: BKG = -BKG
PRINT #1, BGM
CLOSE #1
nosv:
MD = 0: SCRN
COMPRESS N$ + ".LEV"
LOADPALETTE
SETUP
END SUB

SUB SCRN
DQBLINE LAYER, DQBmouseX, DQBmouseY + 8, DQBmouseX, DQBmouseY, 15
DQBLINE LAYER, DQBmouseX + 8, DQBmouseY, DQBmouseX, DQBmouseY, 15
DQBCOPYLAYER LAYER, VIDEO
LAYER = LAYER + 1: IF LAYER > 2 THEN LAYER = 1
IF BMP$ = "" THEN DQBclearLayer LAYER ELSE DQBCOPYLAYER 9, LAYER
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 SETUP
SCREEN 13
WINDW 0
NN = nt \ 3: IF NN = 1 THEN NN = 50
FOR O3 = 0 TO 1
IF nt > 2 THEN PAL 247 * O3, (NN * 2) MOD 64, 0, NN ELSE PAL 247 * O3, 0, 0, 0
NEXT
PAL bk, 0, 0, 0
TP = P
P = 0
FOR O = 248 TO 255
PAL O, P, 0, 0: P = P + 9: NEXT
LOADPALETTE
P = TP
MD = 13
MDE = 13
DQBRESETMOUSE
DQBSETMOUSEPOS 160, 100
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 AND BKG > 0 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

