{-# LANGUAGE
BangPatterns
, InstanceSigs
, FlexibleInstances
, OverloadedStrings
, TypeSynonymInstances
, ViewPatterns
#-}
{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}
module Vivid.Actions.IO (
defineSDFromFileWith
) where
import Vivid.Actions.Class
import Vivid.OSC (OSC(..), encodeOSC, Timestamp(..), timestampFromUTC)
import Vivid.SC.Server.Commands as SCCmd
import Vivid.SCServer.State (BufferId(..), NodeId(..), SyncId(..), getNextAvailable', SCServerState(..))
import Vivid.SCServer.Connection ( getSCServerSocket', waitForSync_io', sendMaybePad)
import Vivid.SynthDef
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (readTVarIO, atomically, modifyTVar)
import Control.Monad
import Control.Monad.Trans.Reader (ReaderT(..), runReaderT)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (writeFile)
import Data.Hashable
import qualified Data.Set as Set
import Data.Time (getCurrentTime)
import System.Directory (getTemporaryDirectory)
instance VividAction (ReaderT SCServerState IO) where
callOSC :: OSC -> ReaderT SCServerState IO ()
callOSC :: OSC -> ReaderT SCServerState IO ()
callOSC OSC
message = ByteString -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => ByteString -> m ()
callBS (OSC -> ByteString
encodeOSC OSC
message)
callBS :: ByteString -> ReaderT SCServerState IO ()
callBS :: ByteString -> ReaderT SCServerState IO ()
callBS ByteString
bs = (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO ()) -> ReaderT SCServerState IO ())
-> (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ \SCServerState
serverState -> do
Socket
sock <- SCServerState -> IO Socket
getSCServerSocket' SCServerState
serverState
ConnProtocol
connProtocol <- TVar ConnProtocol -> IO ConnProtocol
forall a. TVar a -> IO a
readTVarIO (SCServerState -> TVar ConnProtocol
_scServerState_connProtocol SCServerState
serverState)
()
_ <- ConnProtocol -> Socket -> ByteString -> IO ()
sendMaybePad ConnProtocol
connProtocol Socket
sock ByteString
bs
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sync :: ReaderT SCServerState IO ()
sync :: ReaderT SCServerState IO ()
sync = do
Float -> ReaderT SCServerState IO ()
forall (m :: * -> *) n. (VividAction m, Real n) => n -> m ()
wait (Float
0.01 :: Float)
SyncId
sid <- ReaderT SCServerState IO SyncId
forall (m :: * -> *). VividAction m => m SyncId
newSyncId
OSC -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> ReaderT SCServerState IO ())
-> OSC -> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
sid
SyncId -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => SyncId -> m ()
waitForSync SyncId
sid
waitForSync :: SyncId -> ReaderT SCServerState IO ()
waitForSync :: SyncId -> ReaderT SCServerState IO ()
waitForSync SyncId
syncId =
(SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO ()) -> ReaderT SCServerState IO ())
-> (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ \SCServerState
serverState ->
SCServerState -> SyncId -> IO ()
waitForSync_io' SCServerState
serverState SyncId
syncId
wait :: Real n => n -> ReaderT SCServerState IO ()
wait :: n -> ReaderT SCServerState IO ()
wait n
t = (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO ()) -> ReaderT SCServerState IO ())
-> (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ \SCServerState
_ ->
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (n -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (n
t n -> n -> n
forall a. Num a => a -> a -> a
* n
10n -> Int -> n
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6::Int)) :: Double)
getTime :: ReaderT SCServerState IO Timestamp
getTime :: ReaderT SCServerState IO Timestamp
getTime = (SCServerState -> IO Timestamp)
-> ReaderT SCServerState IO Timestamp
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO Timestamp)
-> ReaderT SCServerState IO Timestamp)
-> (SCServerState -> IO Timestamp)
-> ReaderT SCServerState IO Timestamp
forall a b. (a -> b) -> a -> b
$ \SCServerState
_ -> UTCTime -> Timestamp
timestampFromUTC (UTCTime -> Timestamp) -> IO UTCTime -> IO Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
newBufferId :: ReaderT SCServerState IO BufferId
newBufferId :: ReaderT SCServerState IO BufferId
newBufferId = (SCServerState -> IO BufferId) -> ReaderT SCServerState IO BufferId
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO BufferId)
-> ReaderT SCServerState IO BufferId)
-> (SCServerState -> IO BufferId)
-> ReaderT SCServerState IO BufferId
forall a b. (a -> b) -> a -> b
$ \SCServerState
serverState -> do
Int32
maxBufIds <- TVar Int32 -> IO Int32
forall a. TVar a -> IO a
readTVarIO (SCServerState -> TVar Int32
_scServerState_maxBufIds SCServerState
serverState)
BufferId Int32
nn <- SCServerState -> (SCServerState -> TVar [BufferId]) -> IO BufferId
forall a. SCServerState -> (SCServerState -> TVar [a]) -> IO a
getNextAvailable' SCServerState
serverState SCServerState -> TVar [BufferId]
_scServerState_availableBufferIds
BufferId -> IO BufferId
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferId -> IO BufferId)
-> (Int32 -> BufferId) -> Int32 -> IO BufferId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> BufferId
BufferId (Int32 -> IO BufferId) -> Int32 -> IO BufferId
forall a b. (a -> b) -> a -> b
$ Int32
nn Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`mod` Int32
maxBufIds
newNodeId :: ReaderT SCServerState IO NodeId
newNodeId :: ReaderT SCServerState IO NodeId
newNodeId = (SCServerState -> IO NodeId) -> ReaderT SCServerState IO NodeId
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO NodeId) -> ReaderT SCServerState IO NodeId)
-> (SCServerState -> IO NodeId) -> ReaderT SCServerState IO NodeId
forall a b. (a -> b) -> a -> b
$ \SCServerState
serverState ->
SCServerState -> (SCServerState -> TVar [NodeId]) -> IO NodeId
forall a. SCServerState -> (SCServerState -> TVar [a]) -> IO a
getNextAvailable' SCServerState
serverState SCServerState -> TVar [NodeId]
_scServerState_availableNodeIds
newSyncId :: ReaderT SCServerState IO SyncId
newSyncId :: ReaderT SCServerState IO SyncId
newSyncId = (SCServerState -> IO SyncId) -> ReaderT SCServerState IO SyncId
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO SyncId) -> ReaderT SCServerState IO SyncId)
-> (SCServerState -> IO SyncId) -> ReaderT SCServerState IO SyncId
forall a b. (a -> b) -> a -> b
$ \SCServerState
serverState ->
SCServerState -> (SCServerState -> TVar [SyncId]) -> IO SyncId
forall a. SCServerState -> (SCServerState -> TVar [a]) -> IO a
getNextAvailable' SCServerState
serverState SCServerState -> TVar [SyncId]
_scServerState_availableSyncIds
fork :: ReaderT SCServerState IO () -> ReaderT SCServerState IO ()
fork :: ReaderT SCServerState IO () -> ReaderT SCServerState IO ()
fork ReaderT SCServerState IO ()
action = (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO ()) -> ReaderT SCServerState IO ())
-> (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ \SCServerState
serverState -> do
ThreadId
_ <- IO () -> IO ThreadId
forkIO (ReaderT SCServerState IO () -> SCServerState -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT SCServerState IO ()
action SCServerState
serverState)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
defineSD :: SynthDef a -> ReaderT SCServerState IO ()
defineSD :: SynthDef a -> ReaderT SCServerState IO ()
defineSD synthDef :: SynthDef a
synthDef@(SynthDef SDName
name [(ByteString, Float)]
_ Map Int UGen
_) = (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((SCServerState -> IO ()) -> ReaderT SCServerState IO ())
-> (SCServerState -> IO ()) -> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ \SCServerState
serverState -> do
Bool
hasBeenDefined <- (((SDName
name, SynthDef a -> Int
forall a. Hashable a => a -> Int
hash SynthDef a
synthDef) (SDName, Int) -> Set (SDName, Int) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member`) (Set (SDName, Int) -> Bool) -> IO (Set (SDName, Int)) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (Set (SDName, Int)) -> IO Bool)
-> IO (Set (SDName, Int)) -> IO Bool
forall a b. (a -> b) -> a -> b
$
TVar (Set (SDName, Int)) -> IO (Set (SDName, Int))
forall a. TVar a -> IO a
readTVarIO (SCServerState -> TVar (Set (SDName, Int))
_scServerState_definedSDs SCServerState
serverState)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasBeenDefined (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(ReaderT SCServerState IO () -> SCServerState -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` SCServerState
serverState) (ReaderT SCServerState IO () -> IO ())
-> ReaderT SCServerState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (SyncId -> ReaderT SCServerState IO ())
-> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => (SyncId -> m ()) -> m ()
oscWSync ((SyncId -> ReaderT SCServerState IO ())
-> ReaderT SCServerState IO ())
-> (SyncId -> ReaderT SCServerState IO ())
-> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ \SyncId
syncId ->
OSC -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> ReaderT SCServerState IO ())
-> OSC -> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$
[LiteralSynthDef] -> Maybe OSC -> OSC
SCCmd.d_recv [SynthDef a -> LiteralSynthDef
forall (a :: [Symbol]). SynthDef a -> LiteralSynthDef
sdToLiteral SynthDef a
synthDef] (OSC -> Maybe OSC
forall a. a -> Maybe a
Just (OSC -> Maybe OSC) -> OSC -> Maybe OSC
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
syncId)
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Set (SDName, Int))
-> (Set (SDName, Int) -> Set (SDName, Int)) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (SCServerState -> TVar (Set (SDName, Int))
_scServerState_definedSDs SCServerState
serverState) ((Set (SDName, Int) -> Set (SDName, Int)) -> STM ())
-> (Set (SDName, Int) -> Set (SDName, Int)) -> STM ()
forall a b. (a -> b) -> a -> b
$
((SDName
name, SynthDef a -> Int
forall a. Hashable a => a -> Int
hash SynthDef a
synthDef) (SDName, Int) -> Set (SDName, Int) -> Set (SDName, Int)
forall a. Ord a => a -> Set a -> Set a
`Set.insert`)
defineSDFromFileWith :: SCServerState -> SynthDef a -> IO ()
defineSDFromFileWith :: SCServerState -> SynthDef a -> IO ()
defineSDFromFileWith SCServerState
serverState SynthDef a
theSD = do
FilePath
tempDir <- IO FilePath
getTemporaryDirectory
let fName :: FilePath
fName = FilePath
tempDirFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (SynthDef a -> Int
forall a. Hashable a => a -> Int
hash SynthDef a
theSD) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".scsyndef"
FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fName (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ SynthDef a -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
encodeSD SynthDef a
theSD
(ReaderT SCServerState IO () -> SCServerState -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` SCServerState
serverState) (ReaderT SCServerState IO () -> IO ())
-> ReaderT SCServerState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (SyncId -> ReaderT SCServerState IO ())
-> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => (SyncId -> m ()) -> m ()
oscWSync ((SyncId -> ReaderT SCServerState IO ())
-> ReaderT SCServerState IO ())
-> (SyncId -> ReaderT SCServerState IO ())
-> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ \SyncId
syncId ->
OSC -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> ReaderT SCServerState IO ())
-> OSC -> ReaderT SCServerState IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe OSC -> OSC
SCCmd.d_load FilePath
fName (OSC -> Maybe OSC
forall a. a -> Maybe a
Just (OSC -> Maybe OSC) -> OSC -> Maybe OSC
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
syncId)