module Sound.SC3.Server.Transport.Monad where
import Control.Monad
import Data.List
import Data.List.Split
import Data.Maybe
import Safe
import Sound.OSC
import Sound.SC3.Server.Command
import qualified Sound.SC3.Server.Command.Generic as Generic
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
async :: DuplexOSC m => Message -> m Message
async m = sendMessage m >> waitReply "/done"
async_ :: DuplexOSC m => Message -> m ()
async_ = void . async
maybe_async :: DuplexOSC m => Message -> m ()
maybe_async m = if isAsync m then async_ m else sendMessage m
maybe_async_at :: DuplexOSC m => Time -> Message -> m ()
maybe_async_at t m =
if isAsync m
then async_ m
else sendBundle (bundle t [m])
sc3_default_udp :: IO UDP
sc3_default_udp = openUDP "127.0.0.1" 57110
withSC3 :: Connection UDP a -> IO a
withSC3 = withTransport sc3_default_udp
withSC3_ :: Connection UDP a -> IO ()
withSC3_ = void . withSC3
stop :: SendOSC m => m ()
stop = sendMessage (g_freeAll [1])
reset :: SendOSC m => m ()
reset =
let m = [clearSched
,n_free [1,2]
,g_new [(1,AddToHead,0),(2,AddToTail,0)]]
in sendBundle (bundle immediately m)
type Play_Opt = (Node_Id,AddAction,Group_Id,[(String,Double)])
play_graphdef_msg :: Play_Opt -> G.Graphdef -> Message
play_graphdef_msg (nid,act,gid,param) g =
let nm = ascii_to_string (G.graphdef_name g)
in s_new nm nid act gid param
playGraphdef :: DuplexOSC m => Play_Opt -> G.Graphdef -> m ()
playGraphdef opt g = async_ (d_recv' g) >> sendMessage (play_graphdef_msg opt g)
play_synthdef_msg :: Play_Opt -> Synthdef -> Message
play_synthdef_msg (nid,act,gid,param) syn = s_new (synthdefName syn) nid act gid param
playSynthdef :: DuplexOSC m => Play_Opt -> Synthdef -> m ()
playSynthdef opt syn = async_ (d_recv syn) >> sendMessage (play_synthdef_msg opt syn)
playUGen :: DuplexOSC m => Play_Opt -> UGen -> m ()
playUGen loc =
playSynthdef loc .
synthdef "Anonymous" .
wrapOut Nothing
run_bundle :: Transport m => Time -> Bundle -> m ()
run_bundle t0 b = do
let t = t0 + bundleTime b
latency = 0.1
liftIO (pauseThreadUntil (t latency))
mapM_ (maybe_async_at t) (bundleMessages b)
nrt_play :: Transport m => NRT -> m ()
nrt_play sc = do
t0 <- liftIO time
mapM_ (run_bundle t0) (nrt_bundles sc)
nrt_play_reorder :: Transport m => NRT -> m ()
nrt_play_reorder 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)
nrt_audition :: NRT -> IO ()
nrt_audition = withSC3 . nrt_play
class Audible e where
play_at :: Transport m => Play_Opt -> e -> m ()
play :: Transport m => e -> m ()
play = play_at (1,AddToHead,1,[])
instance Audible G.Graphdef where
play_at = playGraphdef
instance Audible Synthdef where
play_at = playSynthdef
instance Audible UGen where
play_at = playUGen
audition_at :: Audible e => Play_Opt -> 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 m = let (_,_,_,r) = unpack_b_setn_err m in r
sendMessage (b_getn1 b s)
liftM f (waitReply "/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 m = let (_,nf,nc,_) = unpack_b_info_err m
ix = (0,nf * nc)
deinterleave = transpose . chunksOf nc
in liftM deinterleave (b_getn1_data_segment n b ix)
sendMessage (b_query1 b)
waitReply "/b_info" >>= f
b_fetch1 :: DuplexOSC m => Int -> Int -> m [Double]
b_fetch1 n b = liftM (headNote "b_fetch1: no data") (b_fetch n b)
b_fetch_hdr :: Transport m => Int -> Int -> m ((Int,Int,Int,Double),[[Double]])
b_fetch_hdr k b = do
q <- b_query1_unpack b
d <- b_fetch k b
return (q,d)
b_query1_unpack_generic :: (DuplexOSC m,Num n,Fractional r) => Int -> m (n,n,n,r)
b_query1_unpack_generic n = do
sendMessage (b_query1 n)
q <- waitReply "/b_info"
return (Generic.unpack_b_info_err q)
b_query1_unpack :: DuplexOSC m => Buffer_Id -> m (Int,Int,Int,Double)
b_query1_unpack = b_query1_unpack_generic
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")
n_query1_unpack_f :: Transport m => (Message -> t) -> Node_Id -> m t
n_query1_unpack_f f n = do
sendMessage (n_query [n])
r <- waitReply "/n_info"
return (f r)
n_query1_unpack :: Transport m => Node_Id -> m (Maybe (Int,Int,Int,Int,Int,Maybe (Int,Int)))
n_query1_unpack = n_query1_unpack_f unpack_n_info
n_query1_unpack_plain :: Transport m => Node_Id -> m [Int]
n_query1_unpack_plain = n_query1_unpack_f unpack_n_info_plain
g_queryTree1_unpack :: Transport m => Group_Id -> m Query_Node
g_queryTree1_unpack n = do
sendMessage (g_queryTree [(n,True)])
r <- waitReply "/g_queryTree.reply"
return (queryTree (messageDatum r))
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"