Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Tiny piano – Rondo Alla Turca
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. render 9e6 (\_->0) . Sequence[]
$[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=Sequence[][2-^8,1-^8,0-^8,1-^8,3-^4]
cM=Sequence[][7-^20,8-^20,9.^4,Sequence[(7,0),(6,1)](map((2).(.^4))[6,5,6])%0.75]
cMv=Sequence[][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
(Sequence[][6-^4,lp(8.^43)%(3/4),sil%2,lp(5.^43)%h,lp(5.^42)%h,1-^17]&(-14)#7#4%5)
mMa f=Sequence[][(1-3*f).^4,lp(5.^4(-2-f))%0.75,mMa f%1.5,mMa(f*2)%h,mMa f%1]#7
mTm=Sequence[][mM%1,mM&2%1,mM#4&4%h,mM&7%h,mM&7%1,8.^4,Sequence[][10.^4]%0.2,cM%1,cM%1,cM%0.85,Sequence[][4.^42,5.^2]#6#4%2]#7
mT=p$Sequence[][mTm%8.1(Sequence[][sil%h,mMa 0%4,mMa 1%2.75,2.^4,(-2)-^2]&(-7)%8)]
m2=Sequence[][Sequence[](map((2).(.^4))[1,2,3,3]++[es[6,5,4,3]%h]++[0-^22])%2
(Sequence[][sil%h,1.^4,8.^4,3.^4,10.^4,5-^2]1.3&(-14)%2)]
t2=p$Sequence[][m2&2%1.8,0-^5,m2&2%2,m2#7%1.8,(-2)-^5,m2#7%2,mT%3.5,cMv]
m3=Sequence[]$[3-^4,4-^4,5-^2]++map(-^4)[3,4,5,4,3,2,1,2,3,4,2,0]
m3a=Sequence[][(Sequence[][sil%(1/8),lp(8.^4)%1]:zw(\d n->Sequence[][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=Sequence[][Sequence[][o$ḋ[m3%4,m3%2.5,1-^4,4-^4,2-^4,0-^4]&(-2)%7.5,1-^27]%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=mM4
i4 e=ḋ[m411%h,m49%h,mQ48%h,Sequence[(5,e),(4,1)][mQ7%h,mQ5%h,m4&5%h,m4&7%h]%2,es[10,9,10,9]#2%h ]
mla[b,c,d]=Sequence[][b-^4,lp(c-^4(d-^4))%1]%1
i4a=ḋ[sil%h,Sequence[](map mla[[1,3,5],[2,4,5],[1,3,5],[0,2,5]])#5%4,Sequence[](map mla[[1,3,5],[2,5,7],[2,6,8]])#4%3,5-^2(7-^2)]
t4=p$Sequence[][ḋ[i4 1%4,i4 0%2.5,Sequence[][mQ6%h,mQ4%h]#4#2%1,3-^2]%8(i4a&(-9)%8)]
mlaa=mla[1,3,5]
m5=Sequence[]$map(-^8)[1..4]
i5=ḋ[m56%h,m5%h,m5&4%h,m59%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,Sequence[][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(Sequence[][Sequence[][i4 1%4,es[3,2,3,1,4,3,4,3,4,3,4,3]#2#1&7%1.5,m513%h,mQ8%h,m5&7%(3/8),6-^8,mQ7#5%h,6-^2]%8
(Sequence[][i4a%3.5,Sequence[(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-^d25
amf=1-^υ2(5-^13)
vh v(c,d)=lp(Sequence[][v-^12]:map(\t->Sequence[][t0%0.04,t%d])c,d)
aam=vh 11.am
aar=Sequence[][1-^10,4-^10,6-^1]&4
eam=vh 10.em
dm=6-^12(11-^1)
em d=5-^d2(9-^1)
cdM=ḋ[4-^8,3-^8,2.^8,3.^8,cdM%1]
cdT=ḋ[Sequence[][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(Sequence[](sil%(11/24) : map((%1).(m3a&))[4,4,4,0,4,1,4,4,4,0,4,1])&(-18)%13.1)
,p(Sequence[][Sequence[][Sequence[][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(Sequence[](map m3ra[0,0,0,0,1,0,2])&(-7)%7)])%6.75
,Sequence[][p(Sequence[][12-^4])%(1/4),am 1,am 1,cdM&7%1,dm,aam 1%1,eam 4%1,amf,Sequence[][3-^4,1-^υ,5-^4,1-^υ,3-^4,1-^4,3-^4,1-^4,5-^4,1-^2]%3.757,Sequence[][amf(-14)]%0.56,Sequence[][amf(-14)]0.8%1]%12(Sequence[](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 Volume = Double
type SemitoneShift = Double
type Duration = Double
type Frequency = Double
type DiatonicPitch = Int
type Accidental = (DiatonicPitch, SemitoneShift)
type Accidental'd = DiatonicPitch -> SemitoneShift
type TimeBlock = ([Figure], Duration)
data Figure
= Note { notePitch :: DiatonicPitch
, noteVelo :: Volume }
| Sequence { accidentals :: [Accidental]
, theSequence :: [TimeBlock] }
-- | Apply a function to all the sub-sequences, rather than the top sequence as a whole.
(⇸) :: (Figure->Figure) -> Figure->Figure
φSequence a fs=Sequence a$map(\(f,d)->(map φ f,d))fs
_Note i d=Note i d
-- | Look up the frequency of the diatonic pitch, which may be subject to semitone shifting via accidentals.
(##) :: DiatonicPitch -> Accidental'd -> Frequency
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;4->5;5->7;6->8;7->10;_->fromIntegral i})
type Audio = [Double]
render :: Duration -> Accidental'd -> Figure -> Audio
render dur acc (Note n v) = map (harmExcite . oscillate) [1..dur]
where harmExcite x = sin $ x + τ x ^ 2 / η
oscillate i = v * envelope * sin(i*ω)
where envelope = attack * decay * release
decay = exp $ -i*η/s
attack = τ(i*v)
release = 0.8-τ((i-dur)/90)
ω = n##acc / 15.5
η = exp $ fromIntegral n/9
render dur acc(Sequence accm fs)=render' dur (foldr(\(q,m)f i->if q==i then m else f i)acc accm) fs
render' :: Duration -> Accidental'd -> [TimeBlock] -> Audio
render' dur _ _|dur<=0 = []
render' dur _ []=map(\_->0)[1..dur]
render' dur acc((f,dr):fs)|n<-min dr dur=transition(round n)(foldr1(\a b->sum a`par`sum b`pseq`zw(+)a b)(map(render(n+99)acc)f))$render'(dur-dr)acc fs
transition :: Int -> Audio -> Audio -> Audio
transition n a b|(f,ol)<-splitAt n a,(or,l)<-splitAt 99 b=f++zw(+)ol or++l
-- | Apply a sharp-accidental to all notes of the specified pitch in the sequence.
(#) :: Figure -> DiatonicPitch -> Figure
Sequence a fs#q=Sequence((q,1):a)fs
(&), (⇅), (⇆) :: Figure -> Int -> Figure
-- | Transpose the sequence by /n/ (diatonic) steps.
Note i d&n=Note(n+i)d
f&n=(&n)f
-- | Invert the sequence.
Note i dn=Note(n-i)d
fn=(n)f
-- | Retrograde.
Note i d_=Note i d
Sequence a fsn=Sequence a.reverse$take n fs
-- | Adjust the dynamics/volume.
(⊿) :: Figure -> Volume -> Figure
Note i dv=Note i$d*v
fv=(v)f
-- | Play in piano (dynamics).
p=(0.3)
type InverseDuration = Double
(.^), (-^) :: DiatonicPitch -> InverseDuration -> TimeBlock
-- | A simple staccato note of the specified note value.
n.^q=([Sequence[][([Note n 1],s/2/q)]],s/q)
-- | Legato note.
n-^q=([Note n 1],s/q)
-- | Put two time-blocks in parallel / play them simultaneously.
(⋎) :: TimeBlock -> TimeBlock -> TimeBlock
(l,d)(r,_)=(l++r,d)
-- | Add the nth note above as a harmony to all notes in the block.
(∡) :: TimeBlock -> Int -> TimeBlock
(l,d)j=(l++map(\h->Sequence[][h0%0.01,h&j%100])l,d)
-- | Cut a sequence to the specified duration.
(%) :: Figure -> Duration -> TimeBlock
f%t=([f],s*t)
tr n=Sequence[]$cycle[n-^15,(n+1)-^20]
=Sequence$zip[6,3,7][1,1,1]
lp=Sequence[].repeat
sil=Note 0 0
tev f(l,d)=(map f l,d)
h=1/2
υ=4/3
s=4e+4
sq d=Sequence[].map(-^d)
es=sq 8
arp8 n@(Note i v)=Sequence[][([n,Sequence[][n0%(1/8),n&7(v/υ)%100]],s)]
arp8 f=arp8f
hom q=Sequence[].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$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
@leftaroundabout

This comment has been minimized.

Copy link
Owner Author

leftaroundabout commented May 4, 2013

This program generates Mozart's Ronda Alla Turca (Piano Sonata #11) as ahem CD-Quality pcm audio on standard output, so it can be piped in real-time (with enormous latency) to aplay -f cd. This is a solution to this challenge on codegolf.stackexchange.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.