'$DYNAMIC
'$INCLUDE: 'c:\qb45\qb.bi'
DIM SHARED inregs AS RegType, outregs AS RegType
DIM gbuf%(32100), mapbuf%(32100), blkbuf%(32100)
DIM rt1%(1000), rt2%(1000)
DIM cl%(15, 15)
DIM rc%(255), gc%(255), bc%(255)
SCREEN 13
DEF SEG = VARSEG(blkbuf%(0))
BLOAD "game1.pic", 0
DEF SEG = VARSEG(mapbuf%(0))
BLOAD "game1.lvl", 0

GOSUB setg
OPEN "game1.pll" FOR BINARY AS #1
rc% = 0
FOR a% = 0 TO 255
rc% = rc% + 1: GET #1, rc%, rrc%
rc% = rc% + 1: GET #1, rc%, rgc%
rc% = rc% + 1: GET #1, rc%, rbc%
rrc% = rrc% AND 255
rgc% = rgc% AND 255
rbc% = rbc% AND 255
PALETTE a%, rrc% + rgc% * 256 + rbc% * 65536
NEXT
CLOSE #1

DEF SEG = VARSEG(rt1%(0))
a% = 3
o& = VARSEG(gbuf%(0))
GOSUB pokeloc
DEF SEG = VARSEG(rt2%(0))
a% = 3
o& = VARSEG(gbuf%(0))
GOSUB pokeloc
a% = 5
o& = VARSEG(mapbuf%(0))
GOSUB pokeloc
a% = 7
o& = VARSEG(blkbuf%(0))
GOSUB pokeloc
maxmpx% = 150
maxmpy% = 20
c% = 1

DO
GOSUB mouseget
IF msk = 2 THEN
msx1 = (msx / 320) * maxmpx% * 16
msy1 = (msy / 200) * maxmpy% * 16
END IF
IF msk = 1 THEN
DEF SEG = VARSEG(mapbuf%(0))
POKE FIX((msy1 / 16) + ((msy - 16) / 16)) * maxmpx% + FIX((msx1 / 16) + ((msx - 16) / 16)), c%
END IF
a$ = INKEY$
IF a$ = "," THEN c% = c% - 1
IF a$ = "." THEN c% = c% + 1
IF a$ = "s" THEN
DEF SEG = VARSEG(mapbuf%(0))
BSAVE "game1.lvl", 0, 6100
END IF
IF a$ = "i" AND msy1 > 0 THEN msy1 = msy1 - 16
IF a$ = "m" AND msy1 < (maxmpy% * 16) - 10 THEN msy1 = msy1 + 16
IF a$ = "j" AND msx1 > 0 THEN msx1 = msx1 - 16
IF a$ = "k" AND msx1 < (maxmpx% * 16) - 20 THEN msx1 = msx1 + 16
IF mpx% < msx1 THEN mpx% = mpx% + ((msx1 - mpx%) / 5) + 1
IF mpy% < msy1 THEN mpy% = mpy% + ((msy1 - mpy%) / 5) + 1
IF mpx% > msx1 THEN mpx% = mpx% + ((msx1 - mpx%) / 5) - 1
IF mpy% > msy1 THEN mpy% = mpy% + ((msy1 - mpy%) / 5) - 1
GOSUB mapback
GOSUB pageup
LOOP

mapback:
DEF SEG = VARSEG(rt2%(0))
a% = 9
o& = mpx%
GOSUB pokeloc
a% = 11
o& = mpy%
GOSUB pokeloc
a% = 13
o& = maxmpx%
GOSUB pokeloc
CALL ABSOLUTE(0)
RETURN

pageup:
DEF SEG = VARSEG(rt1%(0))
CALL ABSOLUTE(0)
RETURN

pokeloc:
POKE a%, o& AND 255
POKE a% + 1, (o& AND 65280) / 256
RETURN

setg:
fl& = 0
OPEN "vga1.com" FOR BINARY AS #1
DEF SEG = VARSEG(rt1%(0))
WHILE EOF(1) = 0
fl& = fl& + 1
GET #1, fl&, nm%
nm% = nm% AND 255
POKE fl& - 1, nm%
WEND
CLOSE #1
fl& = 0
OPEN "vga3.com" FOR BINARY AS #1
DEF SEG = VARSEG(rt2%(0))
WHILE EOF(1) = 0
fl& = fl& + 1
GET #1, fl&, nm%
nm% = nm% AND 255
POKE fl& - 1, nm%
WEND
CLOSE #1
RETURN

mouseget:
inregs.ax = 3
PSET (msx, msy), 15 XOR POINT(msx, msy)
CALL INTERRUPT(&H33, inregs, outregs)
msx = outregs.cx / 2
msy = outregs.dx
msk = outregs.bx
LOCATE 22: PRINT msx, msy
PSET (msx, msy), 15 XOR POINT(msx, msy)
RETURN