100
110
120
130
140
200
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
240 f=OPENOUT":RAM.-/beeps.dat"
300
310 READ s$:LET sl=LEN(s$):IF sl=0 THEN GOTO 820
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
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
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#f,n$+f$+STR$octave+"="+STR$mult,duration,note
710 PRINTTAB(0,VPOS)"Please wait... (";EXT#f;")";
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
820 PRINT:IF PTR#f=0 GOTO 860
830 CLOSE#f:f=OPENIN":RAM.-/beeps.dat"
840 REPEAT:INPUT#f,n$,duration,note:PRINT n$;" ";:PROC_BEEP(duration,note):UNTIL EOF#f
850 PRINT
860 CLOSE#f:*ERASE :RAM.-/beeps.dat
870 END
900
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
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
2290 LD (beep_d+1),BC
2300 LD (beep_p_a+1),DE
2310 LD (beep_p_b+1),HL
2320
2330 LD HL,0
2340 ADD HL,SP
2350 LD SP,&1FFE
2360 PUSH HL
2370
2380 CALL OZ_Di
2390 PUSH AF
2400
2410 .beep_d LD DE,0
2420 .beep_loop
2430
2440 LD A,(&0400+COM)
2450 XOR 2^SBIT
2460 OUT (COM),A
2470 .beep_p_a LD BC,0
2480 CALL delay
2490
2500 NEG:NEG:NOP
2510
2520 LD A,(&0400+COM)
2530 OUT (COM),A
2540 .beep_p_b LD BC,0
2550 CALL delay
2560
2570 DEC DE
2580 LD A,D
2590 OR E
2600 JP NZ,beep_loop
2610
2620 POP AF
2630 CALL OZ_Ei
2640
2650 POP HL
2660 LD SP,HL
2670 RET
2680
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