Player.hs

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

-- /home/renick/haskell/conductive-0.3c/Player.hs
-- created: Sun Sep 16 22:20:21 JST 2012

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

-- | This is a collection of functions which are useful for dealing with Players. 

module Sound.Conductive.Player where

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

-- | Displays information about a single player.

displayPlayer :: MusicalEnvironment -> String -> IO ()
displayPlayer env player = do
    Just p <- (playerStore 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 = 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 :: MusicalEnvironment -> String -> (Player -> Player) -> IO ()
modifyPlayer e k func = do
    Just p <- (playerStore e) ?@ k
    addVal (playerStore e) (k,func p)

withPlayers :: MusicalEnvironment -> (Player -> a1) -> [String] -> IO [Maybe a1]
withPlayers e func = withKeys (playerStore e) func

------------------------------------------------------------------------------
-- the boilerplate for records is annoying. Is there no cleaner way?
---- can I eliminate all of these functions with a cleaner spelling using modifyPlayer directly?
--------------------------------------------------------------------------------

-- functions for updating one record of a player

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

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

-- | Change the status of a player.

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

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

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

-- | Change the counter value of a player.

swapCounter :: MusicalEnvironment -> String -> Integer -> IO ()
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 :: MusicalEnvironment -> String -> String -> IO ()
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 :: MusicalEnvironment -> String -> String -> IO ()
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 :: MusicalEnvironment -> String -> String -> IO ()
swapInterrupt e k new = modifyPlayer e k $ (\x -> x { playerInterrupt = new })

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

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

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

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

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

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

play :: MusicalEnvironment -> String -> IO ()
play e player = let
    statusCheck p Stopped   = (forkIO $ basicPlay e player $ Stopped) >> return ()
    statusCheck p Playing   = putStrLn $ "Player "++player++" is already Playing!"
    statusCheck p Pausing   = sleep 0.01 >> play e player -- why is there a hardcoded sleep here and below?
    statusCheck p Paused    = (forkIO $ basicPlay e player $ Paused) >> return ()
    statusCheck p Stopping  = sleep 0.01 >> play e player
    statusCheck p Resetting = sleep 0.01 >> play e player
    in do Just p <- (playerStore e) ?@ player
          statusCheck p $ playerStatus p

-- | 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 -> 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] -> MusicalEnvironment -> String -> IO ()
playAtTimeString ts e player = do
    Just p <- (playerStore e) ?@ player
    Just clock <- (tempoClockStore e) ?@ (playerClock p)
    let beat = musicalTimeToBeats clock $ timeStringToMusicalTime ts
    playAt beat e player

playNow :: MusicalEnvironment -> String -> IO ()
playNow e player = do
    Just p <- (playerStore e) ?@ player
    Just tc <- (tempoClockStore e) ?@ (playerClock p)
    cb <- currentBeat tc
    playAt cb e player

playAtStartOfNMeasure :: MusicalEnvironment -> Int -> String -> IO ()
playAtStartOfNMeasure e measure player = do
    Just p <- (playerStore e) ?@ player
    Just clock <- (tempoClockStore e) ?@ (playerClock p)
    cm <- currentMeasure clock
    let beat = musicalTimeToBeats clock $ MusicalTime {measure = cm + measure, beat = 0.0}
    playAt beat e player

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

basicPlay :: MusicalEnvironment -> String -> PlayerStatus -> IO ()
basicPlay e player Stopped = do
    swapStatus e player Playing
    basicPlay e player Playing

basicPlay e player Playing = do
    Just p <- (playerStore e) ?@ player
    Just tc <- (tempoClockStore e) ?@ (playerClock p)
    cb <- currentBeat tc
    let pb = playerBeat p
    if (pb > cb)
        then do let diff = pb - cb 
                putStrLn "\n-------------------------------------------------"
                putStrLn $ "The beat for player " ++ player ++ " to play on is in the future."
                putStrLn $ show player
                putStrLn $ "currentBeat = " ++ show cb
                putStrLn $ "playerBeat = " ++ (show $ playerBeat p)
                putStrLn $ "diff = " ++ (show $ diff)
                putStrLn "Sleeping and trying again at that time."
                putStrLn "-------------------------------------------------\n"
                sleep diff 
                Just p1 <- (playerStore e) ?@ player
                basicPlay e player $ playerStatus p1
        else do Just interrupt <- (interruptStore e) ?@ (playerInterrupt p)
                sequence_ interrupt
                Just a <- (actionStore e) ?@ (playerAction p)
                Just iOIFunc <- (iOIStore e) ?@ (playerIOI p)
                beatOfNextEvent <- iOIFunc e p pb cb
                forkIO $ a e p cb (beatOfNextEvent - cb) >> return ()
                swapBeat e player beatOfNextEvent
                -- swapCounter e player $ 1 + (playerCounter p)
                sleep $ beatsToDelta tc $ beatOfNextEvent - cb
                Just p1 <- (playerStore e) ?@ player
                basicPlay e player $ playerStatus p

basicPlay e player Pausing = do
    swapStatus e player Paused
    putStrLn $ "Player " ++ player ++ " has been paused."
    return ()

basicPlay e player Paused = do
    swapStatus e player Playing
    basicPlay e player Playing

basicPlay e player Stopping = do
    swapStatus e player Stopped
    putStrLn $ "Player " ++ player ++ " has been stopped."
    return ()

basicPlay e player Resetting = do
    swapStatus e player Stopped
    putStrLn $ "Player " ++ player ++ " has been reset."
    return ()

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

-- | Pauses the specified player.

pause :: MusicalEnvironment -> String -> IO ()
pause e player = do
    Just p <- (playerStore e) ?@ player
    if (playerStatus p) == Playing
        then do actualTime <- currentTime
                swapPauseTime e player actualTime
                swapStatus e player Pausing >> return ()
        else do putStrLn $ "Player " ++ player ++ " is not playing. It cannot be paused."

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

stop :: MusicalEnvironment -> String -> IO ()
stop e player = do
    Just p <- (playerStore e) ?@ player
    if (playerStatus p) == Playing
        then do swapCounter e player 0
                swapBeat e player 0
                swapStatus e player Stopping >> return ()
        else do putStrLn $ "Player " ++ player ++ " is not playing. It cannot be stopped."

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

reset :: MusicalEnvironment -> String -> IO ()
reset e player = do
    Just p <- (playerStore e) ?@ player
    if (playerStatus p) == Paused
        then do swapCounter e player 0
                swapBeat e player 0
                swapStatus e player Resetting >> return ()
        else do putStrLn $ "Player " ++ player ++ " is not paused, therefore this player cannot be reset."

playN :: MusicalEnvironment -> [String] -> IO ()
playN e ps = mapM_ (play e) ps

playAll :: MusicalEnvironment -> IO ()
playAll e = players e >>= \x -> mapM_ (play e) $ x

-- the playAt functions appear not to work correctly. why?

-- playNAt e timestring ps = mapM_ (playAtTimeString timestring e) ps

-- playAllAt e timestring = players e >>= \x -> mapM_ (playAtTimeString timestring e) $ x

pauseN :: MusicalEnvironment -> [String] -> IO ()
pauseN e ps = mapM_ (pause e) ps

pauseAll :: MusicalEnvironment -> IO ()
pauseAll e = players e >>= \x -> mapM_ (pause e) $ x

stopN :: MusicalEnvironment -> [String] -> IO ()
stopN e ps = mapM_ (stop e) ps

stopAll :: MusicalEnvironment -> IO ()
stopAll e = players e >>= \x -> mapM_ (stop e) $ x

resetN :: MusicalEnvironment -> [String] -> IO ()
resetN e ps = mapM_ (reset e) ps

resetAll :: MusicalEnvironment -> IO ()
resetAll e = players e >>= \x -> mapM_ (reset e) $ x

-- | 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)) -> IO (TVar (Map String Player))
newPlayerStore (k,(t, deltaf, actionf, beat)) =
    let p = newPlayer k t deltaf actionf beat
    in newMMap [(k,p)]

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

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