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 >
Wrap
Commodore BASIC
|
2022-10-26
|
9KB
|
182 lines
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