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
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
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
:: MVar MusicalEnvironment
-> String
-> (Player -> Player)
-> IO MusicalEnvironment
modifyPlayer e k func = do
p <- getPlayer e k
addPlayer e (k,func p)
swapName
:: MVar MusicalEnvironment
-> String
-> String
-> IO MusicalEnvironment
swapName e k new = modifyPlayer e k $ (\x -> x { playerName = new })
swapStatus
:: MVar MusicalEnvironment
-> String
-> PlayerStatus
-> IO MusicalEnvironment
swapStatus e k new = modifyPlayer e k $ (\x -> x { playerStatus = new })
swapIOI
:: MVar MusicalEnvironment
-> String
-> String
-> IO MusicalEnvironment
swapIOI e k new = modifyPlayer e k $ (\x -> x { playerIOI = new })
swapCounter
:: MVar MusicalEnvironment
-> String
-> Integer
-> IO MusicalEnvironment
swapCounter e k new = modifyPlayer e k $ (\x -> x { playerCounter = new })
swapClock
:: MVar MusicalEnvironment
-> String
-> String
-> IO MusicalEnvironment
swapClock e k new = modifyPlayer e k $ (\x -> x { playerClock = new })
swapActions
:: MVar MusicalEnvironment
-> String
-> String
-> IO MusicalEnvironment
swapActions e k new = modifyPlayer e k $ (\x -> x { playerAction = new })
swapInterrupt
:: MVar MusicalEnvironment
-> String
-> String
-> IO MusicalEnvironment
swapInterrupt e k new = modifyPlayer e k $ (\x -> x { playerInterrupt = new })
swapBeat
:: MVar MusicalEnvironment
-> String
-> Double
-> IO MusicalEnvironment
swapBeat e k new = modifyPlayer e k $ (\x -> x { playerBeat = new })
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
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 ()
playAt :: Double -> MVar MusicalEnvironment -> String -> IO ()
playAt beat e player = do
swapBeat e player beat
play e player
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
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 ()
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."
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."
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."
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)]
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)