module Sound.SC3.Server.Transport.Monad where
import Control.Monad
import Data.Maybe
import Sound.OSC
import Sound.SC3.Server.Command
import Sound.SC3.Server.Enum
import qualified Sound.SC3.Server.Graphdef as G
import Sound.SC3.Server.NRT
import Sound.SC3.Server.Status
import Sound.SC3.Server.Synthdef
import Sound.SC3.UGen.Bindings.Composite (wrapOut)
import Sound.SC3.UGen.Type
send :: SendOSC m => Message -> m ()
send = sendMessage
async :: DuplexOSC m => Message -> m Message
async m = send m >> waitReply "/done"
withSC3 :: Connection UDP a -> IO a
withSC3 = withTransport (openUDP "127.0.0.1" 57110)
stop :: SendOSC m => m ()
stop = send (g_freeAll [1])
reset :: SendOSC m => m ()
reset =
let m = [clearSched
,g_freeAll [1,2]
,g_new [(1,AddToHead,0),(2,AddToTail,0)]]
in sendBundle (bundle immediately m)
playGraphdef :: DuplexOSC m => (Int,AddAction,Int) -> G.Graphdef -> m ()
playGraphdef (nid,act,gid) g = do
_ <- async (d_recv' g)
send (s_new0 (ascii_to_string (G.graphdef_name g)) nid act gid)
playSynthdef :: DuplexOSC m => (Int,AddAction,Int) -> Synthdef -> m ()
playSynthdef opt = playGraphdef opt . synthdef_to_graphdef
playUGen :: DuplexOSC m => (Int,AddAction,Int) -> UGen -> m ()
playUGen loc =
playSynthdef loc .
synthdef "Anonymous" .
wrapOut Nothing
run_bundle :: Transport m => Time -> Bundle -> m ()
run_bundle st b = do
let t = bundleTime b
latency = 0.1
wr m = if isAsync m
then async m >> return ()
else sendBundle (bundle (st + t) [m])
liftIO (pauseThreadUntil (st + t latency))
mapM_ wr (bundleMessages b)
performNRT :: Transport m => NRT -> m ()
performNRT s = do
let (i,r) = nrt_span (<= 0) s
i' = concatMap bundleMessages i
(a,b) = partition_async i'
mapM_ async a
t <- liftIO time
mapM_ (run_bundle t) (Bundle 0 b : r)
class Audible e where
play_at :: Transport m => (Int,AddAction,Int) -> e -> m ()
play :: Transport m => e -> m ()
play = play_at (1,AddToHead,1)
instance Audible G.Graphdef where
play_at k = playGraphdef k
instance Audible Synthdef where
play_at = playSynthdef
instance Audible UGen where
play_at = playUGen
instance Audible NRT where
play_at _ = performNRT
audition_at :: Audible e => (Int,AddAction,Int) -> e -> IO ()
audition_at k = withSC3 . play_at k
audition :: Audible e => e -> IO ()
audition = audition_at (1,AddToHead,1)
withNotifications :: DuplexOSC m => m a -> m a
withNotifications f = do
_ <- async (notify True)
r <- f
_ <- async (notify False)
return r
b_getn1_data :: DuplexOSC m => Int -> (Int,Int) -> m [Double]
b_getn1_data b s = do
let f d = case d of
Int32 _:Int32 _:Int32 _:x -> mapMaybe datum_floating x
_ -> error "b_getn1_data"
sendMessage (b_getn1 b s)
liftM f (waitDatum "/b_setn")
b_getn1_data_segment :: DuplexOSC m =>
Int -> Int -> (Int,Int) -> m [Double]
b_getn1_data_segment n b (i,j) = do
let ix = b_indices n j i
d <- mapM (b_getn1_data b) ix
return (concat d)
b_fetch :: DuplexOSC m => Int -> Int -> m [Double]
b_fetch n b = do
let f d = case d of
[Int32 _,Int32 nf,Int32 nc,Float _] ->
let ix = (0,fromIntegral (nf * nc))
in b_getn1_data_segment n b ix
_ -> error "b_fetch"
sendMessage (b_query1 b)
waitDatum "/b_info" >>= f
c_getn1_data :: DuplexOSC m => (Int,Int) -> m [Double]
c_getn1_data s = do
let f d = case d of
Int32 _:Int32 _:x -> mapMaybe datum_floating x
_ -> error "c_getn1_data"
sendMessage (c_getn1 s)
liftM f (waitDatum "/c_setn")
serverStatus :: DuplexOSC m => m [String]
serverStatus = liftM statusFormat serverStatusData
serverSampleRateNominal :: DuplexOSC m => m Double
serverSampleRateNominal = liftM (extractStatusField 7) serverStatusData
serverSampleRateActual :: DuplexOSC m => m Double
serverSampleRateActual = liftM (extractStatusField 8) serverStatusData
serverStatusData :: DuplexOSC m => m [Datum]
serverStatusData = do
sendMessage status
waitDatum "/status.reply"