10 REM ************************************************************************
11 REM *                                                                      *
12 REM * 'DRUM SYNTH 64' - AN EXPERIMENTAL DRUM SYNTHESIS PROGRAM WITH        *
13 REM *                   RECORDING, EDITING, PLAYBACK AND STORAGE OPTIONS.  *
14 REM *                                                                      *
15 REM * AUTHOR OF PROGRAM  : ANDREW D. LEEDER, AGE 16                        *
16 REM * COMPUTER           : COMMODORE 64 MICROCOMPUTER                      *
17 REM * LANGUAGE           : CBM BASIC V2.0 AND MACHINE CODE                 *
18 REM * DATE OF COMPLETION : AUGUST, 1987                                    *
19 REM *                                                                      *
20 REM ************************************************************************
21 :
22 :
50 REM***********************************************************INITIALISATION
72 V=53248:POKEV+21,0:S=54272:TP=128:PN=0:PM=16384:PL=49156:DS=49334:HL=49411
73 DIMSN(8,8),SN$(8),VC(2),PF(3),SG(64),SD(64):FORA=0TO34:POKE53213+A,0:NEXTA
74 FORA=0TO2:POKE53213+A,1:NEXTA:GOSUB10001:GOSUB9005:GOSUB3004:SYSDS,PM+3
75 GOSUB911:GOSUB921:GOSUB1005:POKE56325,40:SYS51200
100 REM*********************************************************OPERATE WINDOWS
109 GOSUB141:IFX>208ANDY>56ANDY<145THENGOSUB150
110 IFX>32ANDX<197ANDY>56ANDY<145THENGOSUB201
121 IFY>155THENGOSUB301
130 GOTO109
140 REM***********************************************OBTAIN POINTER X,Y VALUES
141 X=PEEK(V)+(256*PEEK(V+16)):Y=PEEK(V+1):RETURN
149 REM***************************************************************MAIN MENU
150 A$=" **** OPTIONS ****":GOSUB901
151 GETA$:IFA$=""THENGOSUB170
153 IFA$=""THENAD=V+32:GOSUB180
154 IFA$=""THENAD=V+33:GOSUB180
155 IFA$=""THENAD=V+39:GOSUB180
156 IFA$=""THENGOSUB191
157 IFA$=""THENSYS65126
160 GOSUB141:IFX<208ORY>145THENGOSUB911:RETURN
161 IFPEEK(56320)<>111ORX<216ORX>330ORY<82ORY>137THENGOTO151
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)
163 FORF=0TO80STEP40:SYSHL,LC+F,3,1:NEXTF
164 ONCGOSUB401,371,431,502,351,422,701,552
165 FORF=0TO80STEP40:SYSHL,LC+F,3,12:NEXTF:FORF=1TO100:NEXTF:GOTO151
169 REM**************************************************CHANGE CURSOR VELOCITY
170 GOSUB911:PRINT""TAB(9)"CURSOR VELOCITY (0-9) ?"
171 GETA$:IFA$<"0"ORA$>"9"THENGOTO171
172 A=VAL(A$):POKE56325,16+(A*6):A$="**** MENU ****":GOSUB901:RETURN
179 REM**********************************************************CHANGE COLOURS
180 IFPEEK(AD)<255THENPOKEAD,PEEK(AD)+1:RETURN
181 POKEAD,0:RETURN
190 REM***************************************************MANUAL PATTERN CHANGE
191 GOSUB911:INPUT"NEW PATTERN NUMBER ";A$:A=VAL(A$):IFA<0ORA>255THENGOTO191
192 PN=A:PM=16384+(A*35):SYSDS,PM+3:GOSUB921:GOSUB1005:A$=" **** OPTIONS ****"
193 GOSUB901:RETURN
200 REM************************************************************SELECT DRUMS
201 A$="SOUND SELECTION...":GOSUB901
202 GOSUB141:IFX>197ORY>145THENGOSUB911:GOSUB240:RETURN
203 IFPEEK(56320)<>111THENGOTO202
204 GOSUB141:FORA=0TO2:IFX>(36+(52*A))ANDX<(86+(52*A))ANDY>81ANDY<126THENGOSUB250
205 NEXTA:GOTO202
240 FORA=0TO2:VC(A)=(PEEK(2045+A))-215:POKEPM+A,VC(A):NEXTA:GOSUB1005:RETURN
250 B=216:IFPEEK(2045+A)<223THENB=PEEK(2045+A)+1
251 POKE2045+A,B:PRINT"[152]"SPC((A*7)+3)SN$(B-215):RETURN
300 REM**********************************************************RECORD PATTERN
301 A$="RECORD/EDIT PATTERN...":GOSUB901:A=0:B=0
303 GOSUB141:IFY<155THENGOSUB911:RETURN
304 IFPEEK(56320)<>111ORX<66ORX>323ORY<173ORY>233THENGOTO303
305 GOSUB141:A=INT((X-3)/8)-8:B=(INT((Y-5)/8)-21)*40
307 IF(PEEK(1670+A+B)=219)THENGOSUB312:GOTO311
308 IF(PEEK(1670+A+B)=209)THENGOSUB314
311 FORC=1TO100:NEXTC:GOTO303
312 POKE1670+A+B,209:POKEPM+3+A,(PEEK(PM+3+A)OR(2^(B/40))):RETURN
314 POKE1670+A+B,219:POKEPM+3+A,(PEEK(PM+3+A)AND(255-(2^(B/40)))):RETURN
350 REM***************************************************CHANGE PATTERN NUMBER
351 A$="CHANGE PATTERN...":GOSUB901:SYS51213
352 A=PEEK(56320):IFA=123ANDPN>0THENPN=PN-1:PM=PM-35
353 IFA=119ANDPN<255THENPN=PN+1:PM=PM+35
354 SYSDS,PM+3:PRINT""SPC(22)"   [157][157][157][157]"PN:IFA<>111THENGOTO352
360 SYS51200:GOSUB911:GOSUB1005:RETURN
370 REM************************************************************CHANGE TEMPO
371 A$="CHANGE TEMPO...":GOSUB901:SYS51213
372 A=PEEK(56320):IFA=123ANDTP>0THENTP=TP-1
373 IFA=119ANDTP<255THENTP=TP+1
374 PRINT""SPC(35)"   [157][157][157][157]"TP:IFA<>111THENGOTO372
375 SYS51200:GOSUB911:RETURN
400 REM************************************************************PLAY PATTERN
401 A$="PLAYING PATTERN...":GOSUB901:FORA=0TO2:POKE253+A,2^(PEEK(PM+A)-1):NEXTA
402 SYSPL,PM+3,TP:IFPEEK(252)<>0THENGOSUB911:RETURN
403 GOTO402
420 REM***********************************************************ERASE PATTERN
422 B=14:A$="ERASE PATTERN...":GOSUB901
425 FORA=1TO200:NEXTA:SYSHL,PM+3,32,0:SYSDS,PM+3:GOSUB911:RETURN
430 REM***********************************************************COPY PATTERNS
431 GOSUB911:PRINT"[152]     CUT         COPY         PASTE    [146]";
432 GOSUB141:IFX<136THENSYSHL,55296,14,1:SYSHL,55310,26,12:A=1
433 IFX>136ANDX<240THENSYSHL,55296,14,12:SYSHL,55310,13,1:SYSHL,55323,13,12:A=2
434 IFX>240THENSYSHL,55296,27,12:SYSHL,55323,13,1:A=3
435 IFPEEK(56320)<>111THENGOTO432
436 IFA=1ORA=2THENGOSUB470:IFA=1THENSYSHL,PM+3,32,0:SYSDS,PM+3
438 IFA=3THENGOSUB480:GOSUB1005
439 GOSUB911:RETURN
470 FORB=0TO34:POKE53213+B,PEEK(PM+B):NEXTB:RETURN
480 FORB=0TO34:POKEPM+B,PEEK(53213+B):NEXTB:SYSDS,PM+3:RETURN
500 REM*******************************************************SEQUENCE PATTERNS
502 GOSUB911:FORA=1TO64:AA=A:PRINT"ELEMENT ";A:PRINT"#"
504 INPUT"PATTERN";B$:IFLEFT$(B$,1)="X"THENA=64:GOTO508
505 B=VAL(B$):IFB<0ORB>255THENGOTO504
506 INPUT"TIMES";C$:C=VAL(C$):IFC<1ORC>256THEN506
508 SG(AA)=B:SD(AA)=C:GOSUB911:NEXTA:SE=AA-1:RETURN
550 REM***********************************************************PLAY SEQUENCE
552 FORZ=1TOSE:PN=SG(Z):GOSUB911
553 PRINT"ELEMENT "Z"[157], PATTERN"PN"[157],"SD(Z)"TIMES...":PRINT"#"
554 PM=16384+(PN*35):SYSDS,PM+3:GOSUB921:GOSUB1005:FORX=1TOSD(Z):FORY=0TO2
556 POKE253+Y,2^(PEEK(PM+Y)-1):NEXTY:SYSPL,PM+3,TP:NEXTX,Z:GOSUB911:RETURN
700 REM************************************************************DISK STORAGE
701 GOSUB911:PRINT"       SAVE                LOAD        [146]";
702 GOSUB141:IFX<183THENSYSHL,55296,20,1:SYSHL,55316,20,12:A=1:B$="WRITE"
703 IFX>183THENSYSHL,55296,20,12:SYSHL,55316,20,1:A=2:B$="READ"
704 IFPEEK(56320)<>111THENGOTO702
705 GOSUB911:INPUT"ENTER FILENAME";FL$:FF$="0:PAT."+LEFT$(FL$,12)+",SEQ,"+B$
706 IFA=1THENGOSUB752
707 IFA=2THENGOSUB772
709 POKEV+21,255:SYS51200:RETURN
750 REM SAVE PATTERN
752 GOSUB911:INPUT"FIRST PATTERN";SP$:SP=VAL(SP$):IFSP<0ORSP>255THENGOTO752
754 GOSUB911:INPUT"LAST PATTERN";EP$:EP=VAL(EP$):IFEP<0OREP>255OREP<SPTHENGOTO754
756 A$="SAVING... PLEASE WAIT":GOSUB901:POKEV+21,0:SYS51213
757 OPEN15,8,15:OPEN2,8,1,FF$:INPUT#15,AA,B$,C$,D$
758 IFAA<>0THENGOSUB911:PRINT"DISK ERROR:"AA"[157],"B$","C$","D$:CLOSE2:CLOSE15:RETURN
759 PRINT#2,CHR$(SP);:SP=16384+(SP*35):EP=16418+(EP*35)
760 FORA=SPTOEP:PRINT#2,CHR$(PEEK(A));:NEXTA:PRINT#2,CHR$(13):CLOSE2:CLOSE15:RETURN
770 REM LOAD PATTERN
772 A$="LOADING... PLEASE WAIT":GOSUB901:POKEV+21,0:SYS51213:A=0
773 OPEN15,8,15:OPEN2,8,2,FF$:INPUT#15,AA,B$,C$,D$
774 IFAA<>0THENGOSUB911:PRINT"DISK ERROR:"AA"[157],"B$","C$","D$:CLOSE2:CLOSE15:RETURN
775 GET#2,SP$:SP=ASC(SP$+CHR$(0)):SA=16384+(SP*35)
776 GET#2,A$:IFA$<>CHR$(13)THENPOKESA+A,ASC(A$+CHR$(0)):A=A+1:GOTO776
778 CLOSE2:CLOSE15:PN=SP:PM=SA:SYSDS,PM+3:GOSUB921:GOSUB1005:RETURN
900 REM*********************************************************DISPLAY MESSAGE
901 PRINT"                                        ";:A=((40-LEN(A$))/2)
902 PRINT""TAB(A)""A$:RETURN
910 REM***********************************************************CLEAR MESSAGE
911 SYSHL,1024,40,32:RETURN
920 REM*******************************************************DISPLAY PN AND TP
921 PRINT""SPC(22)"   [157][157][157][157]"PN
922 PRINT""SPC(35)"   [157][157][157][157]"TP:RETURN
1000 REM**********************************************************SET UP VOICES
1005 FORA=0TO2:VC(A)=PEEK(PM+A):POKE2045+A,VC(A)+215:NEXTA:FORA=0TO6:FORB=0TO2
1010 POKES+(B*7)+A,SN(VC(B),A+1):NEXTB,A:FORA=0TO2:POKE49152+A,SN(VC(A),5)+1
1020 NEXTA:CT=PF(1):RS=PF(2):FT=PF(3):FORA=0TO2:IFSN(VC(A),8)=1THENRS=RS+(2^A)
1060 NEXTA:POKE54294,CT:POKE54295,RS:POKE54296,15+FT
1065 PRINT"[152]"SN$(VC(0))""SN$(VC(1))""SN$(VC(2)):RETURN
3000 REM***********************************************************PRINT SCREEN
3004 POKEV+32,0:POKEV+33,0:POKEV+24,31
3005 PRINT"[158][147]":FORA=1TO8:PRINT""SN$(A):NEXTA
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]";
3008 PRINT"[151][161][152][194]      SOUNDS       [152][221][161][154][194]    OPTIONS    [154][221]";
3010 PRINT"[151][161][152][194]                   [221][161][154][194]               [221]";
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]";
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]";
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]";
3018 PRINT"[151][161][152][194]                   [221][161][154][194]               [221]";
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]";
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]";
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]";
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]";
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]";
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]";
3035 PRINT"[129][161][158][194]SND[158] PATTERN NUMBER:       TEMPO:    [158] [221]";
3037 PRINT"[129][161][158][194]    ^_<>^_<>^_<>^_<>^_<>^_<>^_<>^_<> [221]";
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
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
9000 REM*****************************************************INITIALISE SPRITES
9005 FORA=0TO2:POKEV+10+(A*2),37+(54*A):POKEV+11+(A*2),82:POKEV+44+A,0
9006 POKE2045+A,216+A:NEXTA:POKEV+23,224:POKEV+29,224:POKE2040,214
9007 POKEV+16,0:POKEV,224:POKEV+1,86:POKEV+39,1:POKEV+21,255:RETURN
10000 REM*************************************************READ SOUND PARAMETERS
10001 FORA=1TO8:READSN$(A):FORB=1TO8:READSN(A,B):NEXTB,A:READPF(1),PF(2),PF(3)
10002 RETURN
10009 REM SOUND NAME,L/FREQ,H/FREQ,L/PULSE,H/PULSE,WAVEFORM,A/D,S/R,FILT ON/OFF
10010 DATA"CYM",30,134,0,0,128,12,10,1,"BSD",12,1,0,0,128,7,5,0
10030 DATA"LTM",48,4,0,0,16,24,4,0,"HTM",97,8,0,0,16,24,4,0
10050 DATA"SND",15,67,0,0,128,8,6,0,"HIH",30,134,0,0,128,5,3,1
10060 DATA"BEL",194,102,200,7,64,42,74,0,"HCP",176,230,0,0,128,25,8,0
10070 DATA174,176,64