-- | Transformations over 'Graph' structure.
module Sound.SC3.UGen.Graph.Transform where

import Data.Either {- base -}
import Data.List {- base -}

import Sound.SC3.Common.Rate
import Sound.SC3.UGen.Graph
import Sound.SC3.UGen.Type

-- * Lift constants

-- | Transform 'U_Node_C' to 'U_Node_K', 'id' for other 'U_Node' types.
--
-- > let k = U_Node_K 8 KR Nothing "k_8" 0.1 K_KR Nothing
-- > node_k_eq k (snd (constant_to_control 8 (U_Node_C 0 0.1)))
constant_to_control :: UID_t -> U_Node -> (UID_t,U_Node)
constant_to_control :: UID_t -> U_Node -> (UID_t, U_Node)
constant_to_control UID_t
z U_Node
n =
    case U_Node
n of
      U_Node_C UID_t
_ Sample
k -> (UID_t
z UID_t -> UID_t -> UID_t
forall a. Num a => a -> a -> a
+ UID_t
1,UID_t
-> Rate
-> Maybe UID_t
-> String
-> Sample
-> K_Type
-> Maybe (Control_Meta Sample)
-> U_Node
U_Node_K UID_t
z Rate
KR Maybe UID_t
forall a. Maybe a
Nothing (String
"k_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UID_t -> String
forall a. Show a => a -> String
show UID_t
z) Sample
k K_Type
K_KR Maybe (Control_Meta Sample)
forall a. Maybe a
Nothing)
      U_Node
_ -> (UID_t
z,U_Node
n)

-- | If the 'From_Port' is a /constant/ generate a /control/ 'U_Node', else retain 'From_Port'.
c_lift_from_port :: U_Graph -> UID_t -> From_Port -> (UID_t,Either From_Port U_Node)
c_lift_from_port :: U_Graph -> UID_t -> From_Port -> (UID_t, Either From_Port U_Node)
c_lift_from_port U_Graph
g UID_t
z From_Port
fp =
    case From_Port
fp of
      From_Port_C UID_t
_ ->
        let n :: U_Node
n = U_Graph -> From_Port -> U_Node
ug_from_port_node_err U_Graph
g From_Port
fp
            (UID_t
z',U_Node
n') = UID_t -> U_Node -> (UID_t, U_Node)
constant_to_control UID_t
z U_Node
n
        in (UID_t
z',U_Node -> Either From_Port U_Node
forall a b. b -> Either a b
Right U_Node
n')
      From_Port
_ -> (UID_t
z,From_Port -> Either From_Port U_Node
forall a b. a -> Either a b
Left From_Port
fp)

-- | Lift a set of 'U_NodeU' /inputs/ from constants to controls.  The
-- result triple gives the incremented 'UID_t', the transformed
-- 'From_Port' list, and the list of newly minted control 'U_Node's.
c_lift_inputs :: U_Graph -> UID_t -> [From_Port] -> (UID_t,[From_Port],[U_Node])
c_lift_inputs :: U_Graph -> UID_t -> [From_Port] -> (UID_t, [From_Port], [U_Node])
c_lift_inputs U_Graph
g UID_t
z [From_Port]
i =
    let (UID_t
z',[Either From_Port U_Node]
r) = (UID_t -> From_Port -> (UID_t, Either From_Port U_Node))
-> UID_t -> [From_Port] -> (UID_t, [Either From_Port U_Node])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (U_Graph -> UID_t -> From_Port -> (UID_t, Either From_Port U_Node)
c_lift_from_port U_Graph
g) UID_t
z [From_Port]
i
        f :: Either From_Port U_Node -> From_Port
f Either From_Port U_Node
e = case Either From_Port U_Node
e of
                Left From_Port
fp -> From_Port
fp
                Right U_Node
n -> U_Node -> From_Port
u_node_from_port U_Node
n
        r' :: [From_Port]
r' = (Either From_Port U_Node -> From_Port)
-> [Either From_Port U_Node] -> [From_Port]
forall a b. (a -> b) -> [a] -> [b]
map Either From_Port U_Node -> From_Port
f [Either From_Port U_Node]
r
    in (UID_t
z',[From_Port]
r',[Either From_Port U_Node] -> [U_Node]
forall a b. [Either a b] -> [b]
rights [Either From_Port U_Node]
r)

-- | Lift inputs at 'U_Node_U' as required.
c_lift_ugen :: U_Graph -> UID_t -> U_Node -> (UID_t,U_Node,[U_Node])
c_lift_ugen :: U_Graph -> UID_t -> U_Node -> (UID_t, U_Node, [U_Node])
c_lift_ugen U_Graph
g UID_t
z U_Node
n =
    let i :: [From_Port]
i = U_Node -> [From_Port]
u_node_u_inputs U_Node
n
        (UID_t
z',[From_Port]
i',[U_Node]
k) = U_Graph -> UID_t -> [From_Port] -> (UID_t, [From_Port], [U_Node])
c_lift_inputs U_Graph
g UID_t
z [From_Port]
i
    in (UID_t
z',U_Node
n {u_node_u_inputs :: [From_Port]
u_node_u_inputs = [From_Port]
i'},[U_Node]
k)

-- | 'c_lift_ugen' at list of 'U_Node_U'.
c_lift_ugens :: U_Graph -> UID_t -> [U_Node] -> (UID_t,[U_Node],[U_Node])
c_lift_ugens :: U_Graph -> UID_t -> [U_Node] -> (UID_t, [U_Node], [U_Node])
c_lift_ugens U_Graph
g  =
    let recur :: ([U_Node], [U_Node])
-> UID_t -> [U_Node] -> (UID_t, [U_Node], [U_Node])
recur ([U_Node]
k,[U_Node]
r) UID_t
z [U_Node]
u =
            case [U_Node]
u of
              [] -> (UID_t
z,[U_Node]
k,[U_Node] -> [U_Node]
forall a. [a] -> [a]
reverse [U_Node]
r)
              U_Node
n:[U_Node]
u' -> let (UID_t
z',U_Node
n',[U_Node]
k') = U_Graph -> UID_t -> U_Node -> (UID_t, U_Node, [U_Node])
c_lift_ugen U_Graph
g UID_t
z U_Node
n
                      in ([U_Node], [U_Node])
-> UID_t -> [U_Node] -> (UID_t, [U_Node], [U_Node])
recur ([U_Node]
k[U_Node] -> [U_Node] -> [U_Node]
forall a. [a] -> [a] -> [a]
++[U_Node]
k',U_Node
n'U_Node -> [U_Node] -> [U_Node]
forall a. a -> [a] -> [a]
:[U_Node]
r) UID_t
z' [U_Node]
u'
    in ([U_Node], [U_Node])
-> UID_t -> [U_Node] -> (UID_t, [U_Node], [U_Node])
recur ([],[])

{-| Lift constants to controls.

> import Sound.SC3 {- hsc3 -}
> import Sound.SC3.UGen.Dot {- hsc3-dot -}

> let u = out 0 (sinOsc AR 440 0 * 0.1)
> let g = ugen_to_graph u
> draw g
> draw (lift_constants g)

-}
lift_constants :: U_Graph -> U_Graph
lift_constants :: U_Graph -> U_Graph
lift_constants U_Graph
g =
    let (U_Graph UID_t
z [U_Node]
_ [U_Node]
k [U_Node]
u) = U_Graph -> U_Graph
ug_remove_implicit U_Graph
g
        (UID_t
z',[U_Node]
k',[U_Node]
u') = U_Graph -> UID_t -> [U_Node] -> (UID_t, [U_Node], [U_Node])
c_lift_ugens U_Graph
g UID_t
z [U_Node]
u
        g' :: U_Graph
g' = UID_t -> [U_Node] -> [U_Node] -> [U_Node] -> U_Graph
U_Graph UID_t
z' [] ((U_Node -> U_Node -> Bool) -> [U_Node] -> [U_Node]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy U_Node -> U_Node -> Bool
u_node_k_eq ([U_Node]
k [U_Node] -> [U_Node] -> [U_Node]
forall a. [a] -> [a] -> [a]
++ [U_Node]
k')) [U_Node]
u'
    in U_Graph -> U_Graph
ug_add_implicit U_Graph
g'