Skip to main content

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:

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, [])

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


machinehuman said…
Excellent. That was fun. Thanks for sharing.
Sven Heyll said…
thanks for the nice comment :)

Popular posts from this blog

Keys, Values and Rules: Three Important Shake Concepts

The title was a click-bait! This article will actually try to explain five instead of three important notions in Shake.

These are:
RulesKeysValuesThe Build DatabaseActions
This short blog post was inspired by the hurdles with my Shake based build, after the new Shake version was released, which had breaking API changes.

Jump to the next section if you are not interested in the why and how of this blog post.

Shake is rule based build system much like GNU make. Like make it is robust, unlike make, it is pretty fast and supports dynamic build dependencies.

But you knew all that already, if you are the target audience of this post, since this post is about me explaining to myself by explaining to you, how that build tool, I used for years, actually works.

Although I used it for years, I never read the paper or wrapped my head around it more than absolutely necessary to get the job done.

When Shake was updated to version 0.16.x, the internal API for custom rules was removed. Until then I w…

Lazy Evaluation(there be dragons and basement cats)

Lazy Evaluation and "undefined"
I am on the road to being a haskell programmer, and it still is a long way to go. Yesterday I had some nice guys from #haskell explain to me lazy evaluation.

Take a look at this code:

Prelude> let x = undefined in "hello world"
"hello world"

Because of Haskells lazyness, x will not be evaluated because it is not used, hence undefined will not be evaluated and no exception will occur.

The evaluation of "undefined" will result in a runtime exception:

Prelude> undefined
*** Exception: Prelude.undefined

Strictness means that the result of a function is undefined, if one of the arguments, the function is applied to, is undefined.
Classical programming languages are strict. The following example in Java will demonstrate this. When the programm is run, it will throw a RuntimeException, although the variable "evilX" is never actually used, strictness requires that all
arguments of a fu…

Erlang mock - erlymock

The project has evolved and can be found here: ErlyMock

Some features

Easy to use
Design based on easymock
Works together with otp: can be used even if the clut is called from another process, by invoking mock:verify_after_last_call(Mock,optional: timeout)
custom return functions
predefined return functions for returning values, receiving message, throwing exceptions, etc..
erlymock automatically purges all modules that were mocked, after verify()
Custom argument matchers:

%% Orderchecking types: in_order, out_of_order, stub;
%% Answering: {return, ...}|{error, ...}|{throw, ...}|{exit, ...}|{rec_msg, Pid}|{function, Fun(Args) -> RetVal}
expect(Mock, Type, Module, Function, Arguments, Answer = {AT, _}) when AT==return;AT==error;AT==throw;AT==exit;AT==rec_msg;AT==function ->
call(Mock, {expect, Type, Module, Function, length(Arguments), {Arguments, Answer}}).

%% this version of expect is suited for useing custom argument matchers
expect(Mock, Type, Module, Fun, …