{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}
module Vivid.Actions.IO (
defineSDFromFile
) where
import Vivid.Actions.Class
import Vivid.OSC (OSC(..), OSCDatum(..), encodeOSC, Timestamp(..), timestampFromUTC)
import Vivid.SC.Server.Commands as SCCmd
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 as BS (writeFile)
import Data.Hashable
import qualified Data.Set as Set
import Data.Time (getCurrentTime)
import System.Directory (getTemporaryDirectory)
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 <- newSyncId
callOSC $ SCCmd.sync sid
waitForSync sid
waitForSync :: SyncId -> IO ()
waitForSync = waitForSync_io
wait :: Real n => n -> IO ()
wait t = threadDelay $ round (realToFrac (t * 10^(6::Int)) :: Double)
getTime :: IO Timestamp
getTime = timestampFromUTC <$> 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
oscWSync $ \syncId ->
callOSC $
SCCmd.d_recv [sdToLiteral synthDef] (Just $ SCCmd.sync syncId)
atomically $ modifyTVar (_scServerState_definedSDs scServerState) $
((name, hash synthDef) `Set.insert`)
defineSDFromFile :: SynthDef a -> IO ()
defineSDFromFile theSD = do
tempDir <- getTemporaryDirectory
let fName = tempDir++"/" ++ show (hash theSD) ++ ".scsyndef"
BS.writeFile fName $ encodeSD theSD
oscWSync $ \syncId ->
callOSC $ SCCmd.d_load fName (Just $ SCCmd.sync syncId)