-- | Decode (read) a 'Graphdef' into a 'Graph'.
module Sound.SC3.Server.Graphdef.Read where

import Sound.OSC.Datum {- hosc -}

import qualified Sound.SC3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.SC3.Server.Graphdef as Graphdef {- hsc3 -}
import qualified Sound.SC3.UGen.Graph as Graph {- hsc3 -}
import qualified Sound.SC3.UGen.Type as Type {- hsc3 -}

control_to_node :: Graphdef.Graphdef -> Type.UID_t -> (Graphdef.Control,Type.Sample) -> Graph.U_Node
control_to_node :: Graphdef -> UID_t -> (Control, Sample) -> U_Node
control_to_node Graphdef
g UID_t
z ((Name
nm,UID_t
ix),Sample
v) =
    let z' :: UID_t
z' = Graphdef -> UID_t -> UID_t
Graphdef.graphdef_control_nid Graphdef
g UID_t
z
        nm' :: String
nm' = Name -> String
ascii_to_string Name
nm
    in UID_t
-> Rate
-> Maybe UID_t
-> String
-> Sample
-> K_Type
-> Maybe (Control_Meta Sample)
-> U_Node
Graph.U_Node_K UID_t
z' Rate
Rate.KR (UID_t -> Maybe UID_t
forall a. a -> Maybe a
Just UID_t
ix) String
nm' Sample
v K_Type
Rate.K_KR Maybe (Control_Meta Sample)
forall a. Maybe a
Nothing

-- | Note: Graphs with multiple Control UGens are not accounted for.
input_to_from_port :: Graphdef.Graphdef -> Graphdef.Input -> Graph.From_Port
input_to_from_port :: Graphdef -> Input -> From_Port
input_to_from_port Graphdef
g (Graphdef.Input UID_t
u UID_t
p) =
    if UID_t
u UID_t -> UID_t -> Bool
forall a. Eq a => a -> a -> Bool
== -UID_t
1
    then UID_t -> From_Port
Graph.From_Port_C (Graphdef -> UID_t -> UID_t
Graphdef.graphdef_constant_nid Graphdef
g UID_t
p)
    else if Graphdef -> Input -> Bool
Graphdef.input_is_control Graphdef
g (UID_t -> UID_t -> Input
Graphdef.Input UID_t
u UID_t
p)
         then UID_t -> K_Type -> From_Port
Graph.From_Port_K (Graphdef -> UID_t -> UID_t
Graphdef.graphdef_control_nid Graphdef
g UID_t
p) K_Type
Rate.K_KR
         else let ugen :: UGen
ugen = Graphdef -> [UGen]
Graphdef.graphdef_ugens Graphdef
g [UGen] -> UID_t -> UGen
forall a. [a] -> UID_t -> a
!! UID_t
u
                  port :: Maybe UID_t
port = if [UID_t] -> UID_t
forall (t :: * -> *) a. Foldable t => t a -> UID_t
length (UGen -> [UID_t]
Graphdef.ugen_outputs UGen
ugen) UID_t -> UID_t -> Bool
forall a. Ord a => a -> a -> Bool
> UID_t
1
                         then UID_t -> Maybe UID_t
forall a. a -> Maybe a
Just UID_t
p
                         else Maybe UID_t
forall a. Maybe a
Nothing
              in UID_t -> Maybe UID_t -> From_Port
Graph.From_Port_U (Graphdef -> UID_t -> UID_t
Graphdef.graphdef_ugen_nid Graphdef
g UID_t
u) Maybe UID_t
port

ugen_to_node :: Graphdef.Graphdef -> Type.UID_t -> Graphdef.UGen -> Graph.U_Node
ugen_to_node :: Graphdef -> UID_t -> UGen -> U_Node
ugen_to_node Graphdef
g UID_t
z UGen
u =
    let (Name
name,UID_t
rate,[Input]
inputs,[UID_t]
outputs,UID_t
special) = UGen
u
        z' :: UID_t
z' = Graphdef -> UID_t -> UID_t
Graphdef.graphdef_ugen_nid Graphdef
g UID_t
z
        rate' :: Rate
rate' = UID_t -> Rate
forall a. Enum a => UID_t -> a
toEnum UID_t
rate
        name' :: String
name' = Name -> String
ascii_to_string Name
name
        inputs' :: [From_Port]
inputs' = (Input -> From_Port) -> [Input] -> [From_Port]
forall a b. (a -> b) -> [a] -> [b]
map (Graphdef -> Input -> From_Port
input_to_from_port Graphdef
g) [Input]
inputs
        outputs' :: [Rate]
outputs' = (UID_t -> Rate) -> [UID_t] -> [Rate]
forall a b. (a -> b) -> [a] -> [b]
map UID_t -> Rate
forall a. Enum a => UID_t -> a
toEnum [UID_t]
outputs
        special' :: Special
special' = UID_t -> Special
Type.Special UID_t
special
    in UID_t
-> Rate
-> String
-> [From_Port]
-> [Rate]
-> Special
-> UGenId
-> U_Node
Graph.U_Node_U UID_t
z' Rate
rate' String
name' [From_Port]
inputs' [Rate]
outputs' Special
special' (UID_t -> UGenId
Type.UId UID_t
z')

graphdef_to_graph :: Graphdef.Graphdef -> (String,Graph.U_Graph)
graphdef_to_graph :: Graphdef -> (String, U_Graph)
graphdef_to_graph Graphdef
g =
    let constants_nd :: [U_Node]
constants_nd = (UID_t -> Sample -> U_Node) -> [UID_t] -> [Sample] -> [U_Node]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith UID_t -> Sample -> U_Node
Graph.U_Node_C [UID_t
0..] (Graphdef -> [Sample]
Graphdef.graphdef_constants Graphdef
g)
        controls_nd :: [U_Node]
controls_nd = (UID_t -> (Control, Sample) -> U_Node)
-> [UID_t] -> [(Control, Sample)] -> [U_Node]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Graphdef -> UID_t -> (Control, Sample) -> U_Node
control_to_node Graphdef
g) [UID_t
0 ..] (Graphdef -> [(Control, Sample)]
Graphdef.graphdef_controls Graphdef
g)
        ugens_nd :: [U_Node]
ugens_nd = (UID_t -> UGen -> U_Node) -> [UID_t] -> [UGen] -> [U_Node]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Graphdef -> UID_t -> UGen -> U_Node
ugen_to_node Graphdef
g) [UID_t
0 ..] (Graphdef -> [UGen]
Graphdef.graphdef_ugens Graphdef
g)
        nm :: String
nm = Name -> String
ascii_to_string (Graphdef -> Name
Graphdef.graphdef_name Graphdef
g)
        gr :: U_Graph
gr = UID_t -> [U_Node] -> [U_Node] -> [U_Node] -> U_Graph
Graph.U_Graph (-UID_t
1) [U_Node]
constants_nd [U_Node]
controls_nd [U_Node]
ugens_nd
    in (String
nm,U_Graph
gr) -- S.Synthdef nm gr

-- | Read graphdef file and translate to graph.
read_graph :: FilePath -> IO Graph.U_Graph
read_graph :: String -> IO U_Graph
read_graph String
sy_nm = do
  Graphdef
d <- String -> IO Graphdef
Graphdef.read_graphdef_file String
sy_nm
  let (String
_,U_Graph
g) = Graphdef -> (String, U_Graph)
graphdef_to_graph Graphdef
d
  U_Graph -> IO U_Graph
forall (m :: * -> *) a. Monad m => a -> m a
return U_Graph
g

-- | Read graphdef file, translate to graph, and run 'ug_stat_ln'.
scsyndef_ug_stat :: FilePath -> IO String
scsyndef_ug_stat :: String -> IO String
scsyndef_ug_stat String
sy_nm = do
  U_Graph
g <- String -> IO U_Graph
read_graph String
sy_nm
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
unlines (U_Graph -> [String]
Graph.ug_stat_ln U_Graph
g))