Euterpea Simple Examples

From MCIS Wiki
Jump to: navigation, search

Play a piece of music twice:

twice :; Music a -> Music a
twice m = m :+: m

Repeat a piece of music n times:

repeatm :: Int -> Music a -> Music a
repeatm 0 m = rest 0
repeatm n m = m :+: repeatm (n-1) m

Create a major chord:

maj m = m :=: transpose 4 m :=: transpose 7 m

Repeat music, changing at every step:

rpc :: Int -> (Music a -> Music a) -> Music a -> Music a
rpc 0 fn m = rest 0
rpc n fn m = m :+: rpc (n-1) fn (fn m)

Turn a list of integers into a line:

mel ints = line (map (\i -> transpose i (c 4 en)) ints)

Turn a list of intervals into a list of note numbers:

toScale ints = scanl (+) 0 ints

Given a starting note and a length, return a list of notes starting on the given scale note with the given length:

makeScale firstNote len intervals =
  take len (drop firstNote (scanl (+) 0 (cycle intervals)))

Create a triad from scale notes:

triad (n1:_:n2:_:n3:_) = [n1, n2, n3]

A short example of Markov music:

goingUp = state 1 [(0.6, goingUp), (0.2, goingDown), (0.2, goingUpFast)]

goingUpFast = state 2 [(1, goingUp)]

goingDown = state (-1) [(0.2, goingUp), (0.8, goingDown)]

intervals = runState 1 goingUp

notes = toScale intervals

randomMelody = mel (take 100 notes)

Adding rhythm to music:

r1 = "0+++00000+++0---"  -- This is 4 beats of 1/16 notes.  Quarter, 4 1/16, Quarter, 1/16, 3/16 rest
r1t = toRhythm r1        -- This converts to a list of durations
m1 = line $ addRhythm r1t (c 4 wn)  -- Play the rhythm on c4
tune = [c 4 wn, d 4 wn, e 4 wn, f 4 wn, g 4 wn, f 4 wn, e 4 wn, d 4 wn, c 4 wn]
m2 = line $ addRhythms r1t tune  -- Add to a tune

== Utilities File ==
<pre>

module Utils(module Utils, module System.Random) where

import Euterpea
import System.Random
import qualified Data.List

-- Repeat a piece of music, changing it at each step

repeatAndChange :: Int -> (Music a -> Music a) -> Music a -> Music a
repeatAndChange 0 fn m = rest 0
repeatAndChange n fn m = m :+: repeatAndChange (n-1) fn (fn m)

-- Convert 
melody :: Music a -> [Int] -> Music a
melody base ints = line (map (\i -> transpose i base) ints)

-- Base a melody on c 4 en

mel :: [Int] -> Music Pitch
mel ints = melody (c 4 en) ints

-- Turn a list of intervals into an infinite list of note numbers:

toScale :: [Int] -> [Int]
toScale ints = scanl (+) 0 (cycle ints)

repeatList :: Int -> [a] -> [a]
repeatList n s = concat (take n (repeat s))

-- Take every other element of a list

eo :: [a] -> [a]
eo [] = []
eo [a] = []
eo (x : _ : xs) = x : eo xs

-- Select elements of a list by a function over the position

filterByPos :: (Int -> Bool) -> [a] -> [a]
filterByPos f s = map snd $ filter (\(i,x) -> f i) $ zip [0..] s

arpeggio :: [Int] -> Int -> [Int] -> [Int]
arpeggio notes base scale =
   map (m !!) notes where
     m = drop base scale



-- Random number stuff

randomChoice :: StdGen -> [a] -> [a]
randomChoice gen lst = map (lst !!) (randomRs (0, length lst-1) gen) 

shuffle :: StdGen -> [a] -> [a]
shuffle gen lst = map snd (Data.List.sortBy (\(n1,_) (n2, _) -> compare n1 n2) 
                                  (zip (randomRs (0,10000::Int) gen) lst))

age :: StdGen -> StdGen
age g = g' where (_, g') = next g


-- Markov Music

-- Defines a state.  The state value can be randomly varied
data State a = State (Float -> a) (Float -> State a)

state :: a -> [(Float, State a)] -> State a
state value transitions =
  State (const value) (\r -> getNextState r transitions)

rstate :: (Float -> a) -> [(Float, State a)] -> State a
rstate rv transitions =
  State rv (\r -> getNextState r transitions)

getNextState r [(_,s)] = s
getNextState r ((p,s):t) | r <= p = s
                         | otherwise = getNextState (r-p) t

runState :: Int -> State a -> [a]
runState seed = runState1 rfloats where
  runState1 (r1:r2:rs) (State rv f) =
                rv r1 : runState1 rs (f r2)
  rfloats :: [Float]
  rfloats = randoms (mkStdGen seed) 

newGen :: Float -> StdGen
newGen f = mkStdGen (round (1000000 * f))

chooseOne :: Float -> [a] -> a
chooseOne r l = l !! (floor (r * (fromIntegral (length l))))

-- Stuff for Rhythms

-- A Rhythm is a list of pairs.  Each pair is two durations - a note duration
-- and a rest duration.  The rest comes before the note.  If there is a
-- trailing rest the note duration of the last tuple is 0.

-- The string representation is "0" for the head of a note, + for the body, and
-- a - for rest.  The overall meter will interpret the basic beat as a 
-- sixteenth note.

type Rhythm = [(Dur, Dur)]

toRhythm :: String -> Rhythm
toRhythm "" = []
toRhythm ('-':s) = let (rl, nxt) = span (== '-') s in
                       genRNote (sn * (fromIntegral (length rl + 1))) nxt
toRhythm s = genRNote 0 s     

genRNote :: Dur -> String -> Rhythm
genRNote restLen "" = [(restLen * sn, 0)]
genRNote restLen ('0':r) =
             let (nb, remaining) = span (== '+') r in
                   (restLen, fromIntegral (1+length nb) * sn) :
                           toRhythm remaining
getRNote _ (c:_) = error ("Bad character " ++ [c] ++ " in toRhythm")

addRhythm :: Rhythm -> Music Pitch -> [Music Pitch]
addRhythm r m = addRhythms r (repeat m)

addOneRhythm :: (Dur, Dur) -> Music Pitch -> Music Pitch
addOneRhythm (0,0) m = rest 0
addOneRhythm (0,1) m = m
addOneRhythm (0,d) m = tempo (1/d) m
addOneRhythm (r,0) m = rest r
addOneRhythm (r,1) m = rest r :+: m
addOneRhythm (r,d) m = rest r :+: tempo (1/d) m

addRhythms :: Rhythm -> [Music Pitch] -> [Music Pitch]
addRhythms [] _ = []
addRhythms ((r,0):rs) ms = rest r : addRhythms rs ms
addRhythms _ [] = []
addRhythms (r : rs) (m:ms) = addOneRhythm r m : addRhythms rs ms