' Worm game
' by Svjatoslav Agejenko 2002

DECLARE FUNCTION cnum$ (a%)
DECLARE SUB putworm (a%)
DECLARE SUB level (a%)
DECLARE SUB showb ()
DECLARE SUB sc2 (x%, y%)
DECLARE SUB ai (a%)
DECLARE SUB autop (a%)
DECLARE SUB stat ()
DECLARE SUB prc (a%)
DECLARE SUB stuff ()
DECLARE SUB dead (a%)
DECLARE SUB add (a%)
DECLARE SUB tkt ()
DECLARE SUB subt (b%)
DECLARE SUB show ()
DECLARE SUB start ()
DECLARE SUB init ()
DECLARE SUB sc (x%, y%)
DEFINT A-Z

DIM SHARED buf(0 TO 36, 0 TO 36)
DIM SHARED buf2(0 TO 36, 0 TO 36)
DIM SHARED ussx(1 TO 2000, 1 TO 5)
DIM SHARED ussy(1 TO 2000, 1 TO 5)
DIM SHARED ussp(1 TO 5)
DIM SHARED ussl(1 TO 5)
DIM SHARED usss(1 TO 5)
DIM SHARED ussk(1 TO 2000, 1 TO 5)
DIM SHARED usskp(1 TO 5)

DIM SHARED ux(1 TO 5), uy(1 TO 5), uxp(1 TO 5), uyp(1 TO 5)
DIM SHARED mtm
DIM SHARED ussm
DIM SHARED elud(1 TO 5)
DIM SHARED auto(1 TO 5)
DIM SHARED ail, lvl, wai
DIM SHARED elum
DIM SHARED spd

ussm = 1
ail = 10
lvl = 1
wai = 0
wai = 20


auto(1) = 0
auto(2) = 0
auto(3) = 0
auto(4) = 0
auto(5) = 0
CLS

INPUT "How mutch players 1 - 5:", ussm
INPUT "How mutch of them is computers:", a
FOR b = ussm TO ussm - a + 1 STEP -1
auto(b) = 1
NEXT b

INPUT "How mutch lives:", elum
INPUT "Speed: (1-slow 3-ok 10-very fast)", spd


start

level lvl
1
tkt
SOUND 0, 5 / spd
IF mtm >= 15 THEN
mtm = 1
lvl = lvl + 1
level lvl
END IF
GOTO 1

SUB ai (a)


FOR y = 0 TO 36
FOR x = 0 TO 36
buf2(x, y) = 32000
IF buf(x, y) = 2 THEN buf2(x, y) = 0
IF buf(x, y) > 9 OR buf(x, y) = 1 THEN buf2(x, y) = -1
NEXT x
NEXT y

IF buf2(16, 16) = 32000 THEN buf2(16, 16) = 15000


6
b = 0
FOR y = 1 TO 35
FOR x = 1 TO 34
IF (buf2(x + 1, y) > buf2(x, y) + 1) AND (buf2(x, y) >= 0) THEN buf2(x + 1, y) = buf2(x, y) + 1: b = 1
NEXT x
FOR x = 35 TO 2 STEP -1
IF (buf2(x - 1, y) > buf2(x, y) + 1) AND (buf2(x, y) >= 0) THEN buf2(x - 1, y) = buf2(x, y) + 1: b = 1
NEXT x

IF (buf2(1, y) > buf2(35, y) + 1) AND (buf2(35, y) >= 0) THEN buf2(1, y) = buf2(35, y) + 1: b = 1
IF (buf2(35, y) > buf2(1, y) + 1) AND (buf2(1, y) >= 0) THEN buf2(35, y) = buf2(1, y) + 1: b = 1
NEXT y

FOR x = 1 TO 35
FOR y = 1 TO 34
IF (buf2(x, y + 1) > buf2(x, y) + 1) AND (buf2(x, y) >= 0) THEN buf2(x, y + 1) = buf2(x, y) + 1: b = 1
NEXT y
FOR y = 35 TO 2 STEP -1
IF (buf2(x, y - 1) > buf2(x, y) + 1) AND (buf2(x, y) >= 0) THEN buf2(x, y - 1) = buf2(x, y) + 1: b = 1
NEXT y


IF (buf2(x, 1) > buf2(x, 35) + 1) AND (buf2(x, 35) >= 0) THEN buf2(x, 1) = buf2(x, 35) + 1: b = 1
IF (buf2(x, 35) > buf2(x, 1) + 1) AND (buf2(x, 1) >= 0) THEN buf2(x, 35) = buf2(x, 1) + 1: b = 1
NEXT x

IF b = 1 THEN GOTO 6

tx = ux(a)
ty = uy(a)
'sc2 tx, ty

d = 0
7
b = 32001
tmpxp = 0
tmpyp = 0
IF (buf2(tx - 1, ty) < b) AND (buf2(tx - 1, ty) >= 0) THEN b = buf2(tx - 1, ty): tmpxp = -1: tmpyp = 0: c = 1
IF (buf2(tx, ty - 1) < b) AND (buf2(tx, ty - 1) >= 0) THEN b = buf2(tx, ty - 1): tmpxp = 0: tmpyp = -1: c = 2
IF (buf2(tx + 1, ty) < b) AND (buf2(tx + 1, ty) >= 0) THEN b = buf2(tx + 1, ty): tmpxp = 1: tmpyp = 0: c = 3
IF (buf2(tx, ty + 1) < b) AND (buf2(tx, ty + 1) >= 0) THEN b = buf2(tx, ty + 1): tmpxp = 0: tmpyp = 1: c = 4

IF b = 32001 THEN
'SOUND 3000, 1
tmpxp = -1
tmpyp = 0
c = 1
b = -1
END IF

buf2(tx, ty) = -1
d = d + 1
ussk(d, a) = c
tx = tx + tmpxp
ty = ty + tmpyp
IF tx = 1 THEN tx = 34
IF ty = 1 THEN ty = 34
IF tx = 35 THEN tx = 2
IF ty = 35 THEN ty = 2
e = buf2(tx, ty)
buf2(tx, ty) = -1

sc2 tx, ty
IF d > ail THEN GOTO 8
IF (e > 0) AND (b > -1) THEN GOTO 7
8
d = d + 1
ussk(d, a) = 5
usskp(a) = 1

'DIM SHARED ussk(1 TO 2000, 1 TO 5)
'DIM SHARED usskp(1 TO 5)


showb

END SUB

SUB autop (a)
c = 0
5
IF usskp(a) > 0 THEN
b = ussk(usskp(a), a)
IF b = 1 THEN uxp(a) = -1: uyp(a) = 0
IF b = 2 THEN uxp(a) = 0: uyp(a) = -1
IF b = 3 THEN uxp(a) = 1: uyp(a) = 0
IF b = 4 THEN uxp(a) = 0: uyp(a) = 1
IF b = 5 THEN ai a: GOTO 5
usskp(a) = usskp(a) + 1
END IF

nx = ux(a) + uxp(a)
ny = uy(a) + uyp(a)
b = buf(INT(nx), INT(ny))
IF (b = 1 OR b > 9) AND (c = 0) THEN ai a: c = 1: GOTO 5


END SUB

FUNCTION cnum$ (a)

b$ = STR$(a)
IF LEFT$(b$, 1) = " " THEN b$ = RIGHT$(b$, LEN(b$) - 1)
cnum$ = b$

END FUNCTION

SUB dead (a)
elud(a) = elud(a) - 1
putworm a
END SUB

SUB init
level 1
END SUB

SUB level (a)
LOCATE 5, 5
PRINT "G E T   R E A D Y"
LOCATE 7, 5
PRINT "L E V E L :"; a

FOR b = 1 TO wai
SOUND 0, 1
NEXT b
CLS


FOR y = 0 TO 36
FOR x = 0 TO 36
buf(x, y) = 0
NEXT x
NEXT y

FOR x = 0 TO 36
buf(x, 0) = 1
buf(x, 36) = 1
buf(0, x) = 1
buf(36, x) = 1
NEXT x



b$ = cnum(a) + ".lvl"
OPEN b$ FOR INPUT AS #1
d = 0
10
IF EOF(1) <> 0 THEN GOTO 11
LINE INPUT #1, c$
IF LEFT$(c$, 1) = "/" THEN
d = d + 1
IF d > 35 THEN GOTO 12
g = LEN(c$)
IF g > 36 THEN g = 36
FOR e = 2 TO g
f$ = RIGHT$(LEFT$(c$, e), 1)
IF f$ = "#" OR f$ = "m" THEN buf(e - 1, d) = 1 ELSE buf(e - 1, d) = 0
NEXT e
END IF
12

GOTO 10
11

CLOSE #1


stuff
show


FOR b = 1 TO ussm
ussl(b) = 0
putworm b
NEXT b
stat
END SUB

SUB prc (a)

subt a
ussp(a) = ussp(a) + 1

IF elud(a) = 0 THEN GOTO 4

IF auto(a) = 1 THEN autop a



ux(a) = ux(a) + uxp(a)
uy(a) = uy(a) + uyp(a)
IF ux(a) = 35 THEN ux(a) = 2
IF uy(a) = 35 THEN uy(a) = 2
IF ux(a) = 1 THEN ux(a) = 34
IF uy(a) = 1 THEN uy(a) = 34


x = ux(a)
y = uy(a)

3
IF buf(x, y) = 2 THEN
buf(x, y) = 0
sc x, y
stuff
ussl(a) = ussl(a) + mtm
usss(a) = usss(a) + mtm
FOR b = 1 TO ussm
IF (elud(b) > 0) AND (auto(b) = 1) THEN ai b
NEXT b
stat
GOTO 3
END IF

IF buf(x, y) > 0 THEN dead a: GOTO 4
IF a = 1 THEN buf(x, y) = 10
IF a = 2 THEN buf(x, y) = 11
IF a = 3 THEN buf(x, y) = 12
IF a = 4 THEN buf(x, y) = 13
IF a = 5 THEN buf(x, y) = 14
sc x, y
IF ussp(a) > 2000 THEN ussp(a) = ussp(a) - 2000
ussx(ussp(a), a) = x
ussy(ussp(a), a) = y

4

END SUB

SUB putworm (a)
b = ussl(a)
FOR c = b TO 1 STEP -1
ussl(a) = c
subt a
NEXT c

9
uy(a) = INT(RND * 30 + 2)
ux(a) = INT(RND * 10 + 5)
FOR b = ux(a) TO ux(a) + 10
IF buf(b, uy(a)) <> 0 THEN GOTO 9
NEXT b

uxp(a) = 1
uyp(a) = 0
ussl(a) = 3
stat

END SUB

SUB sc (x, y)
x1 = x * 5
y1 = y * 5

LINE (x1, y1)-(x1 + 3, y1 + 3), 0, BF

SELECT CASE buf(x, y)
CASE 0
LINE (x1, y1)-(x1 + 3, y1 + 3), 1, BF
CASE 1
LINE (x1, y1)-(x1 + 3, y1 + 3), 7, BF
LINE (x1, y1)-(x1 + 3, y1 + 3), 8, B
CASE 2
LINE (x1, y1)-(x1 + 3, y1 + 3), 14, BF
CASE 10
LINE (x1, y1)-(x1 + 3, y1 + 3), 10, BF
PSET (x1, y1), 0
PSET (x1 + 3, y1), 0
PSET (x1, y1 + 3), 0
PSET (x1 + 3, y1 + 3), 0

CASE 11
LINE (x1, y1)-(x1 + 3, y1 + 3), 12, BF
PSET (x1, y1), 0
PSET (x1 + 3, y1), 0
PSET (x1, y1 + 3), 0
PSET (x1 + 3, y1 + 3), 0

CASE 12
LINE (x1, y1)-(x1 + 3, y1 + 3), 13, BF
PSET (x1, y1), 0
PSET (x1 + 3, y1), 0
PSET (x1, y1 + 3), 0
PSET (x1 + 3, y1 + 3), 0

CASE 13
LINE (x1, y1)-(x1 + 3, y1 + 3), 15, BF
PSET (x1, y1), 0
PSET (x1 + 3, y1), 0
PSET (x1, y1 + 3), 0
PSET (x1 + 3, y1 + 3), 0

CASE 14
LINE (x1, y1)-(x1 + 3, y1 + 3), 9, BF
PSET (x1, y1), 0
PSET (x1 + 3, y1), 0
PSET (x1, y1 + 3), 0
PSET (x1 + 3, y1 + 3), 0


END SELECT

END SUB

SUB sc2 (x, y)
'LOCATE 1, 1
'PRINT x, y
'x1 = x * 5 + 2
'y1 = y * 5 + 2
'PSET (x1, y1), 15


'a$ = INPUT$(1)

END SUB

SUB show
FOR y = 1 TO 35
FOR x = 1 TO 35
sc x, y

NEXT x
NEXT y

END SUB

SUB showb
GOTO 15
FOR x = 1 TO 35
FOR y = 1 TO 35

LINE (x * 2 + 200, y * 2 + 100)-(x * 2 + 201, y * 2 + 101), buf2(x, y) MOD 255, BF
NEXT y
NEXT x
15
'a$ = INPUT$(1)
END SUB

SUB start
SCREEN 13
RANDOMIZE TIMER

uy(1) = 5
uy(2) = 10
uy(3) = 15
uy(4) = 20
uy(5) = 25


FOR a = 1 TO ussm
ux(a) = 15
uxp(a) = 1
uyp(a) = 0
ussp(a) = 0
ussl(a) = 3
elud(a) = elum
usss(a) = 0
usskp(a) = 1
ussk(1, a) = 5
NEXT a
mtm = 0
END SUB

SUB stat
LOCATE 1, 25
PRINT mtm


FOR a = 1 TO 5
COLOR 15
LOCATE 2 + a, 24
PRINT RIGHT$(STR$(a), 1)

COLOR 10
LOCATE 2 + a, 26
IF auto(a) = 1 THEN PRINT "*" ELSE PRINT "-"

COLOR 12
LOCATE 2 + a, 27
b$ = STR$(usss(a))
PRINT RIGHT$(b$, LEN(b$) - 1)

COLOR 13
LOCATE 2 + a, 30
b$ = STR$(elud(a))
PRINT RIGHT$(b$, LEN(b$) - 1)
NEXT a

COLOR 10
LOCATE 8, 26
PRINT "Auto"

COLOR 12
LOCATE 2, 27
PRINT "Score"

COLOR 13
LOCATE 8, 30
PRINT "Lives"

LOCATE 1, 30
PRINT "Level:"; lvl


END SUB

SUB stuff
2
x = INT(RND * 33 + 2)
y = INT(RND * 33 + 2)
IF buf(x, y) = 0 THEN
buf(x, y) = 2
sc x, y
ELSE
GOTO 2
END IF
mtm = mtm + 1
stat
END SUB

SUB subt (b)
a = ussp(b) - ussl(b)
IF a < 1 THEN a = a + 2000
IF ussx(a, b) > 0 THEN

buf(ussx(a, b), ussy(a, b)) = 0
sc ussx(a, b), ussy(a, b)
ussx(a, b) = 0
END IF
END SUB

SUB tkt
a$ = INKEY$
IF a$ = CHR$(27) THEN SYSTEM
IF (a$ = CHR$(0) + "M") AND (uxp(1) <> -1) THEN uxp(1) = 1: uyp(1) = 0
IF (a$ = CHR$(0) + "K") AND (uxp(1) <> 1) THEN uxp(1) = -1: uyp(1) = 0
IF (a$ = CHR$(0) + "P") AND (uyp(1) <> -1) THEN uxp(1) = 0: uyp(1) = 1
IF (a$ = CHR$(0) + "H") AND (uyp(1) <> 1) THEN uxp(1) = 0: uyp(1) = -1

IF (a$ = "d") AND (uxp(2) <> -1) THEN uxp(2) = 1: uyp(2) = 0
IF (a$ = "a") AND (uxp(2) <> 1) THEN uxp(2) = -1: uyp(2) = 0
IF (a$ = "s") AND (uyp(2) <> -1) THEN uxp(2) = 0: uyp(2) = 1
IF (a$ = "w") AND (uyp(2) <> 1) THEN uxp(2) = 0: uyp(2) = -1

b = VAL(a$)
IF b > 0 THEN
IF auto(b) = 1 THEN auto(b) = 0 ELSE auto(b) = 1
stat
END IF

FOR a = 1 TO ussm
prc a
NEXT a

END SUB