-- | /FD/ variant of interaction with the scsynth server.
--
-- This duplicates functions at 'Sound.SC3.Server.Transport.Monad' and
-- at some point at least part of the duplication will be removed.
module Sound.SC3.Server.Transport.FD where

import Control.Monad {- base -}
import qualified Data.ByteString.Lazy as L {- bytestring -}
import Data.List {- base -}
import qualified Data.List.Split as Split {- split -}
import System.FilePath {- filepath -}

import Sound.OSC.FD {- hosc -}

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.Options
import Sound.SC3.Server.Status
import Sound.SC3.Server.Synthdef
import Sound.SC3.UGen.Type

-- * hosc variants

-- | Send a 'Message' and 'waitReply' for a @\/done@ reply.
async :: Transport t => t -> Message -> IO Message
async :: 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 (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"

-- | If 'isAsync' then 'void' 'async' else 'sendMessage'.
maybe_async :: (Transport t) => t -> Message -> IO ()
maybe_async :: 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

-- | Variant that timestamps synchronous messages.
maybe_async_at :: (Transport t) => t -> Time -> Message -> IO ()
maybe_async_at :: 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 -> Bundle -> IO ()
forall t. Transport t => t -> Bundle -> IO ()
sendBundle t
fd (Time -> [Message] -> Bundle
bundle Time
t [Message
m])

-- | Bracket @SC3@ communication.
withSC3 :: (UDP -> IO a) -> IO a
withSC3 :: (UDP -> IO a) -> IO a
withSC3 = IO UDP -> (UDP -> IO a) -> IO a
forall t a. Transport t => IO t -> (t -> IO a) -> IO a
withTransport (Address_Pattern -> Int -> IO UDP
openUDP Address_Pattern
"127.0.0.1" Int
forall i. Num i => i
sc3_port_def)

-- * Server control

-- | Free all nodes ('g_freeAll') at group @1@.
stop :: Transport t => t -> IO ()
stop :: t -> IO ()
stop t
fd = t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd ([Int] -> Message
g_freeAll [Int
1])

-- | Free all nodes ('g_freeAll') at and re-create groups @1@ and @2@.
reset :: Transport t => t -> IO ()
reset :: t -> IO ()
reset t
fd = do
  t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd ([Int] -> Message
g_freeAll [Int
1,Int
2])
  t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd ([(Int, AddAction, Int)] -> Message
g_new [(Int
1,AddAction
AddToTail,Int
0),(Int
2,AddAction
AddToTail,Int
0)])

-- | Send 'd_recv' and 's_new' messages to scsynth.
playGraphdef :: Transport t => Int -> t -> G.Graphdef -> IO ()
playGraphdef :: Int -> t -> Graphdef -> IO ()
playGraphdef Int
k t
fd Graphdef
g = do
  let nm :: Address_Pattern
nm = ASCII -> Address_Pattern
ascii_to_string (Graphdef -> ASCII
G.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
G.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 ()
G.graphdefWrite Address_Pattern
fn Graphdef
g IO () -> IO Message -> IO Message
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 (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 -> Int -> AddAction -> Int -> Message
s_new0 Address_Pattern
nm Int
k AddAction
AddToTail Int
1)

-- | 'playGraphdef' of 'synthdef_to_graphdef'.
playSynthdef :: Transport t => Int -> t -> Synthdef -> IO ()
playSynthdef :: Int -> t -> Synthdef -> IO ()
playSynthdef Int
k t
fd = Int -> t -> Graphdef -> IO ()
forall t. Transport t => Int -> t -> Graphdef -> IO ()
playGraphdef Int
k t
fd (Graphdef -> IO ()) -> (Synthdef -> Graphdef) -> Synthdef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthdef -> Graphdef
synthdef_to_graphdef

-- | Send an /anonymous/ instrument definition using 'playSynthdef'.
playUGen :: Transport t => Int -> t -> UGen -> IO ()
playUGen :: Int -> t -> UGen -> IO ()
playUGen Int
k t
fd = Int -> t -> Synthdef -> IO ()
forall t. Transport t => Int -> t -> Synthdef -> IO ()
playSynthdef Int
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"

-- * Non-real time

-- | Wait ('pauseThreadUntil') until bundle is due to be sent relative
-- to initial 'Time', then send each message, asynchronously if
-- required.
run_bundle :: Transport t => t -> Time -> Bundle -> IO ()
run_bundle :: t -> Time -> Bundle -> IO ()
run_bundle t
fd Time
t0 Bundle
b = do
  let t :: Time
t = Time
t0 Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Bundle -> Time
bundleTime Bundle
b
      latency :: Time
latency = Time
0.1
  Time -> IO ()
forall (m :: * -> *). MonadIO m => Time -> 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) (Bundle -> [Message]
bundleMessages Bundle
b)

-- | Perform an 'NRT' score (as would be rendered by 'writeNRT').  In
-- particular note that all timestamps /must/ be in 'NTPr' form.
nrt_play :: Transport t => t -> NRT -> IO ()
nrt_play :: t -> NRT -> IO ()
nrt_play t
fd NRT
sc = IO Time
forall (m :: * -> *). MonadIO m => m Time
time IO Time -> (Time -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Time
t0 -> (Bundle -> IO ()) -> [Bundle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (t -> Time -> Bundle -> IO ()
forall t. Transport t => t -> Time -> Bundle -> IO ()
run_bundle t
fd Time
t0) (NRT -> [Bundle]
nrt_bundles NRT
sc)

-- | 'withSC3' of 'nrt_play'
nrt_audition :: NRT -> IO ()
nrt_audition :: NRT -> IO ()
nrt_audition NRT
sc = (UDP -> IO ()) -> IO ()
forall a. (UDP -> IO a) -> IO a
withSC3 (UDP -> NRT -> IO ()
forall t. Transport t => t -> NRT -> IO ()
`nrt_play` NRT
sc)

-- * Audible

-- | Class for values that can be encoded and sent to @scsynth@ for audition.
class Audible e where
    play_id :: Transport t => Int -> t -> e -> IO ()
    play :: Transport t => t -> e -> IO ()
    play = Int -> t -> e -> IO ()
forall e t. (Audible e, Transport t) => Int -> t -> e -> IO ()
play_id (-Int
1)

instance Audible G.Graphdef where
    play_id :: Int -> t -> Graphdef -> IO ()
play_id = Int -> t -> Graphdef -> IO ()
forall t. Transport t => Int -> t -> Graphdef -> IO ()
playGraphdef

instance Audible Synthdef where
    play_id :: Int -> t -> Synthdef -> IO ()
play_id = Int -> t -> Synthdef -> IO ()
forall t. Transport t => Int -> t -> Synthdef -> IO ()
playSynthdef

instance Audible UGen where
    play_id :: Int -> t -> UGen -> IO ()
play_id = Int -> t -> UGen -> IO ()
forall t. Transport t => Int -> t -> UGen -> IO ()
playUGen

-- | 'withSC3' of 'play_id'
audition_id :: Audible e => Int -> e -> IO ()
audition_id :: Int -> e -> IO ()
audition_id Int
k e
e = (UDP -> IO ()) -> IO ()
forall a. (UDP -> IO a) -> IO a
withSC3 (\UDP
fd -> Int -> UDP -> e -> IO ()
forall e t. (Audible e, Transport t) => Int -> t -> e -> IO ()
play_id Int
k UDP
fd e
e)

-- | 'audition_id' of @-1@.
audition :: Audible e => e -> IO ()
audition :: e -> IO ()
audition = Int -> e -> IO ()
forall e. Audible e => Int -> e -> IO ()
audition_id (-Int
1)

-- * Notifications

-- | Turn on notifications, run /f/, turn off notifications, return
-- result.
withNotifications :: Transport t => t -> (t -> IO a) -> IO a
withNotifications :: 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 (m :: * -> *) a. Monad m => a -> m a
return a
r

-- * Buffer

-- | Variant of 'b_getn1' that waits for return message and unpacks it.
--
-- > withSC3 (\fd -> b_getn1_data fd 0 (0,5))
b_getn1_data :: Transport t => t -> Int -> (Int,Int) -> IO [Double]
b_getn1_data :: t -> Int -> (Int, Int) -> IO [Time]
b_getn1_data t
fd Int
b (Int, Int)
s = do
  let f :: Message -> [Time]
f Message
m = let (Int
_,Int
_,Int
_,[Time]
r) = Message -> (Int, Int, Int, [Time])
unpack_b_setn_err Message
m in [Time]
r
  t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd (Int -> (Int, Int) -> Message
b_getn1 Int
b (Int, Int)
s)
  (Message -> [Time]) -> IO Message -> IO [Time]
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")

-- | Variant of 'b_getn1_data' that segments individual 'b_getn'
-- messages to /n/ elements.
--
-- > withSC3 (\fd -> b_getn1_data_segment fd 1 0 (0,5))
b_getn1_data_segment :: Transport t => t -> Int -> Int -> (Int,Int) -> IO [Double]
b_getn1_data_segment :: t -> Int -> Int -> (Int, Int) -> IO [Time]
b_getn1_data_segment t
fd Int
n Int
b (Int
i,Int
j) = do
  let ix :: [(Int, Int)]
ix = Int -> Int -> Int -> [(Int, Int)]
b_indices Int
n Int
j Int
i
  [[Time]]
d <- ((Int, Int) -> IO [Time]) -> [(Int, Int)] -> IO [[Time]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (t -> Int -> (Int, Int) -> IO [Time]
forall t. Transport t => t -> Int -> (Int, Int) -> IO [Time]
b_getn1_data t
fd Int
b) [(Int, Int)]
ix
  [Time] -> IO [Time]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Time]] -> [Time]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Time]]
d)

-- | Variant of 'b_getn1_data_segment' that gets the entire buffer.
b_fetch :: Transport t => t -> Int -> Int -> IO [[Double]]
b_fetch :: t -> Int -> Int -> IO [[Time]]
b_fetch t
fd Int
n Int
b = do
  let f :: Message -> IO [[Time]]
f Message
m = let (Int
_,Int
nf,Int
nc,Time
_) = Message -> (Int, Int, Int, Time)
unpack_b_info_err Message
m
                ix :: (Int, Int)
ix = (Int
0,Int
nf Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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
. Int -> [a] -> [[a]]
forall e. Int -> [e] -> [[e]]
Split.chunksOf Int
nc
            in ([Time] -> [[Time]]) -> IO [Time] -> IO [[Time]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Time] -> [[Time]]
forall a. [a] -> [[a]]
deinterleave (t -> Int -> Int -> (Int, Int) -> IO [Time]
forall t. Transport t => t -> Int -> Int -> (Int, Int) -> IO [Time]
b_getn1_data_segment t
fd Int
n Int
b (Int, Int)
ix)
  t -> Message -> IO ()
forall t. Transport t => t -> Message -> IO ()
sendMessage t
fd (Int -> Message
b_query1 Int
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message -> IO [[Time]]
f

-- | 'head' of 'b_fetch'.
b_fetch1 :: Transport t => t -> Int -> Int -> IO [Double]
b_fetch1 :: t -> Int -> Int -> IO [Time]
b_fetch1 t
fd Int
n Int
b = ([[Time]] -> [Time]) -> IO [[Time]] -> IO [Time]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Time]] -> [Time]
forall a. [a] -> a
head (t -> Int -> Int -> IO [[Time]]
forall t. Transport t => t -> Int -> Int -> IO [[Time]]
b_fetch t
fd Int
n Int
b)

-- * Status

-- | Collect server status information.
serverStatus :: Transport t => t -> IO [String]
serverStatus :: t -> IO [Address_Pattern]
serverStatus = ([Datum] -> [Address_Pattern])
-> IO [Datum] -> IO [Address_Pattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Datum] -> [Address_Pattern]
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

-- | Read nominal sample rate of server.
serverSampleRateNominal :: Transport t => t -> IO Double
serverSampleRateNominal :: t -> IO Time
serverSampleRateNominal = ([Datum] -> Time) -> IO [Datum] -> IO Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Datum] -> Time
forall n. Floating n => Int -> [Datum] -> n
extractStatusField Int
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

-- | Read actual sample rate of server.
serverSampleRateActual :: Transport t => t -> IO Double
serverSampleRateActual :: t -> IO Time
serverSampleRateActual = ([Datum] -> Time) -> IO [Datum] -> IO Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Datum] -> Time
forall n. Floating n => Int -> [Datum] -> n
extractStatusField Int
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

-- | Retrieve status data from server.
serverStatusData :: Transport t => t -> IO [Datum]
serverStatusData :: 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"