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:

Plucked	play
Clarinet	play
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
{-
    
NoteOn delay channel midi-note volume
NoteOff delay channel midi-note volume
time is always the time to wait after the last event
arg1 is the midi note number
arg2 is the volume
-}
to_skini :: [MusicEvent] -> [[Char]]
to_skini event_stream = skini_stream
where (time_acc, skini_stream) = foldl make_skini (0.0, []) event_stream
 make_skini :: (AbsDur, [[Char]]) -> MusicEvent -> (AbsDur, [[Char]])
 make_skini (total_time, other_skini) (MusicEv mtype pitch ev_time)  =
  (ev_time, other_skini ++ [(show mtype) ++ "   " ++ (show (ev_time - total_time)) ++ "   1   " ++ (show pitch) ++ "   127.0"])

music_to_skini :: Music -> BeatPM -> [[Char]]
music_to_skini m bpm = to_skini event_stream 
where (_, event_stream) = to_event_stream bpm m 0.0