module Sound.Sc3.Server.Transport.Fd where
import Control.Monad
import Data.List
import Data.Maybe
import System.Environment
import System.FilePath
import qualified Data.ByteString.Lazy as L
import qualified Data.List.Split as Split
import qualified Safe
import Sound.Osc.Fd
import Sound.Sc3.Server.Command
import Sound.Sc3.Server.Enum
import qualified Sound.Sc3.Server.Graphdef as Graphdef
import qualified Sound.Sc3.Server.Graphdef.Binary as Graphdef
import qualified Sound.Sc3.Server.Nrt as Nrt
import qualified Sound.Sc3.Server.Status as Status
import Sound.Sc3.Server.Synthdef
import Sound.Sc3.Ugen.Ugen
async :: Transport t => t -> Message -> IO Message
async :: forall t. Transport t => t -> Message -> IO Message
async t
fd Message
m = t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd Message
m IO () -> IO Message -> IO Message
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> Address_Pattern -> IO Message
forall t. Transport t => t -> Address_Pattern -> IO Message
waitReply t
fd Address_Pattern
"/done"
maybe_async :: (Transport t) => t -> Message -> IO ()
maybe_async :: forall t. Transport t => t -> Message -> IO ()
maybe_async t
fd Message
m = if Message -> Bool
isAsync Message
m then IO Message -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (t -> Message -> IO Message
forall t. Transport t => t -> Message -> IO Message
async t
fd Message
m) else t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd Message
m
maybe_async_at :: (Transport t) => t -> Time -> Message -> IO ()
maybe_async_at :: forall t. Transport t => t -> Time -> Message -> IO ()
maybe_async_at t
fd Time
t Message
m =
if Message -> Bool
isAsync Message
m
then IO Message -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (t -> Message -> IO Message
forall t. Transport t => t -> Message -> IO Message
async t
fd Message
m)
else t -> BundleOf Message -> IO ()
forall t. Transport t => t -> BundleOf Message -> IO ()
sendBundle t
fd (Time -> [Message] -> BundleOf Message
forall t. Time -> [t] -> BundleOf t
bundle Time
t [Message
m])
defaultSc3OscSocketAddress :: IO OscSocketAddress
defaultSc3OscSocketAddress :: IO OscSocketAddress
defaultSc3OscSocketAddress = do
let f :: Address_Pattern -> Address_Pattern -> IO Address_Pattern
f Address_Pattern
key Address_Pattern
defaultValue = (Maybe Address_Pattern -> Address_Pattern)
-> IO (Maybe Address_Pattern) -> IO Address_Pattern
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Address_Pattern -> Maybe Address_Pattern -> Address_Pattern
forall a. a -> Maybe a -> a
fromMaybe Address_Pattern
defaultValue) (Address_Pattern -> IO (Maybe Address_Pattern)
lookupEnv Address_Pattern
key)
Address_Pattern
protocol <- Address_Pattern -> Address_Pattern -> IO Address_Pattern
f Address_Pattern
"ScTransport" Address_Pattern
"Tcp"
Address_Pattern
hostname <- Address_Pattern -> Address_Pattern -> IO Address_Pattern
f Address_Pattern
"ScHostname" Address_Pattern
"127.0.0.1"
Address_Pattern
port <- Address_Pattern -> Address_Pattern -> IO Address_Pattern
f Address_Pattern
"ScPort" Address_Pattern
"57110"
OscSocketAddress -> IO OscSocketAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address_Pattern -> OscProtocol
forall a. Read a => Address_Pattern -> a
read Address_Pattern
protocol, Address_Pattern
hostname, Address_Pattern -> OscPort
forall a. Read a => Address_Pattern -> a
read Address_Pattern
port)
withSc3 :: (OscSocket -> IO a) -> IO a
withSc3 :: forall a. (OscSocket -> IO a) -> IO a
withSc3 OscSocket -> IO a
process = do
OscSocketAddress
address <- IO OscSocketAddress
defaultSc3OscSocketAddress
IO OscSocket -> (OscSocket -> IO a) -> IO a
forall t a. Transport t => IO t -> (t -> IO a) -> IO a
withTransport (OscSocketAddress -> IO OscSocket
openOscSocket OscSocketAddress
address) OscSocket -> IO a
process
stop :: Transport t => t -> IO ()
stop :: forall t. Transport t => t -> IO ()
stop t
fd = t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd ([OscPort] -> Message
g_freeAll [OscPort
1])
reset :: Transport t => t -> IO ()
reset :: forall t. Transport t => t -> IO ()
reset t
fd = do
t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd ([OscPort] -> Message
g_freeAll [OscPort
1, OscPort
2])
t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd ([(OscPort, AddAction, OscPort)] -> Message
g_new [(OscPort
1, AddAction
AddToTail, OscPort
0), (OscPort
2, AddAction
AddToTail, OscPort
0)])
playGraphdef :: Transport t => Int -> t -> Graphdef.Graphdef -> IO ()
playGraphdef :: forall t. Transport t => OscPort -> t -> Graphdef -> IO ()
playGraphdef OscPort
k t
fd Graphdef
g = do
let nm :: Address_Pattern
nm = Ascii -> Address_Pattern
ascii_to_string (Graphdef -> Ascii
Graphdef.graphdef_name Graphdef
g)
fn :: Address_Pattern
fn = Address_Pattern
"/tmp" Address_Pattern -> Address_Pattern -> Address_Pattern
</> Address_Pattern
nm Address_Pattern -> Address_Pattern -> Address_Pattern
<.> Address_Pattern
"scsyndef"
by :: ByteString
by = Graphdef -> ByteString
Graphdef.encode_graphdef Graphdef
g
sz :: Int64
sz = ByteString -> Int64
L.length ByteString
by
if Int64
sz Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
65507
then IO Message -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (t -> Message -> IO Message
forall t. Transport t => t -> Message -> IO Message
async t
fd (ByteString -> Message
d_recv_bytes ByteString
by))
else Address_Pattern -> Graphdef -> IO ()
Graphdef.graphdefWrite Address_Pattern
fn Graphdef
g IO () -> IO Message -> IO Message
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> Message -> IO Message
forall t. Transport t => t -> Message -> IO Message
async t
fd (Address_Pattern -> Message
d_load Address_Pattern
fn) IO Message -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd (Address_Pattern -> OscPort -> AddAction -> OscPort -> Message
s_new0 Address_Pattern
nm OscPort
k AddAction
AddToTail OscPort
1)
playSynthdef :: Transport t => Int -> t -> Synthdef -> IO ()
playSynthdef :: forall t. Transport t => OscPort -> t -> Synthdef -> IO ()
playSynthdef OscPort
k t
fd = OscPort -> t -> Graphdef -> IO ()
forall t. Transport t => OscPort -> t -> Graphdef -> IO ()
playGraphdef OscPort
k t
fd (Graphdef -> IO ()) -> (Synthdef -> Graphdef) -> Synthdef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthdef -> Graphdef
synthdef_to_graphdef
playUgen :: Transport t => Int -> t -> Ugen -> IO ()
playUgen :: forall t. Transport t => OscPort -> t -> Ugen -> IO ()
playUgen OscPort
k t
fd = OscPort -> t -> Synthdef -> IO ()
forall t. Transport t => OscPort -> t -> Synthdef -> IO ()
playSynthdef OscPort
k t
fd (Synthdef -> IO ()) -> (Ugen -> Synthdef) -> Ugen -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address_Pattern -> Ugen -> Synthdef
synthdef Address_Pattern
"Anonymous"
run_bundle :: Transport t => t -> Time -> BundleOf Message -> IO ()
run_bundle :: forall t. Transport t => t -> Time -> BundleOf Message -> IO ()
run_bundle t
fd Time
t0 BundleOf Message
b = do
let t :: Time
t = Time
t0 Time -> Time -> Time
forall a. Num a => a -> a -> a
+ BundleOf Message -> Time
forall t. BundleOf t -> Time
bundleTime BundleOf Message
b
latency :: Time
latency = Time
0.1
Time -> IO ()
forall (m :: * -> *) n. (MonadIO m, RealFrac n) => n -> m ()
pauseThreadUntil (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
latency)
(Message -> IO ()) -> [Message] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (t -> Time -> Message -> IO ()
forall t. Transport t => t -> Time -> Message -> IO ()
maybe_async_at t
fd Time
t) (BundleOf Message -> [Message]
forall t. BundleOf t -> [t]
bundleMessages BundleOf Message
b)
nrt_play :: Transport t => t -> Nrt.Nrt -> IO ()
nrt_play :: forall t. Transport t => t -> Nrt -> IO ()
nrt_play t
fd Nrt
sc = IO Time
forall (m :: * -> *). MonadIO m => m Time
time IO Time -> (Time -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Time
t0 -> (BundleOf Message -> IO ()) -> [BundleOf Message] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (t -> Time -> BundleOf Message -> IO ()
forall t. Transport t => t -> Time -> BundleOf Message -> IO ()
run_bundle t
fd Time
t0) (Nrt -> [BundleOf Message]
Nrt.nrt_bundles Nrt
sc)
nrt_audition :: Nrt.Nrt -> IO ()
nrt_audition :: Nrt -> IO ()
nrt_audition Nrt
sc = (OscSocket -> IO ()) -> IO ()
forall a. (OscSocket -> IO a) -> IO a
withSc3 (OscSocket -> Nrt -> IO ()
forall t. Transport t => t -> Nrt -> IO ()
`nrt_play` Nrt
sc)
class Audible e where
play_id :: Transport t => Int -> t -> e -> IO ()
play :: Transport t => t -> e -> IO ()
play = OscPort -> t -> e -> IO ()
forall t. Transport t => OscPort -> t -> e -> IO ()
forall e t. (Audible e, Transport t) => OscPort -> t -> e -> IO ()
play_id (-OscPort
1)
instance Audible Graphdef.Graphdef where
play_id :: forall t. Transport t => OscPort -> t -> Graphdef -> IO ()
play_id = OscPort -> t -> Graphdef -> IO ()
forall t. Transport t => OscPort -> t -> Graphdef -> IO ()
playGraphdef
instance Audible Synthdef where
play_id :: forall t. Transport t => OscPort -> t -> Synthdef -> IO ()
play_id = OscPort -> t -> Synthdef -> IO ()
forall t. Transport t => OscPort -> t -> Synthdef -> IO ()
playSynthdef
instance Audible Ugen where
play_id :: forall t. Transport t => OscPort -> t -> Ugen -> IO ()
play_id = OscPort -> t -> Ugen -> IO ()
forall t. Transport t => OscPort -> t -> Ugen -> IO ()
playUgen
audition_id :: Audible e => Int -> e -> IO ()
audition_id :: forall e. Audible e => OscPort -> e -> IO ()
audition_id OscPort
k e
e = (OscSocket -> IO ()) -> IO ()
forall a. (OscSocket -> IO a) -> IO a
withSc3 (\OscSocket
fd -> OscPort -> OscSocket -> e -> IO ()
forall t. Transport t => OscPort -> t -> e -> IO ()
forall e t. (Audible e, Transport t) => OscPort -> t -> e -> IO ()
play_id OscPort
k OscSocket
fd e
e)
audition :: Audible e => e -> IO ()
audition :: forall e. Audible e => e -> IO ()
audition = OscPort -> e -> IO ()
forall e. Audible e => OscPort -> e -> IO ()
audition_id (-OscPort
1)
withNotifications :: Transport t => t -> (t -> IO a) -> IO a
withNotifications :: forall t a. Transport t => t -> (t -> IO a) -> IO a
withNotifications t
fd t -> IO a
f = do
Message
_ <- t -> Message -> IO Message
forall t. Transport t => t -> Message -> IO Message
async t
fd (Bool -> Message
notify Bool
True)
a
r <- t -> IO a
f t
fd
Message
_ <- t -> Message -> IO Message
forall t. Transport t => t -> Message -> IO Message
async t
fd (Bool -> Message
notify Bool
False)
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
b_getn1_data :: Transport t => t -> Int -> (Int, Int) -> IO [Double]
b_getn1_data :: forall t.
Transport t =>
t -> OscPort -> (OscPort, OscPort) -> IO [Time]
b_getn1_data t
fd OscPort
b (OscPort, OscPort)
s = do
let f :: Message -> [Time]
f Message
m = let (OscPort
_, OscPort
_, OscPort
_, [Time]
r) = Message -> (OscPort, OscPort, OscPort, [Time])
unpack_b_setn_err Message
m in [Time]
r
t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd (OscPort -> (OscPort, OscPort) -> Message
b_getn1 OscPort
b (OscPort, OscPort)
s)
(Message -> [Time]) -> IO Message -> IO [Time]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> [Time]
f (t -> Address_Pattern -> IO Message
forall t. Transport t => t -> Address_Pattern -> IO Message
waitReply t
fd Address_Pattern
"/b_setn")
b_getn1_data_segment :: Transport t => t -> Int -> Int -> (Int, Int) -> IO [Double]
b_getn1_data_segment :: forall t.
Transport t =>
t -> OscPort -> OscPort -> (OscPort, OscPort) -> IO [Time]
b_getn1_data_segment t
fd OscPort
n OscPort
b (OscPort
i, OscPort
j) = do
let ix :: [(OscPort, OscPort)]
ix = OscPort -> OscPort -> OscPort -> [(OscPort, OscPort)]
b_indices OscPort
n OscPort
j OscPort
i
[[Time]]
d <- ((OscPort, OscPort) -> IO [Time])
-> [(OscPort, OscPort)] -> IO [[Time]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (t -> OscPort -> (OscPort, OscPort) -> IO [Time]
forall t.
Transport t =>
t -> OscPort -> (OscPort, OscPort) -> IO [Time]
b_getn1_data t
fd OscPort
b) [(OscPort, OscPort)]
ix
[Time] -> IO [Time]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Time]] -> [Time]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Time]]
d)
b_fetch :: Transport t => t -> Int -> Int -> IO [[Double]]
b_fetch :: forall t. Transport t => t -> OscPort -> OscPort -> IO [[Time]]
b_fetch t
fd OscPort
n OscPort
b = do
let f :: Message -> IO [[Time]]
f Message
m =
let (OscPort
_, OscPort
nf, OscPort
nc, Time
_) = Message -> (OscPort, OscPort, OscPort, Time)
unpack_b_info_err Message
m
ix :: (OscPort, OscPort)
ix = (OscPort
0, OscPort
nf OscPort -> OscPort -> OscPort
forall a. Num a => a -> a -> a
* OscPort
nc)
deinterleave :: [a] -> [[a]]
deinterleave = [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OscPort -> [a] -> [[a]]
forall e. OscPort -> [e] -> [[e]]
Split.chunksOf OscPort
nc
in ([Time] -> [[Time]]) -> IO [Time] -> IO [[Time]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Time] -> [[Time]]
forall {a}. [a] -> [[a]]
deinterleave (t -> OscPort -> OscPort -> (OscPort, OscPort) -> IO [Time]
forall t.
Transport t =>
t -> OscPort -> OscPort -> (OscPort, OscPort) -> IO [Time]
b_getn1_data_segment t
fd OscPort
n OscPort
b (OscPort, OscPort)
ix)
t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd (OscPort -> Message
b_query1 OscPort
b)
t -> Address_Pattern -> IO Message
forall t. Transport t => t -> Address_Pattern -> IO Message
waitReply t
fd Address_Pattern
"/b_info" IO Message -> (Message -> IO [[Time]]) -> IO [[Time]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message -> IO [[Time]]
f
b_fetch1 :: Transport t => t -> Int -> Int -> IO [Double]
b_fetch1 :: forall t. Transport t => t -> OscPort -> OscPort -> IO [Time]
b_fetch1 t
fd OscPort
n OscPort
b = ([[Time]] -> [Time]) -> IO [[Time]] -> IO [Time]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Address_Pattern -> [[Time]] -> [Time]
forall a. Partial => Address_Pattern -> [a] -> a
Safe.headNote Address_Pattern
"b_fetch1") (t -> OscPort -> OscPort -> IO [[Time]]
forall t. Transport t => t -> OscPort -> OscPort -> IO [[Time]]
b_fetch t
fd OscPort
n OscPort
b)
serverStatus :: Transport t => t -> IO [String]
serverStatus :: forall t. Transport t => t -> IO [Address_Pattern]
serverStatus = ([Datum] -> [Address_Pattern])
-> IO [Datum] -> IO [Address_Pattern]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Datum] -> [Address_Pattern]
Status.statusFormat (IO [Datum] -> IO [Address_Pattern])
-> (t -> IO [Datum]) -> t -> IO [Address_Pattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO [Datum]
forall t. Transport t => t -> IO [Datum]
serverStatusData
serverSampleRateNominal :: Transport t => t -> IO Double
serverSampleRateNominal :: forall t. Transport t => t -> IO Time
serverSampleRateNominal = ([Datum] -> Time) -> IO [Datum] -> IO Time
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OscPort -> [Datum] -> Time
forall n. Floating n => OscPort -> [Datum] -> n
Status.extractStatusField OscPort
7) (IO [Datum] -> IO Time) -> (t -> IO [Datum]) -> t -> IO Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO [Datum]
forall t. Transport t => t -> IO [Datum]
serverStatusData
serverSampleRateActual :: Transport t => t -> IO Double
serverSampleRateActual :: forall t. Transport t => t -> IO Time
serverSampleRateActual = ([Datum] -> Time) -> IO [Datum] -> IO Time
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OscPort -> [Datum] -> Time
forall n. Floating n => OscPort -> [Datum] -> n
Status.extractStatusField OscPort
8) (IO [Datum] -> IO Time) -> (t -> IO [Datum]) -> t -> IO Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO [Datum]
forall t. Transport t => t -> IO [Datum]
serverStatusData
serverStatusData :: Transport t => t -> IO [Datum]
serverStatusData :: forall t. Transport t => t -> IO [Datum]
serverStatusData t
fd = do
t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd Message
status
t -> Address_Pattern -> IO [Datum]
forall t. Transport t => t -> Address_Pattern -> IO [Datum]
waitDatum t
fd Address_Pattern
"/status.reply"