{-# LANGUAGE
FlexibleInstances
, InstanceSigs
, KindSignatures
, TypeSynonymInstances
#-}
{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}
module Vivid.Actions.Scheduled (
Scheduled
, doScheduledInWith
, doScheduledAtWith
, doScheduledNowWith
) where
import Vivid.Actions.Class
import Vivid.Actions.IO ()
import Vivid.OSC
import Vivid.SCServer
import Vivid.SynthDef (SynthDef)
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, mapReaderT)
import Control.Monad.State (evalStateT, put, get, modify, StateT)
import Data.ByteString (ByteString)
import Prelude
type Scheduled = ReaderT SCServerState (StateT Timestamp IO)
instance VividAction Scheduled where
callOSC :: OSC -> Scheduled ()
callOSC :: OSC -> Scheduled ()
callOSC OSC
message = do
Timestamp
now <- Scheduled Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime
(IO () -> StateT Timestamp IO ())
-> ReaderT SCServerState IO () -> Scheduled ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO () -> StateT Timestamp IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO () -> Scheduled ())
-> (OSCBundle -> ReaderT SCServerState IO ())
-> OSCBundle
-> Scheduled ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => ByteString -> m ()
callBS (ByteString -> ReaderT SCServerState IO ())
-> (OSCBundle -> ByteString)
-> OSCBundle
-> ReaderT SCServerState IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OSCBundle -> ByteString
encodeOSCBundle (OSCBundle -> Scheduled ()) -> OSCBundle -> Scheduled ()
forall a b. (a -> b) -> a -> b
$ Timestamp -> [Either ByteString OSC] -> OSCBundle
OSCBundle Timestamp
now [OSC -> Either ByteString OSC
forall a b. b -> Either a b
Right OSC
message]
callBS :: ByteString -> Scheduled ()
callBS :: ByteString -> Scheduled ()
callBS ByteString
message = do
Timestamp
now <- Scheduled Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime
(IO () -> StateT Timestamp IO ())
-> ReaderT SCServerState IO () -> Scheduled ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO () -> StateT Timestamp IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO () -> Scheduled ())
-> (OSCBundle -> ReaderT SCServerState IO ())
-> OSCBundle
-> Scheduled ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => ByteString -> m ()
callBS (ByteString -> ReaderT SCServerState IO ())
-> (OSCBundle -> ByteString)
-> OSCBundle
-> ReaderT SCServerState IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OSCBundle -> ByteString
encodeOSCBundle (OSCBundle -> Scheduled ()) -> OSCBundle -> Scheduled ()
forall a b. (a -> b) -> a -> b
$ Timestamp -> [Either ByteString OSC] -> OSCBundle
OSCBundle Timestamp
now [ByteString -> Either ByteString OSC
forall a b. a -> Either a b
Left ByteString
message]
sync :: Scheduled ()
sync :: Scheduled ()
sync = () -> Scheduled ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
waitForSync :: SyncId -> Scheduled ()
waitForSync :: SyncId -> Scheduled ()
waitForSync SyncId
_ = () -> Scheduled ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
wait :: Real n => n -> Scheduled ()
wait :: n -> Scheduled ()
wait n
t = (Timestamp -> Timestamp) -> Scheduled ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Timestamp -> Double -> Timestamp
`addSecs` n -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
t)
getTime :: Scheduled Timestamp
getTime :: Scheduled Timestamp
getTime = Scheduled Timestamp
forall s (m :: * -> *). MonadState s m => m s
get
newBufferId :: Scheduled BufferId
newBufferId :: Scheduled BufferId
newBufferId = (IO BufferId -> StateT Timestamp IO BufferId)
-> ReaderT SCServerState IO BufferId -> Scheduled BufferId
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO BufferId -> StateT Timestamp IO BufferId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO BufferId
forall (m :: * -> *). VividAction m => m BufferId
newBufferId :: ReaderT SCServerState IO BufferId)
newNodeId :: Scheduled NodeId
newNodeId :: Scheduled NodeId
newNodeId = (IO NodeId -> StateT Timestamp IO NodeId)
-> ReaderT SCServerState IO NodeId -> Scheduled NodeId
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO NodeId -> StateT Timestamp IO NodeId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO NodeId
forall (m :: * -> *). VividAction m => m NodeId
newNodeId :: ReaderT SCServerState IO NodeId)
newSyncId :: Scheduled SyncId
newSyncId :: Scheduled SyncId
newSyncId = (IO SyncId -> StateT Timestamp IO SyncId)
-> ReaderT SCServerState IO SyncId -> Scheduled SyncId
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT IO SyncId -> StateT Timestamp IO SyncId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ReaderT SCServerState IO SyncId
forall (m :: * -> *). VividAction m => m SyncId
newSyncId :: ReaderT SCServerState IO SyncId)
fork :: Scheduled () -> Scheduled ()
fork :: Scheduled () -> Scheduled ()
fork Scheduled ()
action = do
Timestamp
timeOfFork <- Scheduled Timestamp
forall s (m :: * -> *). MonadState s m => m s
get
Scheduled ()
action
Timestamp -> Scheduled ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Timestamp
timeOfFork
defineSD :: SynthDef a -> Scheduled ()
defineSD :: SynthDef a -> Scheduled ()
defineSD = (IO () -> StateT Timestamp IO ())
-> ReaderT SCServerState IO () -> Scheduled ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (IO () -> StateT Timestamp IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT Timestamp IO ())
-> (IO () -> IO ()) -> IO () -> StateT Timestamp IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO) (ReaderT SCServerState IO () -> Scheduled ())
-> (SynthDef a -> ReaderT SCServerState IO ())
-> SynthDef a
-> Scheduled ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynthDef a -> ReaderT SCServerState IO ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD
doScheduledAtWith :: SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith :: SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith SCServerState
serverState Timestamp
startTime Scheduled a
action =
let stateAction :: StateT Timestamp IO a
stateAction = Scheduled a -> SCServerState -> StateT Timestamp IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Scheduled a
action SCServerState
serverState
in StateT Timestamp IO a -> Timestamp -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT Timestamp IO a
stateAction Timestamp
startTime
doScheduledInWith :: SCServerState -> Double -> Scheduled x -> IO x
doScheduledInWith :: SCServerState -> Double -> Scheduled x -> IO x
doScheduledInWith SCServerState
serverState Double
numSecs Scheduled x
action = do
Timestamp
now <- ReaderT SCServerState IO Timestamp -> SCServerState -> IO Timestamp
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT SCServerState IO Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime :: ReaderT SCServerState IO Timestamp) SCServerState
serverState
SCServerState -> Timestamp -> Scheduled x -> IO x
forall a. SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith SCServerState
serverState (Timestamp -> Double -> Timestamp
addSecs Timestamp
now Double
numSecs) Scheduled x
action
doScheduledNowWith :: SCServerState -> Scheduled x -> IO x
doScheduledNowWith :: SCServerState -> Scheduled x -> IO x
doScheduledNowWith SCServerState
serverState Scheduled x
action = do
Timestamp
now <- ReaderT SCServerState IO Timestamp -> SCServerState -> IO Timestamp
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT SCServerState IO Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime :: ReaderT SCServerState IO Timestamp) SCServerState
serverState
SCServerState -> Timestamp -> Scheduled x -> IO x
forall a. SCServerState -> Timestamp -> Scheduled a -> IO a
doScheduledAtWith SCServerState
serverState Timestamp
now Scheduled x
action