module Sound.SC3.Server.Transport.FD where
import Data.Maybe
import Control.Monad
import Sound.OSC.FD
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.Type
send :: (Transport t) => t -> Message -> IO ()
send = sendMessage
async :: Transport t => t -> Message -> IO Message
async fd m = sendMessage fd m >> waitReply fd "/done"
withSC3 :: (UDP -> IO a) -> IO a
withSC3 = withTransport (openUDP "127.0.0.1" 57110)
stop :: Transport t => t -> IO ()
stop fd = sendMessage fd (g_freeAll [1])
reset :: Transport t => t -> IO ()
reset fd = do
sendMessage fd (g_freeAll [1,2])
sendMessage fd (g_new [(1,AddToTail,0),(2,AddToTail,0)])
playGraphdef :: Transport t => Int -> t -> G.Graphdef -> IO ()
playGraphdef k fd g = do
_ <- async fd (d_recv' g)
sendMessage fd (s_new0 (ascii_to_string (G.graphdef_name g)) k AddToTail 1)
playSynthdef :: Transport t => Int -> t -> Synthdef -> IO ()
playSynthdef k fd = playGraphdef k fd . synthdef_to_graphdef
playUGen :: Transport t => Int -> t -> UGen -> IO ()
playUGen k fd = playSynthdef k fd . synthdef "Anonymous"
run_bundle :: Transport t => t -> Time -> Bundle -> IO ()
run_bundle fd st b = do
let t = bundleTime b
latency = 0.1
wr m = if isAsync m
then async fd m >> return ()
else sendBundle fd (bundle (st + t) [m])
pauseThreadUntil (st + t latency)
mapM_ wr (bundleMessages b)
performNRT :: Transport t => t -> NRT -> IO ()
performNRT fd s = time >>= \i -> mapM_ (run_bundle fd i) (nrt_bundles s)
class Audible e where
play_id :: Transport t => Int -> t -> e -> IO ()
play :: Transport t => t -> e -> IO ()
play = play_id (1)
instance Audible G.Graphdef where
play_id k fd = playGraphdef k fd
instance Audible Synthdef where
play_id = playSynthdef
instance Audible UGen where
play_id = playUGen
instance Audible NRT where
play_id _ = performNRT
audition_id :: Audible e => Int -> e -> IO ()
audition_id k e = withSC3 (\fd -> play_id k fd e)
audition :: Audible e => e -> IO ()
audition = audition_id (1)
withNotifications :: Transport t => t -> (t -> IO a) -> IO a
withNotifications fd f = do
_ <- async fd (notify True)
r <- f fd
_ <- async fd (notify False)
return r
b_getn1_data :: Transport t => t -> Int -> (Int,Int) -> IO [Double]
b_getn1_data fd b s = do
let f d = case d of
Int32 _:Int32 _:Int32 _:x -> mapMaybe datum_floating x
_ -> error "b_getn1_data"
sendMessage fd (b_getn1 b s)
fmap f (waitDatum fd "/b_setn")
b_getn1_data_segment :: Transport t => t -> Int -> Int -> (Int,Int) -> IO [Double]
b_getn1_data_segment fd n b (i,j) = do
let ix = b_indices n j i
d <- mapM (b_getn1_data fd b) ix
return (concat d)
b_fetch :: Transport t => t -> Int -> Int -> IO [Double]
b_fetch fd 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 fd n b ix
_ -> error "b_fetch"
sendMessage fd (b_query1 b)
waitDatum fd "/b_info" >>= f
serverStatus :: Transport t => t -> IO [String]
serverStatus = liftM statusFormat . serverStatusData
serverSampleRateNominal :: Transport t => t -> IO Double
serverSampleRateNominal = liftM (extractStatusField 7) . serverStatusData
serverSampleRateActual :: Transport t => t -> IO Double
serverSampleRateActual = liftM (extractStatusField 8) . serverStatusData
serverStatusData :: Transport t => t -> IO [Datum]
serverStatusData fd = do
sendMessage fd status
waitDatum fd "/status.reply"