{-# LANGUAGE DataKinds #-}

{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}

module Vivid.UGens.Analysis (

     -- * Analysis > Amplitude

     ampComp
---   , ampCompA
   , amplitude
   , detectSilence
---   , loudness
---   , peak
---   , peakFollower
---   , sendPeakRMS

     -- * Analysis > Pitch

---   , keyTrack
   , pitch
---   , zeroCrossing

     -- * Analysis

---   , beatTrack
---   , beatTrack2
---    , mfcc
---   , onsets
     -- In UGens.Maths
   -- , runningSum
     -- In UGens.Filters.Linear:
   -- , slope
   ) where

import Vivid.SC.SynthDef.Types (CalculationRate(..))
import Vivid.SynthDef
import Vivid.SynthDef.FromUA
import Vivid.UGens.Args

-- | "Implements the (optimized) formula:
-- 
--      compensationFactor = (root / freq) ** exp
-- 
--   Higher frequencies are normally perceived as louder, which AmpComp compensates."
-- 
--   "Note that for frequencies very much smaller than root the amplitudes can become very high. In this case limit the freq with freq.max(minval), or use AmpCompA."
-- 
--   Computed at "AR", "KR", or "IR"
ampComp :: (Args '["freq", "root"] '["exponent"] a) => a -> SDBody a Signal
ampComp :: a -> SDBody a Signal
ampComp = String
-> CalculationRate
-> Vs '["freq", "root", "exponent"]
-> UA "exponent" (SDBodyArgs a)
-> a
-> SDBody a Signal
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args Signal
makeUGen
   String
"AmpComp" CalculationRate
AR
   (Vs '["freq", "root", "exponent"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "root", "exponent"])
   (Float -> UA "exponent" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "exponent" as
exponent_ (Float
0.3333::Float))

-- | "Higher frequencies are normally perceived as louder, which AmpCompA compensates. Following the measurings by Fletcher and Munson, the ANSI standard describes a function for loudness vs. frequency.
--   Note that this curve is only valid for standardized amplitude."
-- 
--   _NOTE_ "Apart from freq, the values are not modulatable"


--- ampCompA ::
--- ampCompA =

amplitude :: Args '["in"] '["attackSecs", "releaseSecs"] a => a -> SDBody a Signal
amplitude :: a -> SDBody a Signal
amplitude = String
-> CalculationRate
-> Vs '["in", "attackSecs", "releaseSecs"]
-> (UA "attackSecs" (SDBodyArgs a),
    UA "releaseSecs" (SDBodyArgs a))
-> a
-> SDBody a Signal
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args Signal
makeUGen
   String
"Amplitude" CalculationRate
AR
   (Vs '["in", "attackSecs", "releaseSecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "attackSecs", "releaseSecs"])
   (Float -> UA "attackSecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "attackSecs" as
attackSecs_ (Float
0.01::Float), Float -> UA "releaseSecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "releaseSecs" as
releaseSecs_ (Float
0.01::Float))

detectSilence :: Args '["in"] '["amp", "time", "doneAction"] a => a -> SDBody a Signal
detectSilence :: a -> SDBody a Signal
detectSilence = String
-> CalculationRate
-> Vs '["in", "amp", "time", "doneAction"]
-> (UA "amp" (SDBodyArgs a), UA "time" (SDBodyArgs a),
    UA "doneAction" (SDBodyArgs a))
-> a
-> SDBody a Signal
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args Signal
makeUGen
   String
"DetectSilence" CalculationRate
AR
   (Vs '["in", "amp", "time", "doneAction"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "amp", "time", "doneAction"])
   (Float -> UA "amp" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "amp" as
amp_ (Float
0.0001::Float), Float -> UA "time" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "time" as
time_ (Float
0.1::Float), Float -> UA "doneAction" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "doneAction" as
doneAction_ (Float
0::Float))


--- loudness ::
--- loudness =
--- peak ::
--- peak =
--- peakFollower ::
--- peakFollower =
--- sendPeakRMS ::
--- sendPeakRMS =
--- keyTrack ::
--- keyTrack =

-- | "This is a better pitch follower than ZeroCrossing, but more costly of CPU. For most purposes the default settings can be used and only in needs to be supplied."
--   
--   "[This function] returns two values [...], a freq which is the pitch estimate and hasFreq, which tells whether a pitch was found."
--
--   Note -- as this returns a 2-tuple of 'Signal's -- that you may need to be careful not
--   to accidentally use functions from the Foldable instance for (,) with the return
--   value of 'pitch'.
-- 
--   "Some vowels are still problematic, for instance a wide open mouth sound somewhere between a low pitched short 'a' sound as in 'sat', and long 'i' sound as in 'fire', contains enough overtone energy to confuse the algorithm."
-- 
--   "None of these settings are time variable."
-- 
--   Can only run at "KR"
pitch :: (Args '["in"] '["initFreq", "minFreq", "maxFreq", "execFreq", "maxBinsPerOctave", "median", "ampThreshold", "peakThreshold", "downSample", "clar"] a) => a -> SDBody a (Signal, Signal)
pitch :: a -> SDBody a (Signal, Signal)
pitch = ((\[Signal
a,Signal
b]->(Signal
a,Signal
b)) ([Signal] -> (Signal, Signal))
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     [Signal]
-> SDBody a (Signal, Signal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (StateT
   ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
   Identity
   [Signal]
 -> SDBody a (Signal, Signal))
-> (a
    -> StateT
         ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
         Identity
         [Signal])
-> a
-> SDBody a (Signal, Signal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> String
-> CalculationRate
-> Vs
     '["in", "initFreq", "minFreq", "maxFreq", "execFreq",
       "maxBinsPerOctave", "median", "ampThreshold", "peakThreshold",
       "downSample", "clar"]
-> (UA "initFreq" (SDBodyArgs a), UA "minFreq" (SDBodyArgs a),
    UA "maxFreq" (SDBodyArgs a), UA "execFreq" (SDBodyArgs a),
    UA "maxBinsPerOctave" (SDBodyArgs a), UA "median" (SDBodyArgs a),
    UA "ampThreshold" (SDBodyArgs a),
    UA "peakThreshold" (SDBodyArgs a), UA "downSample" (SDBodyArgs a),
    UA "clar" (SDBodyArgs a))
-> a
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     [Signal]
forall (tags :: [Symbol]) optional userSupplied (args :: [Symbol]).
(GetSymbolVals (Vs tags), FromUA optional, FromUA userSupplied,
 SDBodyArgs optional ~ SDBodyArgs userSupplied,
 SDBodyArgs optional ~ args) =>
Int
-> String
-> CalculationRate
-> Vs tags
-> optional
-> userSupplied
-> SDBody' args [Signal]
makePolyUGen Int
2
   String
"Pitch" CalculationRate
KR
   (Vs
  '["in", "initFreq", "minFreq", "maxFreq", "execFreq",
    "maxBinsPerOctave", "median", "ampThreshold", "peakThreshold",
    "downSample", "clar"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "initFreq", "minFreq", "maxFreq", "execFreq", "maxBinsPerOctave", "median", "ampThreshold", "peakThreshold", "downSample", "clar"])
   (Float -> UA "initFreq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "initFreq" as
initFreq_ (Float
440::Float), Float -> UA "minFreq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "minFreq" as
minFreq_ (Float
60 ::Float), Float -> UA "maxFreq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "maxFreq" as
maxFreq_ (Float
4000 ::Float), Float -> UA "execFreq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "execFreq" as
execFreq_ (Float
100::Float), Float -> UA "maxBinsPerOctave" (SDBodyArgs a)
forall s (as :: [Symbol]).
ToSig s as =>
s -> UA "maxBinsPerOctave" as
maxBinsPerOctave_ (Float
16::Float), Float -> UA "median" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "median" as
median_ (Float
1::Float), Float -> UA "ampThreshold" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "ampThreshold" as
ampThreshold_ (Float
0.01::Float), Float -> UA "peakThreshold" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "peakThreshold" as
peakThreshold_ (Float
0.5::Float), Float -> UA "downSample" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "downSample" as
downSample_ (Float
1::Float), Float -> UA "clar" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "clar" as
clar_ (Float
0::Float))

--- zeroCrossing ::
--- zeroCrossing =
--- beatTrack ::
--- beatTrack =
--- beatTrack2 ::
--- beatTrack2 =
--- mfcc ::
--- mfcc =
--- onsets ::
--- onsets =