100 REM BASIC Month 5: Crisps Tunes
  110 REM http://reddit.com/r/RetroBattlestations
  120 REM written by FozzTexx
  130 REM Get Commander le Clef's Secret Encoder Wheel to make this easier to type in!
  140 REM http://retrobattlestations.com/Cmdr-le-Clef/Secret-Encoder-Wheel.pdf
  200 REM Initialize variables
  210 DIM m(7):FOR i=1 TO 7:READ m(i):NEXT i
  220 LET shfl=0:LET rhythm=0:LET omax=4:DIM a(12*omax)
  230 PROC_BEEP_INIT
  300 REM Loop through data and play song
  310 READ s$:LET sl=LEN(s$):IF sl=0 THEN STOP
  320 FOR i = 1 TO sl
  330   LET octave=4:LET duration=0.05:LET div=0:LET mult=0:LET accd=0
  340   IF i > sl THEN GOTO 800
  350   LET n$=MID$(s$,i,1)
  360   IF n$ = " " THEN GOTO 800
  370   IF n$ = "|" THEN GOSUB 910:GOTO 800
  380   IF n$ = "^" THEN LET accd=1:LET shfl=shfl+1:LET i=i+1:GOTO 340
  390   IF n$ = "_" THEN LET accd=1:LET shfl=shfl-1:LET i=i+1:GOTO 340
  400   IF n$ = "=" THEN LET accd=1:LET shfl=0:LET i=i+1:GOTO 340
  410   IF n$ >= "a" AND n$ <= "g" THEN LET c=ASC n$:LET c=c-32:LET n$=CHR$ c:LET octave=octave+1
  420   IF n$ >= "A" AND n$ <= "G" THEN LET c=ASC n$:LET c=c-64:LET note=m(c)
  500   REM Keep reading modifier after the note until there's another note
  510   LET i=i+1:IF i > sl THEN GOTO 610
  520   LET m$=MID$(s$,i,1)
  530   IF m$ = "," THEN LET octave=octave-1:GOTO 510
  540   IF m$ = "'" THEN LET octave=octave+1:GOTO 510
  550   IF m$ >= "0" AND m$ <= "9" THEN LET c=ASC m$:LET mult=mult*10+c-48:GOTO 510
  560   IF m$ = "/" THEN LET div=1:GOTO 510
  570   IF m$ = "<" THEN LET rhythm=1:LET rmult=0.5:GOTO 510
  580   IF m$ = ">" THEN LET rhythm=1:LET rmult=1.5:GOTO 510
  590   LET i=i-1
  600   REM Play note
  610   LET note = note + (octave - 4) * 12
  620   IF accd THEN LET a(note+13)=shfl:LET shfl=0
  630   LET shfl=a(note+13):LET note=note+shfl
  640   IF div AND mult=0 THEN LET mult=2
  650   IF div THEN LET mult=1/mult
  660   IF mult=0 THEN LET mult=1
  670   IF rhythm THEN LET mult=mult*rmult
  680   LET duration=duration*mult
  690   LET f$="":IF shfl <> 0 THEN LET f$="#":IF shfl<0 THEN LET f$="$"
  700   PRINT n$;f$;octave;"=";mult;" ";
  710   PROC_BEEP(duration,note)
  720   IF rhythm THEN LET rhythm = rhythm+1:LET rmult=2-rmult:IF rhythm=3 THEN LET rhythm=0
  800 NEXT i
  810 GOTO 310
  900 REM clear all accidentals
  910 FOR a=0 TO 12*omax:a(a)=0:NEXT a
  940 RETURN
 1000 DATA 9,11,0,2,4,5,7
 1010 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"
 1020 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"
 1030 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"
 1040 DATA "| D,2 | E,4 ^F,2 | A,2 B,4 | A,_B, =B,2 G,2 | G,2 G,2 G,8"
 1050 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"
 1060 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"
 1070 DATA "| B,4< C4 | B,C D2 | A,2 A,2 A,2 | D2
 1080 DATA "| G,2 A,2 C2
 1090 DATA "| B,2 G,2 C16"
 1100 DATA ""
 2000 END
 2010 REM Z88 BEEP(duration,note) routines by Ben Ryves 2020
 2020 DEF PROC_BEEP(duration,note)
 2030 LOCAL p,p_a,p_b,t_p,d
 2040 p=((beep_p/2^(note/12))-122)/13
 2050 p_a=INT(p):IF p_a<0 ENDPROC
 2060 p_b=INT(p+0.5)
 2070 t_p=p*13+122
 2080 d=INT(cpu_f/t_p/2*duration)
 2090 IF d<=0 ENDPROC
 2100 IF d>65535 d=65535
 2110 D%=p_a DIV 256:E%=p_a
 2120 H%=p_b DIV 256:L%=p_b
 2130 B%=d DIV 256:C%=d
 2140 CALL beep
 2150 ENDPROC
 2160 DEF PROC_BEEP_INIT
 2170 cpu_f=3276800
 2180 root_f=261.6255653
 2190 beep_p=cpu_f/root_f/2
 2200 OZ_Di=&0051:OZ_Ei=&0054
 2210 COM=&B0:SBIT=6
 2220 beep_s=100
 2230 DIM beep beep_s
 2240 FOR pass=0 TO 2 STEP 2
 2250   P%=beep
 2260   [
 2270   OPT pass
 2280   ; Store duration/periods
 2290   LD (beep_d+1),BC
 2300   LD (beep_p_a+1),DE
 2310   LD (beep_p_b+1),HL
 2320   ; Preserve BASIC stack pointer
 2330   LD HL,0
 2340   ADD HL,SP
 2350   LD SP,&1FFE
 2360   PUSH HL
 2370   ; Disable interrupts
 2380   CALL OZ_Di
 2390   PUSH AF
 2400   ; Restore beep duration and loop
 2410   .beep_d LD DE,0
 2420   .beep_loop
 2430   ; High part of cycle
 2440   LD A,(&0400+COM)
 2450   XOR 2^SBIT
 2460   OUT (COM),A
 2470   .beep_p_a LD BC,0
 2480   CALL delay
 2490   ; Pad for loop overhead
 2500   NEG:NEG:NOP
 2510   ; Low part of cycle
 2520   LD A,(&0400+COM)
 2530   OUT (COM),A
 2540   .beep_p_b LD BC,0
 2550   CALL delay
 2560   ; Loop for duration
 2570   DEC DE
 2580   LD A,D
 2590   OR E
 2600   JP NZ,beep_loop
 2610   ; Restore interrupts
 2620   POP AF
 2630   CALL OZ_Ei
 2640   ; Restore BASIC stack pointer
 2650   POP HL
 2660   LD SP,HL
 2670   RET
 2680   ; Delays for BC*13+61 cycles
 2690   .delay
 2700   LD A,B
 2710   OR A
 2720   JR NZ,long_delay_loop
 2730   OR C
 2740   NOP
 2750   JR NZ,short_delay
 2760   NOP
 2770   RET
 2780   .long_delay_loop
 2790   NEG
 2800   LD A,(BC)
 2810   LD A,B
 2820   LD B,251
 2830   CALL short_delay_loop
 2840   LD B,A
 2850   DJNZ long_delay_loop
 2860   LD A,C
 2870   OR A
 2880   JR NZ,short_delay
 2890   NOP
 2900   RET
 2910   .short_delay
 2920   LD B,C
 2930   .short_delay_loop
 2940   DJNZ short_delay_loop
 2950   RET
 2960   ]
 2970 NEXT pass
 2980 IF P%-beep<>beep_s PRINT "beep routine is ";beep_s;" bytes"
 2990 ENDPROC