Polyphonic, Haskell, 2826 3177 4719
Audio output:
https://www.dropbox.com/s/nba6489tfet740r/hs-golf-turca.ogg
Features:
- All notes
from the right hand. I could of course add the left hand, too (done that).
- Proper articulation of the staccato notes etc.
- Reasonably nice sound with dynamics. Not just simple volume modulation, but proper morphing of the attack character and overtone content,
like you get on a real piano actually, rather more... hey this piece is supposed to be imitating Turkish Janissary bands, right?
- Reverb. Doesn't sound amazingly great, but not too bad, either.
- Dynamic compression. Don't ask...
- Dithering of the output. This is kind of ridiculous: with proper 16-bit resolution, hardly anybody would hear the quantisation artifacts, but to avoid including the binary library, I effectively use only 7-bits resolution, which I can cover with ASCII output. The dither itself is rather loud, no noise-shaping...
- Multithreaded calculation of polyphonic chords.
import Control.Parallel
main=mapM_ (\(d,s)->(\p->p>>p>>p>>p).putChar.toEnum.round.(+d).(*62).min 2.abs$s+1).zip(dθ 1).lim.rev.hgp 9. pl 9e6 (\_->0) . ä
$[mT%8.1,t2%16.1,t3(∡7)%8,t4%8,t5%16,t3(∡7)%8,mT%8.1,t2%16.1,t3(tev arp8)%8,cdT%99] >>= \e->[e,e]
mM=ä[2-^8,1-^8,0-^8,1-^8,3-^4]
cM=ä[7-^20,8-^20,9.^4,F[(7,0),(6,1)](map((∡2).(.^4))[6,5,6])%0.75]
cMv=ä[10-^2,8.^4,9.^4,hom(.^4)[[24,5],[23,8,12],[22,4],[21,6,9],[22,3],[19,5,8],[20,4],[18,6,9],[17]]#7&(-14)%2.5,tr 2%0.4,1-^9,2-^12,1-^1]%4.5
⋎(ä[6-^4,lp(8.^4∡3)%(3/4),sil%2,lp(5.^4∡3)%h,lp(5.^4∡2)%h,1-^1∡7]&(-14)#7#4%5)
mMa f=ä[(1-3*f).^4,lp(5.^4∡(-2-f))%0.75,mMa f%1.5,mMa(f*2)%h,mMa f%1]#7
mTm=ä[mM%1,mM&2%1,mM#4&4%h,mM&7%h,mM&7%1,8.^4,ä[10.^4]%0.2,cM%1,cM%1,cM%0.85,ä[4.^4∡2,5.^2]#6#4%2]#7
mT=p$ä[mTm%8.1⋎(ä[sil%h,mMa 0%4,mMa 1%2.75,2.^4,(-2)-^2]&(-7)%8)]
m2=ä[ä(map((∡2).(.^4))[1,2,3,3]++[es[6,5,4,3]%h]++[0-^2∡2])%2
⋎(ä[sil%h,1.^4,8.^4,3.^4,10.^4,5-^2]⊿1.3&(-14)%2)]
t2=p$ä[m2&2%1.8,0-^5,m2&2%2,m2#7%1.8,(-2)-^5,m2#7%2,mT%3.5,cMv]
m3=ä$[3-^4,4-^4,5-^2]++map(-^4)[3,4,5,4,3,2,1,2,3,4,2,0]
m3a=ä[(ä[sil%(1/8),lp(8.^4)%1]:zw(\d n->ä[sil%(d/24),n-^1]⊿cos d)[0..][1,3,5],s),m3a%1]
m3ra=(map((%1). \[a,b,c]->es[a,c,b,c,a,c,b,c])[[1,3,5],[1,4,6],[-2,0,5]]!!)
t3 o=ä[ä[o$ḋ[m3%4,m3%2.5,1-^4,4-^4,2-^4,0-^4]&(-2)%7.5,1-^2∡7]%8
⋎(ḋ[sil%(3/8),m3a&4%2,m3a%h,m3a#4%h,m3a&1%1,m3a&4%2,m3a%h,m3a&1%(5/8),5-^2]&(-18)%8)]
mQ=es[2,1,0,2]
m4=mM⇆4
i4 e=ḋ[m4⇅11%h,m4⇅9%h,mQ⇆4⇅8%h,F[(5,e),(4,1)][mQ⇅7%h,mQ⇅5%h,m4&5%h,m4&7%h]%2,es[10,9,10,9]#2%h ]
mla[b,c,d]=ä[b-^4,lp(c-^4⋎(d-^4))%1]%1
i4a=ḋ[sil%h,ä(map mla[[1,3,5],[2,4,5],[1,3,5],[0,2,5]])#5%4,ä(map mla[[1,3,5],[2,5,7],[2,6,8]])#4%3,5-^2⋎(7-^2)]
t4=p$ä[ḋ[i4 1%4,i4 0%2.5,ä[mQ⇅6%h,mQ⇅4%h]#4#2%1,3-^2]%8⋎(i4a&(-9)%8)]
mlaa=mla[1,3,5]
m5=ä$map(-^8)[1..4]
i5=ḋ[m5⇅6%h,m5%h,m5&4%h,m5⇅9%h]
i5d=hom(-^4)[[2],[4,5],[0],[4,5]]%1
i5a=ḋ[sil%h,mlaa,i5d,mlaa,mla[-2,0,4],mlaa,i5d,sq 4[1,-1,-3,-2,-6,1]%2]&(-7)
t5=ḋ[ḋ[i5%2,i5%1.5,ä[8-^4,9-^4]#1%h,i5%2,ḋ[es[5,4,3,2,3,5,1,3,2,4,0,2]%2]%1.5,1-^2]%8⋎(i5a%8)
,p(ä[ä[i4 1%4,es[3,2,3,1,4,3,4,3,4,3,4,3]#2#1&7%1.5,m5⇅13%h,mQ⇅8%h,m5&7%(3/8),6-^8,mQ⇅7#5%h,6-^2]%8
⋎(ä[i4a%3.5,F[(1,-1),(7,0),(6,1)][hom(-^4)[[-2],[3,5],[2,5],[1,5]]%1]%1,mla[-3,1,4],mla[-3,2,4],hom(-^4)[[-2],[1,3],[-2],[2,4],[1,3]]%1.5]&(-9)%8)])%8]⊿0.8
am d=3-^d∡2∡5
amf=1-^υ∡2⋎(5-^1∡3)
vh v(c,d)=lp(ä[v-^12]:map(\t->ä[t⊿0%0.04,t%d])c,d)
aam=vh 11.am
aar=ä[1-^10,4-^10,6-^1]&4
eam=vh 10.em
dm=6-^1∡2⋎(11-^1)
em d=5-^d∡2⋎(9-^1)
cdM=ḋ[4-^8,3-^8,2.^8,3.^8,cdM%1]
cdT=ḋ[ä[3-^(8/3)∡7,10-^6,am 1,am 1,cdM&7%1,dm,aam 4.05%1,em(4/3),12-^4,am 1,am 1,cdM&7%1,dm,aam 1%1,eam 4%1]%12.5⋎(ä(sil%(11/24) : map((%1).(m3a&))[4,4,4,0,4,1,4,4,4,0,4,1])&(-18)%13.1)
,p(ä[ä[ä[8-^2]⊿2%h,aar%(3/8),10-^8,aar%1,aar%1,cdM&7%1,11-^1,vh 11(10-^4)%1,9-^(4/3)]%7⋎(ä(map m3ra[0,0,0,0,1,0,2])&(-7)%7)])%6.75
,ä[p(ä[12-^4])%(1/4),am 1,am 1,cdM&7%1,dm,aam 1%1,eam 4%1,amf,ä[3-^4,1-^υ,5-^4,1-^υ,3-^4,1-^4,3-^4,1-^4,5-^4,1-^2]%3.75∡7,ä[amf∡(-14)]%0.56,ä[amf∡(-14)]⊿0.8%1]%12⋎(ä(sil%(1/8):map((%1).(m3a&))[4,4,4,0,4,1,4,4,4]++[m3a&4%h,m3a&4%h,5-^(8/5)])&(-18)%12)]
type D=Double
data F=N Int D|F[(Int,D)][([F],D)]
φ⇸F a fs=F a$map(\(f,d)->(map φ f,d))fs
_⇸N i d=N i d
i##c
|i<1=(i+7)##c/2
|i>7=(i-7)##c*2
|1>0=1.06**(c i+case i of{1->0;3->3;4->5;5->7;6->8;7->10;_->fri i})
pl dur acc(N n v)=(\ω η->map(sin.(\x->x+τ x^2/η). \i->v*exp(-i*η/s)*τ(i*v)*(0.8-τ((i-dur)/90))*sin(i*ω))[1..dur])(n##acc/15.5).exp$fri n/9
pl dur acc(F accm fs)=pl' dur (foldr(\(q,m)f i->if q==i then m else f i)acc accm) fs
pl' dur _ _|dur<=0 = []
pl' dur _ []=map(\_->0)[1..dur]
pl' dur acc((f,dr):fs)|n<-min dr dur=trans(round n)(foldr1(\a b->sum a`par`sum b`pseq`zw(+)a b)(map(pl(n+99)acc)f))$pl'(dur-dr)acc fs
trans n a b|(f,ol)<-splitAt n a,(or,l)<-splitAt 99 b=f++zw(+)ol or++l
fri=fromIntegral
F a fs#q=F((q,1):a)fs
N i d&n=N(n+i)d
f&n=(&n)⇸f
N i d⇅n=N(n-i)d
f⇅n=(⇅n)⇸f
N i d⇆_=N i d
F a fs⇆n=F a.reverse$take n fs
N i d⊿v=N i$d*v
f⊿v=(⊿v)⇸f
p=(⊿0.3)
n.^q=([F[][([N n 1],s/2/q)]],s/q)
n-^q=([N n 1],s/q)
(l,d)⋎(r,_)=(l++r,d)
(l,d)∡j=(l++map(\h->ä[h⊿0%0.01,h&j%100])l,d)
f%t=([f],s*t)
tr n=F[]$cycle[n-^15,(n+1)-^20]
ä=F[];ḋ=F$zip[6,3,7][1,1,1]
lp=ä.repeat
sil=N 0 0
tev f(l,d)=(map f l,d)
h=1/2
υ=4/3
s=4e+4
sq d=ä.map(-^d)
es=sq 8
arp8 n@(N i v)=F[][([n,ä[n⊿0%(1/8),n&7⊿(v/υ)%100]],s)]
arp8 f=arp8⇸f
hom q=ä.map(foldr((⋎).q)$sil%1)
dθ l=2*asin l/pi:dθ(abs.sin$l*1e+9)
rev ls=(\z->z id(foldr(\m sg->(\v->z(*v)(map(*0)[0..m*14349]++sg)sg)$abs(cos$(m*3)^2)-0.6)ls.take 9$dθ 1)ls)$(.lwp 3 0).zw.((+).)
lwp ω c(x:l)=c:lwp ω((x+c*ω)/(ω+1))l
lwp _ _ _=[]
hgp ω l=zw(-)l$lwp ω 0 l
lime e(x:l)
|abs(e*x)>1,e'<-((e*8+abs(1/x))/9)=e':lime e' l
|1>0=e:lime((e*49999+1)/5e4)l
lime _[]=[]
lim ls=zw(\a u->τ$a/9+max(-2)(min 2$a*u)/6)(map(*0)[0..500]++ls).lwp 9 0.lime 1$hgp 9 ls
zw=zipWith
τ=tanh
$ make
ghc -o bin/def0-hs def0.hs -O2 -fllvm -threaded
[1 of 1] Compiling Main ( def0.hs, def0.o )
Linking bin/def0-hs ...
time sh -c 'bin/def0-hs +RTS -N4 > hsoutp.pcm'
189.39user 138.41system 2:06.62elapsed 258%CPU (0avgtext+0avgdata 6440240maxresident)k
0inputs+0outputs (0major+403037minor)pagefaults 0swaps
ffmpeg -loglevel panic -y -f s16le -ar 44.1k -ac 2 -i hsoutp.pcm hsoutp.ogg
Here's a partially ungolfed and commented version: https://gist.github.com/leftaroundabout/5517198.
Do you have a link to sheet music? – beary605 – 2013-04-23T23:44:49.347
No currently, I was typing the sample program by listening and trial&error. Now looking for... – Vi. – 2013-04-24T00:56:43.640
For example, this.
– Vi. – 2013-04-24T00:59:03.100Also, I assume you've already realised this, but everyone is going to use square waves. – Peter Taylor – 2013-04-24T07:12:42.153
Related question – Peter Taylor – 2013-04-24T08:44:12.317
@Peter Taylor, Polyphony and trying it to make sound nicer can be bonus points. – Vi. – 2013-04-24T11:07:17.990
Having issue with your example - getting: Bareword found where operator expected at ./rondo.pl line 39, near "s![^ #]!!gr" syntax error at ./rondo.pl line 39, near "s![^ #]!!gr" – lochok – 2013-04-25T06:45:53.673
@lochok, Does your Perl understand s/$pat/$sub/r expression? You may substitute it with
my $tmp = $1; $tmp =~ s![^ #]!!g; my $n = length($tmp);
– Vi. – 2013-04-25T08:35:03.433@Vi.,
/r
was only introduced in 5.16. Perhaps you should update the code to get rid of it, so more people can run it. – None – 2013-04-25T12:27:45.150@dan1111, Done. (Note: I feel the music itself is a bit wrong in one place, maybe I'll fix it later also). – Vi. – 2013-04-25T16:25:09.913
2Note: the arrangement in the linked score is pretty useless for anyone trying to implement this with only one voice. I've downloaded various MIDI files and they don't agree on all of the notes - they can be in the same key, but disagree on some notes by 4 semitones! To make this a well-specified problem it really needs a single canonical score (preferably in some easily parsed format, so that implementers can convert it to a format convenient for their implementation without introducing transcription errors). – Peter Taylor – 2013-04-27T07:35:23.910
@Peter Taylor, Done (based on my MIDI file). – Vi. – 2013-04-28T22:36:26.727