------------------------------------------------------------------------------

-- Generator.hs
-- created: Fri Oct  1 23:20:44 JST 2010

------------------------------------------------------------------------------

-- | This is a module for creating and manipulating mutable generators. Generators contain a source finite list and a counter. Items are retrieved from the list one at a time, and the list loops when the last item has been given.

module Sound.Conductive.Generator where

import Control.Concurrent.MVar
import Data.IORef
import Data.Map
import Data.Maybe
import Sound.Conductive.ConductiveBaseData


-- | creates a new Generator from the given source list.

newGenerator :: [a] -> IO (Generator a)
newGenerator source = do
    c <- newCounter
    g <- newMVar source
    l <- newIORef $ length source
    return $ Generator { generatorSource = g
                       , sourceLength = l
                       , generatorCounter = c
                       }

-- | swaps the source of a Generator

swapGenerator :: Generator a -> [a] -> IO [a]
swapGenerator oldGenerator newSource = do
    writeIORef ( sourceLength oldGenerator) $ length newSource
    swapMVar ( generatorSource oldGenerator) newSource

newCounter :: IO (IORef Int)
newCounter = newIORef (-1)

-- | returns the current value of a counter in a Generator

getCount :: Generator a -> IO Int
getCount generator = do
    c <- readIORef $ generatorCounter generator
    return $ c + 1

-- | returns the source of a Generator

getGeneratorSource :: Generator a -> IO [a]
getGeneratorSource generator = readMVar $ generatorSource generator

-- | resets the counter of a Generator

resetCounter :: Generator a -> IO ()
resetCounter generator = writeIORef (generatorCounter generator) (-1)

-- | returns the next item from a Generator

next :: Generator a -> IO a
next generator = nextWithOffset 0 generator

-- | adds the first argument to the counter value of a Generator and returns the corresponding item from the source

nextWithOffset :: Int -> Generator a -> IO a
nextWithOffset offset generator = do
    lastCount <- readIORef $ generatorCounter generator
    let newCount = lastCount + 1
    writeIORef (generatorCounter generator) newCount
    g <- getGeneratorSource generator
    l <- readIORef $ sourceLength generator
    let next' (l,xs) n = xs !! (mod n l)
    return $ g !! (mod (newCount + offset) l)

-- | given a list of Generators, returns a list containing the next item from all of them

nexts :: [Generator b] -> IO [b]
nexts generators = mapM next generators

-- | runs a pure function on the next item from a Generator

withNext :: Generator a -> (a -> b) -> IO b
withNext generator function = fmap function $ next generator

-- | creates a Map for storing Generators in

newGeneratorStore
  :: (Ord t) => (t, [a]) -> IO (Data.Map.Map t (Generator a))
newGeneratorStore (k,s) = do
    g <- newGenerator s
    return $ fromList [(k,g)]

-- | the defaultGeneratorStore used by the defaultMusicalEnvironment

defaultGeneratorStore
  :: IO (Data.Map.Map [Char] (Generator Double))
defaultGeneratorStore = newGeneratorStore ("default",[1.0])