module Vivid.SCServer.State (
BufferId(..)
, NodeId(..)
, SyncId(..)
, scServerState
, SCServerState(..)
, setClientId
, setMaxBufferIds
, getNextAvailable
, numberOfSyncIdsToDrop
) where
import Vivid.OSC (OSC)
import Vivid.SCServer.Types
import Vivid.SynthDef.Types
import Network.Socket (Socket)
import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar
import Control.Concurrent.STM
import Control.Monad (when)
import Data.Bits
import Data.Int (Int32)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Prelude
import System.IO.Unsafe (unsafePerformIO)
scServerState :: SCServerState
scServerState = unsafePerformIO makeEmptySCServerState
data SCServerState
= SCServerState
{ _scServerState_socketConnectStarted :: TVar Bool
, _scServerState_socket :: !(TMVar Socket)
, _scServerState_listener :: !(TMVar ThreadId)
, _scServerState_availableBufferIds :: !(TVar [BufferId])
, _scServerState_maxBufIds :: !(TVar Int32)
, _scServerState_availableNodeIds :: !(TVar [NodeId])
, _scServerState_availableSyncIds :: !(TVar [SyncId])
, _scServerState_syncIdMailboxes :: !(TVar (Map SyncId (MVar ())))
, _scServerState_serverMessageFunction :: !(TVar (OSC -> IO ()))
, _scServerState_definedSDs :: !(TVar (Set (SDName, Int)))
}
setClientId :: Int32 -> IO ()
setClientId clientId = do
when (clientId < 0 || clientId > 31) $
error "client id must be betw 0 and 31"
atomically $ writeTVar (_scServerState_availableNodeIds scServerState) $
(flip map) [1000..] $ \nodeNum -> NodeId $
((clientId `shiftL` ((finiteBitSize nodeNum5)1)) .|.) $
((maxBound `shiftR` 5) .&. nodeNum)
numberOfSyncIdsToDrop :: Int
numberOfSyncIdsToDrop = 10000
makeEmptySCServerState :: IO SCServerState
makeEmptySCServerState = atomically $ do
sockConnectStarted <- newTVar False
sockIORef <- newEmptyTMVar
listenerIORef <- newEmptyTMVar
availBufIds <- newTVar $ drop 512 $ map BufferId [0..]
availNodeIds <- newTVar $ map (NodeId . ((1 `shiftL` 26) .|.)) [1000..]
maxBufIds <- newTVar 1024
syncIds <- newTVar $ drop numberOfSyncIdsToDrop $ map SyncId [0..]
syncMailboxes <- newTVar $ Map.empty
serverMessageFunction <- newTVar $ \_ -> return ()
definedSDs <- newTVar $ Set.empty
return $ SCServerState
{ _scServerState_socketConnectStarted = sockConnectStarted
, _scServerState_socket = sockIORef
, _scServerState_listener = listenerIORef
, _scServerState_availableBufferIds = availBufIds
, _scServerState_maxBufIds = maxBufIds
, _scServerState_availableNodeIds = availNodeIds
, _scServerState_availableSyncIds = syncIds
, _scServerState_syncIdMailboxes = syncMailboxes
, _scServerState_serverMessageFunction = serverMessageFunction
, _scServerState_definedSDs = definedSDs
}
setMaxBufferIds :: Int32 -> IO ()
setMaxBufferIds newMax = atomically $
writeTVar (_scServerState_maxBufIds scServerState) newMax
getNextAvailable :: (SCServerState -> TVar [a]) -> IO a
getNextAvailable getter =
getNextAvailables 1 getter >>= \case
[x] -> return x
_ -> error "i don't even - 938"
getNextAvailables :: Int -> (SCServerState -> TVar [a]) -> IO [a]
getNextAvailables numToGet getter = do
let !_ = scServerState
atomically $ do
let avail = getter scServerState
(ns, rest) <- splitAt numToGet <$> readTVar avail
writeTVar avail rest
return ns