home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 1 #4 / Commodore_Disk_User_Vol.1_4_1988_-.d64 / ds.bas (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  9KB  |  182 lines
  1. 10 rem ************************************************************************
  2. 11 rem *                                                                      *
  3. 12 rem * 'drum synth 64' - an experimental drum synthesis program with        *
  4. 13 rem *                   recording, editing, playback and storage options.  *
  5. 14 rem *                                                                      *
  6. 15 rem * author of program  : andrew d. leeder, age 16                        *
  7. 16 rem * computer           : commodore 64 microcomputer                      *
  8. 17 rem * language           : cbm basic v2.0 and machine code                 *
  9. 18 rem * date of completion : august, 1987                                    *
  10. 19 rem *                                                                      *
  11. 20 rem ************************************************************************
  12. 21 :
  13. 22 :
  14. 50 rem***********************************************************initialisation
  15. 72 v=53248:pokev+21,0:s=54272:tp=128:pn=0:pm=16384:pl=49156:ds=49334:hl=49411
  16. 73 dimsn(8,8),sn$(8),vc(2),pf(3),sg(64),sd(64):fora=0to34:poke53213+a,0:nexta
  17. 74 fora=0to2:poke53213+a,1:nexta:gosub10001:gosub9005:gosub3004:sysds,pm+3
  18. 75 gosub911:gosub921:gosub1005:poke56325,40:sys51200
  19. 100 rem*********************************************************operate windows
  20. 109 gosub141:ifx>208andy>56andy<145thengosub150
  21. 110 ifx>32andx<197andy>56andy<145thengosub201
  22. 121 ify>155thengosub301
  23. 130 goto109
  24. 140 rem***********************************************obtain pointer x,y values
  25. 141 x=peek(v)+(256*peek(v+16)):y=peek(v+1):return
  26. 149 rem***************************************************************main menu
  27. 150 a$=" **** options ****":gosub901
  28. 151 geta$:ifa$=""thengosub170
  29. 153 ifa$=""thenad=v+32:gosub180
  30. 154 ifa$=""thenad=v+33:gosub180
  31. 155 ifa$=""thenad=v+39:gosub180
  32. 156 ifa$=""thengosub191
  33. 157 ifa$=""thensys65126
  34. 160 gosub141:ifx<208ory>145thengosub911:return
  35. 161 ifpeek(56320)<>111orx<216orx>330ory<82ory>137thengoto151
  36. 162 a=int((x-216)/30)+1:b=int((y-82)/28):c=a+(b*4):d=a-1:lc=55480+(b*160)+(d*4)
  37. 163 forf=0to80step40:syshl,lc+f,3,1:nextf
  38. 164 oncgosub401,371,431,502,351,422,701,552
  39. 165 forf=0to80step40:syshl,lc+f,3,12:nextf:forf=1to100:nextf:goto151
  40. 169 rem**************************************************change cursor velocity
  41. 170 gosub911:print""tab(9)"cursor velocity (0-9) ?"
  42. 171 geta$:ifa$<"0"ora$>"9"thengoto171
  43. 172 a=val(a$):poke56325,16+(a*6):a$="**** menu ****":gosub901:return
  44. 179 rem**********************************************************change colours
  45. 180 ifpeek(ad)<255thenpokead,peek(ad)+1:return
  46. 181 pokead,0:return
  47. 190 rem***************************************************manual pattern change
  48. 191 gosub911:input"new pattern number ";a$:a=val(a$):ifa<0ora>255thengoto191
  49. 192 pn=a:pm=16384+(a*35):sysds,pm+3:gosub921:gosub1005:a$=" **** options ****"
  50. 193 gosub901:return
  51. 200 rem************************************************************select drums
  52. 201 a$="sound selection...":gosub901
  53. 202 gosub141:ifx>197ory>145thengosub911:gosub240:return
  54. 203 ifpeek(56320)<>111thengoto202
  55. 204 gosub141:fora=0to2:ifx>(36+(52*a))andx<(86+(52*a))andy>81andy<126thengosub250
  56. 205 nexta:goto202
  57. 240 fora=0to2:vc(a)=(peek(2045+a))-215:pokepm+a,vc(a):nexta:gosub1005:return
  58. 250 b=216:ifpeek(2045+a)<223thenb=peek(2045+a)+1
  59. 251 poke2045+a,b:print"[152]"spc((a*7)+3)sn$(b-215):return
  60. 300 rem**********************************************************record pattern
  61. 301 a$="record/edit pattern...":gosub901:a=0:b=0
  62. 303 gosub141:ify<155thengosub911:return
  63. 304 ifpeek(56320)<>111orx<66orx>323ory<173ory>233thengoto303
  64. 305 gosub141:a=int((x-3)/8)-8:b=(int((y-5)/8)-21)*40
  65. 307 if(peek(1670+a+b)=219)thengosub312:goto311
  66. 308 if(peek(1670+a+b)=209)thengosub314
  67. 311 forc=1to100:nextc:goto303
  68. 312 poke1670+a+b,209:pokepm+3+a,(peek(pm+3+a)or(2^(b/40))):return
  69. 314 poke1670+a+b,219:pokepm+3+a,(peek(pm+3+a)and(255-(2^(b/40)))):return
  70. 350 rem***************************************************change pattern number
  71. 351 a$="change pattern...":gosub901:sys51213
  72. 352 a=peek(56320):ifa=123andpn>0thenpn=pn-1:pm=pm-35
  73. 353 ifa=119andpn<255thenpn=pn+1:pm=pm+35
  74. 354 sysds,pm+3:print""spc(22)"   [157][157][157][157]"pn:ifa<>111thengoto352
  75. 360 sys51200:gosub911:gosub1005:return
  76. 370 rem************************************************************change tempo
  77. 371 a$="change tempo...":gosub901:sys51213
  78. 372 a=peek(56320):ifa=123andtp>0thentp=tp-1
  79. 373 ifa=119andtp<255thentp=tp+1
  80. 374 print""spc(35)"   [157][157][157][157]"tp:ifa<>111thengoto372
  81. 375 sys51200:gosub911:return
  82. 400 rem************************************************************play pattern
  83. 401 a$="playing pattern...":gosub901:fora=0to2:poke253+a,2^(peek(pm+a)-1):nexta
  84. 402 syspl,pm+3,tp:ifpeek(252)<>0thengosub911:return
  85. 403 goto402
  86. 420 rem***********************************************************erase pattern
  87. 422 b=14:a$="erase pattern...":gosub901
  88. 425 fora=1to200:nexta:syshl,pm+3,32,0:sysds,pm+3:gosub911:return
  89. 430 rem***********************************************************copy patterns
  90. 431 gosub911:print"[152]     cut         copy         paste    [146]";
  91. 432 gosub141:ifx<136thensyshl,55296,14,1:syshl,55310,26,12:a=1
  92. 433 ifx>136andx<240thensyshl,55296,14,12:syshl,55310,13,1:syshl,55323,13,12:a=2
  93. 434 ifx>240thensyshl,55296,27,12:syshl,55323,13,1:a=3
  94. 435 ifpeek(56320)<>111thengoto432
  95. 436 ifa=1ora=2thengosub470:ifa=1thensyshl,pm+3,32,0:sysds,pm+3
  96. 438 ifa=3thengosub480:gosub1005
  97. 439 gosub911:return
  98. 470 forb=0to34:poke53213+b,peek(pm+b):nextb:return
  99. 480 forb=0to34:pokepm+b,peek(53213+b):nextb:sysds,pm+3:return
  100. 500 rem*******************************************************sequence patterns
  101. 502 gosub911:fora=1to64:aa=a:print"element ";a:print"#"
  102. 504 input"pattern";b$:ifleft$(b$,1)="x"thena=64:goto508
  103. 505 b=val(b$):ifb<0orb>255thengoto504
  104. 506 input"times";c$:c=val(c$):ifc<1orc>256then506
  105. 508 sg(aa)=b:sd(aa)=c:gosub911:nexta:se=aa-1:return
  106. 550 rem***********************************************************play sequence
  107. 552 forz=1tose:pn=sg(z):gosub911
  108. 553 print"element "z"[157], pattern"pn"[157],"sd(z)"times...":print"#"
  109. 554 pm=16384+(pn*35):sysds,pm+3:gosub921:gosub1005:forx=1tosd(z):fory=0to2
  110. 556 poke253+y,2^(peek(pm+y)-1):nexty:syspl,pm+3,tp:nextx,z:gosub911:return
  111. 700 rem************************************************************disk storage
  112. 701 gosub911:print"       save                load        [146]";
  113. 702 gosub141:ifx<183thensyshl,55296,20,1:syshl,55316,20,12:a=1:b$="write"
  114. 703 ifx>183thensyshl,55296,20,12:syshl,55316,20,1:a=2:b$="read"
  115. 704 ifpeek(56320)<>111thengoto702
  116. 705 gosub911:input"enter filename";fl$:ff$="0:pat."+left$(fl$,12)+",seq,"+b$
  117. 706 ifa=1thengosub752
  118. 707 ifa=2thengosub772
  119. 709 pokev+21,255:sys51200:return
  120. 750 rem save pattern
  121. 752 gosub911:input"first pattern";sp$:sp=val(sp$):ifsp<0orsp>255thengoto752
  122. 754 gosub911:input"last pattern";ep$:ep=val(ep$):ifep<0orep>255orep<spthengoto754
  123. 756 a$="saving... please wait":gosub901:pokev+21,0:sys51213
  124. 757 open15,8,15:open2,8,1,ff$:input#15,aa,b$,c$,d$
  125. 758 ifaa<>0thengosub911:print"disk error:"aa"[157],"b$","c$","d$:close2:close15:return
  126. 759 print#2,chr$(sp);:sp=16384+(sp*35):ep=16418+(ep*35)
  127. 760 fora=sptoep:print#2,chr$(peek(a));:nexta:print#2,chr$(13):close2:close15:return
  128. 770 rem load pattern
  129. 772 a$="loading... please wait":gosub901:pokev+21,0:sys51213:a=0
  130. 773 open15,8,15:open2,8,2,ff$:input#15,aa,b$,c$,d$
  131. 774 ifaa<>0thengosub911:print"disk error:"aa"[157],"b$","c$","d$:close2:close15:return
  132. 775 get#2,sp$:sp=asc(sp$+chr$(0)):sa=16384+(sp*35)
  133. 776 get#2,a$:ifa$<>chr$(13)thenpokesa+a,asc(a$+chr$(0)):a=a+1:goto776
  134. 778 close2:close15:pn=sp:pm=sa:sysds,pm+3:gosub921:gosub1005:return
  135. 900 rem*********************************************************display message
  136. 901 print"                                        ";:a=((40-len(a$))/2)
  137. 902 print""tab(a)""a$:return
  138. 910 rem***********************************************************clear message
  139. 911 syshl,1024,40,32:return
  140. 920 rem*******************************************************display pn and tp
  141. 921 print""spc(22)"   [157][157][157][157]"pn
  142. 922 print""spc(35)"   [157][157][157][157]"tp:return
  143. 1000 rem**********************************************************set up voices
  144. 1005 fora=0to2:vc(a)=peek(pm+a):poke2045+a,vc(a)+215:nexta:fora=0to6:forb=0to2
  145. 1010 pokes+(b*7)+a,sn(vc(b),a+1):nextb,a:fora=0to2:poke49152+a,sn(vc(a),5)+1
  146. 1020 nexta:ct=pf(1):rs=pf(2):ft=pf(3):fora=0to2:ifsn(vc(a),8)=1thenrs=rs+(2^a)
  147. 1060 nexta:poke54294,ct:poke54295,rs:poke54296,15+ft
  148. 1065 print"[152]"sn$(vc(0))""sn$(vc(1))""sn$(vc(2)):return
  149. 3000 rem***********************************************************print screen
  150. 3004 pokev+32,0:pokev+33,0:pokev+24,31
  151. 3005 print"[158][147]":fora=1to8:print""sn$(a):nexta
  152. 3006 print"[151][172][152][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174][146][172][154][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]";
  153. 3008 print"[151][161][152][194]      sounds       [152][221][161][154][194]    options    [154][221]";
  154. 3010 print"[151][161][152][194]                   [221][161][154][194]               [221]";
  155. 3012 print"[151][161][152][194]                   [221][161][154][194][152][146]@[\[154] [152][146][201][202][203][154] [152][146][213][214][215][154] [152][214][202][203][154][221]";
  156. 3014 print"[151][161][152][194]                   [221][161][154][194][152][146]]$%[154] [152][146][204][205][206][154] [152][146][216][218][220][154] [152][211] [213][154][221]";
  157. 3016 print"[151][161][152][194]                   [221][161][154][194][152][146]&_[193][154] [152][146][207][208][211][154] [152][146][255][223][166][154] [152][216][218][220][154][221]";
  158. 3018 print"[151][161][152][194]                   [221][161][154][194]               [221]";
  159. 3020 print"[151][161][152][194]                   [221][161][154][194][152][\][154] [152][146][168][169][171][154] [152][166][168][169][154] [152][146]@[\[154][221]";
  160. 3022 print"[151][161][152][194]                   [221][161][154][194][152]$[146][221]&[154] [152][146][177][178][179][154] [152][171][177][178][154] [152][146]]$%[154][221]";
  161. 3024 print"[151][161][152][194]                   [221][161][154][194][152][193][201][255][154] [152][146][186][191]@[154] [152][179][186][191][154] [152][146]&_[193][154][221]";
  162. 3026 print"[151][161][152][173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189][161][154][173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189]";
  163. 3028 print"[151][146][188][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][146][190][188][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][146][190]";
  164. 3034 print"[129][146][172][158][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]";
  165. 3035 print"[129][161][158][194]snd[158] pattern number:       tempo:    [158] [221]";
  166. 3037 print"[129][161][158][194]    ^_<>^_<>^_<>^_<>^_<>^_<>^_<>^_<> [221]";
  167. 3038 fora=0to7:print"[129][161][158][194] [219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219] [221]";:nexta
  168. 3046 print"[129][161][158][173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195]";:poke2023,253:return
  169. 9000 rem*****************************************************initialise sprites
  170. 9005 fora=0to2:pokev+10+(a*2),37+(54*a):pokev+11+(a*2),82:pokev+44+a,0
  171. 9006 poke2045+a,216+a:nexta:pokev+23,224:pokev+29,224:poke2040,214
  172. 9007 pokev+16,0:pokev,224:pokev+1,86:pokev+39,1:pokev+21,255:return
  173. 10000 rem*************************************************read sound parameters
  174. 10001 fora=1to8:readsn$(a):forb=1to8:readsn(a,b):nextb,a:readpf(1),pf(2),pf(3)
  175. 10002 return
  176. 10009 rem sound name,l/freq,h/freq,l/pulse,h/pulse,waveform,a/d,s/r,filt on/off
  177. 10010 data"cym",30,134,0,0,128,12,10,1,"bsd",12,1,0,0,128,7,5,0
  178. 10030 data"ltm",48,4,0,0,16,24,4,0,"htm",97,8,0,0,16,24,4,0
  179. 10050 data"snd",15,67,0,0,128,8,6,0,"hih",30,134,0,0,128,5,3,1
  180. 10060 data"bel",194,102,200,7,64,42,74,0,"hcp",176,230,0,0,128,25,8,0
  181. 10070 data174,176,64
  182.