module Sound.Tidal.EspGrid where
import Control.Concurrent.MVar
import Control.Concurrent
import Control.Monad (forever)
import Control.Monad.Loops (iterateM_)
import Sound.OSC.FD
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time.Calendar (fromGregorian)
import Sound.Tidal.Tempo
import Sound.Tidal.Time as T
import Sound.Tidal.Stream
import Sound.Tidal.Dirt
import Sound.Tidal.Transition (transition)
import Sound.Tidal.Pattern (silence)
parseEspTempo :: [Datum] -> Maybe Tempo
parseEspTempo d = do
on <- datum_integral (d!!0)
bpm <- datum_floating (d!!1)
t1 <- datum_integral (d!!2)
t2 <- datum_integral (d!!3)
n <- datum_integral (d!!4)
let nanos = (t1*1000000000) + t2
let utc = posixSecondsToUTCTime ((realToFrac nanos)/1000000000)
return (Tempo utc (fromIntegral n) (bpm/60) (on==0) 0.04)
changeTempo :: MVar Tempo -> Packet -> IO ()
changeTempo mvar (Packet_Message msg) = do
case parseEspTempo (messageDatum msg) of
Just t -> tryTakeMVar mvar >> putMVar mvar t
Nothing -> putStrLn "Unable to parse message as Tempo"
changeTempo _ _ = putStrLn "Can only process Packet_Message"
getTempo :: MVar Tempo -> IO Tempo
getTempo = readMVar
runClientEsp :: IO (MVar Tempo,MVar Double)
runClientEsp = do
mTempo <- newEmptyMVar
mCps <- newEmptyMVar
socket <- openUDP "127.0.0.1" 5510
forkIO $ forever $ do
sendOSC socket $ Message "/esp/tempo/q" []
response <- waitAddress socket "/esp/tempo/r"
changeTempo mTempo response
threadDelay 100000
return (mTempo, mCps)
sendEspTempo :: Real t => t -> IO ()
sendEspTempo t = do
socket <- openUDP "127.0.0.1" 5510
sendOSC socket $ Message "/esp/beat/tempo" [float (t*60)]
cpsUtilsEsp :: IO (Double -> IO (), IO Rational, IO Tempo)
cpsUtilsEsp = do
(mTempo,mCps) <- runClientEsp
return (sendEspTempo,getCurrentBeat mTempo,getTempo mTempo)
clockedTickEsp :: Int -> (Tempo -> Int -> IO ()) -> IO ()
clockedTickEsp tpb callback = do
(mTempo, _) <- runClientEsp
nowBeat <- getCurrentBeat mTempo
let nextTick = ceiling (nowBeat * (fromIntegral tpb))
iterateM_ (clockedTickLoopEsp tpb callback mTempo) nextTick
clockedTickLoopEsp :: Int -> (Tempo -> Int -> IO ()) -> MVar Tempo -> Int -> IO Int
clockedTickLoopEsp tpb callback mTempo tick = do
tempo <- readMVar mTempo
if (paused tempo)
then do
let pause = 0.01
threadDelay $ floor (pause * 1000000)
return $ if cps tempo < 0 then 0 else tick
else do
now <- getCurrentTime
let beatsFromAtToTick = fromIntegral tick / fromIntegral tpb - beat tempo
delayUntilTick = beatsFromAtToTick / cps tempo - realToFrac (diffUTCTime now (at tempo))
threadDelay $ floor (delayUntilTick * 1000000)
callback tempo tick
return $ tick + 1
streamEsp :: Backend a -> Shape -> IO (ParamPattern -> IO ())
streamEsp backend shape = do
patternM <- newMVar silence
forkIO $ clockedTickEsp ticksPerCycle (onTick backend shape patternM)
return $ \p -> do swapMVar patternM p
return ()
dirtStreamEsp :: IO (ParamPattern -> IO ())
dirtStreamEsp = do
backend <- dirtBackend
streamEsp backend dirt
stateEsp :: Backend a -> Shape -> IO (MVar (ParamPattern, [ParamPattern]))
stateEsp backend shape = do
patternsM <- newMVar (silence, [])
let ot = (onTick' backend shape patternsM) :: Tempo -> Int -> IO ()
forkIO $ clockedTickEsp ticksPerCycle ot
return patternsM
dirtSettersEsp :: IO T.Time -> IO (ParamPattern -> IO (), (T.Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())
dirtSettersEsp getNow = do
backend <- dirtBackend
ds <- stateEsp backend dirt
return (setter ds, transition getNow ds)
superDirtSettersEsp :: IO T.Time -> IO (ParamPattern -> IO (), (T.Time -> [ParamPattern] -> ParamPattern) -> ParamPattern -> IO ())
superDirtSettersEsp getNow = do
backend <- superDirtBackend 57120
ds <- stateEsp backend dirt
return (setter ds, transition getNow ds)