-- | Actions. 'Vivid.Actions.Class.VividAction' has 3 instances:
-- 
--   - "Vivid.Actions.IO" : happens right here, right now
--   - "Vivid.Actions.Scheduled" : happens at some point in the (maybe near) future.
--        The timing is precise, unlike IO
--   - "Vivid.Actions.NRT" : non-realtime. Writes to an audio file

{-# LANGUAGE
     DataKinds
   , OverloadedStrings
   , ViewPatterns
   #-}
   -- , Safe

{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}

-- For 'MonoOrPoly':
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}

module Vivid.Actions (
     synth
   , synthG
   , synthNamed
   , synthNamedG
   , newSynthBefore
   , synthBefore
   , newSynthAfter
   , synthAfter
   , newSynthAtHead
   , synthHead
   , synthOn
   , newSynthAtTail
   , synthTail

   , newGroup
   , newGroupBefore
   , newGroupAfter
   , newGroupAtHead
   , newGroupAtTail
   , newParGroup
   , newParGroupBefore
   , newParGroupAfter
   , newParGroupAtHead
   , newParGroupAtTail

   , set
   , play
   , free
   , freeSynth
   , release
   , releaseIn
   , freeBuf
   , quitSCServerWith
   , module Vivid.Actions.Class
   -- , module Vivid.Actions.IO
   , module Vivid.Actions.NRT
   , module Vivid.Actions.Scheduled

   , makeSynth

   , MonoOrPoly -- TODO: export?
   ) where

import Vivid.OSC
import qualified Vivid.SC.Server.Commands as SCCmd
import Vivid.SC.Server.Types
import Vivid.SC.SynthDef.Types (CalculationRate(..))

import Vivid.Actions.Class
import Vivid.Actions.IO ()
import Vivid.Actions.NRT
import Vivid.Actions.Scheduled
import Vivid.SCServer (defaultGroup, SCServerState)
import Vivid.SCServer.Connection (closeSCServerConnection')
import Vivid.SCServer.Types
import Vivid.SynthDef (getSDHashName, sd {- , SDBody -}) -- SynthDef(..), SDBody, Signal)
-- import Vivid.SynthDef.Types (SDName(..))
import Vivid.SynthDef.TypesafeArgs

import Control.Monad.Reader (runReaderT)
import qualified Data.ByteString.UTF8 as UTF8
import Data.ByteString (ByteString)
import Data.Monoid

-- for "play":
import qualified Data.Map as Map
-- import Data.Map (Map)

-- for "play":
import Vivid.SynthDef (makeSynthDef)
-- import Vivid.SynthDef.FromUA (NoDefaults(..))
import Vivid.SynthDef.Types
import Vivid.UGens.InOut (out)

-- todo: this segfaults if you have a kr output i think:
-- e.g.:
   -- let foo = kOut_mono 100 =<< (phasor (end_ 999) ? KR)
   -- play $ foo
   -- it has the same output as sclang:
   -- putStrLn $ sdLitPretty $ sdToLiteral $ sd () $ foo >> out 0 []
   -- same as:
   -- synthdefcatcher: SynthDef(\a, {Out.kr(100, Phasor.kr(end: 999))}).send(~hsServ)
-- | Given a UGen graph, just start playing it right away.
-- 
--   e.g.
-- 
--   > play $ do
--   >    s <- 0.2 ~* lpf (in_ whiteNoise, freq_ 440)
--   >    out 0 [s, s]
-- 
--   The "out" is optional, too -- so you can write
-- 
--   > play $ 0.2 ~* lpf (in_ whiteNoise, freq_ 440)
-- 
--   and an "out" will be added, in stereo
play :: (VividAction m, MonoOrPoly s) => SDBody' '[] s -> m (Synth '[])
play :: SDBody' '[] s -> m (Synth '[])
play SDBody' '[] s
monoOrPolyVersion = do
   let polyVersion :: SDBody' '[] [Signal]
polyVersion = SDBody' '[] s -> SDBody' '[] [Signal]
forall s (a :: [Symbol]).
MonoOrPoly s =>
SDBody' a s -> SDBody' a [Signal]
getPoly SDBody' '[] s
monoOrPolyVersion
   let sdUGens :: [(UGenName, CalculationRate)]
       sdUGens :: [(UGenName, CalculationRate)]
sdUGens =
          (UGen -> (UGenName, CalculationRate))
-> [UGen] -> [(UGenName, CalculationRate)]
forall a b. (a -> b) -> [a] -> [b]
map (\UGen
x -> (UGen -> UGenName
_ugenName UGen
x, UGen -> CalculationRate
_ugenCalculationRate UGen
x)) ([UGen] -> [(UGenName, CalculationRate)])
-> [UGen] -> [(UGenName, CalculationRate)]
forall a b. (a -> b) -> a -> b
$
             Map Int UGen -> [UGen]
forall k a. Map k a -> [a]
Map.elems (Map Int UGen -> [UGen]) -> Map Int UGen -> [UGen]
forall a b. (a -> b) -> a -> b
$ SynthDef '[] -> Map Int UGen
forall (args :: [Symbol]). SynthDef args -> Map Int UGen
_sdUGens (SynthDef '[] -> Map Int UGen) -> SynthDef '[] -> Map Int UGen
forall a b. (a -> b) -> a -> b
$ SDName
-> () -> SDBody' (InnerVars ()) [Signal] -> SynthDef (InnerVars ())
forall argList.
VarList argList =>
SDName
-> argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
makeSynthDef SDName
SDName_Hash () SDBody' '[] [Signal]
SDBody' (InnerVars ()) [Signal]
polyVersion
       -- Note this doesn't check that it's the last one that's
       --   the "Out":
   let sdWithOut :: SynthDef (InnerVars ())
sdWithOut = () -> SDBody' (InnerVars ()) [Signal] -> SynthDef (InnerVars ())
forall argList.
VarList argList =>
argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
sd () (SDBody' (InnerVars ()) [Signal] -> SynthDef (InnerVars ()))
-> SDBody' (InnerVars ()) [Signal] -> SynthDef (InnerVars ())
forall a b. (a -> b) -> a -> b
$
          if ((UGenName, CalculationRate) -> Bool)
-> [(UGenName, CalculationRate)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((UGenName, CalculationRate) -> (UGenName, CalculationRate) -> Bool
forall a. Eq a => a -> a -> Bool
==(ByteString -> UGenName
UGName_S ByteString
"Out", CalculationRate
AR)) [(UGenName, CalculationRate)]
sdUGens
             then SDBody' '[] [Signal]
SDBody' (InnerVars ()) [Signal]
polyVersion
             else do
                [Signal]
foo <- SDBody' '[] [Signal]
polyVersion
                Int -> [Signal] -> SDBody' '[] [Signal]
forall i (a :: [Symbol]) busNum.
(ToSig i a, ToSig busNum a) =>
busNum -> [i] -> SDBody' a [Signal]
out (Int
0::Int) ([Signal] -> SDBody' '[] [Signal])
-> [Signal] -> SDBody' '[] [Signal]
forall a b. (a -> b) -> a -> b
$ [Signal]
foo
   -- TODO: maybe 'defineSD'/'sync' first?:
   -- Or maybe that's the job of 'synth' so do it there
   SynthDef '[] -> () -> m (Synth '[])
forall (m :: * -> *) params (args :: [Symbol]).
(VividAction m, VarList params, Subset (InnerVars params) args) =>
SynthDef args -> params -> m (Synth args)
synth SynthDef '[]
sdWithOut ()

class MonoOrPoly s where
   getPoly :: SDBody' a s -> SDBody' a [Signal]

instance MonoOrPoly [Signal] where
   getPoly :: SDBody' a [Signal] -> SDBody' a [Signal]
   getPoly :: SDBody' a [Signal] -> SDBody' a [Signal]
getPoly = SDBody' a [Signal] -> SDBody' a [Signal]
forall a. a -> a
id

instance MonoOrPoly Signal where
   getPoly :: SDBody' a Signal -> SDBody' a [Signal]
   -- getPoly s = (:[]) <$> s
   -- should this be stereo? a lot of uses call for something else
   getPoly :: SDBody' a Signal -> SDBody' a [Signal]
getPoly SDBody' a Signal
s = do
      Signal
s' <- SDBody' a Signal
s
      [Signal] -> SDBody' a [Signal]
forall (m :: * -> *) a. Monad m => a -> m a
return [Signal
s', Signal
s']

-- | 'G'radually-typed version of 'freeSynth' or 'free'. Note that this
--   allows you to attempt to free a NodeId of a Group as if it were a
--   synth. Be careful!
freeG :: (VividAction m, SynthOrNodeId n) => n -> m ()
freeG :: n -> m ()
freeG (n -> NodeId
forall a. IsNode a => a -> NodeId
getNodeId -> NodeId
nodeId) =
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ NodeId -> OSC
SCCmd.n_free NodeId
nodeId

free, freeSynth :: VividAction m => Synth a -> m ()
-- | Shorter name for 'freeSynth'
free :: Synth a -> m ()
free = Synth a -> m ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
Synth a -> m ()
freeSynth
-- | Immediately stop a synth playing
-- 
--   This can create a \"clipping\" artifact if the sound goes from a high
--   amplitude to 0 in an instant -- you can avoid that with e.g.
--   'Vivid.UGens.lag' or with an envelope (especially 'envGate')
freeSynth :: Synth a -> m ()
freeSynth = Synth a -> m ()
forall (m :: * -> *) n.
(VividAction m, SynthOrNodeId n) =>
n -> m ()
freeG

-- | Assuming your \"gate\" argument is on an EnvGen or similar, will release the synth
--   over the EnvGen-specified fade time
-- 
--   If you'd like to specify a fade time in the moment, check out 'releaseIn'
release :: (Elem "gate" args, VividAction m) => Synth args -> m ()
release :: Synth args -> m ()
release Synth args
s = Synth args -> I "gate" -> m ()
forall (m :: * -> *) params (sdArgs :: [Symbol]).
(VividAction m, Subset (InnerVars params) sdArgs,
 VarList params) =>
Synth sdArgs -> params -> m ()
set Synth args
s (I "gate"
0 ::I "gate")

-- | Assumes your \"gate\" is on an EnvGen or related
-- 
--   Specify a fade time and release
releaseIn :: (Elem "gate" args, VividAction m, Real n) => n -> Synth args -> m ()
releaseIn :: n -> Synth args -> m ()
releaseIn n
releaseSecs Synth args
s =
     -- 'abs' but give positive values yo!:
   Synth args -> I "gate" -> m ()
forall (m :: * -> *) params (sdArgs :: [Symbol]).
(VividAction m, Subset (InnerVars params) sdArgs,
 VarList params) =>
Synth sdArgs -> params -> m ()
set Synth args
s (n -> I "gate"
forall n (a :: Symbol). (Real n, KnownSymbol a) => n -> I a
toI (n -> I "gate") -> n -> I "gate"
forall a b. (a -> b) -> a -> b
$ n -> n
forall a. Num a => a -> a
negate (n -> n) -> n -> n
forall a b. (a -> b) -> a -> b
$ n
1 n -> n -> n
forall a. Num a => a -> a -> a
+ n -> n
forall a. Num a => a -> a
abs n
releaseSecs ::I "gate")

-- | Set the given parameters of a running synth
-- 
--   e.g.
-- 
--   >>> let setTest = sd (0.05 ::I "pan") $ out 0 =<< pan2 (in_ $ 0.1 ~* whiteNoise, pos_ (A::A "pan"))
--   >>> s <- synth setTest ()
--   >>> set s (-0.05 ::I "pan")
-- 
--   Any parameters not referred to will be unaffected, and any you specify that don't exist
--   will be (silently) ignored
set :: (VividAction m, Subset (InnerVars params) sdArgs, VarList params) => Synth sdArgs -> params -> m ()
set :: Synth sdArgs -> params -> m ()
set (Synth NodeId
nodeId) params
params = do
   let ([(String, Float)]
as, VarSet (InnerVars params)
_) = params -> ([(String, Float)], VarSet (InnerVars params))
forall from. VarList from => from -> TypedVarList (InnerVars from)
makeTypedVarList params
params
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ NodeId -> [(String, Either Int32 Float)] -> OSC
SCCmd.n_set NodeId
nodeId (((String, Float) -> (String, Either Int32 Float))
-> [(String, Float)] -> [(String, Either Int32 Float)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
k,Float
v)->(String
k, Float -> Either Int32 Float
forall a b. b -> Either a b
Right Float
v)) [(String, Float)]
as)

-- | Create a real live music-playing synth from a boring, dead SynthDef.
-- 
--   If you haven't defined the SynthDef on the server, this will do it automatically
--   (Note that this may cause jitters in musical timing)
-- 
--   Given...
-- 
--   >>> let foo = sd () $ out 0 [0.1 ~* whiteNoise]
-- 
--   ...you can create a synth with...
-- 
--   >>> synth foo ()
-- 
--   Careful!: The SC server doesn't keep track of your nodes for you,
--   so if you do something like...
-- 
--   >>> s <- synth someSynth ()
--   >>> s <- synth oops ()           -- 's' is overwritten
-- 
--   ...you've got no way to refer to the first synth you've created, and if you
--   want to stop it you have to 'cmdPeriod'
-- 
--   (If you want to interop with SC's language (or other SC clients),
--   use 'sdNamed' and 'synthNamed')
synth :: (VividAction m, VarList params, Subset (InnerVars params) args) => SynthDef args -> params -> m (Synth args)
synth :: SynthDef args -> params -> m (Synth args)
synth SynthDef args
theSD params
params = do
   NodeId -> Synth args
forall (args :: [Symbol]). NodeId -> Synth args
Synth (NodeId -> Synth args) -> m NodeId -> m (Synth args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SynthDef args -> params -> m NodeId
forall (m :: * -> *) params (a :: [Symbol]).
(VividAction m, VarList params) =>
SynthDef a -> params -> m NodeId
synthG SynthDef args
theSD params
params

-- | Make a synth, \"G\"radually typed -- doesn't check that _ is a subset of _
--   Useful e.g. if you want to send a bunch of args, some of which may be discarded
-- 
--   (Personally I'd recommend not using this function)
-- 
--   >>>  let s = undefined :: SynthDef '["ok"]
--   >>>  synth s (4::I "ok", 5::I "throwaway")
--   >>>     <interactive>:
--   >>>         Could not deduce (Elem "ignore" '[]) arising from a use of ‘synth’
--   >>>  synthG s (4::I "ok", 5::I "throwaway")
--   >>>   (works)
synthG :: (VividAction m, VarList params) => SynthDef a -> params -> m NodeId
synthG :: SynthDef a -> params -> m NodeId
synthG SynthDef a
theSD params
params = do
   SynthDef a -> m ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD SynthDef a
theSD -- 'defineSD' only defines it if it hasn't been yet

   ByteString -> params -> AddAction -> Group -> m NodeId
forall (m :: * -> *) params node.
(VividAction m, VarList params, IsNode node) =>
ByteString -> params -> AddAction -> node -> m NodeId
makeSynth (SynthDef a -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
synthName SynthDef a
theSD) params
params AddAction
SCCmd.AddToHead Group
defaultGroup

synthName :: SynthDef a -> ByteString
synthName :: SynthDef a -> ByteString
synthName SynthDef a
theSD = case SynthDef a
theSD of
        SynthDef (SDName_Named ByteString
n) [(ByteString, Float)]
_ Map Int UGen
_ -> ByteString
n
        SynthDef SDName
SDName_Hash [(ByteString, Float)]
_ Map Int UGen
_ -> SynthDef a -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
getSDHashName SynthDef a
theSD

synthNamed :: (VividAction m, VarList params) => String -> params -> m (Synth a)
synthNamed :: String -> params -> m (Synth a)
synthNamed String
name params
params = NodeId -> Synth a
forall (args :: [Symbol]). NodeId -> Synth args
Synth (NodeId -> Synth a) -> m NodeId -> m (Synth a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   ByteString -> params -> AddAction -> Group -> m NodeId
forall (m :: * -> *) params node.
(VividAction m, VarList params, IsNode node) =>
ByteString -> params -> AddAction -> node -> m NodeId
makeSynth (String -> ByteString
UTF8.fromString String
name) params
params AddAction
SCCmd.AddToHead Group
defaultGroup

synthNamedG :: (VividAction m, VarList params) => String -> params -> m NodeId
synthNamedG :: String -> params -> m NodeId
synthNamedG String
name params
params =
   ByteString -> params -> AddAction -> Group -> m NodeId
forall (m :: * -> *) params node.
(VividAction m, VarList params, IsNode node) =>
ByteString -> params -> AddAction -> node -> m NodeId
makeSynth (String -> ByteString
UTF8.fromString String
name) params
params AddAction
SCCmd.AddToHead Group
defaultGroup

makeSynth :: (VividAction m, VarList params, IsNode node) => ByteString -> params -> SCCmd.AddAction -> node -> m NodeId
makeSynth :: ByteString -> params -> AddAction -> node -> m NodeId
makeSynth ByteString
theSynthName params
params AddAction
addAction (node -> NodeId
forall a. IsNode a => a -> NodeId
getNodeId -> NodeId
targetNodeId) = do
   NodeId
nodeId <- m NodeId
forall (m :: * -> *). VividAction m => m NodeId
newNodeId
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString
-> NodeId
-> AddAction
-> NodeId
-> [(ByteString, Either Int32 Float)]
-> OSC
SCCmd.s_new ByteString
theSynthName NodeId
nodeId AddAction
addAction NodeId
targetNodeId (((ByteString, Float) -> (ByteString, Either Int32 Float))
-> [(ByteString, Float)] -> [(ByteString, Either Int32 Float)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
k,Float
v)->(ByteString
k,Float -> Either Int32 Float
forall a b. b -> Either a b
Right Float
v)) [(ByteString, Float)]
paramList)
   NodeId -> m NodeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeId
nodeId
 where
   paramList :: [(ByteString, Float)]
   paramList :: [(ByteString, Float)]
paramList =
      [ (String -> ByteString
UTF8.fromString String
k, Float
v) | (String
k, Float
v) <- (([(String, Float)], VarSet (InnerVars params)) -> [(String, Float)]
forall a b. (a, b) -> a
fst (([(String, Float)], VarSet (InnerVars params))
 -> [(String, Float)])
-> ([(String, Float)], VarSet (InnerVars params))
-> [(String, Float)]
forall a b. (a -> b) -> a -> b
$ params -> ([(String, Float)], VarSet (InnerVars params))
forall from. VarList from => from -> TypedVarList (InnerVars from)
makeTypedVarList params
params) ]


-- Can dedupe all these!:

-- TODO: instead of e.g. 'synthBefore', 'parGroupBefore' etc, can just do 'parGroup AddBefore'

-- | Create a synth at the head of the target group (see \"Order of Execution\")
newSynthAtHead
  , synthHead
  , synthOn
  , newSynthAtTail
  , synthTail
  :: (VividAction m, VarList params, Subset (InnerVars params) args, IsGroup group)
  => group -> SynthDef args -> params -> m (Synth args)
newSynthAtHead :: group -> SynthDef args -> params -> m (Synth args)
newSynthAtHead group
targetNode SynthDef args
theSD params
params = do
   SynthDef args -> m ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD SynthDef args
theSD
   NodeId -> Synth args
forall (args :: [Symbol]). NodeId -> Synth args
Synth (NodeId -> Synth args) -> m NodeId -> m (Synth args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> params -> AddAction -> group -> m NodeId
forall (m :: * -> *) params node.
(VividAction m, VarList params, IsNode node) =>
ByteString -> params -> AddAction -> node -> m NodeId
makeSynth (SynthDef args -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
synthName SynthDef args
theSD) params
params AddAction
SCCmd.AddToHead group
targetNode
-- | Alias for 'newSynthAtHead'
synthHead :: group -> SynthDef args -> params -> m (Synth args)
synthHead = group -> SynthDef args -> params -> m (Synth args)
forall (m :: * -> *) params (args :: [Symbol]) group.
(VividAction m, VarList params, Subset (InnerVars params) args,
 IsGroup group) =>
group -> SynthDef args -> params -> m (Synth args)
newSynthAtHead
-- | Alias for 'newSynthAtHead'
synthOn :: group -> SynthDef args -> params -> m (Synth args)
synthOn = group -> SynthDef args -> params -> m (Synth args)
forall (m :: * -> *) params (args :: [Symbol]) group.
(VividAction m, VarList params, Subset (InnerVars params) args,
 IsGroup group) =>
group -> SynthDef args -> params -> m (Synth args)
newSynthAtHead
-- | Create a synth at the tail of the target group (see \"Order of Execution\")
newSynthAtTail :: group -> SynthDef args -> params -> m (Synth args)
newSynthAtTail group
targetNode SynthDef args
theSD params
params = do
   SynthDef args -> m ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD SynthDef args
theSD
   NodeId -> Synth args
forall (args :: [Symbol]). NodeId -> Synth args
Synth (NodeId -> Synth args) -> m NodeId -> m (Synth args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> params -> AddAction -> group -> m NodeId
forall (m :: * -> *) params node.
(VividAction m, VarList params, IsNode node) =>
ByteString -> params -> AddAction -> node -> m NodeId
makeSynth (SynthDef args -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
synthName SynthDef args
theSD) params
params AddAction
SCCmd.AddToTail group
targetNode
-- | Alias for 'newSynthAtTail'
synthTail :: group -> SynthDef args -> params -> m (Synth args)
synthTail = group -> SynthDef args -> params -> m (Synth args)
forall (m :: * -> *) params (args :: [Symbol]) group.
(VividAction m, VarList params, Subset (InnerVars params) args,
 IsGroup group) =>
group -> SynthDef args -> params -> m (Synth args)
newSynthAtTail

-- | Create a synth just before the target node (see \"Order of Execution\")
newSynthBefore
  , synthBefore
  , newSynthAfter
  , synthAfter
  :: (VividAction m, VarList params, Subset (InnerVars params) args, IsNode node)
  => node -> SynthDef args -> params -> m (Synth args)
newSynthBefore :: node -> SynthDef args -> params -> m (Synth args)
newSynthBefore node
targetNode SynthDef args
theSD params
params = do
   SynthDef args -> m ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD SynthDef args
theSD
   NodeId -> Synth args
forall (args :: [Symbol]). NodeId -> Synth args
Synth (NodeId -> Synth args) -> m NodeId -> m (Synth args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> params -> AddAction -> node -> m NodeId
forall (m :: * -> *) params node.
(VividAction m, VarList params, IsNode node) =>
ByteString -> params -> AddAction -> node -> m NodeId
makeSynth (SynthDef args -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
synthName SynthDef args
theSD) params
params AddAction
SCCmd.AddBefore node
targetNode
-- | Alias for 'newSynthBefore'
synthBefore :: node -> SynthDef args -> params -> m (Synth args)
synthBefore = node -> SynthDef args -> params -> m (Synth args)
forall (m :: * -> *) params (args :: [Symbol]) node.
(VividAction m, VarList params, Subset (InnerVars params) args,
 IsNode node) =>
node -> SynthDef args -> params -> m (Synth args)
newSynthBefore
-- | Create a synth just after the target node (see \"Order of Execution\")
newSynthAfter :: node -> SynthDef args -> params -> m (Synth args)
newSynthAfter node
targetNode SynthDef args
theSD params
params = do
   SynthDef args -> m ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD SynthDef args
theSD
   NodeId -> Synth args
forall (args :: [Symbol]). NodeId -> Synth args
Synth (NodeId -> Synth args) -> m NodeId -> m (Synth args)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> params -> AddAction -> node -> m NodeId
forall (m :: * -> *) params node.
(VividAction m, VarList params, IsNode node) =>
ByteString -> params -> AddAction -> node -> m NodeId
makeSynth (SynthDef args -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
synthName SynthDef args
theSD) params
params AddAction
SCCmd.AddAfter node
targetNode
-- | Alias for 'newSynthAfter'
synthAfter :: node -> SynthDef args -> params -> m (Synth args)
synthAfter = node -> SynthDef args -> params -> m (Synth args)
forall (m :: * -> *) params (args :: [Symbol]) node.
(VividAction m, VarList params, Subset (InnerVars params) args,
 IsNode node) =>
node -> SynthDef args -> params -> m (Synth args)
newSynthAfter

-- | Stop the SuperCollider server
quitSCServerWith :: SCServerState -> IO ()
quitSCServerWith :: SCServerState -> IO ()
quitSCServerWith SCServerState
serverState = do
   ReaderT SCServerState IO () -> SCServerState -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (OSC -> ReaderT SCServerState IO ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC OSC
SCCmd.quit) SCServerState
serverState
   SCServerState -> IO ()
closeSCServerConnection' SCServerState
serverState

-- | Synchronous
freeBuf :: VividAction m => BufferId -> m ()
freeBuf :: BufferId -> m ()
freeBuf BufferId
bufId = (SyncId -> m ()) -> m ()
forall (m :: * -> *). VividAction m => (SyncId -> m ()) -> m ()
oscWSync ((SyncId -> m ()) -> m ()) -> (SyncId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SyncId
syncId ->
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ BufferId -> Maybe OSC -> OSC
SCCmd.b_free BufferId
bufId (OSC -> Maybe OSC
forall a. a -> Maybe a
Just (OSC -> Maybe OSC) -> OSC -> Maybe OSC
forall a b. (a -> b) -> a -> b
$ SyncId -> OSC
SCCmd.sync SyncId
syncId)

newGroup :: VividAction m => m Group
newGroup :: m Group
newGroup = Group -> m Group
forall group (m :: * -> *).
(IsGroup group, VividAction m) =>
group -> m Group
newGroupAtHead Group
defaultGroup

newParGroup :: VividAction m => m ParGroup
newParGroup :: m ParGroup
newParGroup = Group -> m ParGroup
forall group (m :: * -> *).
(IsGroup group, VividAction m) =>
group -> m ParGroup
newParGroupAtHead Group
defaultGroup

newGroupBefore, newGroupAfter :: (IsNode node, VividAction m) => node -> m Group
newGroupBefore :: node -> m Group
newGroupBefore = AddAction -> node -> m Group
forall target (m :: * -> *).
(IsNode target, VividAction m) =>
AddAction -> target -> m Group
makeGroup AddAction
SCCmd.AddBefore
newGroupAfter :: node -> m Group
newGroupAfter = AddAction -> node -> m Group
forall target (m :: * -> *).
(IsNode target, VividAction m) =>
AddAction -> target -> m Group
makeGroup AddAction
SCCmd.AddAfter

newGroupAtHead, newGroupAtTail :: (IsGroup group, VividAction m) => group -> m Group
newGroupAtHead :: group -> m Group
newGroupAtHead = AddAction -> group -> m Group
forall target (m :: * -> *).
(IsNode target, VividAction m) =>
AddAction -> target -> m Group
makeGroup AddAction
SCCmd.AddToHead
newGroupAtTail :: group -> m Group
newGroupAtTail = AddAction -> group -> m Group
forall target (m :: * -> *).
(IsNode target, VividAction m) =>
AddAction -> target -> m Group
makeGroup AddAction
SCCmd.AddToTail

newParGroupBefore, newParGroupAfter :: (IsNode node, VividAction m) => node -> m ParGroup
newParGroupBefore :: node -> m ParGroup
newParGroupBefore = AddAction -> node -> m ParGroup
forall target (m :: * -> *).
(IsNode target, VividAction m) =>
AddAction -> target -> m ParGroup
makeParGroup AddAction
SCCmd.AddBefore
newParGroupAfter :: node -> m ParGroup
newParGroupAfter = AddAction -> node -> m ParGroup
forall target (m :: * -> *).
(IsNode target, VividAction m) =>
AddAction -> target -> m ParGroup
makeParGroup AddAction
SCCmd.AddAfter

newParGroupAtHead, newParGroupAtTail :: (IsGroup group, VividAction m) => group -> m ParGroup
newParGroupAtHead :: group -> m ParGroup
newParGroupAtHead = AddAction -> group -> m ParGroup
forall target (m :: * -> *).
(IsNode target, VividAction m) =>
AddAction -> target -> m ParGroup
makeParGroup AddAction
SCCmd.AddToHead
newParGroupAtTail :: group -> m ParGroup
newParGroupAtTail = AddAction -> group -> m ParGroup
forall target (m :: * -> *).
(IsNode target, VividAction m) =>
AddAction -> target -> m ParGroup
makeParGroup AddAction
SCCmd.AddToTail

makeGroup :: (IsNode target, VividAction m) => SCCmd.AddAction -> target -> m Group
makeGroup :: AddAction -> target -> m Group
makeGroup = GroupCmd -> (NodeId -> Group) -> AddAction -> target -> m Group
forall target (m :: * -> *) group.
(IsNode target, VividAction m) =>
GroupCmd -> (NodeId -> group) -> AddAction -> target -> m group
makeSomeKindaGroup GroupCmd
SCCmd.g_new NodeId -> Group
Group

makeParGroup :: (IsNode target, VividAction m) => SCCmd.AddAction -> target -> m ParGroup
makeParGroup :: AddAction -> target -> m ParGroup
makeParGroup = GroupCmd
-> (NodeId -> ParGroup) -> AddAction -> target -> m ParGroup
forall target (m :: * -> *) group.
(IsNode target, VividAction m) =>
GroupCmd -> (NodeId -> group) -> AddAction -> target -> m group
makeSomeKindaGroup GroupCmd
SCCmd.p_new NodeId -> ParGroup
ParGroup

type GroupCmd = NodeId -> SCCmd.AddAction -> NodeId -> OSC

makeSomeKindaGroup :: (IsNode target, VividAction m) => (GroupCmd) -> (NodeId -> group) -> SCCmd.AddAction -> target -> m group
makeSomeKindaGroup :: GroupCmd -> (NodeId -> group) -> AddAction -> target -> m group
makeSomeKindaGroup GroupCmd
createCommand NodeId -> group
constructor AddAction
addAction (target -> NodeId
forall a. IsNode a => a -> NodeId
getNodeId -> NodeId
targetNode) = do
   NodeId
nodeId <- m NodeId
forall (m :: * -> *). VividAction m => m NodeId
newNodeId
   OSC -> m ()
forall (m :: * -> *). VividAction m => OSC -> m ()
callOSC (OSC -> m ()) -> OSC -> m ()
forall a b. (a -> b) -> a -> b
$ GroupCmd
createCommand NodeId
nodeId AddAction
addAction NodeId
targetNode
   m ()
forall (m :: * -> *). VividAction m => m ()
sync
   group -> m group
forall (f :: * -> *) a. Applicative f => a -> f a
pure (group -> m group) -> group -> m group
forall a b. (a -> b) -> a -> b
$ NodeId -> group
constructor NodeId
nodeId