10 REM PROGRAM NAME SCALES
20 REM DAVID R. BROOKS, JULY 84
30 REM CALCULATES SID POKE VALUES FOR
40 REM HIGHEST OCTAVE FOR EQUAL, JUST
50 REM AND MEANTONE TEMPERAMENT
60 POKE53280,0:POKE53281,0:PRINTCHR$(14)
70 DEF FN R(X)=INT(X*100+.5)/100
80 DIM E(13),J(13),M(13),ER(13),JR(13),MR(13),N$(6),PN$(23),C(3)
90 FORI=1TO23:READPN$(I):NEXT
100 DATA"[193]","[194]B","[194]","[195]","[195]#","[196]","[197]B","[197]","[198]","[198]#","[199]","[199]#","[193]","[194]B","[194]"
110 DATA"[195]","[195]#","[196]","[197]B","[197]","[198]","[198]#","[199]"
120 REM EQUAL TEMPERAMENT RATIOS
130 F=2^(1/12)
140 FORI=0TO12:ER(I+1)=F^I:NEXT
150 REM JUST RATIOS
160 C1=16/15:JR(1)=1:REM C
170 JR(2)=9/8/C1:REM C#
180 JR(3)=9/8:REM D
190 JR(4)=9/8*C1:REM E FLAT
200 JR(5)=5/4:REM E
210 JR(6)=4/3:REM F
220 JR(7)=3/2/C1:REM F#
230 JR(8)=3/2:REM G
240 JR(9)=5/3/C1:REM G#
250 JR(10)=5/3:REM A
260 JR(11)=5/3*C1
270 JR(12)=15/8:REM B
280 JR(13)=2:REM C
290 REM MEAN TONE RATIOS
300 C2=SQR(81/80):C3=SQR(C2):MR(1)=1:REM C
310 MR(2)=25/24*C3:REM C#
320 MR(3)=9/8/C2:REM D
330 MR(4)=6/5/C3:REM E FLAT
340 MR(5)=5/4:REM E
350 MR(6)=4/3*C3:REM F
360 MR(7)=45/32/C2:REM F#
370 MR(8)=3/2/C3:REM G
380 MR(9)=25/16:REM G#
390 MR(10)=5/3*C3:REM A
400 MR(11)=9/5/C2:REM B FLAT
410 MR(12)=15/8/C3:REM B
420 MR(13)=2:REM C
430 N$(1)="[193]":N$(2)="[194]B":N$(3)="[195]":N$(4)="[196]":N$(5)="[198]":N$(6)="[199]"
440 NX(1)=0:NX(2)=1:NX(3)=3:NX(4)=5:NX(5)=8:NX(6)=10
450 PRINT"[147][215]HAT NOTE WOULD YOU LIKE TO START ON?"
460 PRINT"[193]LLOWED VALUES ARE [195], [196], [198], [199], [193], [194]B"
470 INPUTNS$
480 FORI=1TO6:IFNS$=N$(I)ORASC(NS$)+128=ASC(N$(I))THENS=NX(I):GOTO510
490 NEXT
500 PRINT"[206]OTE INPUT ERROR.  [212]RY AGAIN...":GOTO450
510 PRINT"[147] [195]HOOSE FREQUENCY OF STARTING NOTE:"
520 PRINT"1 - EQUALLY TEMPERED VALUE"
530 PRINT"2 - RETAIN [193]440"
540 C(1)=220*F^S:AF=220
550 GETZ$:IFZ$=""THEN550
555 IFZ$<>"1"ANDZ$<>"2"THEN550
560 C(2)=C(1):C(3)=C(2)
570 IFZ$="1"THEN640
580 IFS=3THENC(2)=3/5*2*AF:C(3)=3/5/C3*2*AF:GOTO640
590 IFS=5THENC(2)=2/3*2*AF:C(3)=2/3*C3*2*AF:GOTO640
600 IFS=8THENC(2)=4/5*2*AF:C(3)=4/5*2*AF:GOTO640
610 IFS=10THENC(2)=8/9*2*AF:C(3)=8/9*C2*2*AF:GOTO640
620 IFS=0THENC(2)=AF:C(3)=AF:GOTO640
630 IFS=1THENC(2)=8/15*440:C(3)=8/15*C3*440
640 PRINT"[147]      [211]CALE TEMPERAMENT:"
650 PRINT"[206]OTE  [197]QUAL    [202]UST     [205]EANTONE"
660 PRINT"--------------------------------"
670 FORI=13TO1STEP-1
680 E(I)=C(1)*ER(I)
690 J(I)=C(2)*JR(I)
700 M(I)=C(3)*MR(I)
710 PRINTPN$(I+S);TAB(5);FNR(E(I));TAB(14);FNR(J(I));TAB(23);FNR(M(I))
720 NEXT
730 PRINT"[193]NOTHER SCALE (Y/N)?"
740 GETZ$:IFZ$=""THEN740
750 IFZ$="Y"GOTO450
760 PRINT"[195]ALCULATE [211][201][196] [208][207][203][197] VALUES (Y/N)?"
770 GETZ$:IFZ$=""THEN770
780 IFZ$<>"Y"THENPRINT"[197]ND PROGRAM":GOTO60000
790 PRINT"[147]            [211][201][196] [208][207][203][197] VALUES"
800 DIMOC$(12)
810 C=.06095977
820 OC$(1)=" [195]-7":OC$(2)="[195]#-7":OC$(3)=" [196]-7":OC$(4)="[196]#-7":OC$(5)=" [197]-7"
830 OC$(6)=" [198]-7":OC$(7)="[198]#-7":OC$(8)=" [199]-7":OC$(9)="[199]#-7":OC$(10)=" [193]-7"
840 OC$(11)="[193]#-7":OC$(12)=" [194]-7"
850 C1=8:C2=16
860 IFS=0THENL=4
870 IFS=1THENL=3
880 IFS=3THENL=1
890 IFS=5THENL=11:C1=4:C2=8
900 IFS=8THENL=8:C1=4:C2=8
910 IFS=10THENL=6:C1=4:C2=8
920 J=0
930 PRINT"        [206]OTE [197]QUAL  [202]UST   [205]EANTONE"
940 PRINT"        ---------------------------"
950 FORI=LTO12:DE=E(I)/C*C1:DJ=J(I)/C*C1:DM=M(I)/C*C1
960 J=J+1
970 PRINT"        "OC$(J);INT(DE);INT(DJ);INT(DM):NEXT
980 IFL=1THEN1020
990 FORI=1TOL-1:DE=E(I)/C*C2:DJ=J(I)/C*C2:DM=M(I)/C*C2
1000 J=J+1
1010 PRINT"        "OC$(J);INT(DE);INT(DJ);INT(DM):NEXT
1020 PRINTSPC(12)"<PRESS A KEY>":POKE198,0:WAIT198,1
1030 :
60000 PRINT"[147][215]OULD YOU LIKE TO TRY ANOTHER?"
60010 POKE198,0:WAIT198,1:GETK$:IFK$<>"Y"ANDK$<>"N"THENPOKE53281,RND(1)*15:GOTO60010
60020 IFK$="Y"THEN RUN
60030 :
63000 REM    CONNECT BACK TO LOADSTAR
63010 PRINT"[147]LOAD"CHR$(34)"PAYLOAD"CHR$(34)",8":PRINT"RUN"
63020 POKE631,13:POKE632,13:POKE198,2:END