{- | Module to provide a stateful connection to scsynth.

The purpose is to store Osc Messages that should be sent when resetting the synthesiser.

This should, but does not:

- allow for Scsynth to be at a non-standard address
- allow for multiple Scsynth instances

-}
module Sound.Sc3.Server.Scsynth where

import Data.IORef {- base -}

import qualified Sound.Osc.Packet as Osc {- hosc -}

import Sound.Sc3.Ugen.Ugen {- hsc3 -}
import Sound.Sc3.Ugen.Util {- hsc3 -}

import Sound.Sc3.Server.Transport.Monad {- hsc3 -}

-- | Scsynth state.
data Scsynth = Scsynth {Scsynth -> IORef [Message]
scsynthResetMessages :: IORef [Osc.Message]}

-- | Scsynth with no messages or allocated buffers.
newScsynth :: IO Scsynth
newScsynth :: IO Scsynth
newScsynth = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef [Message] -> Scsynth
Scsynth (forall a. a -> IO (IORef a)
newIORef [])

-- | Print onReset messages.
scsynthPrint :: Scsynth -> IO ()
scsynthPrint :: Scsynth -> IO ()
scsynthPrint (Scsynth IORef [Message]
mRef) = do
  [Message]
m <- forall a. IORef a -> IO a
readIORef IORef [Message]
mRef
  forall a. Show a => a -> IO ()
print [Message]
m

{- | Add a sequence of messages to be sent on scsynth reset.

> scsynth <- newScsynth
> scsynthOnReset scsynth [b_free 100]
> scsynthPrint scsynth
-}
scsynthOnReset :: Scsynth -> [Osc.Message] -> IO ()
scsynthOnReset :: Scsynth -> [Message] -> IO ()
scsynthOnReset (Scsynth IORef [Message]
mRef) [Message]
messages =
  if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
messages)
  then forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [Message]
mRef (forall a. [a] -> [a] -> [a]
++ [Message]
messages)
  else forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | reset scsynth, send all stored onReset messages, clear the onReset message store.
scsynthReset :: Scsynth -> IO ()
scsynthReset :: Scsynth -> IO ()
scsynthReset (Scsynth IORef [Message]
mRef) = do
  [Message]
onResetMessages <- forall a. IORef a -> IO a
readIORef IORef [Message]
mRef
  forall a. IORef a -> a -> IO ()
writeIORef IORef [Message]
mRef []
  forall a. Connection Udp a -> IO a
withSc3 (forall (m :: * -> *). SendOsc m => m ()
reset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). DuplexOsc m => Message -> m ()
maybe_async [Message]
onResetMessages)

{- | Play Ugen at Scsynth.
Send any required initialisation messages and stores and onReset messages.
-}
scsynthPlayAt :: Scsynth -> Play_Opt -> Ugen -> IO ()
scsynthPlayAt :: Scsynth -> Play_Opt -> Ugen -> IO ()
scsynthPlayAt Scsynth
scsynth Play_Opt
opt Ugen
ugen = do
  let ([Message]
pre, [Message]
post) = Ugen -> ([Message], [Message])
ugenCollectBrackets Ugen
ugen
  if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
post) then Scsynth -> [Message] -> IO ()
scsynthOnReset Scsynth
scsynth [Message]
post else forall (m :: * -> *) a. Monad m => a -> m a
return ()
  forall a. Connection Udp a -> IO a
withSc3 (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). DuplexOsc m => Message -> m ()
maybe_async [Message]
pre forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e (m :: * -> *).
(Audible e, Transport m) =>
Play_Opt -> e -> m ()
playAt Play_Opt
opt Ugen
ugen)

-- | scsynthPlayAt with default options.
scsynthPlay :: Scsynth -> Ugen -> IO ()
scsynthPlay :: Scsynth -> Ugen -> IO ()
scsynthPlay Scsynth
scsynth = Scsynth -> Play_Opt -> Ugen -> IO ()
scsynthPlayAt Scsynth
scsynth Play_Opt
def_play_opt