module Sound.SC3.Server.Transport.Monad where
import Control.Monad
import Data.Maybe
import Sound.OSC
import Sound.SC3.Server.Command.Core
import Sound.SC3.Server.Command.Int
import Sound.SC3.Server.Enum
import Sound.SC3.Server.NRT
import Sound.SC3.Server.Status
import Sound.SC3.Server.Synthdef
import Sound.SC3.Server.Synthdef.Type
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 = [g_freeAll [1,2],g_new [(1,AddToTail,0),(2,AddToTail,0)]]
in sendBundle (bundle immediately m)
playSynthdef :: DuplexOSC m => Synthdef -> m ()
playSynthdef s = do
_ <- async (d_recv s)
send (s_new0 (synthdefName s) (1) AddToTail 1)
playUGen :: DuplexOSC m => UGen -> m ()
playUGen = playSynthdef . synthdef "Anonymous"
run_bundle :: Transport m => Time -> Bundle -> m ()
run_bundle i (Bundle t x) = do
let wr m = if isAsync m
then async m >> return ()
else send m
liftIO (pauseThreadUntil (i + t))
mapM_ wr x
performNRT :: Transport m => NRT -> m ()
performNRT s = liftIO time >>= \i -> mapM_ (run_bundle i) (nrt_bundles s)
class Audible e where
play :: Transport m => e -> m ()
instance Audible Graph where
play g = playSynthdef (Synthdef "Anonymous" g)
instance Audible Synthdef where
play = playSynthdef
instance Audible UGen where
play = playUGen
instance Audible NRT where
play = performNRT
audition :: Audible e => e -> IO ()
audition e = withSC3 (play e)
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
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"