-- | Ugen analysis
module Sound.Sc3.Ugen.Analysis where

import Data.List {- base -}

import qualified Sound.Sc3.Common.Mce as Mce {- hsc3 -}
import qualified Sound.Sc3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.Sc3.Ugen.Bindings.Db as Db {- hsc3 -}

import Sound.Sc3.Ugen.Types

{- | Ugen primitive set.
Sees through Proxy and Mrg, possible multiple primitives for Mce.
-}
ugen_primitive_set :: Ugen -> [Primitive Ugen]
ugen_primitive_set :: Ugen -> [Primitive Ugen]
ugen_primitive_set Ugen
u =
  case Ugen
u of
    Constant_U Constant
_ -> []
    Control_U Control
_ -> []
    Label_U Label
_ -> []
    Primitive_U Primitive Ugen
p -> [Primitive Ugen
p]
    Proxy_U Proxy Ugen
p -> [Proxy Ugen -> Primitive Ugen
forall t. Proxy t -> Primitive t
proxySource Proxy Ugen
p]
    Mce_U Mce Ugen
m -> (Ugen -> [Primitive Ugen]) -> [Ugen] -> [Primitive Ugen]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ugen -> [Primitive Ugen]
ugen_primitive_set (Mce Ugen -> [Ugen]
forall t. Mce t -> [t]
Mce.mce_to_list Mce Ugen
m)
    Mrg_U Mrg Ugen
m -> Ugen -> [Primitive Ugen]
ugen_primitive_set (Mrg Ugen -> Ugen
forall t. Mrg t -> t
mrgLeft Mrg Ugen
m)

{- | Heuristic based on primitive name (FFT, PV_...).
Note that IFFT is at /control/ rate, not PV_... rate.
-}
primitive_is_pv_rate :: String -> Bool
primitive_is_pv_rate :: String -> Bool
primitive_is_pv_rate String
nm = String
nm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"FFT" Bool -> Bool -> Bool
|| String
"PV_" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
nm

-- | Variant on primitive_is_pv_rate.
ugen_is_pv_rate :: Ugen -> Bool
ugen_is_pv_rate :: Ugen -> Bool
ugen_is_pv_rate = (Primitive Ugen -> Bool) -> [Primitive Ugen] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
primitive_is_pv_rate (String -> Bool)
-> (Primitive Ugen -> String) -> Primitive Ugen -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Primitive Ugen -> String
forall t. Primitive t -> String
ugenName) ([Primitive Ugen] -> Bool)
-> (Ugen -> [Primitive Ugen]) -> Ugen -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ugen -> [Primitive Ugen]
ugen_primitive_set

{- | Traverse input graph until an FFT or PV_Split node is encountered, and then locate the buffer input.
Biases left at Mce nodes.

> import Sound.Sc3
> let z = soundIn 4
> let f1 = fft 10 z 0.5 0 1 0
> let f2 = ffta 'a' 1024 z 0.5 0 1 0
> pv_track_buffer (pv_BrickWall f1 0.5) == Right 10
> pv_track_buffer (pv_BrickWall f2 0.5) == Right (localBuf 'a' 1024 1)
-}
pv_track_buffer :: Ugen -> Either String Ugen
pv_track_buffer :: Ugen -> Either String Ugen
pv_track_buffer Ugen
u =
  case Ugen -> [Primitive Ugen]
ugen_primitive_set Ugen
u of
    [] -> String -> Either String Ugen
forall a b. a -> Either a b
Left String
"pv_track_buffer: not located"
    Primitive Ugen
p : [Primitive Ugen]
_ -> case Primitive Ugen -> String
forall t. Primitive t -> String
ugenName Primitive Ugen
p of
      String
"FFT" -> Ugen -> Either String Ugen
forall a b. b -> Either a b
Right (Primitive Ugen -> [Ugen]
forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p [Ugen] -> Int -> Ugen
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
      String
"PV_Split" -> Ugen -> Either String Ugen
forall a b. b -> Either a b
Right (Primitive Ugen -> [Ugen]
forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p [Ugen] -> Int -> Ugen
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
      String
_ -> Ugen -> Either String Ugen
pv_track_buffer (Primitive Ugen -> [Ugen]
forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p [Ugen] -> Int -> Ugen
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)

{- | Buffer node number of frames. Biases left at Mce nodes.
Sees through LocalBuf, otherwise uses 'bufFrames'.

> buffer_nframes 10 == bufFrames IR 10
> buffer_nframes (control KR "b" 0) == bufFrames KR (control KR "b" 0)
> buffer_nframes (localBuf 'α' 2048 1) == 2048
-}
buffer_nframes :: Ugen -> Ugen
buffer_nframes :: Ugen -> Ugen
buffer_nframes Ugen
u =
  case Ugen -> [Primitive Ugen]
ugen_primitive_set Ugen
u of
    [] -> Rate -> Ugen -> Ugen
Db.bufFrames (Ugen -> Rate
rateOf Ugen
u) Ugen
u
    Primitive Ugen
p : [Primitive Ugen]
_ -> case Primitive Ugen -> String
forall t. Primitive t -> String
ugenName Primitive Ugen
p of
      String
"LocalBuf" -> Primitive Ugen -> [Ugen]
forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p [Ugen] -> Int -> Ugen
forall a. HasCallStack => [a] -> Int -> a
!! Int
1
      String
_ -> Rate -> Ugen -> Ugen
Db.bufFrames (Ugen -> Rate
rateOf Ugen
u) Ugen
u

-- | 'pv_track_buffer' then 'buffer_nframes'.
pv_track_nframes :: Ugen -> Either String Ugen
pv_track_nframes :: Ugen -> Either String Ugen
pv_track_nframes Ugen
u = Ugen -> Either String Ugen
pv_track_buffer Ugen
u Either String Ugen
-> (Ugen -> Either String Ugen) -> Either String Ugen
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ugen -> Either String Ugen
forall a b. b -> Either a b
Right (Ugen -> Either String Ugen)
-> (Ugen -> Ugen) -> Ugen -> Either String Ugen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ugen -> Ugen
buffer_nframes

{- | Ugen is required to be the root node of complete graph.
This function returns the name of the output Ugen (ie. "Out" or an allowed variant) and the input to that Ugen.
It allows multiple-root graphs.
It is in some sense the inverse of 'wrapOut'.
-}
ugen_remove_out_node :: Ugen -> (String, Ugen)
ugen_remove_out_node :: Ugen -> (String, Ugen)
ugen_remove_out_node Ugen
u =
  let err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"ugen_remove_out_node?"
      assert_is_output :: String -> String
assert_is_output String
x = if String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"Out", String
"ReplaceOut", String
"OffsetOut"] then String
x else String
forall {a}. a
err
  in case Ugen
u of
      Primitive_U (Primitive Rate
Rate.AudioRate String
nm (Ugen
_bus : [Ugen]
inputs) [] Special
_special UgenId
_uid Brackets
_brk) -> (String -> String
assert_is_output String
nm, [Ugen] -> Ugen
mce [Ugen]
inputs)
      Mrg_U (Mrg Ugen
lhs Ugen
rhs) -> let (String
nm, Ugen
res) = Ugen -> (String, Ugen)
ugen_remove_out_node Ugen
lhs in (String
nm, Mrg Ugen -> Ugen
Mrg_U (Ugen -> Ugen -> Mrg Ugen
forall t. t -> t -> Mrg t
Mrg Ugen
res Ugen
rhs))
      Ugen
_ -> (String, Ugen)
forall {a}. a
err