Tuesday, April 29, 2008

Learning Haskell, functional music

As you might have realized, I started to learn Haskell. One of the most fun things to do in any programming language is creating some kind of audible side effects with a program.
Already back in the days when I started programming, I always played around with audio when toying around with a new language.

I have found a wonderful set of lecture slides about haskell and multimedia programming, called school of expression. Inspired by the slides about functional music I implemented a little song. Ahh ... and yes it is intended to sound slightly strange.

I used the synthesis toolkit to transform the music to real noise, simply by piping skini message to std-out.

I used this command line to achieve the results audible in the table:

sven@hhi1214a:~/Mukke$ ghc -o test1 test1.hs && ./test1 | stk-demo Plucked -n 16 -or -ip

Sound samples:




Pluckedplay
Clarinetplay
Whistle(attention very crazy!)play


As always the source...

stueck = anfang :+: mitte :+: ende

anfang = groovy :+: (Trans (-5) trickie)
mitte = seq_overlap (1/3) mitte1 mitte2
mitte1 = (3/4) `schneller` (Trans (-2) groovy)
mitte2 = (3/4) `schneller` groovy
ende = Rest (1/4) :+: (moll_akkord (Note (A,4) 1))

groovy = dumschingbadumschingsching 3 (2/3) -- fast schon swing artiger rythmischer versatz
trickie = dumschingbadumschingsching 2 (3/4)

blim_sching af = ((Note (A,3) (1/4)) :+: (af (Note (A,4) (1/4))))
dumdideldum af = quinten_hochlauf 4 (rpt 2 $ blim_sching af) -- 4 klingt leicht schief
dumschingbadumschingsching r versatz = interleave r versatz (dumdideldum moll_akkord) (Trans 3 (dumdideldum dur_akkord))

main :: IO ()
main = do
mapM_ putStrLn $ music_to_skini stueck 33

-- functional music composition
hochlauf tr n m = rep (Trans quinte) (delay (duration m)) n m
quinten_hochlauf = hochlauf quinte
interleave n dist m1 m2 = (rpt n m1) :=: (Rest dist :+: (rpt n m2))
schneller spdup m = (Tempo ((duration m)*(spdup)) m)

akkord grundton moll_dur = grundton :=: (Trans (3 + moll_dur) grundton) :=: (Trans 7 grundton)
moll_akkord grundton = akkord grundton 0
dur_akkord grundton = akkord grundton 1

terz = 3
gr_terz = 4
quarte = 5
quinte = 7

seq_overlap overlap m1 m2 = m1 :=: (delay ((duration m2) - overlap) m2)

rpt 0 m = Rest 0
rpt n m = m :+: rpt (n-1) m

rptm f 0 m = Rest 0
rptm f n m = m :+: rptm f (n - 1) (f m)

rep f g 0 m = Rest 0
rep f g n m = m :=: g (rep f g (n-1) (f m))

-- functional music basics, based on the school of expression lecture slides
data Music = Note Pitch Dur
| Rest Dur
| Music :+: Music
| Music :=: Music
| Tempo Dur Music
| Trans Int Music
| Instr Int Music
| Control ControlMessage Music
deriving (Show, Eq)

type Dur = Rational

type Pitch = (Tone, Octave)
data Tone = C | Cis | D | Dis | E | F | Fis | G | Gis | A | B | H
deriving (Show, Eq)
type Octave = Int

type ControlMessage = (Int, Int)

-- absolute pitches
type AbsPitch = Int

trans :: Int -> Pitch -> Pitch
trans i p = pitch (absPitch p + i)

pitch :: AbsPitch -> Pitch
pitch p = ([C, Cis, D, Dis, E, F, Fis, G, Gis, A, B, H] !! mod p 12, p `quot` 12)

absPitch :: Pitch -> AbsPitch
absPitch (n, o) = (o * 12) + (case n of C -> 0; Cis -> 1; D -> 2; Dis -> 3; E -> 4; F -> 5; Fis -> 6; G -> 7; Gis -> 8; A -> 9; B -> 10; H -> 11)

-- delay
delay :: Dur -> Music -> Music
delay d = ((Rest d) :+:)

-- absolute durations
abs_dur :: BeatPM -> Dur -> AbsDur
abs_dur bpm d = (fromRational d) / (bpm / (60.0))

type BeatPM = Float
type AbsDur = Float

-- calculate the duration of a piece of music
duration :: Music -> Dur
duration m = case m of
Rest d -> d
Note _ d -> d
m1 :+: m2 -> duration m1 + duration m2
m1 :=: m2 -> max (duration m1) (duration m2)
Tempo d _ -> d
Trans _ m1 -> duration m1
Instr _ m1 -> duration m1
Control _ m1 -> duration m1

-- convert to a simple event stream of musical events with absolute values
-- that soley consist of NoteOn and NoteOff events with midi notes and timestamps
data MusicEvent = MusicEv MusicEventType AbsPitch AbsDur
deriving (Show, Eq)

data MusicEventType = NoteOn | NoteOff
deriving (Show, Eq)

to_event_stream :: BeatPM -> Music -> AbsDur -> (AbsDur, [MusicEvent])
to_event_stream bpm um start_time =
case m of
Note p d ->
let dur = start_time + (abs_dur bpm d)
in (dur, [(MusicEv NoteOn (absPitch p) start_time), (MusicEv NoteOff (absPitch p) dur)])

Rest d ->
(start_time + (abs_dur bpm d), [])

Tempo d m1 ->
to_event_stream (bpm * (fromRational (duration m1)) * 1.0/(fromRational d)) m1 start_time

m1 :+: m2 ->
(total_dur, evt_str1 ++ evt_str2)
where (st1, evt_str1) = to_event_stream bpm m1 start_time
(total_dur, evt_str2) = to_event_stream bpm m2 st1

m1 :=: m2 ->
(max dur1 dur2, merge evt_str1 evt_str2)
where (dur1, evt_str1) = to_event_stream bpm m1 start_time
(dur2, evt_str2) = to_event_stream bpm m2 start_time

_ -> (start_time, [])

where
m = transpose_all um 0
transpose_all :: Music -> Int -> Music
transpose_all m tr = case m of
Trans tr2 m1 -> transpose_all m1 (tr + tr2)
Note p d -> Note (trans tr p) d
m1 :+: m2 -> (transpose_all m1 tr) :+: (transpose_all m2 tr)
m1 :=: m2 -> (transpose_all m1 tr) :=: (transpose_all m2 tr)
other -> other
merge :: [MusicEvent] -> [MusicEvent] -> [MusicEvent]
merge l1 l2 = mergea l1 l2 []
mergea :: [MusicEvent] -> [MusicEvent] -> [MusicEvent] -> [MusicEvent]
mergea [] l2 acc = acc ++ l2
mergea l1 [] acc = acc ++ l1
mergea l1@(e1@(MusicEv _ _ dur1):r1) l2@(e2@(MusicEv _ _ dur2):r2) acc
| dur1 <= dur2 = mergea r1 l2 (acc ++ [e1]) | dur1 > dur2 = mergea l1 r2 (acc ++ [e2])

-- convert to skinni
{-

2 comments:

machinehuman said...

Excellent. That was fun. Thanks for sharing.

Sven Heyll said...

thanks for the nice comment :)