module Sound.SC3.Server.Transport.Monad where
import Control.Monad
import Sound.OSC
import Sound.SC3.Server.Command
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 :: (Transport m) => Message -> m ()
send = sendMessage
wait :: Transport m => String -> m Message
wait = waitReply
async :: Transport m => Message -> m Message
async m = send m >> wait "/done"
withSC3 :: Connection UDP a -> IO a
withSC3 = withTransport (openUDP "127.0.0.1" 57110)
stop :: Transport m => m ()
stop = send (g_freeAll [1])
reset :: Transport m => m ()
reset =
let m = [g_freeAll [1,2],g_new [(1,AddToTail,0),(2,AddToTail,0)]]
in sendBundle (Bundle immediately m)
playSynthdef :: Transport m => Synthdef -> m ()
playSynthdef s = do
_ <- async (d_recv s)
send (s_new (synthdefName s) (1) AddToTail 1 [])
playUGen :: Transport m => UGen -> m ()
playUGen = playSynthdef . synthdef "Anonymous"
run_bundle :: (Transport m) => Double -> Bundle -> m ()
run_bundle i (Bundle t x) =
let wr m = if isAsync m
then void (async m)
else send m
in case t of
NTPr n -> do
liftIO (pauseThreadUntil (i + n))
mapM_ wr x
_ -> error "run_bundle: non-NTPr bundle"
performNRT :: (Transport m) => NRT -> m ()
performNRT s = liftIO utcr >>= \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 :: Transport m => m a -> m a
withNotifications f = do
_ <- async (notify True)
r <- f
_ <- async (notify False)
return r
b_getn1_data :: Transport m => Int -> (Int,Int) -> m [Double]
b_getn1_data b s = do
let f d = case d of
Int _:Int _:Int _:x -> map datum_real_err x
_ -> error "b_getn1_data"
sendMessage (b_getn1 b s)
fmap f (waitDatum "/b_setn")
b_getn1_data_segment :: Transport 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 :: Transport m => Int -> Int -> m [Double]
b_fetch n b = do
let f d = case d of
[Int _,Int nf,Int nc,Float _] ->
let ix = (0,nf * nc)
in b_getn1_data_segment n b ix
_ -> error "b_fetch"
sendMessage (b_query1 b)
waitDatum "/b_info" >>= f
serverStatus :: Transport m => m [String]
serverStatus = liftM statusFormat serverStatusData
serverSampleRateNominal :: (Transport m) => m Double
serverSampleRateNominal = liftM (extractStatusField 7) serverStatusData
serverSampleRateActual :: (Transport m) => m Double
serverSampleRateActual = liftM (extractStatusField 8) serverStatusData
serverStatusData :: Transport m => m [Datum]
serverStatusData = do
sendMessage status
waitDatum "/status.reply"