-- | This is unscheduled - the server will do what you tell it to
--   as soon as it can. That can mean there'll be slight delays
--   because of time it took to compute what to do or because of
--   network latency. If you want more precise timing look at
--   "Scheduled"
-- 
--   Doing \"VividAction\"s in IO can be like a sketchpad:
--   it's the quickest way to get an idea out.
--   The cool thing is you can take an action that you're sketching
--   and put a function in front of it to get more precise timing
--   E.g. if you have the function:
--
--   @
--   playTone = do
--      synth <- play $ 0.1 ~* sinOsc (freq_ 440)
--      wait 1
--      free synth
--   @
-- 
--   You can play it quickly with just:
-- 
--   > playTone
-- 
--   But if you want precise timing all you need to do is say e.g.:
-- 
--   > playScheduledIn 0.01 playTone

{-# LANGUAGE
     BangPatterns
   , InstanceSigs
   , FlexibleInstances
   , OverloadedStrings
   , TypeSynonymInstances
   , ViewPatterns
   #-}
   -- , Safe

{-# 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 ({-getMailboxForSyncId,-} 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) -- Just to make sure you don't "sync" before calling
                           --   the command you want to sync (temporary)
      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
      -- TODO: this 'mod' may not help anything:
      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)
      -- unless hasBeenDefined $ (`runReaderT` serverState) $ do
      -- unless hasBeenDefined $ (serverState runReaderT ) $ do
      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`)

-- This could be written as ReaderT SCServerState:
-- | Synchronous
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)