'$DYNAMIC      
'current library; DIRESTUF.QLB
DEFINT A-Z
DECLARE SUB texttalk (y%, wsay%(), dia%(), dctr%, arg%, big%(), bobpal%(), pale%(), sayx%(), sayy%(), sayw%(), sayl%(), dpage%, vpage%, kp%(), saypx%(), saypy%(), set%)
DECLARE SUB newscreen (plot%(), picset%(), pict%(), nice%(), targ%(), leap%(), dbefore%(), week$(), ts$, day$, timeoday%, pal$, needf%, mainpal%(), hnb%, chp%(), hp%(), ap%(), nbhp%(), nba%(), xyc%(), room%(), mx%, my%, set%, mapset%(), buffer%(),  _
blocker%(), chroma%(), dpage%, vpage%, ickcon%(), itset%(), iactive%(), name$(), oddpal%, speed%())
DECLARE SUB corspeed (speed%(), pict%(), picset%(), plot%())
DECLARE SUB drawmap (room%(), blocker%(), chroma%(), dpage%, vpage%)
DECLARE SUB loadrow (room%(), my%, mx%)
DECLARE SUB loadscreen (set%, mapset%(), mx%, my%, buffer%())
DECLARE SUB showtext (set%, dia%(), dctr%, arg%, sayl%(), sayx%(), sayy%(), dpage%)
DECLARE SUB debugg (w%, weapon%(), pict%(), nice%(), speed%(), x%(), y%())
DECLARE SUB equip (weapon%(), wnum%(), speed%(), nice%(), pict%(), pale%(), picset%(), csr%(), defence%(), guard%(), apic%(), apal%(), apicset%(), armsp%(), inice%(), ap%(), maim%(), nbhp%(), nitel%(), nba%(), niteh%(), flee%(), iflee%(), plot%(),  _
ptemp%(), inft#(), tempinf#(), chp%(), tempchp%(), swim%(), ranatemp%)
DECLARE SUB weirset (plot%(), picset%(), pict%(), nice%())
DECLARE SUB ctrlcode (delay%, oddpal%, timeoday%, plot%(), pal$, needf%, mainpal%(), hnb%, chp%(), hp%(), ap%(), nbhp%(), nba%(), font%, font%(), pale%())
DECLARE SUB sethepal (mainpal%(), pal$, needf%)
DECLARE SUB animate (o%, cfull%, aframe%, aframe%(), acounter%(), aspeed%(), anim%())
DECLARE SUB menu (menuset() AS STRING, menuc%, visrows%, menux%, menuy%, menup%, skip%, csrcol%, txtcol)
DECLARE FUNCTION LARGE% (n1%, n2%)
DECLARE FUNCTION SMALL% (n1%, n2%)
DECLARE SUB hitit (i%, o%, aframe%, aframe%(), picset%(), speed%(), cfull2%, stemp%(), kd%(), d%(), kspeed%(), knock%(), say%(), inuse%(), ai1%(), rate!, target%(), defence%(), chp%(), hp%(), drain%, ap%(), charge%, absorb%(), ahit%)
DECLARE SUB dizzy (o%, spinctr%(), spin%(), cfull2%, d%(), inuse%(), x%(), y%())
DECLARE SUB align (o%, x%(), y%(), speed%())
DECLARE SUB checkinf (o, plot(), infplot(), inf$(), dpage, speed(), inft#(), inftime(), picset(), pict(), ranatemp, ranaset, ranapic, rananice, nice(), pale(), ptemp(), pois#, drain, doom(), bobpal(), x(), y(), btog())
DECLARE SUB toad (ranatemp, ranaset, ranapic, rananice, picset(), pict(), nice(), pale(), ptemp(), inft#(), inftime(), plot%())
DECLARE SUB eventitem (dia(), sayx(), sayy(), sayw(), sayl(), font, ivname$(), ivpic(), ivpal(), ivset(), ivcon(), ivuse$(), plot(), kp(), rate!, vpage, placer(), bobpal(), font(), buffer%(), dpage)
DECLARE SUB wepup (o, y(), x(), mx, my, speed(), cfull2, cant, look, passall(), room(), boomf(), boomer(), htarg(), r(), range(), picset(), acounter())
DECLARE SUB wepright (o, y(), x(), mx, my, speed(), cfull2, cant, look, passall(), room(), boomf(), boomer(), htarg(), r(), range(), picset(), acounter())
DECLARE SUB wepdown (o, y(), x(), mx, my, speed(), cfull2, cant, look, passall(), room(), boomf(), boomer(), htarg(), r(), range(), picset(), acounter())
DECLARE SUB wepleft (o, y(), x(), mx, my, speed(), cfull2, cant, look, passall(), room(), boomf(), boomer(), htarg(), r(), range(), picset(), acounter())
DECLARE SUB sethtarg (targx(), targy(), o, x(), y(), htarg(), speed(), cfull3, xaim(), yaim(), dist!, divnum!)
DECLARE SUB setonkill (o, target(), picset(), beat(), bobpal(), x(), y(), mx, my, ickcon(), chp(), plot(), itset(), iactive(), xper(), levelup(), hp())
DECLARE SUB itemscon (plot(), itset(), picset(), iactive(), mx, my)
DECLARE SUB checkcon (plot(), ickcon(), mx, my, picset())
DECLARE SUB inform (mx, my, plot(), dpage, x(), y(), pict(), pale(), speed(), code$, absorb(), ickcon(), pal$, charge, inuse(), code(), weapon(), target())
DECLARE SUB sloth (speed(), inft#(), inftime(), plot(), pict(), picset())
DECLARE SUB drawshop (font, dia(), sayx(), sayy(), sayw(), sayl(), stock, shx(), shy(), buffer(), spicset(), vpage, placer(), spict(), bobpal(), ptr, ptr2, ptr3, product$(), price(), seed(), descr$(), spale(), chp(), hp(), font(), dest, arg)
DECLARE SUB bossmeter (boss(), chp(), ap(), hp(), dpage)
DECLARE SUB takeitem (hp(), take, chp(), cmax, ap(), seed(), ic1(), ic2(), ic3(), ic4(), itset(), mx, my, plot(), infplot(), inftemp(), inft#(), ickcon(), picset(), iactive(), say(), timef(), inert(), inftime%())
DECLARE SUB reaper (plot(), inft#(), inftime(), drain, doom(), bobpal(), x(), y(), btog(), dpage)
DECLARE SUB fontset (font, font())
DECLARE SUB statusscr (font, font(), csr2, dia(), sayx(), sayy(), sayw(), sayl(), big(), bobpal(), pale(), chp(), hp(), seed(), xper(), levelup(), maim(), csr(), fulpow(), armsp(), iname$(), arm$(), guard(), cmax, day$, ix(), iy(), arm, weps, plot() _
, conptr(), ipicset(), placer(), vpage, dpage, buffer(), ipal(), ipic())
DECLARE SUB poison (pois#, drain, pale(), inft#(), inftime(), plot(), picset(), pict())
DECLARE SUB intox (speed(), inft#(), inftime(), picset(), pict(), plot())
DECLARE SUB charload ()
DECLARE SUB bigsprite (buffer(), nice(), boss(), wbig, u)
DECLARE SUB debugest (code(), code$, plot(), seed(), store, boss(), debug, nice(), picset(), bobpal(), x(), y(), hp(), cmax, target(), allitems, inft#(), pict(), beat%())
DECLARE SUB buyit (ptr, cmax, ptr3, seed(), price(), hp(), liup(), chp(), scure(), chup(), plot(), infplot(), inftemp(), sset1(), sset2(), inft#(), inftime())
DECLARE SUB drawbox (sayx(), sayy(), sayw(), sayl(), dia(), dctr, dest, arg)
DECLARE SUB getday (leap(), dbefore(), week$(), plot(), ts$, day$)
DECLARE SUB loadstock (inum(), product$(), spict(), spale(), spicset(), scure(), chup(), liup(), sset1(), sset2(), shx(), shy(), apear1(), apear2(), plot(), ptr, stock)
DECLARE SUB timeofday (timeoday, plot(), pal$, needf, mainpal(), hnb, chp(), hp(), ap(), nbhp(), nba())
DECLARE SUB clock (rtime$)
DECLARE SUB meter (charge#, fulpow(), cmet!, cmax, fcol, dpage)
DECLARE SUB allsprite (vframe(), d(), af(), aframe(), picset(), order(), boss(), btog(), bobpal(), pale(), x(), y(), placer(), ty(), dpage, big())
DECLARE SUB setmodex ()
DECLARE SUB copypage (BYVAL page1, BYVAL page2)
DECLARE SUB setvispage (BYVAL page)
DECLARE SUB drawsprite (pic(), pal(), BYVAL po, BYVAL x, BYVAL y, BYVAL page)
DECLARE SUB loadsprite (pic(), BYVAL x, BYVAL y, BYVAL w, BYVAL h, BYVAL page)
DECLARE SUB stosprite (pic(), BYVAL x, BYVAL y, BYVAL page)
DECLARE SUB fadeto (palbuff(), BYVAL red, BYVAL green, BYVAL blue)
DECLARE SUB fadetopal (pal(), palbuff())
DECLARE SUB setpal (pal())
DECLARE SUB clearpage (BYVAL page)
DECLARE SUB loadpage (buf(), fil$, BYVAL p)
DECLARE SUB setkeys ()
DECLARE SUB setfont (F())
DECLARE SUB printstr (s$, BYVAL x, BYVAL y, BYVAL p)
DECLARE SUB textcolor (BYVAL F, BYVAL b)
DECLARE SUB setitup (fil$, buff(), BYVAL p)
DECLARE SUB resetdsp
DECLARE SUB playsnd (BYVAL n, BYVAL F)
DECLARE SUB closefile
DECLARE SUB setpicstuf (buf(), BYVAL b, BYVAL p)
DECLARE SUB loadset (fil$, BYVAL i, BYVAL l)
DECLARE SUB storeset (fil$, BYVAL i, BYVAL l)
DECLARE SUB setwait (b(), BYVAL t)
DECLARE FUNCTION Keyseg ()
DECLARE FUNCTION keyoff ()
DECLARE FUNCTION keyval (BYVAL a)
DECLARE FUNCTION getkey ()
TYPE Regtype
 ax AS INTEGER
 bx AS INTEGER
 cx AS INTEGER
 dx AS INTEGER
 bp AS INTEGER
 si AS INTEGER
 di AS INTEGER
 flags AS INTEGER
 ds AS INTEGER
 es AS INTEGER
END TYPE
DIM SHARED regs AS Regtype
regs.ax = &H3509: CALL interruptx(&H21, regs, regs)
off9 = regs.bx: seg9 = regs.es
'DIM voice(16385), game(1000), room(288), mainpal(767), tile(2000), tilex(2000), tiley(2000), timing(1)
'DIM SHARED placer(250), blocker(200), chroma(16 * 30), bobpal(16 * 99), buffer(8000), mapset(512), doorx(500), doory(500), exitx(500), exity(500), font(1024), ickloc(1536), ickcon(3200), order(16)
'DIM SHARED x(16), y(16), pict(16), pale(16), aspeed(16), picset(16), aframe(16), vframe(16), acounter(16), plot(400), whosay(1536), wsay(400), sayx(400), sayy(400), sayl(400), sayw(400), saypx(400), saypy(400), big(1250), fade(1536), item(4300)
'DIM SHARED boss(16), ic1(16), ic2(16), ic3(16), ic4(16), push(16), timef(16), nice(16), hp(16), chp(16), ap(16), defence(16), anim(16), ty(16), name$(16), seed(16), speed(16), stemp(16), kspeed(16), number(16), af(6), nbhp(16), nba(16)
'DIM SHARED itset(4400), ptemp(12), code(16), xtemp(12), ytemp(12), ltemp(12), beat(180), targ(1600), d(16), range(16), homing(16), knock(16), muser(16), boomer(16), inuse(16), absorb(16), passall(16), fuser(16), story!(2000), plotos(512)
'DIM SHARED iname$(30), ipic(30), ipal(30), ipicset(30), wnum(30), apic(30), apal(30), apicset(30), maim(30), guard(30), nitel(30), niteh(30), iflee(30), smaim(30), armsp(30), inice(30), conptr(30), rtime$, cmax, dpage, vpage, charge#, pal$, needf, hnb, day$, fcol, leap(10), dbefore(12)
'DIM SHARED week$(7), x, y, ptr, stock, product$(10), spict(10), spale(10), spicset(10), scure(10), chup(10), liup(10), sset1(10), sset2(10), inum(10), shx(10), shy(10), apear1(10), apear2(10), dia(20), dctr, arg, ptr3, price(10), noise(10), allitems, target(16), xyc(16)
'DIM SHARED ai1(16), swim(4), chase(4), rand(4), atack(4), inert(4), mimic(4), flee(4), eitem(4), itemp(4), seedp(4), xper(16), spin(16), weapon(4), nbe(4), iactive(16), mx, my, store, debug, index$(30), scribe$(8), wbig, presp, conv, btog(8), inft#(10), inflict(8), infprob(10)
'DIM SHARED infplot(10), inftime(10), drain, pois#, font, csr2, levelup(4), csr(3), arm$(30), ix(40), iy(40), weps, arm, doom(150), take, inftemp(10), tempchp(4), descr$(20), ptr2, xaim(16), yaim(16), targx(10), targy(10), htarg(10), cant, look, o, cfull2, cfull3, tempc, tempe
'DIM SHARED boomf(10), r(10), code$, ivname$(40), ivuse$(40), ivpic(40), ivpal(40), ivcon(40), ivset(40), ranaset, ranapic, ranatemp, kp(15), kp$, rananice, begin$(250), cred, cred#, spinctr(4), fulpow(30), say(16), rate!

REM $STATIC
SUB align (o, x(), y(), speed())
IF x(o) / speed(o) <> INT(x(o) / speed(o)) THEN x(o) = INT(x(o) / speed(o)) * speed(o)
IF (y(o) - 15) / speed(o) <> INT((y(o) - 15) / speed(o)) THEN y(o) = (INT((y(o) - 15) / speed(o)) * speed(o)) + 15
END SUB

SUB allsprite (vframe(), d(), af(), aframe(), picset(), order(), boss(), btog(), bobpal(), pale(), x(), y(), placer(), ty(), dpage, big())
FOR i = 1 TO 4
vframe(i) = ((d(i) - 1) * 1250) + (af(aframe(i)) * 250)
NEXT
FOR i = 5 TO 8
vframe(i) = ((d(i) - 1) * 500) + (af(aframe(i)) * 250)
NEXT
FOR i = 9 TO 12
vframe(i) = (af(aframe(i)) * 250)
NEXT
l = 0: FOR i = 1 TO 12
IF picset(i) > 0 THEN l = l + 1: order(l) = i
NEXT
IF l > 1 THEN
 FOR j = 1 TO l - 1
 FOR i = 2 TO l + 1 - j
 IF y(order(i)) < y(order(i - 1)) THEN SWAP order(i), order(i - 1)
 NEXT: NEXT
 END IF
FOR j = 1 TO l
i = order(j)
IF boss(i) > 0 THEN loadsprite big(), btog(i) * 1250, (i - 1) * 8, 50, 50, 3: drawsprite big(), bobpal(), pale(i) * 16, x(i) - 12, y(i) - 25, dpage: GOTO dsp
loadsprite placer(), vframe(i), ty(i), 20, 25, 3
drawsprite placer(), bobpal(), pale(i) * 16, x(i), y(i) - 5, dpage
dsp: NEXT
END SUB

SUB bigsprite (buffer(), nice(), boss(), wbig, u)
setpicstuf buffer(), 2500, 3
FOR u = 1 TO 4
wbig = nice(u): IF wbig = 0 THEN wbig = wbig + boss(u)
IF wbig = 0 THEN GOTO bg1
loadset "data\big.mxs" + CHR$(0), wbig - 1, (u - 1) * 8
bg1: NEXT u
END SUB

SUB bossmeter (boss(), chp(), ap(), hp(), dpage)
FOR j = 2 TO 4
 IF boss(j) > 0 AND chp(j) > 0 AND ap(j) > 1 THEN
 divis = INT(hp(j) / 19) + 1
 textcolor 62, 0
 FOR i = 1 TO INT((chp(j) - 1) / divis) + 1: IF i = INT((chp(j) - 1) / divis) + 1 AND ((chp(j) / divis) <> INT(chp(j) / divis)) THEN textcolor 52 + (((chp(j) / divis) - INT(chp(j) / divis)) * 10), 0
 printstr CHR$(6), (j - 2) * 10, 20 + (9 * i), dpage
 NEXT
 END IF
NEXT
END SUB

SUB buyit (ptr, cmax, ptr3, seed(), price(), hp(), liup(), chp(), scure(), chup(), plot(), infplot(), inftemp(), sset1(), sset2(), inft#(), inftime())
seed(1) = seed(1) - price(ptr)
hp(1) = hp(1) + liup(ptr): hp(1) = SMALL(hp(1), 300)
chp(1) = chp(1) + scure(ptr): chp(1) = SMALL(hp(1), chp(1))
cmax = cmax + chup(ptr): cmax = SMALL(cmax, 20)
FOR j = 1 TO 6: IF plot(infplot(j)) = 1 THEN inftemp(j) = 1
NEXT j
IF sset1(ptr) > 0 THEN plot(ABS(sset1(ptr))) = 1
IF sset1(ptr) < 0 THEN plot(ABS(sset1(ptr))) = 0
IF sset2(ptr) > 0 THEN plot(ABS(sset2(ptr))) = 1
IF sset2(ptr) < 0 THEN plot(ABS(sset2(ptr))) = 0
ptr3 = 0
FOR j = 1 TO 6
IF plot(infplot(j)) = 1 AND inftemp(j) = 0 THEN inft#(j) = TIMER
IF plot(infplot(j)) = 0 AND inftemp(j) = 1 THEN inft#(j) = TIMER - inftime(j): plot(infplot(j)) = 1: IF j = 2 THEN plot(infplot(2)) = 0
inftemp(j) = 0: NEXT j
END SUB

SUB checkcon (plot(), ickcon(), mx, my, picset())
tmcur = ((my * 16) + mx)
IF ickcon((tmcur * 6) + 0) > 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 0))) = 0 THEN picset(2) = 0
IF ickcon((tmcur * 6) + 1) > 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 1))) = 0 THEN picset(3) = 0
IF ickcon((tmcur * 6) + 2) > 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 2))) = 0 THEN picset(4) = 0
IF ickcon((tmcur * 6) + 3) > 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 3))) = 0 THEN picset(2) = 0
IF ickcon((tmcur * 6) + 4) > 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 4))) = 0 THEN picset(3) = 0
IF ickcon((tmcur * 6) + 5) > 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 5))) = 0 THEN picset(4) = 0
IF ickcon((tmcur * 6) + 0) < 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 0))) = 1 THEN picset(2) = 0
IF ickcon((tmcur * 6) + 1) < 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 1))) = 1 THEN picset(3) = 0
IF ickcon((tmcur * 6) + 2) < 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 2))) = 1 THEN picset(4) = 0
IF ickcon((tmcur * 6) + 3) < 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 3))) = 1 THEN picset(2) = 0
IF ickcon((tmcur * 6) + 4) < 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 4))) = 1 THEN picset(3) = 0
IF ickcon((tmcur * 6) + 5) < 0 THEN IF plot(ABS(ickcon((tmcur * 6) + 5))) = 1 THEN picset(4) = 0
END SUB

SUB checkinf (o, plot(), infplot(), inf$(), dpage, speed(), inft#(), inftime(), picset(), pict(), ranatemp, ranaset, ranapic, rananice, nice(), pale(), ptemp(), pois#, drain, doom(), bobpal(), x(), y(), btog())
j = 20
FOR i = 1 TO 6: IF plot(infplot(i)) = 1 THEN printstr inf$(i), 160 - (LEN(inf$(i)) * 4), j, dpage: j = j + 8
NEXT i
IF plot(40) = 1 THEN CALL intox(speed(), inft#(), inftime(), picset(), pict(), plot()): IF plot(40) = 0 THEN o = 1: CALL align(o, x(), y(), speed())
IF plot(63) = 1 THEN CALL sloth(speed(), inft#(), inftime(), plot(), pict(), picset()): IF plot(63) = 0 THEN o = 1: CALL align(o, x(), y(), speed())
IF plot(64) = 1 THEN CALL toad(ranatemp, ranaset, ranapic, rananice, picset(), pict(), nice(), pale(), ptemp(), inft#(), inftime(), plot())
IF plot(62) = 1 THEN CALL poison(pois#, drain, pale(), inft#(), inftime(), plot(), picset(), pict())
IF plot(61) = 1 THEN CALL reaper(plot(), inft#(), inftime(), drain, doom(), bobpal(), x(), y(), btog(), dpage)
END SUB

SUB clock (rtime$)
IF VAL(MID$(TIME$, 1, 2)) > 11 THEN t1$ = "PM" ELSE t1$ = "AM"
t2 = VAL(MID$(TIME$, 1, 2)): IF t2 > 11 THEN t2 = t2 - 12
IF t2 = 0 THEN t2 = 12
t2$ = STR$(t2)
t3$ = MID$(TIME$, 4, 2)
rtime$ = t2$ + ":" + t3$ + t1$
END SUB

SUB debugest (code(), code$, plot(), seed(), store, boss(), debug, nice(), picset(), bobpal(), x(), y(), hp(), cmax, target(), allitems, inft#(), pict(), beat())
'IF keyval(0) > 1 AND keyval(0) < 58 THEN code(0) = keyval(0)
FOR i = 1 TO 58
 IF keyval(i) > 1 THEN code(o) = i
NEXT i
IF code(0) = code(1) THEN EXIT SUB
code$ = MID$(CHR$(code(0) + 30) + code$, 1, 16)
FOR k = 16 TO 1 STEP -1
code(k) = code(k - 1): NEXT k
plot(174) = 0: IF plot(51) = 1 THEN plot(174) = 1
IF MID$(code$, 1, 6) = "0PW3<7" THEN seed(1) = 100: plot(51) = 1
IF MID$(code$, 1, 8) = "25W>O07=" THEN store = 1
IF MID$(code$, 1, 13) = "<02W?6W267=W<" THEN FOR i = 41 TO 51: plot(i) = 1: NEXT: FOR i = 73 TO 78: plot(i) = 1: NEXT: plot(171) = 1: plot(173) = 1
IF MID$(code$, 1, 13) = "20@>5PW=4L15L" THEN boss(1) = boss(1) XOR 1
IF MID$(code$, 1, 11) = "146?W10NP4O" THEN debug = debug XOR 1: plot(51) = 1
IF MID$(code$, 1, 12) = "0PW10A26NW<3" THEN
 FOR k = 2 TO 4
 IF boss(k) = 0 AND nice(k) = 0 AND picset(k) > 0 THEN picset(k) = 0: drawsprite beat(), bobpal(), 32, x(k) - 2, y(k) + 8, 2
 NEXT k: plot(51) = 1
 END IF
IF MID$(code$, 1, 10) = "4162=0P6AL" THEN IF hp(1) < 200 THEN hp(1) = 200: plot(51) = 1
IF MID$(code$, 1, 15) = "24612W0A2WALO47" THEN IF cmax < 12 THEN cmax = 12: plot(51) = 1
IF MID$(code$, 1, 13) = "06?W025P=W06?" THEN
 plot(51) = 1
 FOR k = 2 TO 4
db1: randnum = INT(RND * 4)
 IF randnum + 1 = k THEN GOTO db1
 target(k) = randnum
 IF picset(target(k) + 1) = 0 THEN GOTO db1
 NEXT k
 END IF
IF MID$(code$, 1, 14) = "O/62W0=16AW0O6" THEN allitems = allitems XOR 1
IF MID$(code$, 1, 11) = "@O6=W107<01" THEN plot(61) = 1: inft#(2) = TIMER - 200
IF MID$(code$, 1, 11) = "7<1W<W=2<A2" THEN plot(157) = 1: plot(158) = 0: plot(51) = 1
IF MID$(code$, 2, 12) = "3?51@6P=O<12" AND code(13) < 12 THEN pict(1) = code(13) - 1: IF pict(1) = 10 THEN pict(1) = 0
END SUB

SUB dizzy (o, spinctr(), spin(), cfull2, d(), inuse(), x(), y())
spinctr(o - 4) = spinctr(o - 4) + 1: IF spinctr(o - 4) > spin(o + (8 * (SGN(cfull2)))) - 1 THEN spinctr(o - 4) = 0: spin(o - 4) = spin(o - 4) + 1: IF spin(o - 4) > 4 THEN spin(o - 4) = 1
d(o) = spin(o - 4)
IF inuse(o - 4) > 0 THEN d(o - 4) = spin(o - 4)
IF spin(o - 4) = 1 THEN x(o) = x(o - 4): y(o) = y(o - 4) - 20
IF spin(o - 4) = 2 THEN x(o) = x(o - 4) + 20: y(o) = y(o - 4)
IF spin(o - 4) = 3 THEN x(o) = x(o - 4): y(o) = y(o - 4) + 20
IF spin(o - 4) = 4 THEN x(o) = x(o - 4) - 20: y(o) = y(o - 4)
END SUB

SUB drawbox (sayx(), sayy(), sayw(), sayl(), dia(), dctr, dest, arg)
 b$ = CHR$(22)
 FOR j = 0 TO sayw(dia(dctr) + arg) + 1
 b$ = b$ + CHR$(23)
 NEXT j: b$ = b$ + CHR$(24)
 printstr b$, sayx(dia(dctr) + arg), sayy(dia(dctr) + arg), dest
FOR j = 0 TO sayl(dia(dctr) + arg) + 1
 b$ = CHR$(25)
 FOR jj = 0 TO sayw(dia(dctr) + arg) + 1
 b$ = b$ + CHR$(30)
 NEXT jj: b$ = b$ + CHR$(26)
 printstr b$, sayx(dia(dctr) + arg), sayy(dia(dctr) + arg) + (8 * j) + 8, dest
NEXT j
 b$ = CHR$(27)
 FOR j = 0 TO sayw(dia(dctr) + arg) + 1
 b$ = b$ + CHR$(28)
 NEXT j: b$ = b$ + CHR$(29)
 printstr b$, sayx(dia(dctr) + arg), sayy(dia(dctr) + arg) + (sayl(dia(dctr) + arg) * 8) + 24, dest
END SUB

SUB drawshop (font, dia(), sayx(), sayy(), sayw(), sayl(), stock, shx(), shy(), buffer(), spicset(), vpage, placer(), spict(), bobpal(), ptr, ptr2, ptr3, product$(), price(), seed(), descr$(), spale(), chp(), hp(), font(), dest, arg)
textcolor 15, 0
fontb = font: font = 6: CALL fontset(font, font()): font = fontb
 arg = 0: dctr = 0: dia(0) = 0
 sayx(0) = 8: sayy(0) = 4: sayw(0) = 34: sayl(0) = 4
 CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg)
 sayx(0) = 4: sayy(0) = 70: sayw(0) = 10: sayl(0) = 0
 CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg)
 sayx(0) = 116: sayy(0) = 70: sayw(0) = 9: sayl(0) = 0
 CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg)
 sayx(0) = 220: sayy(0) = 70: sayw(0) = 8: sayl(0) = 0
 CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg)
 sayx(0) = 4: sayy(0) = 104: sayw(0) = 35: sayl(0) = 0
 CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg)
 sayx(0) = 4: sayy(0) = 140: sayw(0) = 6: sayl(0) = 2
 CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg)
CALL fontset(font, font())
textcolor 16, 0
FOR j = 1 TO stock
IF shx(j) > 0 THEN
 loadpage buffer(), "data\item" + MID$(STR$(spicset(j)), 2, LEN(STR$(spicset(j))) - 1) + ".mxs" + CHR$(0), vpage
 loadsprite placer(), (spict(j) + 1) * 500, 0, 20, 25, vpage
 drawsprite placer(), bobpal(), 11 * 16, shx(j), shy(j), 3
 END IF
NEXT j
 printstr product$(ptr), 16, 82, 3
 printstr "Cost:" + STR$(price(ptr)), 129, 82, 3
 printstr STR$(seed(1)) + " " + CHR$(19), 226, 82, 3
 printstr descr$(ptr), 16, 116, 3
 printstr "SHOP", 27, 155, 3
 printstr "EXIT", 27, 165, 3
IF ptr3 = 0 AND ptr2 = 0 THEN textcolor 2, 0: printstr "SHOP", 28, 156, 3: textcolor 16, 0
IF ptr3 = 0 AND ptr2 = 1 THEN textcolor 2, 0: printstr "EXIT", 28, 166, 3: textcolor 16, 0
IF ptr3 = 1 THEN
 loadpage buffer(), "data\item" + MID$(STR$(spicset(ptr)), 2, LEN(STR$(spicset(ptr))) - 1) + ".mxs" + CHR$(0), vpage
 loadsprite placer(), (spict(ptr) + 1) * 500, 0, 20, 25, vpage
 drawsprite placer(), bobpal(), spale(ptr) * 16, shx(ptr), shy(ptr), 3
 textcolor 2, 0
 END IF
printstr "^", shx(ptr) + 8, shy(ptr) + 25, 3: textcolor 16, 0
textcolor 15, 17: printstr "&" + STR$(chp(1)) + "/" + RIGHT$(STR$(hp(1)), LEN(STR$(hp(1))) - 1), 100, 170, 3
END SUB

SUB eventitem (dia(), sayx(), sayy(), sayw(), sayl(), font, ivname$(), ivpic(), ivpal(), ivset(), ivcon(), ivuse$(), plot(), kp(), rate!, vpage, placer(), bobpal(), font(), buffer(), dpage)
dctr = 0: arg = 0: dia(0) = 0: ecsr = 0: j = 0: skip = 0: ivmax = 14
sayx(0) = 8: sayy(0) = 8: sayw(0) = 33: sayl(0) = 5
fontb = font: font = 4: CALL fontset(font, font()): font = fontb
textcolor 15, 0: CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg): textcolor 17, 0
CALL fontset(font, font())
DO
OPEN "data\event.dat" FOR INPUT AS #1
FOR k = 0 TO j + skip
INPUT #1, ivname$(j), ivpic(j), ivpal(j), ivset(j), ivuse$(j), ivcon(j)
NEXT k: CLOSE #1
IF plot(ABS(ivcon(j))) = 0 AND ivcon(j) > 0 THEN j = j - 1: ivmax = ivmax - 1: skip = skip + 1
j = j + 1: LOOP UNTIL j > ivmax
IF ecsr < ivmax THEN GOSUB ei1
setkeys
DO: setkeys
copypage 3, dpage
IF keyval(kp(1)) > 1 AND ecsr > 0 THEN playsnd 48, rate!: ecsr = ecsr - 1: fontb = font: font = 4: CALL fontset(font, font()): font = fontb: textcolor 15, 0: CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg): textcolor 17, 0: CALL  _
fontset(font, font()): IF ecsr < ivmax THEN GOSUB ei1
IF keyval(kp(2)) > 1 AND ecsr < ivmax THEN playsnd 48, rate!: ecsr = ecsr + 1: fontb = font: font = 4: CALL fontset(font, font()): font = fontb: textcolor 15, 0: CALL drawbox(sayx(), sayy(), sayw(), sayl(), dia(), dctr, 3, arg): textcolor 17, 0:  _
CALL fontset(font, font()): IF ecsr < ivmax THEN GOSUB ei1
IF (keyval(kp(12)) > 1 OR keyval(kp(13)) > 1) AND ecsr = ivmax THEN playsnd 49, rate!: EXIT SUB
IF keyval(kp(15)) > 1 THEN EXIT SUB
IF ecsr > 1 THEN printstr ivname$(ecsr - 2), 18, 16, 3
IF ecsr > 0 THEN printstr ivname$(ecsr - 1), 18, 24, 3
printstr ivname$(ecsr), 18, 32, 3: textcolor 2, 0
printstr ivname$(ecsr), 19, 33, 3: textcolor 17, 0
IF ecsr < ivmax THEN printstr ivname$(ecsr + 1), 18, 40, 3
IF ecsr < ivmax - 1 THEN printstr ivname$(ecsr + 2), 18, 48, 3
textcolor 1, 0: printstr ivuse$(ecsr), 18, 62, 3: textcolor 17, 0
LOOP
ei1:
loadpage buffer(), "data\item" + MID$(STR$(ivset(ecsr)), 2, LEN(STR$(ivset(ecsr))) - 1) + ".mxs" + CHR$(0), vpage
loadsprite placer(), (ivpic(ecsr) + 1) * 500, 0, 20, 25, vpage
drawsprite placer(), bobpal(), ivpal(ecsr) * 16, 230, 25, 3
RETURN
END SUB

SUB fontset (font, font())
DEF SEG = VARSEG(font(0)): BLOAD "data\font" + MID$(STR$(font), 2, LEN(STR$(font)) - 1) + ".bob", VARPTR(font(0))
setfont font()
END SUB

SUB getday (leap(), dbefore(), week$(), plot(), ts$, day$)
days = 0
days = days + INT(365.25 * (VAL(RIGHT$(DATE$, 4)) - 1995))
FOR i = 1 TO 12
IF VAL(MID$(DATE$, 1, 2)) = i THEN days = days + dbefore(i)
NEXT i
days = days + VAL(MID$(DATE$, 4, 2))
day$ = week$(days - (INT(days / 7) * 7))
FOR i = 33 TO 39: plot(i) = 0: NEXT
plot(33 + (days - (INT(days / 7) * 7))) = 1
ts$ = MID$(DATE$, 1, 5)
IF ts$ = "02-29" THEN day$ = "LeapYear"
IF ts$ = "12-25" THEN day$ = "Christmas"
IF ts$ = "10-31" THEN day$ = "Halloween"
IF ts$ = "02-19" THEN day$ = "My Birthday"
IF ts$ = "01-18" THEN day$ = "Hobgoblin Day"
IF ts$ = "04-01" THEN day$ = "Fool's Day"
IF DATE$ = "01-01-2000" THEN day$ = "New Millenium!"
IF RIGHT$(DATE$, 4) = "2020" THEN day$ = "Get a new game!"
END SUB

SUB hitit (i, o, aframe, aframe(), picset(), speed(), cfull2, stemp(), kd(), d(), kspeed(), knock(), say(), inuse(), ai1(), rate!, target(), defence(), chp(), hp(), drain, ap(), charge, absorb(), ahit)
hitit: IF i > 4 AND i < 9 THEN
 aframe = 0
 picset(i) = 0: picset(o) = 0: IF speed(o + (8 * (SGN(cfull2)))) > 0 OR speed(i) > 0 THEN EXIT SUB
 IF stemp(o - 4) > 0 OR stemp(i - 4) > 0 THEN EXIT SUB
 kd(i - 4) = d(i - 4) + 2: IF kd(i - 4) > 4 THEN kd(i - 4) = kd(i - 4) - 4
 kd(o - 4) = d(o - 4) + 2: IF kd(o - 4) > 4 THEN kd(o - 4) = kd(o - 4) - 4
 stemp(o - 4) = speed(o - 4): speed(o - 4) = kspeed(i): knock(o - 4) = 2
 stemp(i - 4) = speed(i - 4): speed(i - 4) = kspeed(o): knock(i - 4) = 2
 EXIT SUB
 END IF
IF i > 8 THEN picset(i) = 0: EXIT SUB
IF knock(i + (8 * (SGN(cfull2)))) <> 0 THEN EXIT SUB
IF say(i) > 0 AND inuse(i) = 0 AND ai1(o) <> i THEN ai1(o) = i: playsnd say(i), rate!
IF o > 5 AND i > 1 THEN
 IF speed(o + (8 * (SGN(cfull2)))) = 0 THEN knock(o - 4) = 2: kd(o - 4) = d(o - 4) + 2: IF kd(o - 4) > 4 THEN kd(o - 4) = kd(o - 4) - 4
 IF speed(o + (8 * (SGN(cfull2)))) = 0 THEN IF stemp(o - 4) = 0 THEN stemp(o - 4) = speed(o - 4): speed(o - 4) = speed(o - 4) * 2
 IF i = target(o - 4) + 1 THEN GOTO ht1
 EXIT SUB
 END IF
 otemp = o + (8 * (SGN(cfull2)))
IF defence(otemp) = 4 OR defence(i) = 0 OR (i > 8 AND i < 13) THEN GOTO ht1
 IF defence(otemp) <> defence(i) AND speed(o + (8 * (SGN(cfull2)))) = 0 THEN knock(o - 4) = 2: kd(o - 4) = d(o - 4) + 2: IF kd(o - 4) > 4 THEN kd(o - 4) = kd(o - 4) - 4
 IF defence(otemp) <> defence(i) AND speed(o + (8 * (SGN(cfull2)))) = 0 THEN IF stemp(o - 4) = 0 THEN stemp(o - 4) = speed(o - 4): speed(o - 4) = speed(o - 4) * 2
 IF defence(otemp) <> defence(i) THEN EXIT SUB
ht1: SWAP o, i
aframe(o) = 6: IF knock(i + (8 * (SGN(cfull2)))) = 0 AND chp(o) < 1 THEN picset(o) = 0
IF o = 1 THEN drain = drain + ap(i - 4): drain = drain - absorb(i + (8 * (SGN(cfull2))))
IF o <> 1 THEN chp(o) = chp(o) - (ap(i - 4) + charge): chp(i - 4) = chp(i - 4) + absorb(i + (8 * (SGN(cfull2)))): chp(i - 4) = SMALL(hp(i - 4), chp(i - 4))
IF inuse(o) < 1 THEN knock(o) = knock(i + (8 * (SGN(cfull2)))): kd(o) = d(i): aframe(o) = 6: IF knock(o) > 0 AND stemp(o) = 0 THEN stemp(o) = speed(o): speed(o) = kspeed(i + (8 * (SGN(cfull2))))
IF o = 1 THEN ahit = 1
SWAP o, i
END SUB

SUB inform (mx, my, plot(), dpage, x(), y(), pict(), pale(), speed(), code$, absorb(), ickcon(), pal$, charge, inuse(), code(), weapon(), target())
 tmcur = ((my * 16) + mx)
 printstr STR$(plot(1)), 0, 30, dpage
 printstr STR$(plot(2)), 0, 38, dpage
 printstr STR$(plot(3)), 0, 46, dpage
 printstr STR$(plot(4)), 0, 54, dpage
 printstr STR$(plot(5)), 0, 62, dpage
 printstr STR$(plot(6)), 0, 70, dpage
 printstr STR$(plot(7)), 0, 78, dpage
 printstr STR$(plot(8)), 0, 86, dpage
 printstr STR$(plot(9)), 0, 94, dpage
 printstr STR$(plot(10)), 0, 102, dpage
 printstr "X" + STR$(x(1)), 0, 110, dpage
 printstr "Y" + STR$(y(1)), 0, 118, dpage
 printstr "MX" + STR$(mx), 0, 126, dpage
 printstr "MY" + STR$(my), 0, 134, dpage
 printstr STR$(keyval(0)), 0, 142, dpage
 printstr "Pic:" + STR$(pict(1)), 0, 150, dpage
 printstr "Pal:" + STR$(pale(1)), 0, 158, dpage
 printstr "Speed:" + STR$(speed(1)), 0, 166, dpage
 printstr "Code:" + code$, 0, 174, dpage
 printstr "Drain:" + STR$(absorb(5)), 0, 182, dpage
 IF plot(27) = 1 THEN printstr "Day", 0, 190, dpage
 IF plot(27) = 0 THEN printstr "Night", 0, 190, dpage
 printstr "2:" + STR$(ickcon((tmcur * 6) + 0)), 30, 30, dpage
 printstr "2:" + STR$(ickcon((tmcur * 6) + 3)), 30, 38, dpage
 printstr "3:" + STR$(ickcon((tmcur * 6) + 1)), 30, 46, dpage
 printstr "3:" + STR$(ickcon((tmcur * 6) + 4)), 30, 54, dpage
 printstr "4:" + STR$(ickcon((tmcur * 6) + 2)), 30, 62, dpage
 printstr "4:" + STR$(ickcon((tmcur * 6) + 5)), 30, 70, dpage
 printstr "Hour:" + STR$(VAL(MID$(TIME$, 1, 2))), 30, 78, dpage
 printstr "MasterPal:" + pal$, 30, 86, dpage
 printstr "Charge:" + STR$(charge), 30, 94, dpage
 printstr "E1:" + STR$(inuse(2)), 40, 102, dpage
 printstr "E2:" + STR$(inuse(3)), 40, 110, dpage
 printstr "E3:" + STR$(inuse(4)), 40, 118, dpage
 printstr "Code13:" + STR$(code(13)), 90, 30, dpage
 IF plot(169) = 1 THEN printstr "Lycanthropy Active", 64, 190, dpage
 printstr "Ewep1:" + STR$(weapon(2)), 90, 38, dpage
 printstr "Ewep2:" + STR$(weapon(3)), 90, 46, dpage
 printstr "Ewep3:" + STR$(weapon(4)), 90, 54, dpage
 printstr "Targ1:" + STR$(target(2)), 90, 62, dpage
 printstr "Targ2:" + STR$(target(3)), 90, 70, dpage
 printstr "Targ3:" + STR$(target(4)), 90, 78, dpage
END SUB

SUB intox (speed(), inft#(), inftime(), picset(), pict(), plot())
speed(1) = INT(RND * 10) + 1
IF TIMER - inft#(3) > inftime(3) THEN
 speed(1) = 4: IF picset(1) = 1 AND pict(1) = 3 THEN speed(1) = 2
 plot(40) = 0
 END IF
END SUB

SUB itemscon (plot(), itset(), picset(), iactive(), mx, my)
tmcur = ((my * 16) + mx)
DEF SEG = VARSEG(itset(0)): BLOAD "data\itemcon.dat", VARPTR(itset(0))
IF itset((tmcur * 8) + 0) > 0 THEN IF plot(ABS(itset((tmcur * 8) + 0))) = 0 THEN picset(9) = 0
IF itset((tmcur * 8) + 1) > 0 THEN IF plot(ABS(itset((tmcur * 8) + 1))) = 0 THEN picset(10) = 0
IF itset((tmcur * 8) + 2) > 0 THEN IF plot(ABS(itset((tmcur * 8) + 2))) = 0 THEN picset(11) = 0
IF itset((tmcur * 8) + 3) > 0 THEN IF plot(ABS(itset((tmcur * 8) + 3))) = 0 THEN picset(12) = 0
IF itset((tmcur * 8) + 4) > 0 THEN IF plot(ABS(itset((tmcur * 8) + 4))) = 0 THEN picset(9) = 0
IF itset((tmcur * 8) + 5) > 0 THEN IF plot(ABS(itset((tmcur * 8) + 5))) = 0 THEN picset(10) = 0
IF itset((tmcur * 8) + 6) > 0 THEN IF plot(ABS(itset((tmcur * 8) + 6))) = 0 THEN picset(11) = 0
IF itset((tmcur * 8) + 7) > 0 THEN IF plot(ABS(itset((tmcur * 8) + 7))) = 0 THEN picset(12) = 0
IF itset((tmcur * 8) + 0) < 0 THEN IF plot(ABS(itset((tmcur * 8) + 0))) = 1 THEN picset(9) = 0
IF itset((tmcur * 8) + 1) < 0 THEN IF plot(ABS(itset((tmcur * 8) + 1))) = 1 THEN picset(10) = 0
IF itset((tmcur * 8) + 2) < 0 THEN IF plot(ABS(itset((tmcur * 8) + 2))) = 1 THEN picset(11) = 0
IF itset((tmcur * 8) + 3) < 0 THEN IF plot(ABS(itset((tmcur * 8) + 3))) = 1 THEN picset(12) = 0
IF itset((tmcur * 8) + 4) < 0 THEN IF plot(ABS(itset((tmcur * 8) + 4))) = 1 THEN picset(9) = 0
IF itset((tmcur * 8) + 5) < 0 THEN IF plot(ABS(itset((tmcur * 8) + 5))) = 1 THEN picset(10) = 0
IF itset((tmcur * 8) + 6) < 0 THEN IF plot(ABS(itset((tmcur * 8) + 6))) = 1 THEN picset(11) = 0
IF itset((tmcur * 8) + 7) < 0 THEN IF plot(ABS(itset((tmcur * 8) + 7))) = 1 THEN picset(12) = 0
DEF SEG = VARSEG(itset(0)): BLOAD "data\itemset.dat", VARPTR(itset(0))
FOR i = 1 TO 4
IF iactive(i) = 1 THEN picset(i + 8) = 0
NEXT
END SUB

FUNCTION LARGE (n1, n2)
LARGE = n1
IF n2 > n1 THEN LARGE = n2
END FUNCTION

SUB loadstock (inum(), product$(), spict(), spale(), spicset(), scure(), chup(), liup(), sset1(), sset2(), shx(), shy(), apear1(), apear2(), plot(), ptr, stock)
x = 20: y = 18
FOR b = 1 TO stock
OPEN "data\item.dat" FOR INPUT AS #1
j = 1: WHILE inum(b) > j
FOR o = 1 TO 17
INPUT #1, nil$
NEXT o: j = j + 1: WEND
INPUT #1, product$(b), nil$, spict(b), spale(b), spicset(b), scure(b), nil$, nil$, chup(b), liup(b), nil$, nil$, nil$, sset1(b), sset2(b), nil$, nil$
shx(b) = 0: shy(b) = 0
IF apear1(b) > 0 AND plot(ABS(apear1(b))) = 0 THEN GOTO ls1
IF apear1(b) < 0 AND plot(ABS(apear1(b))) = 1 THEN GOTO ls1
IF apear2(b) > 0 AND plot(ABS(apear2(b))) = 0 THEN GOTO ls1
IF apear2(b) < 0 AND plot(ABS(apear2(b))) = 1 THEN GOTO ls1
shx(b) = x: shy(b) = y: x = x + 28
ls1: CLOSE #1
NEXT b
WHILE shx(ptr) < 10: ptr = ptr - 1: IF ptr < 1 THEN ptr = stock
WEND
END SUB

SUB menu (menuset() AS STRING, menuc, visrows, menux, menuy, menup, skip, csrcol, txtcol)
textcolor txtcol, 0
ulim = LARGE(0, menuc - (visrows - 1))
FOR i = 0 TO visrows - 1
textcolor txtcol, 0
printstr menuset(i + ulim), menux, menuy + (i * skip), menup
textcolor csrcol, 0
IF menuc = i + ulim THEN printstr ">", menux - 10, menuy + (i * skip), menup
NEXT i
textcolor txtcol, 0
END SUB

SUB newscreen (plot(), picset(), pict(), nice(), targ(), leap(), dbefore(), week$(), ts$, day$, timeoday, pal$, needf, mainpal(), hnb, chp(), hp(), ap(), nbhp(), nba(), xyc(), room(), mx, my, set, mapset(), buffer(), blocker(), chroma(), dpage,  _
vpage, ickcon(), itset(), iactive(), name$(), oddpal, speed())
IF plot(169) = 1 THEN weirset plot(), picset(), pict(), nice()
DEF SEG = VARSEG(targ(0)): BLOAD "data\target.bob", VARPTR(targ(0))
CALL getday(leap(), dbefore(), week$(), plot(), ts$, day$)
CALL timeofday(timeoday, plot(), pal$, needf, mainpal(), hnb, chp(), hp(), ap(), nbhp(), nba())
FOR i = 1 TO 12: xyc(i) = 0: NEXT i
loadrow room(), my, mx
loadscreen set, mapset(), mx, my, buffer()
drawmap room(), blocker(), chroma(), dpage, vpage
charload
checkcon plot(), ickcon(), mx, my, picset()
itemscon plot(), itset(), picset(), iactive(), mx, my
printstr name$(5), 320 - (8 * LEN(name$(5))), 0, 2
IF (oddpal AND 1) = 1 THEN pal$ = "1": sethepal mainpal(), pal$, needf
corspeed speed(), pict(), picset(), plot()
needf = 0
END SUB