-- | The unit-generator graph structure implemented by the SuperCollider synthesis server.
module Sound.SC3.Server.Synthdef where

import qualified Data.ByteString.Lazy as L {- bytestring -}

import qualified Sound.SC3.UGen.Graph as UGen.Graph {- hsc3 -}
import qualified Sound.SC3.UGen.Help.Graph as Help.Graph {- hsc3 -}
import qualified Sound.SC3.UGen.Type as UGen {- hsc3 -}

import qualified Sound.SC3.Server.Graphdef as Graphdef {- hsc3 -}
import qualified Sound.SC3.Server.Graphdef.Graph as Graph {- hsc3 -}
import qualified Sound.SC3.Server.Param as Param {- hsc3 -}

-- | A named unit generator graph.
data Synthdef = Synthdef {Synthdef -> String
synthdefName :: String
                         ,Synthdef -> UGen
synthdefUGen :: UGen.UGen}
                deriving (Synthdef -> Synthdef -> Bool
(Synthdef -> Synthdef -> Bool)
-> (Synthdef -> Synthdef -> Bool) -> Eq Synthdef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Synthdef -> Synthdef -> Bool
$c/= :: Synthdef -> Synthdef -> Bool
== :: Synthdef -> Synthdef -> Bool
$c== :: Synthdef -> Synthdef -> Bool
Eq,Int -> Synthdef -> ShowS
[Synthdef] -> ShowS
Synthdef -> String
(Int -> Synthdef -> ShowS)
-> (Synthdef -> String) -> ([Synthdef] -> ShowS) -> Show Synthdef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Synthdef] -> ShowS
$cshowList :: [Synthdef] -> ShowS
show :: Synthdef -> String
$cshow :: Synthdef -> String
showsPrec :: Int -> Synthdef -> ShowS
$cshowsPrec :: Int -> Synthdef -> ShowS
Show)

-- | Alias for 'Synthdef'.
synthdef :: String -> UGen.UGen -> Synthdef
synthdef :: String -> UGen -> Synthdef
synthdef = String -> UGen -> Synthdef
Synthdef

{- | The SC3 /default/ instrument 'Synthdef', see 'default_ugen_graph'.

> import Sound.OSC {- hosc -}
> import Sound.SC3 {- hsc3 -}
> withSC3 (sendMessage (d_recv defaultSynthdef))
> audition defaultSynthdef

-}
defaultSynthdef :: Synthdef
defaultSynthdef :: Synthdef
defaultSynthdef = String -> UGen -> Synthdef
synthdef String
"default" UGen
Help.Graph.default_ugen_graph

-- | The SC3 /default/ sample (buffer) playback instrument 'Synthdef',
-- see 'default_sampler_ugen_graph'.
--
-- > withSC3 (sendMessage (d_recv (defaultSampler False)))
-- > audition (defaultSampler False)
defaultSampler :: Bool -> Synthdef
defaultSampler :: Bool -> Synthdef
defaultSampler Bool
use_gate =
    let nm :: String
nm = String
"default-sampler-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
use_gate then String
"gate" else String
"fixed"
    in String -> UGen -> Synthdef
synthdef String
nm (Bool -> UGen
Help.Graph.default_sampler_ugen_graph Bool
use_gate)

-- | 'ugen_to_graph' of 'synthdefUGen'.
synthdefGraph :: Synthdef -> UGen.Graph.U_Graph
synthdefGraph :: Synthdef -> U_Graph
synthdefGraph = UGen -> U_Graph
UGen.Graph.ugen_to_graph (UGen -> U_Graph) -> (Synthdef -> UGen) -> Synthdef -> U_Graph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthdef -> UGen
synthdefUGen

-- | Parameter names at 'Synthdef'.
--
-- > synthdefParam defaultSynthdef == [("amp",0.1),("pan",0),("gate",1),("freq",440),("out",0)]
synthdefParam :: Synthdef -> Param.Param
synthdefParam :: Synthdef -> Param
synthdefParam =
  (U_Node -> (String, Sample)) -> [U_Node] -> Param
forall a b. (a -> b) -> [a] -> [b]
map (\U_Node
n -> (U_Node -> String
UGen.Graph.u_node_k_name U_Node
n,U_Node -> Sample
UGen.Graph.u_node_k_default U_Node
n)) ([U_Node] -> Param) -> (Synthdef -> [U_Node]) -> Synthdef -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  U_Graph -> [U_Node]
UGen.Graph.ug_controls (U_Graph -> [U_Node])
-> (Synthdef -> U_Graph) -> Synthdef -> [U_Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Synthdef -> U_Graph
synthdefGraph

-- | 'graph_to_graphdef' at 'Synthdef'.
synthdef_to_graphdef :: Synthdef -> Graphdef.Graphdef
synthdef_to_graphdef :: Synthdef -> Graphdef
synthdef_to_graphdef (Synthdef String
nm UGen
u) = String -> U_Graph -> Graphdef
Graph.graph_to_graphdef String
nm (UGen -> U_Graph
UGen.Graph.ugen_to_graph UGen
u)

-- | 'graph_to_graphdef' at 'Synthdef'.
ugen_to_graphdef :: UGen.UGen -> Graphdef.Graphdef
ugen_to_graphdef :: UGen -> Graphdef
ugen_to_graphdef = Synthdef -> Graphdef
synthdef_to_graphdef (Synthdef -> Graphdef) -> (UGen -> Synthdef) -> UGen -> Graphdef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UGen -> Synthdef
Synthdef String
"anonymous"

-- | Encode 'Synthdef' as a binary data stream.
synthdefData :: Synthdef -> L.ByteString
synthdefData :: Synthdef -> ByteString
synthdefData = Graphdef -> ByteString
Graphdef.encode_graphdef (Graphdef -> ByteString)
-> (Synthdef -> Graphdef) -> Synthdef -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthdef -> Graphdef
synthdef_to_graphdef

-- | Write 'Synthdef' to indicated file.
synthdefWrite :: FilePath -> Synthdef -> IO ()
synthdefWrite :: String -> Synthdef -> IO ()
synthdefWrite String
fn = String -> Graphdef -> IO ()
Graphdef.graphdefWrite String
fn (Graphdef -> IO ()) -> (Synthdef -> Graphdef) -> Synthdef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthdef -> Graphdef
synthdef_to_graphdef

-- | Write 'Synthdef' to indicated directory.  The filename is the
-- 'synthdefName' with the appropriate extension (@scsyndef@).
synthdefWrite_dir :: FilePath -> Synthdef -> IO ()
synthdefWrite_dir :: String -> Synthdef -> IO ()
synthdefWrite_dir String
dir = String -> Graphdef -> IO ()
Graphdef.graphdefWrite_dir String
dir (Graphdef -> IO ()) -> (Synthdef -> Graphdef) -> Synthdef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthdef -> Graphdef
synthdef_to_graphdef

-- | 'graph_stat_ln' of 'synth'.
synthstat_ln :: UGen.UGen -> [String]
synthstat_ln :: UGen -> [String]
synthstat_ln = U_Graph -> [String]
UGen.Graph.ug_stat_ln (U_Graph -> [String]) -> (UGen -> U_Graph) -> UGen -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> U_Graph
UGen.Graph.ugen_to_graph

-- | 'unlines' of 'synthstat_ln'.
synthstat :: UGen.UGen -> String
synthstat :: UGen -> String
synthstat = [String] -> String
unlines ([String] -> String) -> (UGen -> [String]) -> UGen -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> [String]
synthstat_ln

-- | 'putStrLn' of 'synthstat'.
--
-- > synthstat_wr Sound.SC3.UGen.Help.Graph.default_ugen_graph
synthstat_wr :: UGen.UGen -> IO ()
synthstat_wr :: UGen -> IO ()
synthstat_wr = String -> IO ()
putStrLn (String -> IO ()) -> (UGen -> String) -> UGen -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> String
synthstat

-- | Variant without UGen sequence.
--
-- > putStrLn $ synthstat_concise (default_sampler_ugen_graph True)
synthstat_concise :: UGen.UGen -> String
synthstat_concise :: UGen -> String
synthstat_concise = [String] -> String
unlines ([String] -> String) -> (UGen -> [String]) -> UGen -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> (UGen -> [String]) -> UGen -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String]) -> (UGen -> [String]) -> UGen -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> (UGen -> [String]) -> UGen -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> [String]
synthstat_ln

-- | 'graphdef_dump_ugens' of 'ugen_to_graphdef'
ugen_dump_ugens :: UGen.UGen -> IO ()
ugen_dump_ugens :: UGen -> IO ()
ugen_dump_ugens = Graphdef -> IO ()
Graphdef.graphdef_dump_ugens (Graphdef -> IO ()) -> (UGen -> Graphdef) -> UGen -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> Graphdef
ugen_to_graphdef