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
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
sleep :: (RealFrac a) => a -> IO ()
sleep x = threadDelay $ truncate $ x * 1000000
newPlayer
:: String
-> String
-> String
-> String
-> Double
-> 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
}
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
swapName :: MusicalEnvironment -> String -> String -> IO ()
swapName e k new = modifyPlayer e k $ (\x -> x { playerName = new })
swapStatus :: MusicalEnvironment -> String -> PlayerStatus -> IO ()
swapStatus e k new = modifyPlayer e k $ (\x -> x { playerStatus = new })
swapIOI :: MusicalEnvironment -> String -> String -> IO ()
swapIOI e k new = modifyPlayer e k $ (\x -> x { playerIOI = new })
swapCounter :: MusicalEnvironment -> String -> Integer -> IO ()
swapCounter e k new = modifyPlayer e k $ (\x -> x { playerCounter = new })
swapClock :: MusicalEnvironment -> String -> String -> IO ()
swapClock e k new = modifyPlayer e k $ (\x -> x { playerClock = new })
swapActions :: MusicalEnvironment -> String -> String -> IO ()
swapActions e k new = modifyPlayer e k $ (\x -> x { playerAction = new })
swapInterrupt :: MusicalEnvironment -> String -> String -> IO ()
swapInterrupt e k new = modifyPlayer e k $ (\x -> x { playerInterrupt = new })
swapBeat :: MusicalEnvironment -> String -> Double -> IO ()
swapBeat e k new = modifyPlayer e k $ (\x -> x { playerBeat = new })
swapPauseTime :: MusicalEnvironment -> String -> Double -> IO ()
swapPauseTime e k new = modifyPlayer e k $ (\x -> x { playerPauseTime = new })
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
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
playAt :: Double -> MusicalEnvironment -> String -> IO ()
playAt beat e player = do
swapBeat e player beat
play e player
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
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
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 ()
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."
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."
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
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
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)]
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)