module Vivid.Actions (
synth
, synthG
, synthNamed
, synthNamedG
, set
, play
, free
, freeBuf
, quitSCServer
, module Vivid.Actions.Class
, module Vivid.Actions.NRT
, module Vivid.Actions.Scheduled
, makeSynth
, synthWAction
) where
import Vivid.Actions.Class
import Vivid.Actions.IO ()
import Vivid.Actions.NRT
import Vivid.Actions.Scheduled
import Vivid.OSC
import Vivid.SCServer.Connection (closeSCServerConnection)
import Vivid.SCServer.Types (NodeId(..), Node(..), HasNodeId(..), BufferId(..))
import Vivid.SynthDef (getSDHashName, sd )
import Vivid.SynthDef.TypesafeArgs
import Control.Arrow (first)
import qualified Data.ByteString.Char8 as BS8 (pack, ByteString)
import Data.Int
import Data.Monoid
import qualified Data.Map as Map
import Vivid.SynthDef (makeSynthDef)
import Vivid.SynthDef.Types
import Vivid.UGens.InOut (out)
play :: (VividAction m, MonoOrPoly s) => SDBody' '[] s -> m (Node '[])
play monoOrPolyVersion = do
let polyVersion = getPoly monoOrPolyVersion
let sdUGens :: [(UGenName, CalculationRate)]
sdUGens =
map (\x -> (_ugenName x, _ugenCalculationRate x)) $
Map.elems $ _sdUGens $ makeSynthDef SDName_Hash () polyVersion
let sdWithOut = sd () $
if any (==(UGName_S "Out", AR)) sdUGens
then polyVersion
else do
foo <- polyVersion
out (0::Int) $ foo
synth sdWithOut ()
class MonoOrPoly s where
getPoly :: SDBody' a s -> SDBody' a [Signal]
instance MonoOrPoly [Signal] where
getPoly :: SDBody' a [Signal] -> SDBody' a [Signal]
getPoly = id
instance MonoOrPoly Signal where
getPoly :: SDBody' a Signal -> SDBody' a [Signal]
getPoly s = do
s' <- s
return [s', s']
free :: (VividAction m, HasNodeId n) => n -> m ()
free (getNodeId -> NodeId nodeId) =
callOSC $ OSC (BS8.pack "/n_free") [ OSC_I nodeId ]
set :: (VividAction m, Subset (InnerVars params) sdArgs, VarList params) => Node sdArgs -> params -> m ()
set (Node (NodeId nodeId)) params = do
let (as, _) = makeTypedVarList params
callOSC $ OSC (BS8.pack "/n_set") $ OSC_I nodeId : paramList as
where
paramList :: [(String, Float)] -> [OSCDatum]
paramList ps = concatMap (\(k,v)->[OSC_S k,OSC_F v]) $
map (first BS8.pack) ps
synth :: (VividAction m, VarList params, Subset (InnerVars params) args) => SynthDef args -> params -> m (Node args)
synth theSD params = do
Node <$> synthG theSD params
synthWAction :: (VividAction m, VarList params, Subset (InnerVars params) args) => SynthDef args -> params -> Int32 -> m (Node args)
synthWAction theSD params actionNum = do
Node <$> synthG_wAction theSD params actionNum
synthG :: (VividAction m, VarList params) => SynthDef a -> params -> m NodeId
synthG theSD params = do
defineSD theSD
let synthName = case theSD of
SynthDef (SDName_Named n) _ _ -> n
SynthDef SDName_Hash _ _ -> getSDHashName theSD
makeSynth synthName params 0
synthG_wAction :: (VividAction m, VarList params) => SynthDef a -> params -> Int32 -> m NodeId
synthG_wAction theSD params actionNum = do
defineSD theSD
let synthName = case theSD of
SynthDef (SDName_Named n) _ _ -> n
SynthDef SDName_Hash _ _ -> getSDHashName theSD
makeSynth synthName params actionNum
synthNamed :: (VividAction m, VarList params) => String -> params -> m (Node a)
synthNamed name params = Node <$> makeSynth (BS8.pack name) params 0
synthNamedG :: (VividAction m, VarList params) => String -> params -> m NodeId
synthNamedG name params = makeSynth (BS8.pack name) params 0
makeSynth :: (VividAction m, VarList params) => BS8.ByteString -> params -> Int32 -> m NodeId
makeSynth synthName params addAction = do
nodeId@(NodeId nn) <- newNodeId
callOSC $ OSC (BS8.pack "/s_new") $ [
OSC_S $ synthName
, OSC_I nn
, OSC_I addAction
, OSC_I 1
] <> paramList
return nodeId
where
paramList :: [OSCDatum]
paramList = concatMap (\(k, v) -> [OSC_S k, OSC_F v]) $
map (first BS8.pack) (fst $ makeTypedVarList params)
quitSCServer :: IO ()
quitSCServer = do
callOSC $ OSC "/quit" []
closeSCServerConnection
freeBuf :: VividAction m => BufferId -> m ()
freeBuf (BufferId bufId) =
callOSC $ OSC "/b_free" [OSC_I bufId]