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

-- Player.hs
-- created: Fri Oct  1 23:21:08 JST 2010

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

-- | This is a collection of functions which are useful for dealing with Players. The Player data type is in the MusicalEnvironment module. 

module Sound.Conductive.Player (  addNewPlayer
                                , displayPlayer
                                , modifyPlayer
                                , newPlayer
                                , newPlayerStore
                                , pause
                                , play
                                , playAt
                                , playAtTimeString
                                , reset
                                , sleep
                                , stop
                                , swapActions
                                , swapBeat
                                , swapClock
                                , swapCounter
                                , swapIOI
                                , swapInterrupt
                                , swapName
                                , swapPauseTime
                                , swapStatus
                                )where

import Control.Concurrent
import Data.Map 
import Data.Maybe
import Sound.Conductive.ConductiveBaseData
import Sound.Conductive.Generator
import Sound.Conductive.MusicalEnvironment
import Sound.Conductive.MusicalTime

-- | Displays information about a single player.

displayPlayer :: MVar MusicalEnvironment -> String -> IO ()
displayPlayer env player = do
    p <- getPlayer env player
    let  pString = concat [  playerName p
                          , "  "
                          , show $ playerStatus p
                          , "  "
                          , "a: "
                          , playerAction p
                          , "  "
                          , "IOI: "
                          , playerIOI p
                          ]
    putStrLn pString 

-- | Creates a thread delay specified in seconds.

sleep :: (RealFrac a) => a -> IO ()
sleep x = threadDelay $ truncate $ x * 1000000

-- | Creates a new player.

newPlayer
  :: String -- ^ the name of the player
    -> String -- ^ the clock it should follow
    -> String -- ^ the name of the IOI function to use
    -> String -- ^ the name of the action to use
    -> Double -- ^ the beat to start on when played
    -> Player
newPlayer name t deltaf actionf beat =
    Player { playerName = name
           --, playerStatus = "not playing"
           , playerStatus = Stopped
           , playerIOI = deltaf
           , playerCounter = 0
           , playerClock = t
           , playerAction = actionf
           , playerInterrupt = "defaultInterrupt"
           , playerStartingBeat = beat
           , playerBeat = beat
           , playerPauseTime = 0
           }

-- | Used to change a player stored in a MusicalEnvironment.

modifyPlayer
  :: MVar MusicalEnvironment
     -> String
     -> (Player -> Player)
     -> IO MusicalEnvironment
modifyPlayer e k func = do
    p <- getPlayer e k
    addPlayer e (k,func p)

------------------------------------------------------------------------------
-- the boilerplate for records is annoying. Is there no cleaner way?

-- functions for updating one record of a player

-- | Change the name of a player from old (second argument) to new (third argument).

swapName
  :: MVar MusicalEnvironment
     -> String
     -> String
     -> IO MusicalEnvironment
swapName e k new = modifyPlayer e k $ (\x -> x { playerName = new })

-- | Change the status of a player.

swapStatus
  :: MVar MusicalEnvironment
     -> String
     -> PlayerStatus
     -> IO MusicalEnvironment
swapStatus e k new = modifyPlayer e k $ (\x -> x { playerStatus = new })

-- | Change the IOI function of a player from old (second argument) to new (third argument).

swapIOI
  :: MVar MusicalEnvironment
     -> String
     -> String
     -> IO MusicalEnvironment
swapIOI e k new = modifyPlayer e k $ (\x -> x { playerIOI = new })

-- | Change the counter value of a player.

swapCounter
  :: MVar MusicalEnvironment
     -> String
     -> Integer
     -> IO MusicalEnvironment
swapCounter e k new = modifyPlayer e k $ (\x -> x { playerCounter = new })

-- | Change the clock a player is following from old (second argument) to new (third argument).

swapClock
  :: MVar MusicalEnvironment
     -> String
     -> String
     -> IO MusicalEnvironment
swapClock e k new = modifyPlayer e k $ (\x -> x { playerClock = new })

-- | Change the action function of a player from old (second argument) to new (third argument).

swapActions
  :: MVar MusicalEnvironment
     -> String
     -> String
     -> IO MusicalEnvironment
swapActions e k new = modifyPlayer e k $ (\x -> x { playerAction = new })

-- | Change the interrupt function of a player from old (second argument) to new (third argument).

swapInterrupt
  :: MVar MusicalEnvironment
     -> String
     -> String
     -> IO MusicalEnvironment
swapInterrupt e k new = modifyPlayer e k $ (\x -> x { playerInterrupt = new })

-- | Change the beat of the next event of a player.

swapBeat
  :: MVar MusicalEnvironment
     -> String
     -> Double
     -> IO MusicalEnvironment
swapBeat e k new = modifyPlayer e k $ (\x -> x { playerBeat = new })

-- | Change the time of the last pause of a player.

swapPauseTime
  :: MVar MusicalEnvironment
     -> String
     -> Double
     -> IO MusicalEnvironment
swapPauseTime e k new = modifyPlayer e k $ (\x -> x { playerPauseTime = new })

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

timeDiff :: TempoClock -> Double -> Double -> Double
timeDiff t b actualTime = let
    s = timeOfTempoChange $ head $ tempoChanges t
    beatDiff = b - (beatOfTempoChange $ head $ tempoChanges t)
    supposedTime = s + (beatsToDelta t beatDiff)
    in actualTime - supposedTime

correctJitter :: TempoClock -> Double -> Double -> Double -> Double
correctJitter t b delta actualTime = let
    s = timeOfTempoChange $ head $ tempoChanges t
    beatDiff = b - (beatOfTempoChange $ head $ tempoChanges t)
    supposedTime = s + (beatsToDelta t $ beatDiff + delta)
    in supposedTime - actualTime

-- | Plays a player, specified by the string, from a MusicalEnvironment. The start time is determined by the playerBeat field of the player.

play :: MVar MusicalEnvironment -> String -> IO ()
play e player = do
    p <- getPlayer e player
    if (playerStatus p == Playing)
        then putStrLn $ "Player "++player++" is already playing!"
        else (forkIO $ basicPlay e player $ playerStatus p) >> return ()

-- | Plays a player, specified by the string, from a MusicalEnvironment. The start time is given in beats as the first argument (the Double), from which the player automatically adjusts the playerBeat record.

playAt :: Double -> MVar MusicalEnvironment -> String -> IO ()
playAt beat e player = do
    swapBeat e player beat
    play e player

-- | Plays a player, specified by the string, from a MusicalEnvironment. The start time is given as a time string as the first argument (the Double), from which the player automatically adjusts the playerBeat record. Time strings are specified in the MusicalTime module.

playAtTimeString
  :: [Char] -> MVar MusicalEnvironment -> String -> IO ()
playAtTimeString ts e player = do
    p <- getPlayer e player
    clock <- getTempoClock e $ playerClock p
    let beat = musicalTimeToBeats clock $ timeStringToMusicalTime ts
    playAt beat e player

------------------------------------------------------------------------------
-- the basicPlay function, number of cases

basicPlay
  :: MVar MusicalEnvironment -> String -> PlayerStatus -> IO ()

basicPlay e player Stopped = do
    swapStatus e player Playing
    p <- getPlayer e player
    basicPlay e player $ playerStatus p

basicPlay e player Playing = do
    p <- getPlayer e player
    tc <- getTempoClock e $ playerClock p
    actualTime <- currentTime
    let diff = timeDiff tc (playerBeat p) actualTime
    if (diff < 0)
        then do sleep $ abs diff
                p1 <- getPlayer e player
                basicPlay e player $ playerStatus p1
        else do interrupt <- getInterrupt e $ playerInterrupt p
                sequence_ interrupt
                d <- getIOI e $ playerIOI p
                delta <- d e p
                a <- getAction e $ playerAction p
                forkIO $ a e p >> return ()
                tc2 <- getTempoClock e $ playerClock p
                actualTime <- currentTime
                swapBeat e player $ (playerBeat p) + delta
                swapCounter e player $ 1 + (playerCounter p)
                sleep $ correctJitter tc2 (playerBeat p) delta actualTime
                p1 <- getPlayer e player
                basicPlay e player $ playerStatus p1

basicPlay e player Pausing = do
    actualTime <- currentTime
    swapPauseTime e player actualTime
    swapStatus e player Paused
    putStrLn "The player has been paused."
    return ()

basicPlay e player Paused = do
    p <- getPlayer e player
    tc <- getTempoClock e $ playerClock p
    let tmp = head $ tempoChanges tc
    t <- currentTime
    let beatsSinceChange = deltaToBeats (t - (timeOfTempoChange tmp)) $ newTempo tmp
    let currentBeat = (beatOfTempoChange tmp) + beatsSinceChange
    swapBeat e player currentBeat
    swapStatus e player Playing
    p <- getPlayer e player
    basicPlay e player $ playerStatus p

basicPlay e player Stopping = do
    swapCounter e player 0
    swapBeat e player 0
    swapStatus e player Stopped
    putStrLn "The player has been stopped."
    return ()

basicPlay e player Resetting = do
    swapCounter e player 0
    swapBeat e player 0
    swapStatus e player Stopped
    putStrLn "The player has been reset."
    return ()

-- end of the basicPlay function
------------------------------------------------------------------------------

-- | Pauses the specified player.

pause :: MVar MusicalEnvironment -> String -> IO ()
pause e player = do
    p <- getPlayer e player
    if (playerStatus p) == Playing
        then do swapStatus e player Pausing >> return ()
        else do putStrLn "The player is not playing. Nothing has been done."

-- | Stops the specified player. Doing so resets both the playerBeat and playerCounter to 0.

stop :: MVar MusicalEnvironment -> String -> IO ()
stop e player = do
    p <- getPlayer e player
    if (playerStatus p) == Playing
        then do swapStatus e player Stopping >> return ()
        else do putStrLn "The player is not playing. Nothing has been done."

-- | Resets a paused player. Resetting means setting the playerBeat and playerCounter to 0.

reset :: MVar MusicalEnvironment -> String -> IO ()
reset e player = do
    p <- getPlayer e player
    if (playerStatus p) == Paused
        then do swapStatus e player Resetting
                basicPlay e player Resetting
        else do putStrLn "The player is not paused. Nothing has been done."

-- | Used for setting up the playerStore of a MusicalEnvironment. It automatically creates one player according to the arguments it is given.

newPlayerStore
  :: (String, (String, String, String, Double))
     -> Data.Map.Map String Player
newPlayerStore (k,(t, deltaf, actionf, beat)) =
    let p = newPlayer k t deltaf actionf beat
    in fromList [(k,p)]

-- | Creates a new player from the given arguments and adds it to the MusicalEnvironment.

addNewPlayer
  :: MVar MusicalEnvironment
     -> (String, (String, String, String, Double))
     -> IO MusicalEnvironment
addNewPlayer e (n,(c,d,a,b)) = addPlayer e (n,newPlayer n c d a b)