home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 57 / 64er_Magazin_Sonderheft_57_19xx_Markt__Technik_de_Side_B.d64 / noteneingabe (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  6KB  |  235 lines
  1. 100 rem *******************************
  2. 110 rem * + -    noteneingabe     - + *
  3. 120 rem * zum programm 'sound-machine'*
  4. 130 rem * fuer den c64                *
  5. 140 rem * von:   arno muhr            *
  6. 150 rem *        unterstr. 32         *
  7. 160 rem *        5176 inden-frenz     *
  8. 170 rem *******************************
  9. 180 poke 53280,9:poke 53281,5:print"[144]"
  10. 190 print"[147]bitte ca. 13  sekunden warten"
  11. 200 na=49152:for i=na to na+3000:pokei,0:next
  12. 210 dim nw(5,203),t(5,203):gosub 320
  13. 220 input"[147]zeit fuer 1/4 note (1-120):";gt
  14. 230 gt=int(gt):gt=gt/120*32:if gt<=0 or gt>32 then 220
  15. 240 print chr$(147)
  16. 250 print chr$(19);c/3+1"[157] . note : ":n$=""
  17. 260 input "note  : ";n$
  18. 270 goto 610
  19. 280 w=1
  20. 290 for i=1 to 98:if n$=n$(i) then w=w(i)
  21. 300 next
  22. 310 return
  23. 320 rem *** notenwerte einlesen ***
  24. 330 dim n$(98),w(98)
  25. 340 for i=1 to 98:read n$
  26. 350 n$(i)=n$:next
  27. 360 for i=1 to 98:read w
  28. 370 w(i)=w:next
  29. 380 return
  30. 390 rem *** notendatas ***
  31. 400 data c0,c#0,d0,d#0,e0,f0,f#0,g0,g#0,a0,a#0,h0
  32. 410 data c1,c#1,d1,d#1,e1,f1,f#1,g1,g#1,a1,a#1,h1
  33. 420 data c2,c#2,d2,d#2,e2,f2,f#2,g2,g#2,a2,a#2,h2
  34. 430 data c3,c#3,d3,d#3,e3,f3,f#3,g3,g#3,a3,a#3,h3
  35. 440 data c4,c#4,d4,d#4,e4,f4,f#4,g4,g#4,a4,a#4,h4
  36. 450 data c5,c#5,d5,d#5,e5,f5,f#5,g5,g#5,a5,a#5,h5
  37. 460 data c6,c#6,d6,d#6,e6,f6,f#6,g6,g#6,a6,a#6,h6
  38. 470 data c7,c#7,d7,d#7,e7,f7,f#7,g7,g#7,a7,a#7,h7
  39. 480 data pause,p
  40. 490 data 268,284,301,318,337,358,379,401,425,451,477,506,536,568,602,637,675
  41. 500 data 716,758,803,851,902,955,1012,1072,1136,1204,1275,1351,1432,1517,1607
  42. 510 data 1703,1804,1911,2025,2145,2273,2408,2551,2703,2864,3034,3215,3406,3608
  43. 520 data 3823,4050,4291,4547,4817,5103,5407,5728,6069,6430,6812,7217,7647,8101
  44. 530 data 8583,9094,9634,10207,10814,11457,12139,12860,13625,14435,15294,16203
  45. 540 data 17167,18188,19269,20415,21629,22915,24278,25721,27251,28871,30588
  46. 550 data 32407,34334,36376,38539,40830,43258,45830,48556,51443,54502,57743
  47. 560 data 61176,64814,0,0
  48. 570 :
  49. 580 rem   ******************
  50. 590 rem   *+- funktionen -+*
  51. 600 rem   ******************
  52. 610 :
  53. 620 if n$="-" and c=>3 then c=c-3:goto 250
  54. 630 if n$="-"      then print "erste note !  ":goto 250
  55. 640 if n$="+"      then c=c+3:goto 250
  56. 650 if n$="save"   then 1120
  57. 660 if n$="load"   then 1870
  58. 670 if n$="def."   then 1280
  59. 680 if n$="copy"   then 1650
  60. 690 if n$="insert" then 1470
  61. 700 if n$="quit"   then 1040
  62. 710 if n$="on"     then sys 53004:goto 250
  63. 720 if n$="off"    then sys 53027:goto 250
  64. 730 if n$="new"    then c=0:goto 240
  65. 740 if n$="clear"  then run
  66. 750 if n$="set end"then 1060
  67. 760 gosub 280
  68. 770 input "zeit  : ";t$:t$=t$+"  "
  69. 780 print "                          [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  70. 790 if w=1 then print "noten fehler!":if zz<>1 goto 250
  71. 800 if w=1 then return
  72. 810 hb=int(w/256):lb=w-256*hb
  73. 820 a=val(t$):aa=3:if a>9 then aa=4
  74. 830 a$=mid$(t$,aa,2):t=0
  75. 840 a1=val(a$)
  76. 850 if a1=64 then t=2
  77. 860 if a1=32 then t=4
  78. 870 if a1=16 then t=8
  79. 880 if a1=08 then t=16
  80. 890 if a1=04 then t=32
  81. 900 if a1=02 then t=64
  82. 910 if a1=01 then t=127
  83. 920 if t=0 then print" zeit fehler!":if zz<>1 then goto 250
  84. 930 if t=0 then return
  85. 940 t=t/32*gt:t=t*a
  86. 950 if t>255 then print " zeit zu lang !":if zz<>1 goto 250
  87. 960 if t>255 then return
  88. 970 if zz=1 then return
  89. 980 poke 49152+c,lb
  90. 990 poke 49153+c,hb
  91. 1000 poke 49154+c,t
  92. 1010 c=c+3
  93. 1020 goto 250
  94. 1030 :
  95. 1040 for i=0 to 9:poke 49152+c+i,0:next
  96. 1050 end
  97. 1060 rem *** set end ***
  98. 1070 rem -ende des stueckes makieren
  99. 1080 poke na+c,0
  100. 1090 poke na+c+1,0
  101. 1100 poke na+c+2,0
  102. 1110 goto 250
  103. 1120 rem *** save ***
  104. 1130 rem -abspeichern von musikstuecken
  105. 1140 sys 53tan27
  106. 1150 i=0:print "[147]abspeichern "
  107. 1160 input "[147]titel ";a$
  108. 1170 if len(a$)>16 then 1150
  109. 1180 if a$="^" then 240
  110. 1190 open 1,8,1,a$
  111. 1200 print#1,chr$(0);chr$(192);
  112. 1210 :np=peek(49152+i)
  113. 1220 :print#1,chr$(np);
  114. 1230 :i=i+1:if i<=c then 1210
  115. 1240 print#1,chr$(0);chr$(0);chr$(0)
  116. 1250 close 1:gosub 2380
  117. 1260 print"";e;z$:print"taste druecken "
  118. 1270 poke 198,0:wait 198,1:poke198,0:goto 240
  119. 1280 rem *** def. ***
  120. 1290 rem -definieren einer notenfolge
  121. 1300 print "[147]":nn=0
  122. 1310 if ns>5 then print"es bestehen schon 6 ":fori=0to999:next:print"[147]":goto250
  123. 1320 print"definitionfile nr.";ns:print nn+1;"[157] . note"
  124. 1330 input "note  : ";n$
  125. 1340 if n$="end" then 1430
  126. 1350 if n$="^" then 240
  127. 1360 if n$="-" then nn=nn-1:goto 1320
  128. 1370 if n$="+" then nn=nn+1:goto 1320
  129. 1380 gosub 280:zz=1:gosub 770:zz=0
  130. 1390 if t=0 or t>255 or w=1 then 1320
  131. 1400 nw(ns,nn)=w:t(ns,nn)=t
  132. 1410 nn=nn+1:if nn<201 then 1320
  133. 1420 print "definitionfile is voll!"
  134. 1430 w=0:t=0:for i=1 to 2:nn=nn+1:nw(ns,nn)=0:t(ns,nn)=0:next
  135. 1440 for i=1 to 999:next:print"[147]"
  136. 1450 ns=ns+1:goto 250
  137. 1460 :
  138. 1470 rem *** insert ***
  139. 1480 rem -einfuegen einer definition
  140. 1490 :
  141. 1500 print "[147]definitionfile einfuegen"
  142. 1510 print "nr. 0-5 oder ^"
  143. 1520 poke 198,0:wait 198,1:get a$
  144. 1530 if a$="^" then 1630
  145. 1540 if a$<"0" or a$>"5" then 1520
  146. 1550 ni=val(a$):a=0
  147. 1560 if ni>ns then 1630
  148. 1570 :p2=int(nw(ni,a)/256):p1=nw(ni,a)-256*p2:p3=t(ni,a)
  149. 1580 :poke 49152+c,p1
  150. 1590 :poke 49153+c,p2
  151. 1600 :poke 49154+c,255-p3
  152. 1610 a=a+1:c=c+3:if p3<>0 then 1570
  153. 1620 c=c-3
  154. 1630 print "[147]":goto 250
  155. 1640 :
  156. 1650 rem *** copy ***
  157. 1660 rem -kopieren von notenreihen
  158. 1670 :
  159. 1680 print "[147]copy"
  160. 1690 input "erste note  :";a$
  161. 1700 a=val (a$)
  162. 1710 input "letzte note :";b
  163. 1720 a=int(a):b=int(b)
  164. 1730 if a<1 or b<1 then 240
  165. 1740 x=1:if a>b then x=-1
  166. 1750 if a>c/3 or b>c/3 then 240
  167. 1760 if a<b then a=a-x:b=b-x
  168. 1770 if a>b then a=a+x:b=b+x
  169. 1780 :
  170. 1790 for i=a to b step x
  171. 1800 :poke 49152+c,peek(49152+i*3)
  172. 1810 :poke 49153+c,peek(49153+i*3)
  173. 1820 :poke 49154+c,peek(49154+i*3)
  174. 1830 :c=c+3
  175. 1840 next
  176. 1850 goto 240
  177. 1860 :
  178. 1870 rem *** load ***
  179. 1880 rem -laden von musikstuecken und $
  180. 1890 rem sys 53027
  181. 1900 print "[147]load song oder directory"
  182. 1910 input "titel :";a$
  183. 1920 if a$="$" then 2150
  184. 1930 if a$="^" then 240
  185. 1940 input "anhaengen (j/n) :";b$
  186. 1950 if b$="^" then 240
  187. 1960 open 1,8,0,a$:gosub 2380:if e<>0 then 2120
  188. 1970 open 1,8,0,a$
  189. 1980 get#1,c$,c$
  190. 1990 if b$<>"j" and b$<>"ja" then c=0
  191. 2000 a=1
  192. 2010 :get#1,c$
  193. 2020 :a2=a1:a1=a
  194. 2030 :if c$<=chr$(0) then a=0:goto 2050
  195. 2040 :a=asc(c$)
  196. 2050 :poke 49152+c,a
  197. 2060 :c=c+1
  198. 2070 :if a=0 and a1=a and a2=a then 2090
  199. 2080 :goto 2010
  200. 2090 c=c-3
  201. 2100 close 1
  202. 2110 gosub 2380
  203. 2120 print"";e;z$:print"taste druecken "
  204. 2130 poke 198,0:wait 198,1:poke198,0:goto 240
  205. 2140 :
  206. 2150 rem --- directory anzeigen ---
  207. 2160 :
  208. 2170 open 1,8,0,"$":kv=0
  209. 2180 for i=0 to 30:get#1,a$:b$=b$+a$:next
  210. 2190 print"  ";b$
  211. 2200 get#1,a$,b$,e$,f$,g$:for i=0 to 26:get#1,d$:c$=c$+d$:next
  212. 2210 if f$<=chr$(0) then a=0:goto 2230
  213. 2220 a=asc(f$)
  214. 2230 if g$<=chr$(0) then b=0:goto 2250
  215. 2240 b=asc(g$)
  216. 2250 d=a+256*b
  217. 2260 if c$="[199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199]" then c$="":goto 2340: rem -27 shift g-
  218. 2270 print d;c$:c$=""
  219. 2280 kv=kv+1:if kv=22 then 2300
  220. 2290 goto 2200
  221. 2300 kv=0:print "taste druecken"
  222. 2310 poke 198,0:wait 198,1
  223. 2320 print"[145]                    ":print"[145][145][145]"
  224. 2330 goto 2200
  225. 2340 kv=0:print "taste druecken"
  226. 2350 poke 198,0:wait 198,1
  227. 2360 close 1:poke 198,0:goto 1870
  228. 2370 :
  229. 2380 rem +++ fehlerkanal abfragen +++
  230. 2390 open 2,8,15
  231. 2400 input#2,e,z$,t,s
  232. 2410 close 1
  233. 2420 close 2
  234. 2430 return
  235.