Snake Game

1 REM A silly serpent game: Works on https://www.calormen.com/jsbasic/
10 LV = 0 : HS = 0 : HL = 1 : TEXT : GOSUB 9000 : GOTO 100

50 REM Buffer key
51 IF KN >= KS THEN RETURN
52 A = PEEK(IK%) : IF A < 128 THEN RETURN
53 POKE QK%, 0 : B = KH + KN : IF B >= KS THEN B = B - KS
54 KB%(B) = A - 128 : KN = KN + 1 : RETURN

60 REM Extract key from buffer
61 K = 0 : IF NOT KN THEN RETURN
62 K = KB%(KH) : KN = KN - 1 : KH = KH + 1 : IF KH >= KS THEN KH = 0
63 RETURN

70 REM Clear key buffer
71 K = 0 : KN = 0 : POKE QK%, 0 : RETURN

100 REM New game loop (preserving high score)
110 GOSUB 7000 : REM Intro
120 SC = 0 : LV = 1 : BS = INT(H / 3) : FL = 5 : DT = 400

200 REM Arena loop
210 GOSUB 8000 : REM BeginLevel
220 AQ = INT(0.75 * ((W - 2 * BS) * (H - 2 * BS)))

300 REM Main loop
310 VTAB 24 : HTAB 22 : PRINT SC;
320 Z%(PX, PY) = 4 + D
330 VTAB OY + PY : HTAB OX + PX : PRINT "#";
340 GOSUB 50
350 FOR I = 1 TO DT : GOSUB 50 : NEXT
360 GOSUB 50 : GOSUB 1000 : REM Fooding
370 GOSUB 50 : GOSUB 60
380 IF K = CU AND PD <> 2 THEN PD = 0
381 IF K = CR AND PD <> 3 THEN PD = 1
382 IF K = CD AND PD <> 0 THEN PD = 2
383 IF K = CL AND PD <> 1 THEN PD = 3
390 A = PX + DX%(PD) : B = PY + DY%(PD)
400 IF A < 0 OR A >= W OR B < 0 OR B >= H THEN GOTO 900 : REM Out of bounds!
410 Z%(PX, PY) = 4 + PD : REM A breadcrumb for the tail
420 PX = A : PY = B
430 A = Z%(PX, PY)
440 IF A = 1 THEN PN = PN + 5 + INT(RND(1) * 8) : NF = NF - 1 : SC = SC + LV
450 IF A >= 4 THEN GOTO 900 : REM Collision!
460 REM Advance tail (A = 1) or allow growth (A = 0)
470 A = 1 : IF PL < PN THEN A = 0 : REM Still growing!
480 PL = PL + 1 - A
490 B = Z%(TX, TY) : F = (1 - A) * B
500 Z%(TX, TY) = F : EX%(NE) = TX : EY%(NE) = TY
510 IF NOT F THEN NE = NE + 1 : REM Add to the pool of empty spaces.
520 VTAB OY + TY : HTAB OX + TX : PRINT MID$(WM$, 1 + A, 1);
530 B = B - 4 : TX = TX + A * DX%(B) : TY = TY + A * DY%(B)
540 IF PL >= AQ THEN GOTO 800 : REM Awesome victory!
550 GOSUB 50
560 GOTO 300

800 REM Screen mostly filled with snake!
820 HOME
830 LV = LV + 1
831 A = INT(0.9 * DT)
832 B = DT : IF LV = 5 * INT(LV / 5) THEN B = DT - 1
833 IF DT < 20 THEN A = B
833 DT = A
834 IF DT < 0 THEN DT = 0
840 IF LV = 3 * INT(LV / 3) THEN FL = FL - 1 : IF FL < 1 THEN FL = 1
845 IF LV = 2 * INT(LV / 2) THEN BS = BS - 1 : IF BS < 1 THEN BS = 1
850 SC = SC + 10 * LV
860 GOSUB 4000 : REM DispLabels
861 VTAB 24 : HTAB 22 : PRINT SC;
870 S0$ = "LEVEL " + STR$(LV - 1) + " COMPLETED"
871 S1$ = "````Doom awaits you in``LEVEL " + STR$(LV)
872 S2$ = "````PRESS ANY KEY"
880 GOSUB 7500 : GOSUB 5000
890 GOTO 200

900 REM Doom and giblets for Dogar and Kazon
910 VTAB OY + PY : HTAB OX + PX : PRINT "*"
920 GOSUB 3000 : REM Drama
930 GOSUB 3500 : REM SprayGiblets
940 IF SC = HS THEN IF LV > HL THEN HL = LV
950 IF SC > HS THEN HS = SC : HL = LV
960 GOTO 100

1000 REM SUB Fooding
1010 FOR I = 1 TO 2
1020 IF NE < 1 THEN RETURN
1030 C = INT(RND(1) * NE) : A = EX%(C) : B = EY%(C)
1040 E = 0 : F = Z%(A, B)
1050 IF F = 0 AND NF < FL THEN E = 1 : F = 1 : NF = NF + 1
1060 Z%(A, B) = F : IF F THEN F = 1
1070 A = A + OX : B = B + OY
1080 S$ = "o": IF NOT E THEN A = 1 : B = DH : S$ = " "
1090 IF NOT F THEN C = NE - 1
1100 EX%(C) = EX%(NE - 1) : EY%(C) = EY%(NE - 1) : NE = NE - F
1110 VTAB B : HTAB A : PRINT S$;
1120 NEXT
1130 RETURN

1500 REM SUB ClearArena
1510 NE = 0
1515 FOR I = 0 TO W - 1 : FOR J = 0 TO H - 1 : Z%(I, J) = 8 : NEXT : NEXT
1520 FOR I = BS TO W - BS - 1 : FOR J = BS TO H - BS - 1
1525 Z%(I, J) = 0 : EX%(NE) = I : EY%(NE) = J : NE = NE + 1
1530 NEXT : NEXT
1540 REM Player (with tail)
1550 PD = 1 + 2 * INT(2 * RND(1))
1560 PX = INT(W / 2) - INT((W - 2 * BS) / 3) * DX%(PD)
1561 PY = INT(H / 2) - INT((H - 2 * BS) / 3) * DY%(PD)
1570 TX = PX : TY = PY
1580 PL = 1 : PN = 10 + 2 * LV
1590 REM Food
1600 NF = 0
1610 RETURN

3000 REM SUB BeginDrama(PX, PY)
3010 S$ = "@ #.* +#" : A = 0
3020 FOR I = 1 TO 600
3030 VTAB OY + PY : HTAB OX + PX : PRINT MID$(S$, A, 1)
3040 A = A + 1 : IF A >= 8 THEN A = 0
3050 NEXT I
3060 RETURN

3500 REM SUB SprayGiblets(PX, PY)
3550 FOR I = 0 TO NG - 1 : GX(I) = OX + PX : GY(I) = OY + PY : NEXT
3560 FOR I = 0 TO NG - 1
3561 B = RND(1) * 2 * PI : A = RND(1): A = 1.3 + 7 * A * A
3562 VX(I) = A * COS(B) : VY(I) = A * SIN(B) - 2.0
3563 NEXT
3570 FOR J = 1 TO 35
3580 FOR I = 0 TO NG - 1
3590 A = INT(GX(I)) : B = INT(GY(I))
3600 GX(I) = GX(I) + VX(I) : GY(I) = GY(I) + VY(I) : VY(I) = VY(I) + 0.7
3610 IF A >= 1 AND A <= DW AND B >= 1 AND B < DH THEN VTAB B : HTAB A : PRINT ".";
3620 A = INT(GX(I)) : B = INT(GY(I))
3630 IF A >= 1 AND A <= DW AND B >= 1 AND B < DH THEN VTAB B : HTAB A : PRINT "*";
3640 NEXT
3650 NEXT
3660 RETURN

4000 REM SUB DispLabels(LV, HS)
4010 VTAB DH
4015 HTAB 4 : PRINT "Level " + STR$(LV);
4020 HTAB INT((DW - 8) / 2) : PRINT "Score";
4025 HTAB DW - 11 : PRINT "Best " + STR$(HS);
4050 RETURN

4500 REM DispArena
4550 FOR J = 0 TO H - 1
4551 FOR I = 0 TO W - 1
4552 VTAB OY + J : HTAB OX + I
4553 A = Z%(I, J)
4554 IF A = 8 THEN PRINT "X";
4555 IF A <> 8 THEN PRINT " ";
4560 NEXT
4561 NEXT
4570 RETURN

5000 REM WaitForKey
5010 GOSUB 70
5020 GOSUB 50 : GOSUB 60 : IF K = 0 GOTO 5020
5030 GOSUB 70
5040 RETURN

7000 REM Intro
7010 S0$ = "DELUXE PROFESSIONAL SNAKE SIMULATOR```Be a snake. Do snake things."
7011 S0$ = S0$ + "`Try not to explode.````CONTROLS``"
7012 S0$ = S0$ + CHR$(CU) + ": Up`  "
7013 S0$ = S0$ + CHR$(CL) + ": Left  "
7014 S0$ = S0$ + CHR$(CD) + ": Down  "
7015 S0$ = S0$ + CHR$(CR) + ": Right"
7020 S1$ = "```Last score: " + STR$(SC) + ", Level " + STR$(LV) + ""
7022 S1$ = S1$ + "``Best score: " + STR$(HS) + ", Level " + STR$(HL) + ""
7023 IF LV < 1 THEN S1$ = "`````"
7025 S2$ = "```PRESS ANY KEY TO BEGIN!"
7030 HOME : GOSUB 7500 : GOSUB 5000
7390 RETURN

7500 REM ShowMsg(S0$, S1$, S2$)
7510 C = 0
7520 FOR I = 0 TO 2
7521 S$ = S0$ : IF I THEN S$ = S1$ : IF I = 2 THEN S$ = S2$
7522 FOR J = 1 TO LEN(S$)
7523 IF LEN(S$) > 0 THEN IF MID$(S$, J, 1) = "`" THEN C = C + 1
7524 NEXT
7525 IF LEN(S$) > 0 THEN C = C + 1
7526 NEXT
7527 D = INT((24 - C) / 2 + 0.5)
7530 FOR I = 0 TO 2
7540 A = 1 : S$ = S0$ : IF I THEN S$ = S1$ : IF I = 2 THEN S$ = S2$
7550 B = LEN(S$) + 1
7560 FOR J = 0 TO LEN(S$) - A
7561 IF MID$(S$, LEN(S$) - J, 1) = "`" THEN B = LEN(S$) - J
7562 NEXT
7570 C = INT((40 + A - B) / 2)
7580 IF C < 1 THEN PRINT : PRINT MID$(S$, A, B - A) : PRINT "TOO LONG!" : STOP
7590 IF B >= A THEN VTAB D : HTAB C : PRINT MID$(S$, A, B - A);
7600 D = D + 1 : A = B + 1
7610 IF A <= LEN(S$) GOTO 7550
7620 NEXT
7630 RETURN

8000 REM BeginLevel
8010 HOME
8020 GOSUB 1500 : REM ClearArena
8030 GOSUB 4000 : REM DispLabels
8040 GOSUB 4500 : REM DispArena
8050 RETURN

9000 REM SUB Initialisation
9010 PI = 3.1415926535897932384626433832795
9015 DW = 40 : DH = 24 : REM Display width and height
9020 REM Board, containing breadcrumbs
9021 W = 24 : H = 20
9022 OX = 1 + INT((DW - W) / 2) : OY = 1 + INT((DH - H) / 2)
9023 DIM Z%(W - 1, H - 1)
9030 REM Directions and unit displacements
9040 DIM DX%(3), DY%(3)
9042 DX%(0) = 0 : DY%(0) = -1
9043 DX%(1) = 1 : DY%(1) = 0
9044 DX%(2) = 0 : DY%(2) = 1
9045 DX%(3) = -1 : DY%(3) = 0
9050 REM IO addresses
9060 IK% = -16384 : QK% = -16368
9070 REM Giblets
9080 NG = 60
9090 DIM GX(NG - 1), GY(NG - 1), VX(NG - 1), VY(NG - 1)
9100 REM Pool of candidate empty spaces
9110 DIM EX%(W * H - 1), EY%(W * H - 1) : NE = 0
9120 REM Keyboard ring buffer
9130 KS = 8 : DIM KB%(KS - 1) : KH = 0 : KN = 0
9140 REM Scripted key sequence
9150 VP = 0 : VQ = 0 : VT = 0 : RESTORE
9160 REM Key bindings
9170 CU = ASC("W") : CL = ASC("A") : CD = ASC("S") : CR = ASC("D")
9180 REM Display options
9190 WB$ = "#" : REM Body
9191 WC$ = " " : REM Worm castings (" " or "." works well.)
9192 WF$ = "o" : REM Adorable furry animal
9200 WM$ = WB$ + WC$
9210 REM Remember to call ClearArea
9220 RETURN