-- | Transformations over 'Graph' structure.
module Sound.Sc3.Ugen.Graph.Transform where

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

import qualified Sound.Sc3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.Sc3.Common.Uid as Uid {- hsc3 -}
import Sound.Sc3.Ugen.Graph

-- * Lift constants

{- | Transform 'U_Node_C' to 'U_Node_K', 'id' for other 'U_Node' types.

> let k = U_Node_K 8 ControlRate Nothing "k_8" 0.1 K_ControlRate Nothing
> node_k_eq k (snd (constant_to_control 8 (U_Node_C 0 0.1)))
-}
constant_to_control :: Uid.Id -> U_Node -> (Uid.Id, U_Node)
constant_to_control :: Id -> U_Node -> (Id, U_Node)
constant_to_control Id
z U_Node
n =
  case U_Node
n of
    U_Node_C Id
_ Sample
k -> (Id
z Id -> Id -> Id
forall a. Num a => a -> a -> a
+ Id
1, Id
-> Rate
-> Maybe Id
-> String
-> Sample
-> K_Type
-> Maybe (Control_Meta Sample)
-> U_Node
U_Node_K Id
z Rate
Rate.ControlRate Maybe Id
forall a. Maybe a
Nothing (String
"k_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
z) Sample
k K_Type
Rate.K_ControlRate Maybe (Control_Meta Sample)
forall a. Maybe a
Nothing)
    U_Node
_ -> (Id
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.Id -> From_Port -> (Uid.Id, Either From_Port U_Node)
c_lift_from_port :: U_Graph -> Id -> From_Port -> (Id, Either From_Port U_Node)
c_lift_from_port U_Graph
g Id
z From_Port
fp =
  case From_Port
fp of
    From_Port_C Id
_ ->
      let n :: U_Node
n = U_Graph -> From_Port -> U_Node
ug_from_port_node_err U_Graph
g From_Port
fp
          (Id
z', U_Node
n') = Id -> U_Node -> (Id, U_Node)
constant_to_control Id
z U_Node
n
      in (Id
z', U_Node -> Either From_Port U_Node
forall a b. b -> Either a b
Right U_Node
n')
    From_Port
_ -> (Id
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.Id', the transformed
'From_Port' list, and the list of newly minted control 'U_Node's.
-}
c_lift_inputs :: U_Graph -> Uid.Id -> [From_Port] -> (Uid.Id, [From_Port], [U_Node])
c_lift_inputs :: U_Graph -> Id -> [From_Port] -> (Id, [From_Port], [U_Node])
c_lift_inputs U_Graph
g Id
z [From_Port]
i =
  let (Id
z', [Either From_Port U_Node]
r) = (Id -> From_Port -> (Id, Either From_Port U_Node))
-> Id -> [From_Port] -> (Id, [Either From_Port U_Node])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (U_Graph -> Id -> From_Port -> (Id, Either From_Port U_Node)
c_lift_from_port U_Graph
g) Id
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 (Id
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.Id -> U_Node -> (Uid.Id, U_Node, [U_Node])
c_lift_ugen :: U_Graph -> Id -> U_Node -> (Id, U_Node, [U_Node])
c_lift_ugen U_Graph
g Id
z U_Node
n =
  case U_Node
n of
    U_Node_U {} ->
      let i :: [From_Port]
i = U_Node -> [From_Port]
u_node_u_inputs U_Node
n
          (Id
z', [From_Port]
i', [U_Node]
k) = U_Graph -> Id -> [From_Port] -> (Id, [From_Port], [U_Node])
c_lift_inputs U_Graph
g Id
z [From_Port]
i
      in (Id
z', U_Node
n {u_node_u_inputs = i'}, [U_Node]
k)
    U_Node
_ -> String -> (Id, U_Node, [U_Node])
forall a. HasCallStack => String -> a
error String
"c_lift_ugen"

-- | 'c_lift_ugen' at list of 'U_Node_U'.
c_lift_ugens :: U_Graph -> Uid.Id -> [U_Node] -> (Uid.Id, [U_Node], [U_Node])
c_lift_ugens :: U_Graph -> Id -> [U_Node] -> (Id, [U_Node], [U_Node])
c_lift_ugens U_Graph
g =
  let recur :: ([U_Node], [U_Node]) -> Id -> [U_Node] -> (Id, [U_Node], [U_Node])
recur ([U_Node]
k, [U_Node]
r) Id
z [U_Node]
u =
        case [U_Node]
u of
          [] -> (Id
z, [U_Node]
k, [U_Node] -> [U_Node]
forall a. [a] -> [a]
reverse [U_Node]
r)
          U_Node
n : [U_Node]
u' ->
            let (Id
z', U_Node
n', [U_Node]
k') = U_Graph -> Id -> U_Node -> (Id, U_Node, [U_Node])
c_lift_ugen U_Graph
g Id
z U_Node
n
            in ([U_Node], [U_Node]) -> Id -> [U_Node] -> (Id, [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) Id
z' [U_Node]
u'
  in ([U_Node], [U_Node]) -> Id -> [U_Node] -> (Id, [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 Id
z [U_Node]
_ [U_Node]
k [U_Node]
u) = U_Graph -> U_Graph
ug_remove_implicit U_Graph
g
      (Id
z', [U_Node]
k', [U_Node]
u') = U_Graph -> Id -> [U_Node] -> (Id, [U_Node], [U_Node])
c_lift_ugens U_Graph
g Id
z [U_Node]
u
      g' :: U_Graph
g' = Id -> [U_Node] -> [U_Node] -> [U_Node] -> U_Graph
U_Graph Id
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'