Opus M. v3.1 with some refinements
Posted: Sat Oct 17, 2015 4:10 pm
- done with fading channels
- better rithm for base and drums
- better rithm for base and drums
Code: Select all
' Opus Magnificus, a music generator
' version 3.1 with some refinements
' coded bij Henko, october 2015
'
dim grp$(16),n$(8),g(17)
app_init
new_song: notes set n$(1),n$(2),n$(3),n$(4),n$(5),n$(6),,,,n$(7) ! notes play
for nc=1 to 7 ! n$(nc)=notes_gen$(g(nc)) ! next nc
go_on: slowdown
k=list_selected("1") ! if k>=0 then g_nr=k
for ch=1 to 6
but$="c"&ch
if not button_pressed(but$) then continue
if g_nr=-1 and g(ch)=-1 then continue
if g_nr=-1 then ! button but$ text "free" ! g(ch)=-1
else
g(ch)=g_nr ! g_nr=-1 ! list "1" select -1 ! button but$ text grp$(g(ch))
end if
n$(ch)=notes_gen$(g(ch)) ! goto new_song
next ch
if button_pressed("c7") then
if g(7)=16 then ! g(7)=-1 ! button "c7" text "Drums OFF"
else ! g(7)=16 ! button "c7" text "Drums"
end if
n$(7)=notes_gen$(g(7)) ! goto new_song
end if
if notes_time()<.7*notes_length() then go_on else new_song
end
def app_init
randomize ! set underground on
graphics ! graphics clear ! draw color 0,0,0 ! fill color .8,.8,.8
for i=0 to 15 ! read .grp$(i) ! next i
for ch=1 to 6 ! read .g(ch) ! next ch
data "Piano","Percussion","Organ","Guitar","Bass","Strings 1"
data "Strings 2","Brass","Reed","Pipe","Synth Lead","Synth Pad"
data "Synth Effects","Ethnic","Percussive","All"
data 15,15,4,-1,-1,-1
for i=1 to 7 ! for j=1 to 7 ! .t$&=chr$(96+j) ! next j ! next i
.note=23 ! .speed$="WHQQQIIIISSST"
c_list("1"," Groups",.grp$,15,10,10,160,400) ! .g_nr=-1
for ch=1 to 6
but$="c"&ch ! if .g(ch)=-1 then tit$="free" else tit$=.grp$(.g(ch))
button but$ title tit$ at 180,50*ch-10 size 120,30
next ch
button "c7" title "Drums" at 180,370 size 120,30 ! .g(7)=16
end def
def notes_gen$(g)
a$=""
if g<0 then return a$
if g=4 or g=16 then nlen=300 else nlen=200
for i=1 to nlen
if i=1 or rnd(1)<.05 then
if g<15 then a$&=" "&(8*g+rnd(8))&":"
if g=15 then a$&=" "&rnd(119)&":"
if g=16 then a$&=" "&(35+rnd(48))&":"
end if
if rnd(1)<.5 then
if g=4 or g=16 then sp=4+rnd(7) else sp=rnd(13) ! a$&=mid$(.speed$,sp,1)
end if
if rnd(1)<.1 then a$&="V"&(48+rnd(80))
a$&=tone_mut$(g)
next i
return a$
end def
def tone_mut$(g)
if g=4 then ! h=14 ! dt=rnd(7)-3
else
h=41 ! lr=-3 ! hr=3
if .note<15 then lr+=floor((25-.note)/10)
if .note>25 then hr-=floor((.note-15)/10)
dt=lr+rnd(hr-lr+1)
end if
.note+=dt ! .note=max(0,.note) ! .note=min(h,.note)
n$=mid$(.t$,.note,1) & str$(floor(.note/7)+1)
return n$
end def
def c_list(id$,title$,cont$(),size,xt,yt,xb,yb)
dim temp$(size+1)
for i=0 to size ! temp$(i)=cont$(i) ! next i
list id$ text temp$ at xt+2,yt+32 size xb-xt-4,yb-yt-34
draw size 3
draw rect xt,yt to xb,yb ! draw line xt,yt+30 to xb,yt+30
fill rect xt+2,yt+2 to xb-2,yt+28
draw color 0,0,1 ! draw text title$ at xt+5,yt+5
draw color 0,0,0
end def