module Vivid.Actions.IO (
) where
import Vivid.Actions.Class
import Vivid.OSC (OSC(..), OSCDatum(..), encodeOSC, Timestamp(..), utcToTimestamp)
import Vivid.SCServer.State (BufferId(..), NodeId(..), SyncId(..), getNextAvailable, scServerState, SCServerState(..))
import Vivid.SCServer.Connection ( getSCServerSocket, waitForSync_io)
import Vivid.SynthDef
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (readTVarIO, atomically, modifyTVar)
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8 (pack)
import Data.Hashable
import qualified Data.Set as Set
import Data.Time (getCurrentTime)
import Network.Socket (withSocketsDo)
import Network.Socket.ByteString (send)
instance VividAction IO where
callOSC :: OSC -> IO ()
callOSC message = callBS (encodeOSC message)
callBS :: ByteString -> IO ()
callBS message = do
let !_ = scServerState
sock <- getSCServerSocket
_ <- withSocketsDo $ send sock message
return ()
sync :: IO ()
sync = do
wait (0.01 :: Float)
sid@(SyncId syncId) <- newSyncId
callOSC $ OSC "/sync" [OSC_I syncId]
waitForSync sid
waitForSync :: SyncId -> IO ()
waitForSync = waitForSync_io
wait :: (RealFrac n) => n -> IO ()
wait t = threadDelay $ round (t * 10^(6::Int))
getTime :: IO Timestamp
getTime = utcToTimestamp <$> getCurrentTime
newBufferId :: IO BufferId
newBufferId = do
maxBufIds <- readTVarIO (_scServerState_maxBufIds scServerState)
BufferId nn <- getNextAvailable _scServerState_availableBufferIds
return . BufferId $ nn `mod` maxBufIds
newNodeId :: IO NodeId
newNodeId = getNextAvailable _scServerState_availableNodeIds
newSyncId :: IO SyncId
newSyncId =
getNextAvailable _scServerState_availableSyncIds
fork :: IO () -> IO ()
fork action = do
_ <- forkIO action
return ()
defineSD :: SynthDef a -> IO ()
defineSD synthDef@(SynthDef name _ _) = do
let !_ = scServerState
hasBeenDefined <- (((name, hash synthDef) `Set.member`) <$>) $
readTVarIO (_scServerState_definedSDs scServerState)
unless hasBeenDefined $ do
syncId@(SyncId syncIdInt) <- newSyncId
callOSC $ OSC (BS8.pack "/d_recv") [
OSC_B $ encodeSD synthDef
, OSC_B . encodeOSC $ OSC "/sync" [OSC_I syncIdInt]
]
waitForSync syncId
atomically $ modifyTVar (_scServerState_definedSDs scServerState) $
((name, hash synthDef) `Set.insert`)