'N-note scales

    INPUT "How many notes per octave",nn

    LPRINT "Equal-temperament for";nn;"notes per octave"

    LPRINT

    'calculate pitches

    FOR j=0 TO nn-1

    f(j)=f0*2^(j/nn)

    NEXT j



    'Pure Ascending Thirds

    'pure thirds C-E/E-G#/G#-C//G-B/B-D#/etc.

    'pure fifths C-G/G-D/D-A

    f=f0:n=0

10  f(n)=f:f(n+4)=5*f(n)/4:f(n+8)=5*f(n+4)/4

    f(n+7)=3+f(n)/2:f(n+11)=5*f(n+7)/4:f(n+3)=5*f(n+11)/8

    f(n+2)=3+f(n+7)/4:f(n+6)=5*f(n+2)/4:f(n+10)=5*f(n+6)/4

    f(n+9)=3*f(n+2)/2:f(n+1)=5*f(n+9)/8:f(n+5)=5*f(n+1)/4

    f=5*f(n+8)/4

    n=n+12:IF n<60 THEN 10

    f(60)=f



    'Pure Ascending Fifths

    'circle of 5ths - method 1

    f=f0

    FOR j=0 TO 60

    k=11-(5*(j+7)) MOD 12

    m=j MOD 12

    n=INT(j/12)

    k1=12*n+k

    f(k1)=f*2^n

    f=3*f/2

10  IF INT(f/f0)<2 THEN 20

    f=f/2:GOTO 10

20  NEXT j



    'Single octave Circle of Fifths

    'method 2

    FOR i=0 TO 10

    n2=n1+7:IF n2>11 THEN n2=n2-12

    f(n2)=1.5*f(n1)

    IF n2<n1 THEN f(n2)=f(n2)/2

    n1=n2

    NEXT i

    'Harmonic scales (n+i)*f/n

    INPUT "Sub-Harmonic ratio",nn

    IF nn=0 THEN END

    LPRINT "Harmonic scale f*(n+i)/n for n =";nn



    f=f0/nn

    FOR i=0 TO 11

    f(i)=(nn+i)+f

    NEXT i



        'N-cent scales

        'BASIC program by Dick Lord 5/7/87

    INPUT "How many cents per note",nn

    LPRINT nn;"cent steps (";

    LPRINT USING " ##.# notes/octave )";1200/nn

    LPRINT

    DIM r(256),n(256),f(61)

    na$="C C#D D#E F F#G G#A A#B "

    f0=261.6256

        'calculate pitch of notes

    FOR j=0 TO 60

    f(j)=f0*2^(j*nn/1200)

    NEXT j

        'Set up MIRAGE internal pitch table

    FOR i=0 TO 255

    ra=2^(i/256)

    r(i)=f0*ra

    n(i)=18705*ra+.5

    NEXT i

    'print pitch and hex MIRAGE data table

    FOR j=0 TO 60

    n=INT(j*nn/1200)

    f=f(j)

20  IF f<2*f0 THEN 30

    f=f/2:GOTO 20

30      'Binary search for best fit to MIRAGE pitch table

    k1=128:k=k1

    FOR i=0 TO 6

    k1=k1/2

    e=r(k)-f

    IF e>0 THEN k=k-k1 ELSE k=k+k1

    NEXT i

    e=f-r(k):e1=f-r(k-1)

    IF ABS(e1)<ABS(e) THEN e=e1:k=k-1

        'Extrapolate for "tweak" values

    k$=HEX$(k):IF LEN(k$)<2 THEN k$="0"+k$

    n$=HEX$(n+7):IF LEN(n$)<2 THEN n$="0"+n$

    e1=0:IF ABS(e)<.001 THEN 40

    IF e<0 THEN 50

    IF k<255 THEN e2=r(k+1)-r(k):e1=INT((f-r(k))*(n(k+1)-n(k))/e2)

    IF k=255 THEN e2=2*r(0)-r(k):e1=INT((f-r(k))*(2*n(0)-n(k))/e2)

40  e2$=n$:e1$=k$

    e0$=HEX$(e1):IF LEN(e0$)<2 THEN e0$="0"+e0$

    IF LEN(e1$)<2 THEN e1$="0"+e1$

    IF LEN(e2$)<2 THEN e2$="0"+e2$

    GOTO 60

50  IF k>0 THEN e2=r(k)-r(k-1):e1=INT((f-r(k-1))*(n(k)-n(k-1))/e2)

    IF k=0 THEN e2=r(k)-r(255)/2:e1=INT((f-r(255)/2)*(2*n(k)-n(255))/e2)

    e2$=n$:IF k>0 THEN e1$=HEX$(k-1) ELSE e1$="FF":e2$=HEX$(n+5)

    e0$=HEX$(e1):IF LEN(e0$)<2 THEN e0$="0"+e0$

60  p$=MID$(na$,1+2*(j MOD 12),2)

        'Print out tables

    LPRINT USING "## \\";j,p$;

    LPRINT TAB(10);

    LPRINT USING "####.# +#.## \\ \\ ";f(j),e,n$,k$;

    LPRINT TAB(32);

    LPRINT USING "\\ \\ \\ ";e2$,e1$,e0$

    NEXT j



'Historic scales

'These are based on distribution of the Pythagorean Comma

'around the circle of fifths.  The number following the name is

'the denominator and the following data are fractions of the comma

'to be added or subtracted ( logarithmically ) for each fifth.



DATA "Pythagorean",1

DATA 0,0,0,0,0,0,0,0,-1,0,0,0

DATA "Van Zwolle",1

DATA 0,0,0,0,0,-1,0,0,0,0,0,0

DATA "Quarter-comma Meantone",4

DATA -1,-1,-1,-1,-1,-1,-1,-1,7,-1,-1,-1

DATA "Silbermann I",6

DATA -1,-1,-1,-1,-1,-1,-1,-1,5,-1,-1,-1

DATA "Silbermann II",6

DATA -1,-1,-1,-1,-1,-1,-1,-1,3,1,-1,-1

DATA "Rameau",12

DATA -3,-3,-3,-3,-3,0,0,0,-2,4,4,-3

DATA "Werckmeister III",4

DATA -1,-1,-1,0,0,-1,0,0,0,0,0,0

DATA "Werckmeister IV",3

DATA -1,0,-1,0,-1,0,-1,0,1,1,-1,0

DATA "Werckmeister V",4

DATA 0,0,-1,-1,0,0,-1,-1,1,0,0,-1

DATA "Werckmeister VI",7

DATA -1,-4,1,0,0,-1,-2,0,1,0,-1,0

DATA "Kirnberger II",2

DATA 0,0,-1,-1,0,0,0,0,0,0,0,0

DATA "Kirnberger III",4

DATA -1,-1,-1,-1,0,0,0,0,0,0,0,0

DATA "Italian 18th Century",12

DATA -3,-3,-3,-3,-1 ,-1,-1,-1,-1,1,1,1,1

DATA "Equal-tempered",12

DATA -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1



FOR s=0 TO 13



READ nm$

LPRINT nm$;" Scale"



'Set up the octave

comma=1.5^12/128

READ dnom

f(0)=f0

n1=0

FOR i=0 TO 11

READ nn:c(i)=comma^(nn/dnom)

NEXT i



FOR i=0 TO 10

n2=n1+7:IF n2>11 THEN n2=n2-12

f(n2)=1.5*c(n1)*f(n1)

IF n2<n1 THEN f(n2)=f(n2)/2

n1=n2

NEXT i



'Insert Display routine for f(i) here



NEXT s