QB / QB64 Discussion Forum     RULES     Other Subforums, Links and Downloads    Index of Threads

 Return to Index  

Snake v0.8 (1 will be the full version...)

December 14 2007 at 11:57 PM
  (Login Tusike)


Response to ProgramList Tusike

Actually, this is the full version now! I added the instructions to the game, too.
Please run creatf.bas first to play the game. Here is the program:

DECLARE SUB customs ()
DECLARE SUB instructions ()
DECLARE SUB drawJEP (lvl%)
DECLARE SUB drawmove ()
DECLARE FUNCTION place% (x%)
DECLARE FUNCTION min% (x%)
DECLARE SUB PRINTIT (text$, x%, y%)
DECLARE SUB startup ()
CONST fleVER = "Files\snake.ver", Ver = "1222"
CONST fleUSE = "Files\snake.use"
CONST fleTEM = "Files\snake.tem"
CONST fleSTR = "Files\snake.str"
CONST fleTOP = "Files\snake.top"
CONST fleMOV = "Files\movie.dat"

DECLARE SUB zap ()
DECLARE FUNCTION MenuChoice% (selections%, start%, xstart%)
DECLARE FUNCTION eng$ (number%, language%)
DECLARE SUB login ()
DECLARE SUB testlevel ()
DEFINT A-Z
DECLARE FUNCTION ask$ (text$, x, y, max, mode)
DECLARE SUB changeapp (i)
DECLARE SUB settings (i)
DECLARE SUB options ()
DECLARE FUNCTION setuplevel ()
DECLARE SUB logo ()
DECLARE SUB highscores (index)
DECLARE SUB SPEEDset ()
DECLARE SUB center (text$, y!)
DECLARE SUB clearground (x, y)
DECLARE SUB mainmenu (mark)
DECLARE SUB showinfo (index, value)
DECLARE SUB initialize ()
DECLARE SUB playSNAKE ()
DECLARE SUB defscreen ()
DECLARE SUB restorecolors ()
DECLARE SUB drawthings ()
DECLARE SUB PUTimage (col, row, index)
RANDOMIZE TIMER
CLEAR , , 3000
CLS
SCREEN 12
DIM SHARED imageSET(7749) AS SINGLE, numSET(399) AS SINGLE, cpu AS DOUBLE
DIM SHARED background(6820) AS SINGLE, global$, start, map$
DIM SHARED ground(1 TO 32, 1 TO 24), lang%, mch(10), side$, sblock(100)
DIM SHARED prey, SPEED AS SINGLE, level, usernumber, users, champdone, champ, realspeed AS SINGLE, score, oldscore, speedlevel, lives, snakelength, oldlength
TYPE topperson
nickname AS STRING * 20
playdate AS STRING * 10
score AS LONG
id AS STRING * 5
END TYPE
DIM SHARED top(1 TO 10) AS topperson
TYPE filmloc
x AS INTEGER
y AS INTEGER
END TYPE
DIM SHARED film AS filmloc
TYPE body
col AS INTEGER
row AS INTEGER
TURN AS INTEGER
dir AS INTEGER
rdir AS INTEGER
END TYPE
TYPE account
nickname AS STRING * 20
password AS STRING * 8
level AS INTEGER
avscore AS INTEGER
gplayed AS INTEGER
lvlreached AS INTEGER
language AS INTEGER
gmode AS INTEGER
rats AS INTEGER
bg AS INTEGER
snakec AS INTEGER
spattern AS INTEGER
END TYPE
DIM SHARED user AS account
DIM SHARED snake(1 TO 2) AS body
CONST head = 0
CONST neck = 500
CONST shoulder = 1000
CONST body = 1500
CONST tail = 2000
CONST tailEND = 2500
CONST rattle = 3000
CONST mouse = 6000
CONST rat = 6500
CONST frog = 7250
CONST blank = 6625
CONST block = 7125
CONST TURN = 3000

CONST west = 0
CONST north = 125
CONST east = 250
CONST south = 375


CONST NE = 0
CONST NW = 125
CONST SW = 250
CONST SE = 375
CONST WN = 375
CONST EN = 250
CONST ES = 125
CONST WS = 0

' Check compatibility with CreateF
DIM SHARED MyErr
ON ERROR GOTO GetMyErr
OPEN fleVER FOR INPUT AS #8: LINE INPUT #8, l$
ON ERROR GOTO 0: CLOSE #8
IF l$ <> Ver THEN
PRINT "SNAKE consists of four programs"
PRINT " CreateF.bas creates initial files, custom.bas will be used later"
PRINT " Snake.bas and profile.bas use those files": PRINT
PRINT " You must ensure CreateF is run first"
PRINT " You must ensure both programs are the same version"
PRINT " Press any key to exit"
PRINT
PRINT
PRINT "SNAKE negy programbol all"
PRINT " custom.bas majd kesobb kell, CreateF.bas letrehozza a fajlokat"
PRINT " melyeket Snake.bas es profile.bas hasznal fel": PRINT
PRINT " Eloszor createF.bas-t kell futtatni"
PRINT " Az is fontos hogy mindharom program ugyanaz a kiadas legyen"
PRINT " Barmely billentyu a kilepeshez"
a$ = INPUT$(1)

SYSTEM
END IF

OPEN "files\snake.tem" FOR OUTPUT AS #1: CLOSE #1
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(champdone)
GET #1, 1, champdone
GET #1, 2, usernumber
GET #1, 3, users
CLOSE #1
OPEN "files\snake.top" FOR RANDOM AS #1 LEN = LEN(top(1))
FOR topers = 1 TO 10
GET #1, topers, top(topers)
NEXT
CLOSE #1
cpu# = 0
IF champdone = 1 THEN
OPEN "profile.txt" FOR APPEND AS #1
IF LOF(1) = 0 THEN
CLOSE #1: KILL "profile.txt"
ELSE
CLOSE #1
OPEN "profile.txt" FOR INPUT AS #1
INPUT #1, nev$
INPUT #1, cpu#
CLOSE #1
KILL "profile.txt"
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
FOR i = 5 TO 4 + users
GET #1, i, user
IF LTRIM$(RTRIM$(UCASE$(user.nickname))) = RTRIM$(LTRIM$(UCASE$(nev$))) THEN CLOSE #1: usernumber = i: GOSUB Getsprites: restorecolors: changeapp 1: changeapp 2: changeapp 3: lang% = user.language: GOTO start
NEXT
END IF
END IF
GOSUB Getsprites
restorecolors

OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
IF usernumber > 4 THEN
IF champdone = 1 THEN GET #1, usernumber, user
ELSE
GET #1, 4, user
END IF
CLOSE #1
lang% = user.language
startup
mainmenu 1
start:
DO
mainmenu 2
LOOP
CLOSE #2: KILL "files\snake.tem"
SYSTEM
GetMyErr: MyErr = ERR: RESUME NEXT

Getsprites:
FOR n = 0 TO 15
OUT &H3C8, n
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT n
IF cpu# = 0 THEN
t# = TIMER
FOR i! = 1 TO 1000000: NEXT
t2# = TIMER
cpu# = t2# - t#
END IF

maxx = 19: maxy = 299: x = -1: y = 0
OPEN "files\images.dat" FOR INPUT AS #1
DO

INPUT #1, counter, colr
IF colr = 7 THEN colr = 3: GOTO 17
IF colr = 14 THEN colr = 3
IF colr = 77 THEN colr = 7
IF colr = 2 AND y > 279 THEN colr = 11
17
FOR i = 1 TO counter
x = x + 1
IF x > maxx THEN x = 0: y = y + 1
PSET (x, y), colr
NEXT
LOOP UNTIL x = maxx AND y = maxy
CLOSE #1
index = 0
placey = 0
DO
IF index = 7000 THEN index = 7250
GET (0, placey)-(19, placey + 19), imageSET(index)
IF index < 6500 OR index = 7250 THEN GOSUB pose
index = index + 500
placey = placey + 20
LOOP UNTIL placey = 300

LINE (0, 0)-(19, 19), 7, BF
FOR i = 1 TO 500
x = INT(RND * 20)
y = INT(RND * 20)
PSET (x, y), 8
PSET (x + 1, y + 1), 15
NEXT
LINE (0, 0)-(19, 19), 7, B
GET (0, 0)-(19, 19), imageSET(block)
LINE (0, 0)-(7, 7), 7, B
GET (0, 0)-(7, 7), sblock
LINE (0, 0)-(19, 19), 3, BF: GET (0, 0)-(19, 19), imageSET(6625)
GET (0, 0)-(19, 19), imageSET(6750)
GET (0, 0)-(19, 19), imageSET(6875)
GET (0, 0)-(19, 19), imageSET(7000)
CLS
COLOR 4
FOR i = 0 TO 9
IF i = 0 THEN s$ = "O" ELSE s$ = LTRIM$(RTRIM$(STR$(i)))
LOCATE 1, 1: PRINT s$
LINE (40, 41)-(46, 53), 15, BF
FOR y = 1 TO 13
FOR x = 0 TO 6
IF POINT(x, y) = 4 THEN PSET (40 + x, 40 + y), 4
NEXT
NEXT
GET (40, 41)-(46, 53), numSET(i * 40)
LINE (40, 41)-(46, 53), 3, BF
NEXT

RETURN
pose:
FOR poses = index TO index + 250 STEP 125
PUT (100, 100), imageSET(poses), PSET
FOR x = 100 TO 119
FOR y = 100 TO 119
PSET (219 - y, x - 20), POINT(x, y)
NEXT y
NEXT x
GET (100, 80)-(119, 99), imageSET(poses + 125)
NEXT poses

RETURN






Paletteinfo:
DATA 0,14,3, 0,0,42, 0,42,0, 0,14,3, 42,0,0, 60,52,0
DATA 60,52,0, 42,42,42, 21,21,21, 21,21,63, 21,63,21, 0,42,0
DATA 63,21,21, 63,21,63, 0,0,0, 63,63,63

intro:
DATA 140, 30, 19, 169, 40, 169, 55, 140, 40, 125, 60, 135, 75, 155, 85, 165, 100, 160, 110
DATA 153, 120, 140, 129, 111, 119, 111, 105, 140, 119, 147, 110, 150, 100, 145, 95, 120, 80, 110, 60, 140, 30, 140, 31
DATA 195, 129, 9, 195, 30, 260, 95, 260, 30, 265, 28, 269, 30, 269, 129,204, 65, 204, 129, 195, 129, 197, 127
DATA 285, 129, 8, 305, 30, 334, 30, 355, 129, 345, 125, 325, 45, 315, 45, 295, 125, 285, 129, 320, 35
DATA 375, 129, 13, 380, 125, 380, 34, 375, 30, 390, 30, 390, 70, 435, 30, 445, 30, 397, 80, 445, 129, 435, 129, 390, 90, 390, 129, 375, 129, 380, 32
DATA 465, 129, 12, 465, 30, 539, 32, 539, 43, 480, 45, 480, 73, 510, 68, 510, 92, 480, 87, 480, 115, 539, 116, 539, 127, 465, 129, 466, 128


lvl1:
DATA 0
lvl2:
DATA 15,8,18,17, 0
lvl3:
DATA 4, 4, 4, 21, 5, 5, 5, 20, 29, 4, 29, 21, 28, 5, 28, 20, 15, 8, 18, 17, 0
lvl4:
DATA 4, 4, 29, 4, 4, 21, 29, 21, 4, 5, 4, 11, 4, 14, 4, 21, 29, 5, 29, 11, 29, 14, 29, 21, 13, 12, 19, 13, 0
lvl5:
DATA 4, 4, 29, 4, 4, 21, 29, 21, 4, 5, 4, 11, 4, 14, 4, 21, 29, 5, 29, 11, 29, 14, 29, 21
DATA 10, 10, 23, 11, 10, 14, 23, 15, 0

lvl6:
DATA 4, 4, 5, 5, 8, 4, 9, 5, 12, 4, 13, 5, 16, 4, 17, 5, 20, 4, 21, 5, 24, 4, 25, 5, 28, 4, 29, 5
DATA 4, 20, 5, 21, 8, 20, 9, 21, 12, 20, 13, 21, 16, 20, 17, 21, 20, 20, 21, 21, 24, 20, 25, 21, 28, 20, 29, 21
DATA 4, 9, 15, 9, 18, 9, 29, 9, 4, 16, 15, 16, 18, 16, 29, 16,0

lvl8:
DATA 4, 4, 29, 4, 4, 21, 29, 21, 4, 5, 4, 11, 4, 14, 4, 21, 29, 5, 29, 11, 29, 14, 29, 21
DATA 10, 12, 23, 12, 10, 13, 23, 13
DATA 7, 7, 26, 7, 7, 18, 26, 18, 7, 8, 7, 11, 7, 14, 7, 17, 26, 8, 26, 11, 26, 14, 26, 17, 0

lvl7:
DATA 2, 11, 2, 11, 2, 14, 2, 14, 31, 11, 31, 11, 31, 14, 31, 14, 15, 2, 15, 2, 18, 2, 18, 2
DATA 18, 6, 19, 6, 20, 7, 21, 7, 22, 8, 23, 8, 24, 9, 24, 9, 25, 10, 25, 10, 26, 11, 26, 11
DATA 18, 19, 19, 19, 20, 18, 21, 18, 22, 17, 23, 17, 24, 16, 24, 16, 25, 15, 25, 15, 26, 14, 26, 14
DATA 14, 6, 15, 6, 12, 7, 13, 7, 10, 8, 11, 8, 9, 9, 9, 9, 8, 10, 8, 10, 7, 11, 7, 11
DATA 14, 19, 15, 19, 12, 18, 13, 18, 10, 17, 11, 17, 9, 16, 9, 16, 8, 15, 8, 15, 7, 14, 7, 14
DATA 2, 2, 3, 2, 2, 3, 2, 3, 30, 2, 31, 2, 31, 3, 31, 3, 31, 22, 31, 23, 30, 23, 30, 23, 2, 23, 3, 23, 2, 22, 2, 22
DATA 0

lvl9:
DATA 2, 2, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, 9, 9, 9, 9, 10, 10, 10, 10, 11, 11, 11, 11, 12, 12, 12, 12, 13, 13
DATA 31, 2, 29, 4, 29, 4, 28, 5, 28, 5, 27, 6, 27, 6, 26, 7, 26, 7, 25, 8, 25, 8, 24, 9, 24, 9, 23, 10, 23, 10, 22, 11, 22, 11, 21, 12, 21, 12, 20, 13
DATA 14, 14, 14, 14, 19, 14, 19, 14
DATA 13, 14, 15, 16, 12, 16, 13, 17, 11, 17, 12, 18, 10, 18, 11, 19, 9, 19, 10, 20, 8, 20, 9, 21
DATA 20, 14, 18, 16, 21, 16, 20, 17, 22, 17, 21, 18, 23, 18, 22, 19, 24, 19, 23, 20, 25, 20, 24, 21
DATA 16, 4, 17, 9
DATA 0

lvls:
DATA 3000, 2600, 2200, 1800, 1400, 1000, 700, 400,200, 0


handler:
PRINT global$
SYSTEM
RESUME

FUNCTION ask$ (text$, x, y, max, mode)
COLOR 15
PRINTIT text$, x, y
startx = x + LEN(text$): x = (x + LEN(text$)) * 8
txtlen = 0
LINE (x, (y - 1) * 2 + y * 14 - 14)-(x, (y - 1) * 2 + y * 14), 7
txt$ = ""
DO
DO: LOOP UNTIL INKEY$ = ""
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
COLOR 5
SELECT CASE a$
CASE CHR$(13): IF txt$ <> "" THEN EXIT DO
CASE CHR$(27)

ask$ = "exit": EXIT FUNCTION
CASE CHR$(0) + "P": ask$ = "down": EXIT FUNCTION
CASE CHR$(0) + "H": ask$ = "up": EXIT FUNCTION
CASE CHR$(8)
IF txtlen > 0 THEN
LOCATE y, startx + txtlen: PRINT SPACE$(max - txtlen + 2)
txtlen = txtlen - 1: IF txtlen = 0 THEN txt$ = "" ELSE txt$ = MID$(txt$, 1, txtlen)
COLOR 5
IF mode = 1 THEN LOCATE y, startx + 1: PRINT txt$ ELSE LOCATE y, startx + 1: PRINT STRING$(txtlen, "*")
LINE (x + (txtlen * 8), (y - 1) * 2 + y * 14 - 14)-(x + (txtlen * 8), (y - 1) * 2 + y * 14), 7
END IF
CASE ELSE
IF mode = 2 THEN minimum = 33: maximum = 126 ELSE minimum = 65: maximum = 90
IF ASC(UCASE$(a$)) >= minimum AND ASC(UCASE$(a$)) <= maximum AND txtlen <= max THEN
txtlen = txtlen + 1
IF txtlen <= max THEN
IF mode = 1 THEN LOCATE y, startx + txtlen: PRINT UCASE$(a$) ELSE LOCATE y, startx + txtlen: PRINT "*"
txt$ = txt$ + UCASE$(a$)
LINE (x + txtlen * 8, (y - 1) * 2 + y * 14 - 14)-(x + txtlen * 8, (y - 1) * 2 + y * 14), 7
ELSE
txtlen = max
END IF
END IF
END SELECT
LOOP
LINE (x + LEN(txt$) * 8, (y - 1) * 2 + y * 14 - 14)-(x + LEN(txt$) * 8, (y - 1) * 2 + y * 14), 3
ask$ = txt$
END FUNCTION

DEFSNG A-Z
SUB center (text$, y)
DIM letter(0 TO 199)
textlen = LEN(text$)
FOR i = 1 TO LEN(text$)
a$ = MID$(text$, i, 1)
IF a$ = "^" THEN textlen = textlen - 1
IF a$ = "-" THEN
textlen = textlen - 2
IF MID$(text$, i + 2, 1) = "-" THEN
textlen = textlen - 1: i = i + 3: GOTO 20
ELSE
textlen = textlen - 2: i = i + 4: GOTO 20
END IF
END IF
20
NEXT

s = 0
textlen = textlen * 8
startx = 320 - (textlen / 2)
y = (y - 1) * 2 + y * 14 - 14
c = 15
ii = 0
FOR i = 1 TO LEN(text$)
a$ = MID$(text$, i, 1)
IF a$ = "-" THEN
IF MID$(text$, i + 2, 1) = "-" THEN c = VAL(MID$(text$, i + 1, 1)): i = i + 2 ELSE c = VAL(MID$(text$, i + 1, 2)): i = i + 3
GOTO 21
END IF
IF a$ = "^" THEN s = 1: GOTO 21
ii = ii + 1
IF a$ = " " THEN
LINE (startx + (ii - 1) * 8, y)-(startx + (ii) * 8, y + 14), 3, BF
GOTO 21
END IF
z = ASC(a$)
SELECT CASE a$
CASE "=": z = 45
CASE "#": IF s = 1 THEN s = 0: z = 144 ELSE z = 130
CASE "@": IF s = 1 THEN s = 0: z = 143 ELSE z = 160
CASE "|": IF s = 1 THEN s = 0: z = 161 ELSE z = 161
CASE "$": IF s = 1 THEN s = 0: z = 162 ELSE z = 162
CASE "_": IF s = 1 THEN s = 0: z = 163 ELSE z = 163
CASE "<": IF s = 1 THEN s = 0: z = 153 ELSE z = 148
CASE ">": IF s = 1 THEN s = 0: z = 154 ELSE z = 129
END SELECT
DEF SEG = VARSEG(letter(0))
global$ = "letters\chr" + LTRIM$(RTRIM$(STR$(z))) + ".chr"
ON ERROR GOTO handler
BLOAD "letters\chr" + LTRIM$(RTRIM$(STR$(z))) + ".chr", VARPTR(letter(0))
DEF SEG
ON ERROR GOTO 0
x = startx + (ii - 1) * 8
SELECT CASE c
CASE 5: index = 160
CASE 8: index = 0
CASE 9: index = 120
CASE 12: index = 40
CASE 15: index = 80
END SELECT
global$ = STR$(x) + STR$(y) + STR$(index)
ON ERROR GOTO handler
IF y > 0 AND (z = 144 OR z = 143 OR z = 154 OR z = 153) THEN PUT (x, y - 2), letter(index), PSET ELSE PUT (x, y), letter(index), PSET
ON ERROR GOTO 0
21

NEXT

END SUB

DEFINT A-Z
SUB changeapp (i)
SELECT CASE i
CASE 1
SELECT CASE user.bg
CASE 1: PALETTE 0, 3 + 256 * 14 + 0 * 65536: PALETTE 3, 3 + 256 * 14 + 0 * 65536
CASE 2: PALETTE 0, 3 + 256 * 0 + 14 * 65536: PALETTE 3, 3 + 256 * 0 + 14 * 65536
CASE 3: PALETTE 0, 14 + 256 * 3 + 0 * 65536: PALETTE 3, 14 + 256 * 3 + 0 * 65536
CASE 4: PALETTE 0, 10 + 256 * 10 + 10 * 65536: PALETTE 3, 10 + 256 * 10 + 10 * 65536
CASE 5: PALETTE 0, 20 + 256 * 10 + 0 * 65536: PALETTE 3, 20 + 256 * 10 + 0 * 65536
END SELECT

CASE 2
SELECT CASE user.snakec
CASE 1: PALETTE 2, 0 + 256 * 42 + 0 * 65536
CASE 2: PALETTE 2, 55 + 256 * 55 + 0 * 65536
CASE 3: PALETTE 2, 49 + 256 * 38 + 13 * 65536
CASE 4: PALETTE 2, 0 + 256 * 0 + 0 * 65536
CASE 5: PALETTE 2, 55 + 256 * 55 + 55 * 65536
END SELECT

CASE 3
SELECT CASE user.spattern
CASE 1: PALETTE 6, 60 + 256 * 52 + 0 * 65536
CASE 2: PALETTE 6, 7 + 256 * 30 + 7 * 65536
CASE 3: PALETTE 6, 7 + 256 * 7 + 30 * 65536
CASE 4: PALETTE 6, 5 + 256 * 5 + 5 * 65536
CASE 5: PALETTE 6, 30 + 256 * 7 + 7 * 65536
END SELECT
END SELECT
END SUB

SUB clearground (mx, my)
y = 20
FOR x = 20 TO 360
LINE (x, y)-(639 - x, 479 - y), 5, B
IF y > 25 THEN
LINE (x - 6, y - 6)-(639 - (x - 6), 479 - (y - 6)), 3, B
END IF
y = y + 1
NEXT
LINE (20, 20)-(619, 459), 3, BF
END SUB

SUB customs
zap
center eng$(73, lang%), 12
mch(1) = 74
mch(2) = 77
mch(3) = 46
SELECT CASE MenuChoice%(3, 1, 15)
CASE 1
OPEN "profile.txt" FOR APPEND AS #11
PRINT #11, user.nickname
PRINT #11, lang%
PRINT #11, cpu#
CLOSE #11
CLS
logo
IF champdone = 1 THEN center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
CLOSE
CHAIN "custom.bas"
CASE 2
zap
SHELL "dir /b maps\*.lvl > temp"
OPEN "temp" FOR INPUT AS #7
OPEN "maps.dat" FOR RANDOM AS #3 LEN = 14
counter = 0
DO WHILE NOT EOF(7)
counter = counter + 1
LINE INPUT #7, map$
PUT #3, counter, map$
LOOP
CLOSE #7
CLOSE #3
KILL "TEMP"
mark = 1
max = counter
OPEN "maps.dat" FOR RANDOM AS #3 LEN = 14
GET #3, mark, map$
center SPACE$(16), 12
center "-9-" + UCASE$(MID$(map$, 1, 1)) + LCASE$(MID$(map$, 2, LEN(map$) - 5)), 12
OPEN "maps\" + map$ FOR INPUT AS #4
FOR x = 1 TO 32
FOR y = 1 TO 24
INPUT #4, g
IF g = 1 THEN PUT (208 + (x - 1) * 7, 208 + (y - 1) * 7), sblock, PSET
NEXT
NEXT
CLOSE #4
DO
DO: a$ = INKEY$: LOOP UNTIL a$ = ""
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
SELECT CASE a$
CASE CHR$(0) + "M": mark = mark + 1: center SPACE$(8), 10: IF mark > counter THEN mark = 1
CASE CHR$(0) + "K": mark = mark - 1: center SPACE$(8), 10: IF mark < 1 THEN mark = counter
CASE CHR$(13), CHR$(32): EXIT DO
CASE CHR$(27): CLOSE #3: KILL "maps.dat": zap: EXIT SUB
END SELECT
GET #3, mark, map$
center SPACE$(12), 12
center "-9-" + UCASE$(MID$(map$, 1, 1)) + LCASE$(MID$(map$, 2, LEN(map$) - 5)), 12
OPEN "maps\" + map$ FOR INPUT AS #4
FOR x = 1 TO 32
FOR y = 1 TO 24
INPUT #4, g
IF g = 1 THEN PUT (208 + (x - 1) * 7, 208 + (y - 1) * 7), sblock, PSET
IF g = 0 THEN LINE (208 + (x - 1) * 7, 208 + (y - 1) * 7)-(208 + (x - 1) * 7 + 6, 208 + (y - 1) * 7 + 6), 3, BF
NEXT
NEXT
CLOSE #4
LOOP
CLOSE #4
CLOSE #3
KILL "maps.dat"
score = 0: oldscore = 0: champ = 0: lives = 1: defscreen: speedlevel = 0: SPEEDset: playSNAKE: EXIT SUB
CASE 3: EXIT SUB
END SELECT
END SUB

SUB defscreen
CLS
PAINT (0, 0), 3
IF map$ = "" THEN
FOR col = 1 TO 32
PUTimage col, 1, block
PUTimage col, 24, block
NEXT col
FOR row = 2 TO 23
PUTimage 32, row, block
PUTimage 1, row, block
NEXT row
ELSE
OPEN "maps\" + map$ FOR INPUT AS #3
FOR col = 1 TO 32
FOR row = 1 TO 24
INPUT #3, ground(col, row)
IF ground(col, row) = 1 THEN PUTimage col, row, block ELSE PUTimage col, row, blank
NEXT
NEXT
CLOSE #3
END IF
PRINTIT "-4-" + eng$(10, lang%), 5, 3
PRINTIT "-4-" + eng$(11, lang%), 64, 3
COLOR 4
LOCATE 3, 36: PRINT "S N A K E"
LINE (27, 2)-(88, 17), 15, BF
LINE (276, 2)-(354, 17), 15, BF
LINE (500, 2)-(592, 17), 15, BF
FOR y = 30 TO 50
FOR x = 25 TO 560
IF POINT(x, y) = 4 THEN PSET (x, y - 29), 4: PSET (x + 1, y - 28), 7
NEXT
NEXT
LINE (25, 30)-(560, 50), 3, BF
PUT (80, 4), numSET(lives * 40), PSET
PUT (552, 4), numSET(0), PSET
PUT (560, 4), numSET(0), PSET
PUT (568, 4), numSET(0), PSET
PUT (576, 4), numSET(0), PSET
PUT (584, 4), numSET(0), PSET
COLOR 4
LOCATE 28, 62: PRINT "Peter Varnai"
PRINTIT "-4-" + eng$(12, lang%), 33, 28
LINE (254, 462)-(385, 477), 15, BF
FOR y = 426 TO 455
FOR x = 254 TO 639
IF POINT(x, y) = 4 THEN PSET (x, y + 30), 4: PSET (x + 1, y + 31), 7
NEXT
NEXT
showinfo 3, prey
LINE (254, 428)-(619, 455), 3, BF
END SUB

SUB drawJEP (lvl)
OPEN "files\lvl" + LTRIM$(RTRIM$(STR$(lvl))) + ".dat" FOR INPUT AS #9

maxx = 359: maxy = 410: x = 279: y = 341
DO

INPUT #9, counter, colr
IF counter = -1 THEN EXIT DO
28
FOR i = 1 TO counter
x = x + 1
IF x > maxx THEN x = 280: y = y + 1
PSET (x, y), colr
NEXT

LOOP
CLOSE #9
END SUB

SUB drawmove
GET #2, place(1), snake(1)
PUTimage snake(1).col, snake(1).row, head + snake(1).dir

GET #2, place(2), snake(1)
PUTimage snake(1).col, snake(1).row, neck + snake(1).TURN + snake(1).dir

GET #2, place(3), snake(1)
PUTimage snake(1).col, snake(1).row, shoulder + snake(1).TURN + snake(1).dir

GET #2, place(snakelength), snake(1)
IF snake(1).row <> 1 AND snake(1).col <> 1 THEN PUTimage snake(1).col, snake(1).row, blank


GET #2, place(snakelength - 1), snake(1)
GET #2, place(snakelength - 2), snake(2)
IF snake(2).TURN = 0 THEN
snake(1).dir = snake(2).dir
ELSE
snake(1).dir = snake(2).rdir
END IF
PUT #2, place(snakelength - 1), snake(1)
PUTimage snake(1).col, snake(1).row, rattle + snake(1).dir

GET #2, place(snakelength - 2), snake(1)
PUTimage snake(1).col, snake(1).row, tailEND + snake(1).TURN + snake(1).dir

GET #2, place(snakelength - 3), snake(1)
PUTimage snake(1).col, snake(1).row, tail + snake(1).TURN + snake(1).dir

GET #2, place(snakelength - 4), snake(1)
PUTimage snake(1).col, snake(1).row, neck + snake(1).TURN + snake(1).dir

GET #2, place(snakelength - 5), snake(1)
PUTimage snake(1).col, snake(1).row, shoulder + snake(1).TURN + snake(1).dir

PUTimage 1, 1, block
END SUB

FUNCTION eng$ (number, language)
SELECT CASE language
CASE 1
OPEN "files\english.txt" FOR RANDOM AS #10 LEN = 35
CASE 2
OPEN "files\magyar.txt" FOR RANDOM AS #10 LEN = 35
END SELECT
GET #10, number, t$
CLOSE #10
eng$ = LTRIM$(RTRIM$((t$)))

END FUNCTION

SUB highscores (index)
logo
IF champdone = 1 THEN center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
' index = 1 --> show the highscores
' index = 2 --> write to AND show the highscores
OPEN "files\snake.top" FOR RANDOM AS #1 LEN = LEN(top(1))
FOR topers = 1 TO 10
GET #1, topers, top(topers)
NEXT
CLOSE #1

user.avscore = ((CLNG(user.avscore * user.gplayed + score)) / (user.gplayed + 1)
testlevel
user.gplayed = user.gplayed + 1
IF index = 1 THEN GOTO 2
IF users > 0 THEN
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
PUT #1, usernumber, user
CLOSE #1
END IF

FOR i = 1 TO 10
IF score >= top(i).score THEN
mark = i
FOR ii = 9 TO i STEP -1
top(ii + 1).score = top(ii).score
top(ii + 1).playdate = top(ii).playdate
top(ii + 1).nickname = top(ii).nickname
NEXT ii
center "-12-" + eng$(32, lang%), 11
COLOR 15: center eng$(33, lang%), 13
inputname:
IF usernumber < 5 THEN
DO: LOOP UNTIL INKEY$ = ""
COLOR 15
pname$ = ask$(eng$(34, lang%), 32, 16, 16, 1)
IF pname$ = "exit" OR pname$ = "up" OR pname$ = "down" OR pname$ = "" THEN GOSUB inputname
LINE ((43 + LEN(pname$)) * 8, 240)-((43 + LEN(pname$)) * 8, 254), 3
pname$ = UCASE$(MID$(pname$, 1, 1)) + LCASE$(MID$(pname$, 2, LEN(pname$) - 1))
ELSE
pname$ = UCASE$(MID$(user.nickname, 1, 1)) + LCASE$(MID$(user.nickname, 2, LEN(user.nickname) - 1))
END IF
top(i).nickname = pname$
top(i).playdate = DATE$
top(i).score = score
OPEN "files\snake.top" FOR RANDOM AS #1 LEN = LEN(top(1))
FOR iii = 1 TO 10
PUT #1, iii, top(iii)
NEXT iii
CLOSE #1
GOTO 2
END IF
NEXT i
COLOR 9
center eng$(30, lang%), 11
COLOR 15
center eng$(31, lang%), 13
mch(1) = 4
mch(2) = 22
mch(3) = 8
SELECT CASE MenuChoice%(3, 1, 16)
CASE 1: highscores 1: EXIT SUB
CASE 2: EXIT SUB
CASE 3: CLOSE #2: KILL "files\snake.tem": SYSTEM
END SELECT
2
LINE (100, 140)-(540, 470), 3, BF
COLOR 15
PRINTIT eng$(40, lang%), 24, 12
PRINTIT eng$(41, lang%), 42, 12
PRINTIT eng$(11, lang%), 54, 12
FOR topers = 1 TO 10
IF topers = mark THEN c = 9 ELSE c = 7
LOCATE topers + 12, 21
IF topers < 10 THEN g = 2 ELSE g = 1
COLOR 4
PRINT LTRIM$(RTRIM$(STR$(topers))); ".";
COLOR c: PRINT SPACE$(g); LEFT$(top(topers).nickname, 16); " "; top(topers).playdate; " "; top(topers).score
NEXT

FOR y = 175 TO 351 STEP 16
LINE (158, y)-(482, y), 2
NEXT
LINE (157, 174)-(483, 352), 2, B
LINE (158, 176)-(158, 350), 2: LINE (482, 176)-(482, 350), 2
LINE (319, 176)-(319, 350), 2: LINE (320, 176)-(320, 350), 2
LINE (412, 176)-(412, 350), 2: LINE (413, 176)-(413, 350), 2
center "-15-" + "[ -5-" + eng$(22, lang%) + "-15- ]", 25
DO: a$ = INKEY$: LOOP UNTIL a$ = CHR$(13) OR a$ = CHR$(32) OR a$ = CHR$(27)
SOUND 150, 1
zap
END SUB

SUB initialize
CLOSE #2
OPEN "files\snake.tem" FOR RANDOM AS #2 LEN = LEN(snake(1))
IF map$ = "" THEN
ERASE ground
FOR col = 1 TO 32
ground(col, 1) = -2
ground(col, 24) = -2
NEXT col
FOR row = 2 TO 23
ground(1, row) = -2
ground(32, row) = -2
NEXT row
FOR y = 2 TO 23
FOR x = 2 TO 31
ground(x, y) = 0
NEXT
NEXT
END IF
oldlength = 16
snakelength = 16
x = 24
FOR i = 1 TO snakelength
x = x - 1
snake(1).col = x
snake(1).row = 23
snake(1).TURN = 0
snake(1).dir = east
SELECT CASE i
CASE 1: index = head
CASE 2: index = neck
CASE 3: index = shoulder
CASE 4: index = body
CASE 5: index = body
CASE 6: index = body
CASE 7: index = body
CASE 8: index = body
CASE 9: index = body
CASE 10: index = body
CASE 11: index = shoulder
CASE 12: index = neck
CASE 13: index = tail
CASE 14: index = tailEND
CASE 15: index = rattle
CASE 16
index = blank
END SELECT
ground(x, 23) = -1

PUTimage x, 23, index + snake(1).dir
PUT #2, i, snake(1)
NEXT i
ground(x, 23) = 0
END SUB

SUB instructions
page = 1
maxpage = 8
DO
center eng$(72, lang%), 10
LINE (70, 134)-(568, 400), 7, B
LINE (68, 132)-(570, 402), 7, B
OPEN "files\page" + LTRIM$(RTRIM$(STR$(page))) + ".txt" FOR INPUT AS #9
FOR i! = 1 TO 7
INPUT #9, english$
INPUT #9, magyar$
IF lang% = 1 THEN CALL center(english$, i! * 2 + 10) ELSE CALL center(magyar$, i! * 2 + 10)
NEXT i!
PRINTIT "-5-" + LTRIM$(RTRIM$(STR$(page))), 70, 27
IF page = 8 THEN
LOCATE 16, 21: COLOR 9: PRINT CHR$(64)
COLOR 5: LOCATE 27, 59: PRINT "Peter Varnai"
IF lang% = 2 THEN PRINTIT "-5-V@rnai P#ter", 59, 27
END IF
29
DO: LOOP UNTIL INKEY$ = ""
DO: a$ = INKEY$: LOOP WHILE a$ = ""
SELECT CASE a$

CASE CHR$(27): CLOSE #9: SYSTEM
CASE CHR$(8), CHR$(13), CHR$(32): CLOSE #9: zap: EXIT SUB
CASE CHR$(0) + "M"
page = page + 1: IF page > maxpage THEN SOUND 150, 4: page = maxpage ELSE zap
CASE CHR$(0) + "K"
page = page - 1: IF page < 1 THEN SOUND 150, 4: page = 1 ELSE zap
CASE "1", "2", "3", "4", "5", "6", "7", "8"
PRINTIT SPACE$(15), 59, 27
page = VAL(a$)
CASE ELSE: GOTO 29
END SELECT
CLOSE #9
LOOP
END SUB

SUB login
LINE (0, 130)-(639, 479), 3, BF
mch(1) = 66
mch(2) = 67
mch(3) = 46
18
SELECT CASE MenuChoice(3, 1, 11)
CASE 3: EXIT SUB
CASE 2
usernumber = 2
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
GET #1, 4, user
CLOSE #1
changeapp 1: changeapp 2: changeapp 3
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(usernumber)
PUT #1, 2, usernumber
CLOSE #1
LINE (0, 130)-(639, 479), 3, BF
center SPACE$(65), 1
center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
EXIT SUB
END SELECT
pname$ = ask$(eng$(68, lang%), 30, 24, 16, 1)
LINE ((40 + LEN(pname$)) * 8, 368)-((40 + LEN(pname$)) * 8, 382), 3
SELECT CASE pname$
CASE "exit": center SPACE$(35), 24: a$ = "": GOTO 18
CASE "down": a$ = CHR$(0) + "P": center SPACE$(35), 24: GOTO 18
CASE "up": a$ = CHR$(0) + "H": center SPACE$(35), 24: GOTO 18
CASE ELSE
GOTO 10
END SELECT
10
pass$ = ask$(eng$(56, lang%), 31, 25, 8, 2)
center SPACE$(35), 25
center SPACE$(35), 24
SELECT CASE pass$
CASE "exit": a$ = "": GOTO 18
CASE "down": a$ = CHR$(0) + "P": GOTO 18
CASE "up": a$ = CHR$(0) + "H": GOTO 18
CASE ELSE
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
FOR i = 5 TO 4 + users
GET #1, i, user
IF RTRIM$(user.nickname) = pname$ AND RTRIM$(user.password) = pass$ THEN
CLOSE #1
usernumber = i
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(usernumber)
PUT #1, 2, usernumber
CLOSE #1
changeapp 1: changeapp 2: changeapp 3
LINE (0, 130)-(639, 479), 3, BF
center SPACE$(65), 1
center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
EXIT SUB
END IF
NEXT
END SELECT
GET #1, usernumber, user
center SPACE$(30), 24
center SPACE$(30), 25
center "-12-" + eng$(69, lang%), 25
t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#
center SPACE$(35), 25
CLOSE #1
a$ = "": GOTO 18
END SUB

SUB logo
' S N A K E logo
RESTORE intro
PALETTE 1, 45
LINE (0, 0)-(639, 479), 3, BF
FOR i = 1 TO 5
READ startx: READ starty
READ counter
FOR n = 1 TO counter
READ x: READ y
LINE (startx, starty)-(x, y), 1
startx = x: starty = y
NEXT
READ px, py: PAINT (px, py), 1, 1
NEXT
LINE (300, 70)-(340, 85), 1, BF
IF champdone = 1 THEN center eng$(9, lang%) + ", " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)) + "!", 1
END SUB

SUB mainmenu (mark)
4
CLS

logo
IF mark = 1 THEN
x = 0
DO
x = x + 1
g = 0: r = 45
FOR c = 1 TO 15
PALETTE 1, (r - c * 3) + (g + c * 3) * 256
t# = TIMER + .05: WHILE t# > TIMER: WEND
NEXT
FOR c = 15 TO 1 STEP -1
PALETTE 1, (r - c * 3) + (g + c * 3) * 256
t# = TIMER + .05: WHILE t# > TIMER: WEND
NEXT
LOOP UNTIL x = 1
END IF

PALETTE 1, 45

OUT &HC8, 0
OUT &HC9, 3
OUT &HC9, 14
OUT &HC9, 0
IF mark = 1 THEN

'Small movie
OPEN "files\movie2.dat" FOR INPUT AS #2
OPEN "files\movie.dat" FOR RANDOM AS #1 LEN = LEN(film)
DO
a$ = INKEY$
INPUT #2, startf: INPUT #2, endf
IF startf = -1 THEN EXIT DO
FOR i = startf TO endf
INPUT #2, index
GET #1, i, film
IF index = 6500 THEN index = 6625
tempx = film.x: tempy = film.y
PUTimage tempx, tempy, index
NEXT
FOR rep = 1 TO 2
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
NEXT
IF a$ <> "" THEN PAINT (0, 0), 3: logo: EXIT DO
LOOP
CLOSE #1
CLOSE #2
END IF
level = 0: champ = 0
center SPACE$(65), 1
DO
IF champdone = 1 THEN center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
score = 0
prey = 0
mark = 1
6
mch(1) = 1
mch(2) = 2
mch(3) = 3
mch(4) = 4
mch(5) = 5
mch(6) = 6
IF champdone = 1 AND users <> 0 THEN mch(7) = 7 ELSE mch(7) = 0
IF champdone = 1 AND usernumber > 4 THEN mch(8) = 71 ELSE mch(8) = 0
IF champdone = 1 AND usernumber > 4 THEN mch(9) = 76 ELSE mch(9) = 0
mch(10) = 8
SELECT CASE MenuChoice%(10, mark, 12)
CASE 1
map$ = ""
score = 0: oldscore = 0: champ = 0: lives = 1: defscreen: speedlevel = 0: SPEEDset: playSNAKE: EXIT SUB
CASE 2
map$ = ""
champ = 1: prey = 10: showinfo 3, prey: level = 1: score = 0: oldscore = 0: lives = 5: defscreen: speedlevel = 0: SPEEDset: playSNAKE: EXIT SUB
CASE 3
map$ = ""
GOSUB pass
CASE 4
highscores 1
mark = 4
GOTO 6
CASE 5
options
CASE 6
zap
instructions
mark = 6
GOTO 6
CASE 7
login
LINE (0, 130)-(639, 479), 3, BF
mark = 7
GOTO 6
CASE 8
SELECT CASE user.level
CASE 1: nextlvl = 200
CASE 2: nextlvl = 400
CASE 3: nextlvl = 700
CASE 4: nextlvl = 1000
CASE 5: nextlvl = 1400
CASE 6: nextlvl = 1800
CASE 7: nextlvl = 2200
CASE 8: nextlvl = 2600
CASE 9: nextlvl = 3000
CASE 10: nextlvl = 0
END SELECT
OPEN "profile.txt" FOR APPEND AS #11
PRINT #11, user.nickname
PRINT #11, user.avscore
PRINT #11, user.gplayed
PRINT #11, user.level
PRINT #11, lang%
PRINT #11, LTRIM$(RTRIM$(STR$(nextlvl)))
PRINT #11, cpu#
CLOSE #11
CLS
logo
IF champdone = 1 THEN center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
drawJEP (user.level)
CHAIN "profile.bas"
CASE 9
customs
map$ = ""
zap
mark = 9: GOTO 6
CASE 10
CLOSE #2: KILL "files\snake.tem": SYSTEM
EXIT SUB
END SELECT
LOOP
pass:
center SPACE$(25), 16
DO
LOCATE 16, 38: PRINT SPACE$(6)
pass$ = ask$("", 38, 16, 5, 2)
SELECT CASE pass$
CASE "down": center eng$(3, lang%), 16: a$ = CHR$(0) + "P": GOTO 6
CASE "up": center eng$(3, lang%), 16: a$ = CHR$(0) + "H": GOTO 6
CASE "exit": a$ = "": GOTO 6
CASE ELSE: EXIT DO
END SELECT
LOOP
FOR i = 1 TO 10
IF pass$ = top(i).id THEN
champ = 1: prey = 10: showinfo 3, prey: level = i: lives = 5: score = 0: oldscore = 0: defscreen: SPEEDset: playSNAKE: EXIT SUB
END IF
NEXT
SOUND 60, 10
LOCATE 16, 39: COLOR 4: PRINT "-----": t# = TIMER + 2: DO: LOOP UNTIL TIMER >= t#
mark = 3
GOTO 6

END SUB

FUNCTION MenuChoice% (selections, start, xstart)
sel = start
CONST MenuBright = "-15-"
CONST MenuDull = "-8-"
DO
FOR i = 1 TO selections
IF mch(i) > 0 THEN
w$ = eng$(mch(i), lang%)
IF i = sel THEN w$ = MenuBright + "[ " + "-5-" + w$ + MenuBright + " ]" ELSE w$ = MenuDull + " " + w$ + " "
center w$, xstart + ((i - 1) * 2)
END IF
NEXT i
DO: LOOP UNTIL INKEY$ = "": DO: a$ = UCASE$(INKEY$): LOOP WHILE a$ = ""

SOUND 150, 1
SELECT CASE a$
CASE CHR$(27): SYSTEM
CASE CHR$(0) + "P":
DO
sel = sel + 1: IF sel > selections THEN sel = 1
LOOP WHILE mch(sel) = 0
CASE CHR$(0) + "H":
DO
sel = sel - 1: IF sel < 1 THEN sel = selections
LOOP WHILE mch(sel) = 0
CASE CHR$(13), CHR$(32): side$ = "": EXIT DO
CASE CHR$(0) + "K": IF side$ = "?" THEN side$ = "-": EXIT DO
CASE CHR$(0) + "M": IF side$ = "?" THEN side$ = "+": EXIT DO
END SELECT
t# = TIMER + .05: DO: LOOP UNTIL TIMER >= t#
LOOP

MenuChoice% = sel
END FUNCTION

SUB options
16
LINE (0, 130)-(639, 479), 3, BF
center eng$(42, lang%), 11
mch(1) = 43
IF champdone = 1 THEN
IF user.lvlreached >= 3 AND usernumber > 4 THEN mch(3) = 47 ELSE mch(3) = 0
mch(2) = 52
ELSE
mch(2) = 0
mch(3) = 0
END IF
mch(4) = 22
mark = MenuChoice%(4, 1, 15)
settings mark
IF mark = 4 THEN LINE (0, 130)-(639, 479), 3, BF: EXIT SUB
GOTO 16
END SUB

FUNCTION place (x)
begin = start
FOR i = 2 TO x STEP 1
begin = begin + 1: IF begin > snakelength THEN begin = 1
NEXT
place = begin
END FUNCTION

SUB playSNAKE
IF user.lvlreached > 4 THEN flag = 2 ELSE flag = 1
3
showinfo 3, prey
death$ = ""
1
rats = 0
IF death$ <> "" THEN
IF lives = 0 THEN score = score + INT((score / 30)) * user.rats: showinfo 2, score
GET (199, 89)-(441, 308), background
LINE (199, 89)-(441, 308), 3, BF
LINE (199, 89)-(441, 308), 7, B
LINE (201, 91)-(439, 306), 7, B

COLOR 15: center death$, 9
IF lives = 0 THEN center eng$(28, lang%), 11: center eng$(29, lang%), 13
IF lives = 0 THEN
mch(1) = 22
IF MenuChoice%(1, 1, 16) = 1 THEN highscores 2: EXIT SUB
END IF
IF lives > 0 THEN mch(1) = 37: mark = 1 ELSE mch(1) = 0: mark = 2
mch(2) = 22
IF MenuChoice%(2, mark, 13) = 2 THEN EXIT SUB
PUT (199, 89), background, PSET
clearground mcol, mrow
IF lives = 0 THEN highscores 2: EXIT SUB
END IF
death$ = ""
initialize
IF champ = 1 THEN score = oldscore: showinfo 2, score
IF champ = 1 THEN IF setuplevel = 2 THEN EXIT SUB
realspeed = SPEED!
IF champ = 0 THEN
GET (199, 89)-(441, 308), background
FOR i = 3 TO 1 STEP -1
center eng$(19, lang%) + STR$(i) + "...", 13
t# = TIMER + 1: DO: LOOP UNTIL TIMER >= t#
NEXT
PUT (199, 89), background, PSET
END IF
GOSUB PUTmouse
col = 23: row = 23
colchange = 1: rowchange = 0
direction = east: oldd = east
plusl = 0
start = 1

DO: LOOP UNTIL INKEY$ = ""
FOR r = 1 TO 10
GOSUB rattle
NEXT r

DO

startplay:
a$ = INKEY$
SELECT CASE a$
CASE CHR$(0) + "M"
IF colchange <> -1 THEN colchange = 1: rowchange = 0: direction = east
CASE CHR$(0) + "P"
IF rowchange <> -1 THEN rowchange = 1: colchange = 0: direction = south
CASE CHR$(0) + "K"
IF colchange <> 1 THEN colchange = -1: rowchange = 0: direction = west
CASE CHR$(0) + "H"
IF rowchange <> 1 THEN rowchange = -1: colchange = 0: direction = north
CASE CHR$(32)
GOSUB pausemenu
CASE CHR$(27)
GOSUB pausemenu
CASE CHR$(13)
GOSUB pausemenu
CASE "p"
GOSUB pausemenu
END SELECT
IF champ = 1 THEN
IF prey = 0 THEN oldscore = score: showinfo 2, score: level = level + 1: clearground mcol, mrow: prey = 10: GOTO 3
END IF
IF ground(col + colchange, row + rowchange) < 0 THEN
t# = TIMER + .1
DO
a$ = INKEY$
SELECT CASE a$
CASE CHR$(0) + "M"
IF colchange <> -1 THEN colchange = 1: rowchange = 0: direction = east: EXIT DO
CASE CHR$(0) + "P"
IF rowchange <> -1 THEN rowchange = 1: colchange = 0: direction = south: EXIT DO
CASE CHR$(0) + "K"
IF colchange <> 1 THEN colchange = -1: rowchange = 0: direction = west: EXIT DO
CASE CHR$(0) + "H"
IF rowchange <> 1 THEN rowchange = -1: colchange = 0: direction = north: EXIT DO
END SELECT
LOOP UNTIL TIMER > t#
END IF
row = row + rowchange: col = col + colchange
IF rats < user.rats THEN IF INT(RND * 100) = 2 THEN GOSUB PUTrat

'lengthen
IF plusl THEN
OPEN "store.txt" FOR RANDOM AS #3 LEN = LEN(snake(1))
FOR i = 1 TO snakelength
GET #2, place(i), snake(1)
PUT #3, i, snake(1)
NEXT
snakelength = snakelength + 1
ground(snake(1).col, snake(1).row) = 0
FOR i = 1 TO snakelength
GET #3, i, snake(1)
IF i = snakelength THEN snake(1).col = 1: snake(1).row = 1
PUT #2, i, snake(1)
NEXT
start = 1
CLOSE #3: KILL "store.txt"
plusl = plusl - 1
END IF
oldstart = start
GET #2, oldstart, snake(1)
snake(2).col = col
snake(2).row = row
snake(2).TURN = 0
snake(2).dir = direction
snake(2).rdir = direction
start = start - 1: IF start = 0 THEN start = snakelength
GET #2, start, snake(1)
ground(snake(1).col, snake(1).row) = 0
PUT #2, start, snake(2)

IF direction <> oldd THEN
GET #2, oldstart, snake(1)
snake(1).TURN = TURN
SELECT CASE oldd
CASE north
IF direction = east THEN snake(1).dir = NE
IF direction = west THEN snake(1).dir = NW
snake(1).rdir = north
CASE east
IF direction = north THEN snake(1).dir = EN
IF direction = south THEN snake(1).dir = ES
snake(1).rdir = east
CASE south
IF direction = east THEN snake(1).dir = SE
IF direction = west THEN snake(1).dir = SW
snake(1).rdir = south
CASE west
IF direction = north THEN snake(1).dir = WN
IF direction = south THEN snake(1).dir = WS
snake(1).rdir = west
END SELECT
PUT #2, oldstart, snake(1)
END IF
oldd = direction
IF ground(col, row) < 0 THEN
lives = lives - 1: showinfo 1, lives
IF ground(col, row) = -2 THEN death$ = "-12-*-15- " + eng$(25, lang%) + "-12- *"
IF ground(col, row) = -1 THEN death$ = "-12-*-15- " + eng$(26, lang%) + "-12- *"
GOTO 1
END IF
27
IF ground(col, row) = 1000 THEN
IF direction = mdirection THEN
score = score + speedlevel * 10: showinfo 2, score
IF champ = 0 THEN prey = prey + 1: showinfo 3, prey
IF champ = 1 THEN prey = prey - 1: showinfo 3, prey
PLAY "MBT80L64O6D-E-E"
IF champ = 1 THEN plusl = plusl + 4
plusl = plusl + 1: GOSUB PUTmouse
ELSE
GOSUB PUTmouse
END IF
END IF
IF ground(col, row) = 2000 THEN
PLAY "MBMST128L64O2D-E-E"
randomdeath = INT(RND * 10) + 1
score = score - 50: IF score < 0 THEN score = 0
showinfo 2, score
rats = rats - 1
IF randomdeath < 3 THEN lives = lives - 1: showinfo 1, lives: death$ = "-12-*-15-" + eng$(27, lang%) + "-12-*": GOTO 1
plusl = plusl + 10
END IF
drawmove

FOR i! = 1 TO realspeed: NEXT


LOOP


PUTmouse:
GET #2, place(snakelength), snake(1)
ground(snake(1).col, snake(1).row) = 1
DO
mcol = INT(RND * 30) + 2
mrow = INT(RND * 22) + 2
LOOP UNTIL ground(mcol, mrow) = 0
mdirection = INT(RND * 4) * 125
IF user.lvlreached > 4 THEN IF flag = 1 THEN flag = 2 ELSE flag = 1
IF flag = 1 THEN PUTimage mcol, mrow, mouse + mdirection
IF flag = 2 THEN PUTimage mcol, mrow, frog + mdirection
ground(mcol, mrow) = 1000
ground(snake(1).col, snake(1).row) = 0
PUT #2, place(snakelength), snake(1)
RETURN

PUTrat:
DO
rcol = INT(RND * 30) + 2
rrow = INT(RND * 22) + 2
LOOP UNTIL ground(rcol, rrow) = 0
PUTimage rcol, rrow, rat
ground(rcol, rrow) = 2000
rats = rats + 1
RETURN

rattle:
PUT (160, 438), imageSET(rattle + east), PSET
GOSUB cd
PUT (160, 440), imageSET(rattle + east), PSET
GOSUB cd
PUT (160, 442), imageSET(rattle + east), PSET
GOSUB cd
PUT (160, 440), imageSET(rattle + east), PSET
GOSUB cd
IF ground(9, 22) < 0 THEN PUTimage 9, 22, block
IF ground(9, 24) < 0 THEN PUTimage 9, 24, block
IF ground(9, 22) = 1000 THEN PUTimage mcol, mrow, mouse + mdirection
RETURN

cd:
PLAY "MFMST255L64O1CD"
RETURN


pausemenu:

GET (199, 89)-(441, 308), background
mark = 1
7
LINE (199, 89)-(441, 308), 3, BF
LINE (199, 89)-(441, 308), 7, B
LINE (201, 91)-(439, 306), 7, B
center eng$(20, lang%), 9
mch(1) = 21
mch(2) = 22
mch(3) = 23
mch(4) = 8
DO
mark = MenuChoice%(4, mark, 12)
LOOP UNTIL side$ = ""
SELECT CASE mark
CASE 1
PUT (199, 89), background, PSET
FOR i = 3 TO 1 STEP -1
center eng$(24, lang%) + STR$(i) + "...", 13
t# = TIMER + 1
DO: LOOP UNTIL TIMER >= t#
NEXT
PUT (199, 89), background, PSET
t# = TIMER + .05: DO: LOOP UNTIL TIMER > t#
RETURN
CASE 2
EXIT SUB
CASE 3
SPEEDset
realspeed = SPEED!: mark = 3: GOTO 7
CASE 4
CLOSE #2: KILL "files\snake.tem": SYSTEM
RETURN
END SELECT
END SUB

SUB PRINTIT (text$, x, y)
textlen = LEN(text$)
FOR i = 1 TO LEN(text$)
a$ = MID$(text$, i, 1)
IF a$ = "^" THEN textlen = textlen - 1
IF a$ = "-" THEN
textlen = textlen - 2
IF MID$(text$, i + 2, 1) = "-" THEN
textlen = textlen - 1: i = i + 3: GOTO 25
ELSE
textlen = textlen - 2: i = i + 4: GOTO 25
END IF
END IF
25
NEXT
s = 0
c = 15
ii = 0
FOR i = 1 TO LEN(text$)
a$ = MID$(text$, i, 1)
IF a$ = "-" THEN
IF MID$(text$, i + 2, 1) = "-" THEN c = VAL(MID$(text$, i + 1, 1)): i = i + 2 ELSE c = VAL(MID$(text$, i + 1, 2)): i = i + 3
GOTO 26
END IF
IF a$ = "^" THEN s = 1: GOTO 26
ii = ii + 1
z = ASC(a$)
SELECT CASE a$
CASE "=": z = 45
CASE "#": IF s = 1 THEN s = 0: z = 144 ELSE z = 130
CASE "@": IF s = 1 THEN s = 0: z = 143 ELSE z = 160
CASE "|": IF s = 1 THEN s = 0: z = 161 ELSE z = 161
CASE "$": IF s = 1 THEN s = 0: z = 162 ELSE z = 162
CASE "_": IF s = 1 THEN s = 0: z = 163 ELSE z = 163
CASE "<": IF s = 1 THEN s = 0: z = 153 ELSE z = 148
CASE ">": IF s = 1 THEN s = 0: z = 154 ELSE z = 129
END SELECT
COLOR c
LOCATE y, x + ii - 1: PRINT CHR$(z)
26
NEXT

END SUB

SUB PUTimage (col, row, index)
x = (col - 1) * 20
y = (row - 1) * 20
PUT (x, y), imageSET(index), PSET
IF index < 6000 THEN ground(col, row) = -1
IF index = block THEN ground(col, row) = -2
END SUB

SUB restorecolors
RESTORE Paletteinfo
FOR n = 0 TO 15
READ red, green, blue
OUT &H3C8, n
OUT &H3C9, red
OUT &H3C9, green
OUT &H3C9, blue
NEXT

END SUB

SUB settings (i)
LINE (0, 130)-(639, 479), 3, BF

SELECT CASE i
CASE 1
mch(1) = 44
mch(2) = 45
mark = 2
CASE 2
mch(1) = 53
IF users > 0 THEN
mch(2) = 54
mch(3) = 55
ELSE
mch(2) = 0
mch(3) = 0
END IF
mch(4) = 46
mark = 4
CASE 3
mch(1) = 48
IF user.lvlreached < 4 THEN mch(2) = 0 ELSE mch(2) = 49
IF user.lvlreached < 6 THEN mch(3) = 0 ELSE mch(3) = 50
IF user.lvlreached < 7 THEN mch(4) = 0 ELSE mch(4) = 51
mch(5) = 46
mark = 5
center "-12-" + SPACE$(14) + STR$(user.rats), 12
PUTimage 24, 10, head + north: PUTimage 24, 11, neck + north: PUTimage 24, 12, shoulder + north
PUTimage 24, 13, body + north: PUTimage 24, 14, shoulder + north: PUTimage 24, 15, neck + north
PUTimage 24, 16, tail + north: PUTimage 24, 17, tailEND + north: PUTimage 24, 18, rattle + north

CASE 4: EXIT SUB
END SELECT
8
SELECT CASE i
CASE 1
LINE (0, 130)-(639, 479), 3, BF
lang% = MenuChoice%(mark, lang%, 12)
zap
center eng$(42, lang%), 11
user.language = lang%
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
IF usernumber > 4 THEN PUT #1, usernumber, user
CLOSE #1
EXIT SUB
CASE 2
SELECT CASE MenuChoice%(4, 1, 15)
CASE 1: oldnumber = usernumber: GOSUB create
CASE 2: oldnumber = usernumber: GOSUB change
CASE 3: oldnumber = usernumber: GOSUB delete
CASE 4
EXIT SUB
END SELECT

CASE 3
mmark = 1
DO
side$ = "?"
mmark = MenuChoice%(mark, mmark, 12)
lrmark = 0
IF side$ = "-" THEN lrmark = -1
IF side$ = "+" THEN lrmark = 1
SELECT CASE mmark
CASE 1
user.rats = user.rats + lrmark: IF user.rats > 5 THEN user.rats = 0
IF user.rats < 0 THEN user.rats = 5
center "-12-" + SPACE$(14) + STR$(user.rats), 12
CASE 2
user.bg = user.bg + lrmark: IF user.bg > 5 THEN user.bg = 1
IF user.bg < 1 THEN user.bg = 5
changeapp 1
CASE 3
user.snakec = user.snakec + lrmark: IF user.snakec > 5 THEN user.snakec = 1
IF user.snakec < 1 THEN user.snakec = 5
changeapp 2
CASE 4
user.spattern = user.spattern + lrmark: IF user.spattern > 5 THEN user.spattern = 1
IF user.spattern < 1 THEN user.spattern = 5
changeapp 3
CASE 5
IF side$ = "" THEN EXIT DO
END SELECT
LOOP
IF usernumber > 4 THEN
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
PUT #1, usernumber, user
CLOSE #1
END IF
EXIT SUB
END SELECT

create:
IF lrmark <> 0 THEN a$ = "": GOTO 8
LINE (0, 130)-(639, 479), 3, BF
DO
LOCATE 16, 30: PRINT SPACE$(33)
pname$ = ask$(eng$(34, lang%), 30, 16, 16, 1)
SELECT CASE pname$
CASE "exit": a$ = "": LINE (0, 130)-(639, 479), 3, BF: GOTO 8
CASE "down"
CASE "up"
CASE ELSE: EXIT DO
END SELECT
LOOP
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
FOR n = 1 TO users
GET #1, n + 4, user
IF RTRIM$(user.nickname) = pname$ THEN center "-12-" + eng$(60, lang%), 17: SOUND 60, 5: t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#: center SPACE$(25), 17: GET #1, oldnumber, user: CLOSE #1: GOSUB create
NEXT
GET #1, usernumber, user
CLOSE #1
DO
center SPACE$(55), 19
center SPACE$(55), 21
9
pass$ = ask$(eng$(3, lang%) + ":", 28, 19, 8, 2)
IF pass$ = "exit" THEN a$ = "": LINE (0, 130)-(639, 479), 3, BF: GOTO 8
IF pass$ = "down" OR pass$ = "up" THEN LOCATE 25, 35: PRINT SPACE$(25): GOTO 9
11
repass$ = ask$(eng$(57, lang%), 26, 21, 8, 2)
IF repass$ = pass$ THEN EXIT DO
IF repass$ = "exit" THEN a$ = "": LINE (0, 130)-(639, 479), 3, BF: GOTO 8
IF repass$ <> "down" AND repass$ <> "up" THEN
SOUND 60, 5
center "-12-" + eng$(59, lang%), 24
t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#
center SPACE$(30), 24
ELSE
center SPACE$(30), 24
GOTO 11
END IF
LOOP

user.nickname = pname$
user.password = pass$
user.level = 1
user.avscore = 0
user.gplayed = 0
user.lvlreached = 1
user.language = lang%
user.gmode = 1
user.rats = 3
user.bg = 1
user.snakec = 1
user.spattern = 1
users = users + 1: usernumber = 4 + users
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
PUT #1, 4 + users, user
CLOSE #1
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(users)
PUT #1, 2, usernumber
PUT #1, 3, users
CLOSE #1
IF users > 0 THEN
mch(2) = 54
mch(3) = 55
ELSE
mch(2) = 0
mch(3) = 0
END IF
center SPACE$(65), 1
center eng$(70, lang) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
changeapp 1: changeapp 2: changeapp 3
LINE (0, 130)-(639, 479), 3, BF: GOTO 8

change:
IF lrmark <> 0 THEN a$ = "": GOTO 8

LINE (0, 130)-(639, 479), 3, BF
DO
LOCATE 16, 30: PRINT SPACE$(53)
pname$ = ask$(eng$(34, lang%), 30, 16, 16, 1)
SELECT CASE pname$
CASE "exit": a$ = "": LINE (0, 130)-(639, 479), 3, BF: GOTO 8
CASE "down"
CASE "up"
CASE ELSE: EXIT DO
END SELECT
LOOP
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
FOR n = 1 TO users
GET #1, n + 4, user
IF RTRIM$(user.nickname) = pname$ THEN usernumber = n + 4: GOTO 15
NEXT
center "-12-" + eng$(61, lang%), 17: usernumber = oldnumber: GET #1, usernumber, user: CLOSE #1: t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#: center SPACE$(55), 17: GOSUB change
15
GET #1, usernumber, user
DO
center SPACE$(50), 19
pass$ = ask$(eng$(56, lang%), 28, 19, 8, 2)
SELECT CASE pass$
CASE "exit": a$ = "": LINE (0, 130)-(639, 479), 3, BF: usernumber = oldnumber: GET #1, usernumber, user: CLOSE #1: GOTO 8
CASE "down"
CASE "up"
CASE ELSE
IF pass$ <> RTRIM$(user.password) THEN center "-12-" + eng$(58, lang%), 20: t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#: center SPACE$(50), 20: GOTO 15
GOTO 14
END SELECT
LOOP
14
LOCATE 25, 35: PRINT SPACE$(35)
DO
pass$ = ask$(eng$(62, lang%), 24, 21, 8, 2)
SELECT CASE pass$
CASE "exit": a$ = "": LINE (0, 130)-(639, 479), 3, BF: usernumber = oldnumber: GET #1, usernumber, user: CLOSE #1: GOTO 8
CASE "down"
CASE "up"
CASE ELSE
EXIT DO
END SELECT
LOOP
DO
pass1$ = ask$(eng$(57, lang%), 22, 22, 8, 2)
SELECT CASE pass1$
CASE "exit": a$ = "": LINE (0, 130)-(639, 479), 3, BF: usernumber = oldnumber: GET #1, usernumber, user: CLOSE #1: GOTO 8
CASE "down"
CASE "up"
CASE ELSE
IF pass$ = pass1$ THEN EXIT DO ELSE center SPACE$(65), 21: center SPACE$(65), 22: center "-12-" + eng$(59, lang%), 21: t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#: center SPACE$(55), 21: GOTO 14
END SELECT
LOOP
user.password = pass$
PUT #1, usernumber, user
CLOSE #1
LINE (0, 130)-(639, 479), 3, BF: a$ = ""
GOTO 8

delete:
IF lrmark <> 0 THEN a$ = "": GOTO 8
LINE (0, 130)-(639, 479), 3, BF
DO
pname$ = ask$(eng$(34, lang%), 30, 16, 16, 1)
LINE ((43 + LEN(pname$)) * 8, 240)-((43 + LEN(pname$)) * 8, 254), 3
SELECT CASE pname$
CASE "exit": a$ = "": LINE (0, 130)-(639, 479), 3, BF: GOTO 8
CASE "down"
CASE "up"
CASE ELSE: EXIT DO
END SELECT
LOOP
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
FOR n = 1 TO users
GET #1, n + 4, user
IF RTRIM$(user.nickname) = pname$ THEN usernumber = n + 4: GOTO 13
NEXT
center "-12-" + eng$(61, lang%), 17: usernumber = oldnumber: GET #1, usernumber, user: CLOSE #1: t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#: GOSUB delete
13
GET #1, usernumber, user
DO
LOCATE 25, 35: PRINT SPACE$(25)
LOCATE 27, 33: PRINT SPACE$(25)
12
pass$ = ask$(eng$(56, lang%), 28, 19, 8, 2)
IF pass$ = "exit" THEN a$ = "": LINE (0, 130)-(639, 479), 3, BF: usernumber = oldnumber: GET #1, usernumber, user: CLOSE #1: a$ = "": GOTO 8
IF pass$ = "down" OR pass$ = "up" THEN center SPACE$(65), 19: GOTO 12
IF pass$ <> RTRIM$(user.password) THEN center SPACE$(60), 19: center "-12-" + eng$(58, lang%), 19: t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#: center SPACE$(50), 19: GOTO 12
COLOR 12: center eng$(63, lang%), 21
mch(1) = 64
mch(2) = 65
IF MenuChoice%(2, 1, 24) = 1 THEN EXIT DO
mch(1) = 53
mch(2) = 54
usernumber = oldnumber: GET #1, usernumber, user: CLOSE #1: LINE (0, 130)-(639, 479), 3, BF: GOTO 8
LOOP
mch(1) = 53
mch(2) = 54
IF users > 1 THEN
FOR n = usernumber + 1 TO 4 + users
GET #1, n, user
PUT #1, n - 1, user
NEXT n
END IF
user.nickname = ""
user.password = ""
user.level = 0
user.avscore = 0
user.lvlreached = 0
user.language = 0
user.gmode = 0
user.rats = 0
user.bg = 0
user.snakec = 0
user.spattern = 0
PUT #1, 4 + users, user
users = users - 1: usernumber = 4
GET #1, 4, user
CLOSE #1
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(users)
PUT #1, 2, usernumber
PUT #1, 3, users
CLOSE #1
IF users > 0 THEN
mch(2) = 54
mch(3) = 55
ELSE
mch(2) = 0
mch(3) = 0
END IF
LINE (0, 130)-(639, 479), 3, BF
center SPACE$(65), 1
center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
changeapp 1: changeapp 2: changeapp 3
a$ = ""
GOTO 8

END SUB

FUNCTION setuplevel
lvl = level
ERASE ground
FOR y = 2 TO 23
FOR x = 2 TO 31
ground(x, y) = 0
LINE ((x - 1) * 20, (y - 1) * 20)-((x - 1) * 20 + 19, (y - 1) * 20 + 19), 3, BF
NEXT
NEXT
initialize
prey = 10
showinfo 3, prey
SELECT CASE lvl
CASE 1: RESTORE lvl1
CASE 2: RESTORE lvl2
CASE 3: RESTORE lvl3
CASE 4: RESTORE lvl4
CASE 5: RESTORE lvl5
CASE 6: RESTORE lvl6
CASE 7: RESTORE lvl7
CASE 8: RESTORE lvl8
CASE 9: RESTORE lvl9
CASE 10
FOR i = 0 TO 1
FOR x = 4 + i TO 28 + i STEP 6
PUTimage x, 4, block
PUTimage x, 21, block
PUTimage x, 9, block
PUTimage x, 10, block
PUTimage x, 15, block
PUTimage x, 16, block
ground(x, 21) = -2: ground(x, 9) = -2: ground(x, 15) = -2
ground(x, 4) = -2: ground(x, 10) = -2: ground(x, 16) = -2
NEXT
NEXT
FOR x = 3 TO 30 STEP 3
PUTimage x, 5, block
PUTimage x, 20, block
PUTimage x, 8, block
PUTimage x, 9, block
PUTimage x, 10, block
PUTimage x, 15, block
PUTimage x, 16, block
PUTimage x, 17, block
ground(x, 5) = -2: ground(x, 8) = -2: ground(x, 10) = -2: ground(x, 16) = -2
ground(x, 20) = -2: ground(x, 9) = -2: ground(x, 15) = -2: ground(x, 17) = -2
NEXT
CASE 11
score = score * lives
showinfo 2, score
GET (190, 119)-(450, 278), background
LINE (190, 119)-(450, 278), 3, BF
LINE (190, 119)-(450, 278), 7, B
LINE (192, 121)-(448, 276), 7, B
center "-12-" + eng$(32, lang%), 11
IF champdone = 0 THEN center eng$(38, lang%), 13
center "-5-" + eng$(22, lang%), 15
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(champdone)
champdone = 1: PUT #1, 1, champdone: CLOSE #1
DO
DO: LOOP UNTIL INKEY$ = ""
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
IF a$ = CHR$(27) OR a$ = CHR$(13) OR a$ = CHR$(32) THEN
PUT (190, 119), background, PSET
clearground 2, 4
highscores 2: setuplevel = 2: EXIT FUNCTION
END IF
LOOP
END SELECT

IF lvl < 10 THEN
DO
READ startx
IF startx = 0 THEN EXIT DO
READ starty, endx, endy
IF startx < endx THEN iist = 1 ELSE iist = -1
IF starty < endy THEN ist = 1 ELSE ist = -1
FOR i = starty TO endy STEP ist
FOR ii = startx TO endx STEP iist

PUTimage ii, i, block
ground(ii, i) = -2
NEXT
NEXT
LOOP
END IF
5
COLOR 15
GET (199, 89)-(441, 308), background
LINE (199, 136)-(441, 280), 3, BF
LINE (201, 138)-(439, 278), 8, B
LINE (199, 136)-(441, 280), 8, B
center eng$(35, lang%) + " = " + LTRIM$(RTRIM$(STR$(lvl))), 10
center top(level).id, 11
mch(1) = 36
mch(2) = 23
mch(3) = 22
SELECT CASE MenuChoice%(3, 1, 13)
CASE 2: SPEEDset: realspeed = SPEED!: GOTO 5
CASE 3: setuplevel = 2
CASE ELSE: setuplevel = 1
END SELECT
PUT (199, 89), background, PSET
END FUNCTION

SUB showinfo (index, value)
SELECT CASE index
CASE 1
PUT (80, 4), numSET(value * 40), PSET
CASE 2
IF value < 10 THEN v$ = "0000" + LTRIM$(RTRIM$(STR$(value)))
IF value > 9 AND value < 100 THEN v$ = "000" + LTRIM$(RTRIM$(STR$(value)))
IF value > 99 AND value < 1000 THEN v$ = "00" + LTRIM$(RTRIM$(STR$(value)))
IF value > 999 AND value < 10000 THEN v$ = "0" + LTRIM$(RTRIM$(STR$(value)))
IF value > 9999 THEN v$ = LTRIM$(RTRIM$(STR$(value)))
FOR i = 552 TO 584 STEP 8
PUT (i, 4), numSET(VAL(MID$(v$, (i - 552) / 8 + 1, 1)) * 40), PSET
NEXT
CASE 3
IF value < 10 THEN p$ = "000" + LTRIM$(RTRIM$(STR$(value)))
IF value > 9 AND value < 100 THEN p$ = "00" + LTRIM$(RTRIM$(STR$(value)))
IF value > 99 AND value < 1000 THEN p$ = "0" + LTRIM$(RTRIM$(STR$(value)))
IF value > 999 THEN p$ = LTRIM$(RTRIM$(STR$(value)))
FOR i = 353 TO 377 STEP 8
PUT (i, 464), numSET(VAL(MID$(p$, (i - 353) / 8 + 1, 1)) * 40), PSET
NEXT
END SELECT

END SUB

SUB SPEEDset
COLOR 15
IF speedlevel = 0 THEN GET (199, 89)-(441, 308), background
LINE (199, 89)-(441, 308), 3, BF
LINE (199, 89)-(441, 308), 7, B
LINE (201, 91)-(439, 306), 7, B
IF speedlevel <> 0 THEN mark = speedlevel ELSE mark = 3
mch(1) = 14
mch(2) = 15
mch(3) = 16
mch(4) = 17
mch(5) = 18
center eng$(13, lang%), 8
SELECT CASE MenuChoice%(5, mark, 10)
CASE 1
SPEED! = 120000 / ((cpu# / 10) / (1.59 / 10)): speedlevel = 1
CASE 2
SPEED! = 90000 / ((cpu# / 14.286) / (1.59 / 14.286)): speedlevel = 2
CASE 3
SPEED! = 60000 / ((cpu# / 20) / (1.59 / 20)): speedlevel = 3
CASE 4
SPEED! = 30000 / ((cpu# / 33.333) / (1.59 / 33.333)): speedlevel = 4
CASE 5
SPEED! = 15000 / ((cpu# / 50) / (1.59 / 50)): speedlevel = 5
END SELECT
FOR i = 8 TO 18 STEP 2
center SPACE$(24), (i)
NEXT
PUT (199, 89), background, PSET
END SUB

SUB startup
PAINT (0, 0), 3
mch(1) = 44
mch(2) = 45
lang% = MenuChoice%(2, 1, 12)
23
IF users > 0 THEN
mch(2) = 66
mch(1) = 67
IF MenuChoice(2, 1, 12) = 1 THEN
GOTO 24
ELSE
center SPACE$(35), 12
center SPACE$(35), 14
pname$ = ask$(eng$(68, lang%), 30, 11, 16, 1)
SELECT CASE pname$
CASE "exit": SYSTEM
CASE ELSE
GOTO 22
END SELECT
22
pass$ = ask$(eng$(56, lang%), 31, 13, 8, 2)
center SPACE$(35), 11
center SPACE$(35), 13
SELECT CASE pass$
CASE "exit": SYSTEM
CASE ELSE
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
FOR i = 5 TO 4 + users
GET #1, i, user
IF RTRIM$(user.nickname) = pname$ AND RTRIM$(user.password) = pass$ THEN
CLOSE #1
usernumber = i
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(usernumber)
PUT #1, 2, usernumber
CLOSE #1
changeapp 1: changeapp 2: changeapp 3
LINE (0, 130)-(639, 479), 3, BF
center SPACE$(65), 1
center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
EXIT SUB
END IF
NEXT
END SELECT
GET #1, usernumber, user
center SPACE$(30), 11
center SPACE$(30), 13
center "-12-" + eng$(69, lang%), 13
t# = TIMER + 1.5: DO: LOOP UNTIL TIMER >= t#
center SPACE$(35), 13
CLOSE #1
PAINT (0, 0), 3
GOTO 23
END IF
ELSE
24
usernumber = 2
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(user)
GET #1, 4, user
CLOSE #1
changeapp 1: changeapp 2: changeapp 3
OPEN "files\snake.use" FOR RANDOM AS #1 LEN = LEN(usernumber)
PUT #1, 2, usernumber
CLOSE #1
LINE (0, 130)-(639, 479), 3, BF
center SPACE$(65), 1
center eng$(70, lang%) + " " + MID$(RTRIM$(user.nickname), 1, 1) + LCASE$(MID$(RTRIM$(user.nickname), 2, LEN(RTRIM$(user.nickname)) - 1)), 1
EXIT SUB
END IF
END SUB

SUB testlevel
RESTORE lvls
FOR i = 10 TO 1 STEP -1
READ x
IF user.avscore >= x THEN user.level = i: EXIT FOR
NEXT
IF user.level > user.lvlreached THEN user.lvlreached = user.level
END SUB

SUB zap
LINE (0, 130)-(639, 479), 3, BF
END SUB



    
This message has been edited by Tusike on Jan 4, 2008 12:13 PM
This message has been edited by Tusike on Dec 22, 2007 11:07 AM
This message has been edited by Tusike on Dec 16, 2007 5:49 AM
This message has been edited by Tusike on Dec 15, 2007 9:37 AM


 
 Respond to this message   
Response TitleAuthorDate
 Creatf.bas -creates files for snake Dec 14, 2007
 profile.bas - used in Snake Dec 15, 2007
 Custom.bas - allows USERS to create levels Dec 22, 2007