{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}
module Vivid.SCServer.State (
BufferId(..)
, NodeId(..)
, SyncId(..)
, scServerState
, SCServerState(..)
, setClientId
, setMaxBufferIds
, getNextAvailable
, numberOfSyncIdsToDrop
) where
import Vivid.OSC (OSC)
import Vivid.SC.Server.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)
{-# NOINLINE scServerState #-}
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 nodeNum-5)-1)) .|.) $
((maxBound `shiftR` 5) .&. nodeNum)
numberOfSyncIdsToDrop :: Int
numberOfSyncIdsToDrop = 10000
makeEmptySCServerState :: IO SCServerState
makeEmptySCServerState = do
sockConnectStarted <- newTVarIO False
sockIORef <- newEmptyTMVarIO
listenerIORef <- newEmptyTMVarIO
availBufIds <- newTVarIO $ drop 512 $ map BufferId [0..]
availNodeIds <- newTVarIO $ map (NodeId . ((1 `shiftL` 26) .|.)) [1000..]
maxBufIds <- newTVarIO 1024
syncIds <- newTVarIO $ drop numberOfSyncIdsToDrop $ map SyncId [0..]
syncMailboxes <- newTVarIO $ Map.empty
serverMessageFunction <- newTVarIO $ \_ -> return ()
definedSDs <- newTVarIO $ 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