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

import Data.List {- base -}

import qualified Sound.Sc3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.Sc3.Ugen.Bindings.Db as Db {- hsc3 -}
import qualified Sound.Sc3.Common.Mce as Mce {- 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 -> [forall t. Proxy t -> Primitive t
proxySource Proxy Ugen
p]
      Mce_U Mce Ugen
m -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ugen -> [Primitive Ugen]
ugen_primitive_set (forall t. Mce t -> [t]
Mce.mce_to_list Mce Ugen
m)
      Mrg_U Mrg Ugen
m -> Ugen -> [Primitive Ugen]
ugen_primitive_set (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 forall a. Eq a => a -> a -> Bool
== String
"FFT" Bool -> Bool -> Bool
|| String
"PV_" 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
primitive_is_pv_rate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Primitive t -> String
ugenName) 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
      [] -> forall a b. a -> Either a b
Left String
"pv_track_buffer: not located"
      Primitive Ugen
p:[Primitive Ugen]
_ -> case forall t. Primitive t -> String
ugenName Primitive Ugen
p of
               String
"FFT" -> forall a b. b -> Either a b
Right (forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p forall a. [a] -> Int -> a
!! Int
0)
               String
"PV_Split" -> forall a b. b -> Either a b
Right (forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p forall a. [a] -> Int -> a
!! Int
1)
               String
_ -> Ugen -> Either String Ugen
pv_track_buffer (forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p forall a. [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 forall t. Primitive t -> String
ugenName Primitive Ugen
p of
               String
"LocalBuf" -> forall t. Primitive t -> [t]
ugenInputs Primitive Ugen
p forall a. [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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. b -> Either a b
Right 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 = forall a. HasCallStack => String -> a
error String
"ugen_remove_out_node?"
      assert_is_output :: String -> String
assert_is_output String
x = if String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"Out", String
"ReplaceOut", String
"OffsetOut"] then String
x else 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 (forall t. t -> t -> Mrg t
Mrg Ugen
res Ugen
rhs))
       Ugen
_ -> forall {a}. a
err