home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 10 / 010.d81 / scales (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  3KB  |  112 lines
  1. 10 rem program name scales
  2. 20 rem david r. brooks, july 84
  3. 30 rem calculates sid poke values for
  4. 40 rem highest octave for equal, just
  5. 50 rem and meantone temperament
  6. 60 poke53280,0:poke53281,0:printchr$(14)
  7. 70 def fn r(x)=int(x*100+.5)/100
  8. 80 dim e(13),j(13),m(13),er(13),jr(13),mr(13),n$(6),pn$(23),c(3)
  9. 90 fori=1to23:readpn$(i):next
  10. 100 data"[193]","[194]b","[194]","[195]","[195]#","[196]","[197]b","[197]","[198]","[198]#","[199]","[199]#","[193]","[194]b","[194]"
  11. 110 data"[195]","[195]#","[196]","[197]b","[197]","[198]","[198]#","[199]"
  12. 120 rem equal temperament ratios
  13. 130 f=2^(1/12)
  14. 140 fori=0to12:er(i+1)=f^i:next
  15. 150 rem just ratios
  16. 160 c1=16/15:jr(1)=1:rem c
  17. 170 jr(2)=9/8/c1:rem c#
  18. 180 jr(3)=9/8:rem d
  19. 190 jr(4)=9/8*c1:rem e flat
  20. 200 jr(5)=5/4:rem e
  21. 210 jr(6)=4/3:rem f
  22. 220 jr(7)=3/2/c1:rem f#
  23. 230 jr(8)=3/2:rem g
  24. 240 jr(9)=5/3/c1:rem g#
  25. 250 jr(10)=5/3:rem a
  26. 260 jr(11)=5/3*c1
  27. 270 jr(12)=15/8:rem b
  28. 280 jr(13)=2:rem c
  29. 290 rem mean tone ratios
  30. 300 c2=sqr(81/80):c3=sqr(c2):mr(1)=1:rem c
  31. 310 mr(2)=25/24*c3:rem c#
  32. 320 mr(3)=9/8/c2:rem d
  33. 330 mr(4)=6/5/c3:rem e flat
  34. 340 mr(5)=5/4:rem e
  35. 350 mr(6)=4/3*c3:rem f
  36. 360 mr(7)=45/32/c2:rem f#
  37. 370 mr(8)=3/2/c3:rem g
  38. 380 mr(9)=25/16:rem g#
  39. 390 mr(10)=5/3*c3:rem a
  40. 400 mr(11)=9/5/c2:rem b flat
  41. 410 mr(12)=15/8/c3:rem b
  42. 420 mr(13)=2:rem c
  43. 430 n$(1)="[193]":n$(2)="[194]b":n$(3)="[195]":n$(4)="[196]":n$(5)="[198]":n$(6)="[199]"
  44. 440 nx(1)=0:nx(2)=1:nx(3)=3:nx(4)=5:nx(5)=8:nx(6)=10
  45. 450 print"[147][215]hat note would you like to start on?"
  46. 460 print"[193]llowed values are [195], [196], [198], [199], [193], [194]b"
  47. 470 inputns$
  48. 480 fori=1to6:ifns$=n$(i)orasc(ns$)+128=asc(n$(i))thens=nx(i):goto510
  49. 490 next
  50. 500 print"[206]ote input error.  [212]ry again...":goto450
  51. 510 print"[147] [195]hoose frequency of starting note:"
  52. 520 print"1 - equally tempered value"
  53. 530 print"2 - retain [193]440"
  54. 540 c(1)=220*f^s:af=220
  55. 550 getz$:ifz$=""then550
  56. 555 ifz$<>"1"andz$<>"2"then550
  57. 560 c(2)=c(1):c(3)=c(2)
  58. 570 ifz$="1"then640
  59. 580 ifs=3thenc(2)=3/5*2*af:c(3)=3/5/c3*2*af:goto640
  60. 590 ifs=5thenc(2)=2/3*2*af:c(3)=2/3*c3*2*af:goto640
  61. 600 ifs=8thenc(2)=4/5*2*af:c(3)=4/5*2*af:goto640
  62. 610 ifs=10thenc(2)=8/9*2*af:c(3)=8/9*c2*2*af:goto640
  63. 620 ifs=0thenc(2)=af:c(3)=af:goto640
  64. 630 ifs=1thenc(2)=8/15*440:c(3)=8/15*c3*440
  65. 640 print"[147]      [211]cale temperament:"
  66. 650 print"[206]ote  [197]qual    [202]ust     [205]eantone"
  67. 660 print"--------------------------------"
  68. 670 fori=13to1step-1
  69. 680 e(i)=c(1)*er(i)
  70. 690 j(i)=c(2)*jr(i)
  71. 700 m(i)=c(3)*mr(i)
  72. 710 printpn$(i+s);tab(5);fnr(e(i));tab(14);fnr(j(i));tab(23);fnr(m(i))
  73. 720 next
  74. 730 print"[193]nother scale (y/n)?"
  75. 740 getz$:ifz$=""then740
  76. 750 ifz$="y"goto450
  77. 760 print"[195]alculate [211][201][196] [208][207][203][197] values (y/n)?"
  78. 770 getz$:ifz$=""then770
  79. 780 ifz$<>"y"thenprint"[197]nd program":goto60000
  80. 790 print"[147]            [211][201][196] [208][207][203][197] values"
  81. 800 dimoc$(12)
  82. 810 c=.06095977
  83. 820 oc$(1)=" [195]-7":oc$(2)="[195]#-7":oc$(3)=" [196]-7":oc$(4)="[196]#-7":oc$(5)=" [197]-7"
  84. 830 oc$(6)=" [198]-7":oc$(7)="[198]#-7":oc$(8)=" [199]-7":oc$(9)="[199]#-7":oc$(10)=" [193]-7"
  85. 840 oc$(11)="[193]#-7":oc$(12)=" [194]-7"
  86. 850 c1=8:c2=16
  87. 860 ifs=0thenl=4
  88. 870 ifs=1thenl=3
  89. 880 ifs=3thenl=1
  90. 890 ifs=5thenl=11:c1=4:c2=8
  91. 900 ifs=8thenl=8:c1=4:c2=8
  92. 910 ifs=10thenl=6:c1=4:c2=8
  93. 920 j=0
  94. 930 print"        [206]ote [197]qual  [202]ust   [205]eantone"
  95. 940 print"        ---------------------------"
  96. 950 fori=lto12:de=e(i)/c*c1:dj=j(i)/c*c1:dm=m(i)/c*c1
  97. 960 j=j+1
  98. 970 print"        "oc$(j);int(de);int(dj);int(dm):next
  99. 980 ifl=1then1020
  100. 990 fori=1tol-1:de=e(i)/c*c2:dj=j(i)/c*c2:dm=m(i)/c*c2
  101. 1000 j=j+1
  102. 1010 print"        "oc$(j);int(de);int(dj);int(dm):next
  103. 1020 printspc(12)"<press a key>":poke198,0:wait198,1
  104. 1030 :
  105. 60000 print"[147][215]ould you like to try another?"
  106. 60010 poke198,0:wait198,1:getk$:ifk$<>"y"andk$<>"n"thenpoke53281,rnd(1)*15:goto60010
  107. 60020 ifk$="y"then run
  108. 60030 :
  109. 63000 rem    connect back to loadstar
  110. 63010 print"[147]load"chr$(34)"payload"chr$(34)",8":print"run"
  111. 63020 poke631,13:poke632,13:poke198,2:end
  112.