conductive-base-0.2: Sound/Conductive/Player.hs
------------------------------------------------------------------------------
-- 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
, pauseN
, pauseAll
, play
, playN
, playAll
, playAt
, playNAt
, playAllAt
, playAtTimeString
, reset
, resetN
, resetAll
, sleep
, stop
, stopN
, stopAll
, swapActions
, swapBeat
, swapClock
, swapCounter
, swapIOI
, swapInterrupt
, swapName
, swapPauseTime
, swapStatus
, timeDiff
)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 -> IO Double
timeDiff t b = let
st = timeOfTempoChange $ head $ tempoChanges t
beatDiff = b - (beatOfTempoChange $ head $ tempoChanges t)
in do actualTime <- currentTime
let d = actualTime - st
return $ d - (beatsToDelta t beatDiff)
-- | 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
diff <- timeDiff tc (playerBeat p)
if (diff < 0)
then do putStrLn $ show player
putStrLn "The beat to play on is in the future!"
putStrLn $ "diff = " ++ show diff
sleep $ abs diff
p1 <- getPlayer e player
basicPlay e player $ playerStatus p1
else do
iOIFunc <- getIOI e $ playerIOI p
beatOfNextEvent <- iOIFunc e p
st <- (timeDiff tc beatOfNextEvent)
let sleepTime = (-1) * st
-- putStrLn $ "sleep time = " ++ show sleepTime
if (sleepTime < 0.025)
then do -- putStrLn "\n"
-- putStrLn "-------------------------------------------------"
-- putStrLn "sleep time was too short!"
-- putStrLn $ playerName p
-- putStrLn $ show tc
-- putStrLn $ "playerBeat = " ++ (show $ playerBeat p)
-- putStrLn $ "nextBeat = " ++ (show $ beatOfNextEvent)
-- putStrLn $ "sleepTime = " ++ show sleepTime
-- putStrLn "-------------------------------------------------"
--swapStatus e player Stopping
--basicPlay e player Stopping
swapBeat e player beatOfNextEvent
p1 <- getPlayer e player
basicPlay e player $ playerStatus p
else do interrupt <- getInterrupt e $ playerInterrupt p
sequence_ interrupt
a <- getAction e $ playerAction p
forkIO $ a e p >> return ()
swapBeat e player beatOfNextEvent
swapCounter e player $ 1 + (playerCounter p)
sleep sleepTime
p1 <- getPlayer e player
basicPlay e player $ playerStatus p
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."
playN e ps = mapM_ (play e) ps
playAll e = players e >>= \x -> mapM_ (play e) $ x
playNAt e timestring ps = mapM_ (playAtTimeString timestring e) ps
playAllAt e timestring = players e >>= \x -> mapM_ (playAtTimeString timestring e) $ x
pauseN e ps = mapM_ (pause e) ps
pauseAll e = players e >>= \x -> mapM_ (pause e) $ x
stopN e ps = mapM_ (stop e) ps
stopAll e = players e >>= \x -> mapM_ (stop e) $ x
resetN e ps = mapM_ (reset e) ps
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))
-> 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)