'$DYNAMIC
'$INCLUDE: 'c:\qb45\qb.bi'
DIM SHARED inregs AS RegType, outregs AS RegType
DIM spritesub%(200), block%(30601), r%(255), g%(255), B%(255), mp%(51200 / 2), cr%(150), pl%(200), pl2%(200)
DIM obt%(8, 16, 16), obx%(8, 16, 16), oby%(8, 16, 16)
SCREEN 13
PALETTE 0, 0
DEF SEG = VARSEG(block%(0))
BLOAD "forest.pic", 0
OPEN "forest.pll" FOR BINARY AS #1
rc% = 0
FOR a% = 0 TO 255
rc% = rc% + 1: GET #1, rc%, r%(a%)
rc% = rc% + 1: GET #1, rc%, g%(a%)
rc% = rc% + 1: GET #1, rc%, B%(a%)
r%(a%) = r%(a%) AND 255
g%(a%) = g%(a%) AND 255
B%(a%) = B%(a%) AND 255
NEXT
CLOSE #1
FOR a% = 0 TO 255
PALETTE a%, r%(a%) + g%(a%) * 256 + B%(a%) * 65536
NEXT
PALETTE 0, 0
LINE (0, 0)-(15, 15), 16, BF
GET (0, 0)-(15, 15), cr%
CLS
main:
PUT (x * 16, y * 16), cr%, XOR
DO
a$ = INPUT$(1)
PUT (x * 16, y * 16), cr%, XOR
IF a$ = "i" AND y > 0 THEN y = y - 1
IF a$ = "m" AND y < 9 THEN y = y + 1
IF a$ = "j" AND x > 0 THEN x = x - 1
IF a$ = "k" AND x < 19 THEN x = x + 1
IF a$ = "o" THEN GOSUB ovvw
IF a$ = "1" THEN cnvrt% = 1: GOSUB ovvw: cnvrt% = 0
IF a$ = "y" AND sy > 0 THEN sy = sy - 1: GOSUB scrnupdt
IF a$ = "b" AND sy < 150 THEN sy = sy + 1: GOSUB scrnupdt
IF a$ = "g" AND sx > 0 THEN sx = sx - 1: GOSUB scrnupdt
IF a$ = "h" AND sx < 300 THEN sx = sx + 1: : GOSUB scrnupdt
IF a$ = "`" THEN SCREEN 0: WIDTH 80: SHELL "c:\sc400\cdplay": SCREEN 13: GOSUB updatepal: GOSUB scrnupdt
IF a$ = "p" THEN GOSUB palchoose
IF a$ = "w" THEN pl2%(bln%) = 1
IF a$ = "W" THEN pl2%(bln%) = 0
IF a$ = "r" THEN pl2%(bln%) = 2
IF a$ = "e" THEN GOSUB enemy
IF a$ = "q" THEN CLOSE : END
IF a$ = "f" THEN GOSUB fill
IF a$ = "0" THEN GOSUB grasser
IF a$ = "[" THEN GOSUB convert
IF a$ = "," THEN bln% = bln% - 1
IF a$ = "." THEN bln% = bln% + 1
IF a$ = " " THEN cc = cc XOR 1
IF bln% < 0 THEN bln% = 199
IF bln% > 199 THEN bln% = 0
sx% = 0: sy% = 180: n% = bln%: GOSUB putsprite
IF a$ = "d" OR cc = 1 THEN GOSUB putmap
IF a$ = "s" THEN GOSUB savemap
IF a$ = "l" THEN GOSUB loadmap
PUT (x * 16, y * 16), cr%, XOR
LOOP

convert:
DEF SEG = VARSEG(mp%(0))
CLS
FOR x1 = 0 TO 15
FOR y1 = 0 TO 15
FOR x2 = 0 TO 19
FOR y2 = 0 TO 9
PSET (x1 * 20 + x2, y1 * 10 + y2), PEEK(((y1 * 16 + x1) * 200) + (y2 * 20 + x2))
NEXT: NEXT: NEXT: NEXT
nlp& = 0
FOR y = 0 TO 159
FOR x = 0 TO 319
POKE nlp&, POINT(x, y)
nlp& = nlp& + 1
NEXT: NEXT
GOSUB savemap
END

palchoose:
WHILE a$ <> CHR$(13)
a$ = INPUT$(1)
IF a$ = "," AND ccc% > 0 THEN ccc% = ccc% - 1
IF a$ = "." AND ccc% < 255 THEN ccc% = ccc% + 1
LINE (0, 199)-(319, 199), ccc%
WEND
pl%(bln%) = ccc%
RETURN

bush:
obln% = bln%
xx = x: yy = y
GOSUB putmap
x = xx + 1: y = yy: bln% = bln% + 1: GOSUB putmap
x = xx: y = yy + 1: bln% = bln% + 1: GOSUB putmap
x = xx + 1: y = yy + 1: bln% = bln% + 1: GOSUB putmap
bln% = obln%: y = yy: xx = x
RETURN

fill:
FOR x = 0 TO 19
FOR y = 0 TO 9
GOSUB putmap
NEXT
NEXT
x = 0: y = 0
RETURN

updatepal:
FOR a% = 0 TO 255
PALETTE a%, r%(a%) + g%(a%) * 256 + B%(a%) * 65536
NEXT
RETURN

grasser:
bbln% = bln%
FOR x = 0 TO 19
FOR y = 0 TO 9
GOSUB peekmap
IF bln% = 0 THEN
IF RND * 3 > 2 THEN bln% = 138
IF RND * 3 > 2 THEN bln% = 139
END IF
GOSUB putmap
NEXT
NEXT
x = 0: y = 0
RETURN

putmap:
sx% = x * 16: sy% = y * 16: n% = bln%: GOSUB putsprite
DEF SEG = VARSEG(mp%(0))
POKE (((sy + y) * 320) + sx + x), bln%
DEF SEG
RETURN

peekmap:
DEF SEG = VARSEG(mp%(0))
bln% = PEEK(((sy + y) * 320) + sx + x)
DEF SEG
RETURN

scrnupdt:
DEF SEG = VARSEG(mp%(0))
FOR cx = 0 TO 19
FOR cy = 0 TO 9
bb% = PEEK(((sy + cy) * 320) + sx + cx)
sx% = cx * 16: sy% = cy * 16: n% = bb%: GOSUB putsprite
NEXT
NEXT
RETURN

dispblks:
pln% = 0
CLS
FOR y = 0 TO 6
FOR x = 0 TO 19
IF pln% > 127 THEN RETURN
sx% = x * 20: sy% = y * 16 + 50: n% = pln%: GOSUB putsprite
pln% = pln% + 1
NEXT: NEXT
RETURN

savemap:
LOCATE 20: INPUT "File"; f$
DEF SEG = VARSEG(mp%(0))
BSAVE f$, VARPTR(mp%(0)), VARPTR(mp%(0)) + 51200
DEF SEG
GOSUB scrnupdt
OPEN "ovpltt.dat" FOR OUTPUT AS #1
FOR a = 0 TO 200
WRITE #1, pl%(a)
NEXT
CLOSE #1
OPEN "blktyp.dat" FOR OUTPUT AS #1
FOR a = 0 TO 127
WRITE #1, pl2%(a)
NEXT
CLOSE #1
OPEN "enmylocs.dat" FOR OUTPUT AS #1
FOR x% = 1 TO 16
FOR y% = 1 TO 16
FOR a% = 1 TO 8
WRITE #1, obt%(a%, x%, y%)
WRITE #1, obx%(a%, x%, y%)
WRITE #1, oby%(a%, x%, y%)
NEXT: NEXT: NEXT
CLOSE #1
RETURN

loadmap:
LOCATE 20: INPUT "File"; f$
DEF SEG = VARSEG(mp%(0))
BLOAD f$, VARPTR(mp%(0))
DEF SEG
GOSUB scrnupdt
OPEN "ovpltt.dat" FOR INPUT AS #1
FOR a = 0 TO 200
INPUT #1, pl%(a)
NEXT
CLOSE #1
OPEN "blktyp.dat" FOR INPUT AS #1
FOR a = 0 TO 127
INPUT #1, pl2%(a)
NEXT
CLOSE #1
RETURN

cblck:
CLS
GOSUB dispblks
cx = 0: cy = 0
PUT (cx * 16, cy * 16 + 50), cr%, XOR
DO
a$ = INPUT$(1)
PUT (cx * 16, cy * 16 + 50), cr%, XOR
IF a$ = "i" AND cy > 0 THEN cy = cy - 1
IF a$ = "m" AND cy < 6 THEN cy = cy + 1
IF a$ = "j" AND cx > 0 THEN cx = cx - 1
IF a$ = "k" AND cx < 19 THEN cx = cx + 1
IF a$ = "c" THEN bln% = cy * 20 + cx: CLS : GOSUB scrnupdt: RETURN
PUT (cx * 16, cy * 16 + 50), cr%, XOR
LOOP

ovvw:
DEF SEG = VARSEG(mp%(0))
FOR a% = 0 TO 199
PALETTE a%, r%(pl%(a%)) + g%(pl%(a%)) * 256 + B%(pl%(a%)) * 65536
NEXT
CLS
FOR x1 = 0 TO 319
FOR y1 = 0 TO 159
a$ = INKEY$: IF a$ <> "" THEN GOSUB scrnupdt: RETURN
PSET (x1, y1), PEEK((y1 * 320) + x1)
NEXT: NEXT
a$ = ""
WHILE a$ <> CHR$(13)
PSET (msx, msy), oc%
a$ = INKEY$
mmsk = msk
GOSUB mouseget
IF msk = 1 AND mmsk = 0 THEN xx = msx: yy = msy
IF msk = 1 THEN LINE (xx, yy)-(msx, msy), bln%: xx = msx: yy = msy
IF a$ = "," THEN bln% = bln% - 1
IF a$ = "." THEN bln% = bln% + 1
IF a$ = "f" THEN PAINT (msx, msy), bln%
IF a$ = "1" THEN GOSUB forest
IF bln% < 0 THEN bln% = 199
IF bln% > 199 THEN bln% = 0
sx% = 0: sy% = 180: n% = bln%: GOSUB putsprite
oc% = POINT(msx, msy)
PSET (msx, msy), 15
WEND
FOR x1 = 0 TO 319
FOR y1 = 0 TO 159
POKE (y1 * 320) + x1, POINT(x1, y1)
NEXT: NEXT
GOSUB updatepal
GOSUB scrnupdt
RETURN

forest:
FOR x% = 0 TO 319
FOR y% = 0 TO 159
erc% = erc% XOR 1
IF POINT(x%, y%) = 24 THEN PSET (x%, y%), 24 + erc%
NEXT
erc% = erc% XOR 1
NEXT
RETURN

mdoor:
IF dn% = 1 THEN GOTO othdr
dsx = sx: dsy = sy: dy = y: dx = x
INPUT "Type #"; typn%
dn% = 1
GOSUB scrnupdt
RETURN
othdr:
WRITE #2, typn%, dsx, dsy, dx, dy, sx, sy, x, y
dn% = 0
RETURN

enemy:
INPUT "Enemy number to change"; en%
INPUT "Enemy number to make"; enm%
obt%(en%, sx, sy) = enm%
obx%(en%, sx, sy) = x
oby%(en%, sx, sy) = y
GOSUB scrnupdt
RETURN

putsprite:
PUT (sx%, sy%), block%(n% * 130), PSET
RETURN

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

peekloc:
o& = (PEEK(aa%) AND 255)
o& = o& + PEEK(aa% + 1) * 256
RETURN

mouseget:
inregs.ax = 3
CALL interrupt(&H33, inregs, outregs)
msx = outregs.cx / 2
msy = outregs.dx
msk = outregs.bx
RETURN

showmouse:
inregs.ax = 1
CALL interrupt(&H33, inregs, outregs)
RETURN

hidemouse:
inregs.ax = 2
CALL interrupt(&H33, inregs, outregs)
RETURN