home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / commodore-scene-files / Coverdisks / CDU / V1D4.D64 / ds.bas (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  8.9 KB  |  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.