{- |
Create chord patterns with controlable level of details.
-}
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) : []) :
   []


{-
candidate for Utility

cf. Data.MarkovChain.randomItem
-}
randomItem :: (RandomGen g) => [a] -> State g a
randomItem x = fmap (x!!) (randomRState (0, length x - 1))

{- |
'System.Random.randomR' wrapped in a State monad.
-}
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