100 REM BASIC Month 5: Crisps Tunes
110 REM http://reddit.com/r/RetroBattlestations
120 REM written by FozzTexx

130 REM If your BASIC has built-in sound/music commands, use the
140 REM Spectrum version as a starting point, not the Apple II version.

200 REM Initialize variables
210 GOSUB 2010
220 DIM M(7):FOR I = 1 TO 7:READ M(I):NEXT I
230 SHFL = 0:RHYTHM = 0:OMAX = 4:DIM A(12 * OMAX)
240 DIM MG(12 * OMAX):P = 1
250 READ T:IF T > -1 THEN MG(P) = T:P = P + 1:GOTO 250

300 REM Loop through data and play song
310 READ S$:SL = LEN(S$):IF SL = 0 THEN END
320 FOR I = 1 TO SL
330 OCTAVE = 4:DUR = 0.05:DIV = 0:MULT = 0:ACCD = 0
340 IF I > SL THEN NEXT I
350 N$ = MID$(S$,I,1)
360 IF N$ = " " THEN NEXT I
370 IF N$ = "!" THEN GOSUB 910:NEXT I
380 IF N$ = "^" THEN ACCD = 1:SHFL = SHFL + 1:I = I + 1:GOTO 340
390 IF N$ = "-" THEN ACCD = 1:SHFL = SHFL - 1:I = I + 1:GOTO 340
400 IF N$ = "=" THEN ACCD = 1:SHFL = 0:I = I + 1:GOTO 340
410 IF N$ >= CHR$(97) AND N$ <= CHR$(103) THEN N$ = CHR$(ASC(N$) - 32):OCTAVE = OCTAVE + 1
420 IF N$ >= "A" AND N$ <= "G" THEN C = ASC(N$):C = C - 64:NT = M(C)

500 REM Keep reading modifier after the note until there's another note
510 I = I + 1:IF I > SL THEN GOTO 610
520 M$ = MID$(S$,I,1)
530 IF M$ = "," THEN OCTAVE = OCTAVE - 1:GOTO 510
540 IF M$ = "'" THEN OCTAVE = OCTAVE + 1:GOTO 510
550 IF M$ >= "0" AND M$ <= "9" THEN C = ASC(M$):MULT = MULT * 10 + C - 48:GOTO 510
560 IF M$ = "/" THEN DIV = 1:GOTO 510
570 IF M$ = "<" THEN RHYTHM = 1:RMULT = 0.5:GOTO 510
580 IF M$ = ">" THEN RHYTHM = 1:RMULT = 1.5:GOTO 510
590 I = I - 1

600 REM Play note
610 NT = NT + (OCTAVE - 4) * 12
620 IF ACCD THEN AI = NT + 13:A(AI) = SHFL:SHFL = 0
630 IF ACCD AND AI < A1 THEN A1 = AI
640 IF ACCD AND AI > A2 THEN A2 = AI
650 SHFL = A(NT + 13):NT = NT + SHFL
660 IF DIV AND MULT = 0 THEN MULT = 2
670 IF DIV THEN MULT = 1/MULT
680 IF MULT = 0 THEN MULT = 1
690 IF RHYTHM THEN MULT = MULT * RMULT
700 DUR = DUR * MULT
710 F$ = "":IF SHFL <> 0 THEN F$ = "#":IF SHFL<0 THEN F$ = "$"
720 PRINT N$;F$;OCTAVE;"=";MULT;" ";
730 REM Note (NT) is numeric note, 0 is middle C. Convert to BEEP magic value
740 &BEEP(DUR * 200, MG(NT + 17))
750 IF RHYTHM THEN RHYTHM = RHYTHM + 1:RMULT = 2 - RMULT:IF RHYTHM = 3 THEN RHYTHM = 0

800 NEXT I
810 GOTO 310

900 REM clear all accidentals
910 FOR AD = A1 TO A2:A(AD) = 0:NEXT AD
920 A1 = 12 * OMAX:A2 = 0
930 RETURN

1000 DATA 9,11,0,2,4,5,7

1010 REM Magic &BEEP() values (not hertz) that sound nice, starting at G below middle C
1020 DATA 253,242,228,215,203,191,180,170,161,151,142,135
1030 DATA 127,119,113,106,100, 95, 89, 84, 79, 74, 70, 66
1040 DATA  62, 58, 55, 52, 49, 19, 43, 14, 38, 36, 15, 32
1050 DATA  30, 28, 26, 12, 11, -1

1480 REM exclamation point has been substituted for pipe,
1490 REM hyphen has been substituted for underscore
1500 DATA "G,G, ! ^G,G, A,A, G,G, ! G,G, ^G,G, A,2 ! G,^G, A,2 E,2 ! E,2 E,2 E,8"
1510 DATA "! G,G, ^G,G, A,A, ! ^G,G, =G,G, ^G,G, ! A,2 G,^G, A,2 ! F,2 F,2 F,2"
1520 DATA "! F,8 ! F,2 F,2 ! F,2 F,2 F,G, ! A,B,5 ! E,2 A,2 E,2 ! A,2 E,F, G,A,5"
1530 DATA "! D,2 ! E,4 ^F,2 ! A,2 B,4 ! A,-B, =B,2 G,2 ! G,2 G,2 G,8"
1540 DATA "! G,G, ^G,G, A,A, ! ^G,G, =G,G, ^G,G, ! A,2 G,^G, A,2 ! E,2 E,2 E,2"
1550 DATA "! E,8 ! E,E, ^D,D, ! E,2 ^F,2 ^G,2 ! E,2 ^F,2 ^G,2 ! A,2 ^G,2 A,2"
1560 DATA "! B,4< C4 ! B,C D2 ! A,2 A,2 A,2 ! D2<A,2 A,2 ! B,2 C2<G,2"
1570 DATA "! G,2 A,2 C2<G,2 ! G,2 ^G,2 ! A,2 ^G,2<A,2 ! -B,2 =B,B, B,-B,"
1580 DATA "! B,2 G,2 C16"
1590 DATA ""

2000 REM Applesoft has no sound commands, add &BEEP command to Applesoft
2010 IF PEEK(1013) = 76 AND PEEK(1014) = 112 AND PEEK(1015) = 128 THEN RETURN
2020 PRINT "Poking in &BEEP() function...";
2030 REM Skip over all the musical DATA statements to get to the assembly routine
2040 READ A$:IF A$ <> "" THEN 2040
2050 ADDRESS = 32768
2060 READ V
2070 REM If done with poking RESTORE DATA to beginning
2080 IF V = -1 THEN RESTORE:CALL 32768:PRINT "done.":RETURN
2090 POKE ADDRESS,V:ADDRESS = ADDRESS + 1:GOTO 2060

2500 DATA 169,76,205,245,3,141,245,3,208,27,173,246,3,201,112,208
2510 DATA 8,173,247,3,201,128,208,1,96,173,246,3,141,135,128,173
2520 DATA 247,3,141,136,128,169,112,141,246,3,169,128,141,247,3,96
2530 DATA 72,152,72,138,72,173,103,128,141,104,128,160,0,152,174,106
2540 DATA 128,224,255,240,25,44,48,192,44,32,192,136,208,11,24,109
2550 DATA 105,128,208,5,206,104,128,240,8,202,208,239,240,224,232,240
2560 DATA 234,104,170,104,168,104,96,114,114,128,114,66,69,69,80,0
2570 DATA 8,72,162,0,160,0,189,107,128,240,14,209,184,208,5,200
2580 DATA 232,76,118,128,104,40,76,201,222,104,104,32,152,217,169,40
2590 DATA 32,192,222,240,36,201,41,240,32,32,103,221,32,82,231,141
2600 DATA 104,128,140,103,128,169,44,32,192,222,240,13,32,248,230,142
2610 DATA 106,128,32,177,0,32,48,128,96,76,201,222
2620 DATA -1