-- | 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.UGen.MCE as MCE {- hsc3 -}
import Sound.SC3.UGen.Type

-- | UGen primitive set.
--   Sees through Proxy and MRG, possible multiple primitives for MCE.
ugen_primitive_set :: UGen -> [Primitive]
ugen_primitive_set :: UGen -> [Primitive]
ugen_primitive_set UGen
u =
    case UGen
u of
      Constant_U Constant
_ -> []
      Control_U Control
_ -> []
      Label_U Label
_ -> []
      Primitive_U Primitive
p -> [Primitive
p]
      Proxy_U Proxy
p -> [Proxy -> Primitive
proxySource Proxy
p]
      MCE_U MCE UGen
m -> (UGen -> [Primitive]) -> [UGen] -> [Primitive]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UGen -> [Primitive]
ugen_primitive_set (MCE UGen -> [UGen]
forall t. MCE t -> [t]
MCE.mce_elem MCE UGen
m)
      MRG_U MRG
m -> UGen -> [Primitive]
ugen_primitive_set (MRG -> UGen
mrgLeft MRG
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 -> Bool) -> [Primitive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
primitive_is_pv_rate (String -> Bool) -> (Primitive -> String) -> Primitive -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Primitive -> String
ugenName) ([Primitive] -> Bool) -> (UGen -> [Primitive]) -> UGen -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> [Primitive]
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_primitive_set UGen
u of
      [] -> String -> Either String UGen
forall a b. a -> Either a b
Left String
"pv_track_buffer: not located"
      Primitive
p:[Primitive]
_ -> case Primitive -> String
ugenName Primitive
p of
               String
"FFT" -> UGen -> Either String UGen
forall a b. b -> Either a b
Right (Primitive -> [UGen]
ugenInputs Primitive
p [UGen] -> Int -> UGen
forall a. [a] -> Int -> a
!! Int
0)
               String
"PV_Split" -> UGen -> Either String UGen
forall a b. b -> Either a b
Right (Primitive -> [UGen]
ugenInputs Primitive
p [UGen] -> Int -> UGen
forall a. [a] -> Int -> a
!! Int
1)
               String
_ -> UGen -> Either String UGen
pv_track_buffer (Primitive -> [UGen]
ugenInputs Primitive
p [UGen] -> Int -> UGen
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_primitive_set UGen
u of
      [] -> Rate -> UGen -> UGen
DB.bufFrames (UGen -> Rate
rateOf UGen
u) UGen
u
      Primitive
p:[Primitive]
_ -> case Primitive -> String
ugenName Primitive
p of
               String
"LocalBuf" -> Primitive -> [UGen]
ugenInputs Primitive
p [UGen] -> Int -> UGen
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 Either String UGen
-> (UGen -> Either String UGen) -> Either String UGen
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 (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.AR String
nm (UGen
_bus:[UGen]
inputs) [] Special
_special UGenId
_uid) -> (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
MRG_U (UGen -> UGen -> MRG
MRG UGen
res UGen
rhs))
       UGen
_ -> (String, UGen)
forall a. a
err