module Haskore.Example.Detail where
import qualified Haskore.Basic.Pitch as Pitch
import Haskore.Basic.Pitch (Class(..))
import qualified Haskore.Melody as Melody
import qualified Haskore.Music.GeneralMIDI as MidiMusic
import qualified Haskore.Music as Music
import qualified System.Random as Random
import System.Random (RandomGen, randomR, mkStdGen, )
import Control.Monad.Trans.State (State, state, evalState, )
import Data.Maybe.HT (toMaybe, )
import qualified Data.List as List
levels :: [[Pitch.T]]
levels =
((0,C) : []) :
((0,C) : (1,C) : []) :
((0,C) : (1,C) : (0,G) : []) :
((0,C) : (1,C) : (0,G) : (0,E) : []) :
((0,C) : (1,C) : (0,G) : (0,E) : (0,D) : (0,F) : []) :
[]
randomItem :: (RandomGen g) => [a] -> State g a
randomItem x = fmap (x!!) (randomRState (0, length x 1))
randomRState :: (RandomGen g) => (Int,Int) -> State g Int
randomRState bnds = state (randomR bnds)
merge :: [a] -> [a] -> [a]
merge xs ys =
concat (zipWith (\x y -> [x,y]) xs ys)
dyadicPattern :: [Pitch.T]
dyadicPattern =
foldl1 merge $
zipWith
(\g level -> flip evalState g (sequence (repeat (randomItem level))))
(List.unfoldr (Just . Random.split) (mkStdGen 925)) $
levels
simpleSong :: MidiMusic.T
simpleSong =
Music.changeTempo 2 $
Music.take 10 $
MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $
MidiMusic.line $
List.map (\p -> Melody.note p MidiMusic.sn ()) dyadicPattern
dyadicLevelPattern :: [(Int, Pitch.T)]
dyadicLevelPattern =
foldl1 merge $
zipWith3
(\g i level -> map ((,) i) $
flip evalState g (sequence (repeat (randomItem level))))
(List.unfoldr (Just . Random.split) (mkStdGen 925))
[0..] $
levels
song :: MidiMusic.T
song =
Music.changeTempo 2 $
MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $
MidiMusic.line $
List.map (maybe MidiMusic.snr (\p -> Melody.note p MidiMusic.sn ())) $
List.zipWith
(\li (l,p) -> toMaybe (l<=li) p)
(concatMap (replicate (2 * 2 ^ length levels)) [0 .. length levels]) $
dyadicLevelPattern