{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

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

module Vivid.UGens.FFT (

   -- * Pre and Post

     fft
   , ifft

     -- In Vivid.UGens.Analysis:
   -- , beatTrack
   -- , beatTrack2
     -- In Vivid.UGens.Convolution:
   -- , convolution
   -- , convolution2
   -- , convolution2L
---   , fftTrigger
---   , packFFT
     -- In Vivid.UGens.Convolution:
   -- , partConv
---   , specCentroid
---   , specFlatness
---   , specPcile
     -- In Vivid.UGens.Convolution:
   -- , stereoConvolution2L
---   , unpack1FFT
---   , unpackFFT

   -- * FFT functions

   , pv_add
   , pv_binScramble
   , pv_binShift
---   , pv_binWipe
   , pv_brickWall
---   , pv_chainUGen
   , pv_conformalMap
   , pv_conj
   , pv_copy
   , pv_copyPhase
   , pv_diffuser
   , pv_div
---   , pv_hainsworthFoote
---   , pv_jensenAndersen
   , pv_localMax
   , pv_magAbove
   , pv_magBelow
   , pv_magClip
---   , pv_magDiv
   , pv_magFreeze
---   , pv_magMul
   , pv_magNoise
   , pv_magShift
   , pv_magSmear
   , pv_magSquared
   , pv_max
   , pv_min
   , pv_mul
   , pv_phaseShift
   , pv_phaseShift270
   , pv_phaseShift90
   , pv_randComb
---   , pv_randWipe
   , pv_rectComb
---   , pv_rectComb2
   ) where

import Data.ByteString (ByteString)

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

-- | You can use "wintype_" and "winsize_" if you're used to the SC args:
fft :: (Args '["buf"] '["in", "hop", "windowType", "active", "windowSize"] a) => a -> SDBody a Signal
fft :: a -> SDBody a Signal
fft = String
-> CalculationRate
-> Vs '["buf", "in", "hop", "windowType", "active", "windowSize"]
-> (UA "in" (SDBodyArgs a), UA "hop" (SDBodyArgs a),
    UA "windowType" (SDBodyArgs a), UA "active" (SDBodyArgs a),
    UA "windowSize" (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
"FFT" CalculationRate
KR
   (Vs '["buf", "in", "hop", "windowType", "active", "windowSize"]
forall (a :: [Symbol]). Vs a
Vs::Vs ["buf", "in", "hop", "windowType", "active", "windowSize"])
   (Float -> UA "in" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "in" as
in_ (Float
0::Float), Float -> UA "hop" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "hop" as
hop_ (Float
0.5::Float), Float -> UA "windowType" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "windowType" as
wintype_ (Float
0::Float), Float -> UA "active" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "active" as
active_ (Float
1::Float), Float -> UA "windowSize" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "windowSize" as
winsize_ (Float
0::Float))

-- | You can use "wintype_" and "winsize_" if you're used to the SC args:
ifft :: (Args '["buf"] '["windowType", "windowSize"] a) => a -> SDBody a Signal
ifft :: a -> SDBody a Signal
ifft =
   String
-> CalculationRate
-> Vs '["buf", "windowType", "windowSize"]
-> (UA "windowType" (SDBodyArgs a), UA "windowSize" (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
"IFFT" CalculationRate
AR
   (Vs '["buf", "windowType", "windowSize"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "windowType", "windowSize"])
   (Float -> UA "windowType" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "windowType" as
wintype_ (Float
0::Float), Float -> UA "windowSize" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "windowSize" as
winsize_ (Float
0::Float))

--- fftTrigger ::
--- fftTrigger =

--- packFFT :: Args ["buf","bufsize","magsphases","tobin"] '["frombin","zeroothers"] a => a -> SDBody a Signal
--- packFFT =
-- frombin: 0, zeroothers: 0

{-
"
Given an FFT chain, this measures the spectral centroid, which is the weighted mean frequency, or the "centre of mass" of the spectrum. (DC is ignored.)
This can be a useful indicator of the perceptual brightness of a signal.
"
-}

--- specCentroid ::
--- specCentroid =

--- specFlatness ::
--- specFlatness =

--- specPcile ::
--- specPcile =

--- unpack1FFT :: Args '["chain","bufsize","binindex"] '["whichmeasure"] a => SDBody a Signal
--- unpack1FFT =
-- whichmeasure: 0

--- unpackFFT :: Args '["chain","bufsize","tobin"] '["frombin"] a => SDBody a Signal
--- unpackFFT =
-- frombin: 0

pv_add :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal
pv_add :: bufA -> bufB -> SDBody' as Signal
pv_add =
   ByteString -> bufA -> bufB -> SDBody' as Signal
forall s0 (as :: [Symbol]) s1.
(ToSig s0 as, ToSig s1 as) =>
ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen ByteString
"PV_Add"

pv_binScramble :: (Args '["buf"] '["wipe", "width", "trigger"] a) => a -> SDBody a Signal
pv_binScramble :: a -> SDBody a Signal
pv_binScramble = String
-> CalculationRate
-> Vs '["buf", "wipe", "width", "trigger"]
-> (UA "wipe" (SDBodyArgs a), UA "width" (SDBodyArgs a),
    UA "trigger" (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
"PV_BinScramble" CalculationRate
KR
   (Vs '["buf", "wipe", "width", "trigger"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "wipe", "width", "trigger"])
   (Float -> UA "wipe" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "wipe" as
wipe_ (Float
0::Float), Float -> UA "width" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "width" as
width_ (Float
0.2::Float), Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trigger_ (Float
0::Float))

pv_binShift :: (Args '["buf"] '["stretch", "shift", "interp"] a) => a -> SDBody a Signal
pv_binShift :: a -> SDBody a Signal
pv_binShift = String
-> CalculationRate
-> Vs '["buf", "stretch", "shift", "interp"]
-> (UA "stretch" (SDBodyArgs a), UA "shift" (SDBodyArgs a),
    UA "interp" (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
"PV_BinShift" CalculationRate
KR
   (Vs '["buf", "stretch", "shift", "interp"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "stretch", "shift", "interp"])
   (Float -> UA "stretch" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "stretch" as
stretch_ (Float
1::Float), Float -> UA "shift" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "shift" as
shift_ (Float
0::Float), Float -> UA "interp" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "interp" as
interp_ (Float
0::Float))

--- pv_binWipe ::
--- pv_binWipe =

pv_brickWall :: (Args '["buf"] '["wipe"] a) => a -> SDBody a Signal
pv_brickWall :: a -> SDBody a Signal
pv_brickWall = String
-> CalculationRate
-> Vs '["buf", "wipe"]
-> UA "wipe" (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
"PV_BrickWall" CalculationRate
KR
   (Vs '["buf", "wipe"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "wipe"])
   (Float -> UA "wipe" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "wipe" as
wipe_ (Float
0::Float))

--- pv_chainUGen ::
--- pv_chainUGen =

pv_conformalMap :: (Args '["buf"] '["aReal", "aImag"] a) => a -> SDBody a Signal
pv_conformalMap :: a -> SDBody a Signal
pv_conformalMap = String
-> CalculationRate
-> Vs '["buf", "aReal", "aImag"]
-> (UA "aReal" (SDBodyArgs a), UA "aImag" (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
"PV_ConformalMap" CalculationRate
KR
   (Vs '["buf", "aReal", "aImag"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "aReal","aImag"])
   (Float -> UA "aReal" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "aReal" as
aReal_ (Float
0::Float), Float -> UA "aImag" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "aImag" as
aImag_ (Float
0::Float))

pv_conj :: (Args '["buf"] '[] a) => a -> SDBody a Signal
pv_conj :: a -> SDBody a Signal
pv_conj = String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults (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
"PV_Conj" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

pv_copy :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal
pv_copy :: bufA -> bufB -> SDBody' as Signal
pv_copy =
   ByteString -> bufA -> bufB -> SDBody' as Signal
forall s0 (as :: [Symbol]) s1.
(ToSig s0 as, ToSig s1 as) =>
ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen ByteString
"PV_Copy"

pv_copyPhase :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal
pv_copyPhase :: bufA -> bufB -> SDBody' as Signal
pv_copyPhase =
   ByteString -> bufA -> bufB -> SDBody' as Signal
forall s0 (as :: [Symbol]) s1.
(ToSig s0 as, ToSig s1 as) =>
ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen ByteString
"PV_CopyPhase"


twoArgUGen :: (ToSig s0 as, ToSig s1 as) => ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen :: ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen ByteString
ugenName s0
s0 s1
s1 = do
   Signal
s0' <- s0 -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig s0
s0
   Signal
s1' <-  s1 -> SDBody' as Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig s1
s1
   UGen -> SDBody' as Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addMonoUGen (UGen -> SDBody' as Signal) -> UGen -> SDBody' as Signal
forall a b. (a -> b) -> a -> b
$ UGenName -> CalculationRate -> [Signal] -> Int -> UGen
UGen (ByteString -> UGenName
UGName_S ByteString
ugenName) CalculationRate
KR [Signal
s0', Signal
s1'] Int
1


pv_diffuser :: (Args '["buf"] '["trigger"] a) => a -> SDBody a Signal
pv_diffuser :: a -> SDBody a Signal
pv_diffuser = String
-> CalculationRate
-> Vs '["buf", "trigger"]
-> UA "trigger" (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
"PV_Diffuser" CalculationRate
KR
   (Vs '["buf", "trigger"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "trigger"])
   (Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trig_ (Float
0::Float))

pv_div :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal
pv_div :: bufA -> bufB -> SDBody' as Signal
pv_div =
   ByteString -> bufA -> bufB -> SDBody' as Signal
forall s0 (as :: [Symbol]) s1.
(ToSig s0 as, ToSig s1 as) =>
ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen ByteString
"PV_Div"

--- pv_hainsworthFoote ::
--- pv_hainsworthFoote =
--- pv_jensenAndersen ::
--- pv_jensenAndersen =

pv_localMax :: (Args '["buf"] '["threshold"] a) => a -> SDBody a Signal
pv_localMax :: a -> SDBody a Signal
pv_localMax = String
-> CalculationRate
-> Vs '["buf", "threshold"]
-> UA "threshold" (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
"PV_LocalMax" CalculationRate
KR
   (Vs '["buf", "threshold"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "threshold"])
   (Float -> UA "threshold" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "threshold" as
threshold_ (Float
0::Float))

pv_magAbove :: (Args '["buf", "threshold"] '[] a) => a -> SDBody a Signal
pv_magAbove :: a -> SDBody a Signal
pv_magAbove = String
-> CalculationRate
-> Vs '["buf", "threshold"]
-> NoDefaults (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
"PV_MagAbove" CalculationRate
KR
   (Vs '["buf", "threshold"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "threshold"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

pv_magBelow :: (Args '["buf", "threshold"] '[] a) => a -> SDBody a Signal
pv_magBelow :: a -> SDBody a Signal
pv_magBelow = String
-> CalculationRate
-> Vs '["buf", "threshold"]
-> NoDefaults (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
"PV_MagBelow" CalculationRate
KR
   (Vs '["buf", "threshold"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "threshold"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

pv_magClip :: (Args '["buf", "threshold"] '[] a) => a -> SDBody a Signal
pv_magClip :: a -> SDBody a Signal
pv_magClip = String
-> CalculationRate
-> Vs '["buf", "threshold"]
-> NoDefaults (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
"PV_MagClip" CalculationRate
KR
   (Vs '["buf", "threshold"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "threshold"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

--- pv_magDiv ::
--- pv_magDiv =

pv_magFreeze :: (Args '["buf"] '["freeze"] a) => a -> SDBody a Signal
pv_magFreeze :: a -> SDBody a Signal
pv_magFreeze = String
-> CalculationRate
-> Vs '["buf", "freeze"]
-> UA "freeze" (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
"PV_MagFreeze" CalculationRate
KR
   (Vs '["buf", "freeze"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "freeze"])
   (Float -> UA "freeze" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freeze" as
freeze_ (Float
0::Float))

--- pv_magMul ::
--- pv_magMul =

pv_magNoise :: (Args '["buf"] '[] a) => a -> SDBody a Signal
pv_magNoise :: a -> SDBody a Signal
pv_magNoise = String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults (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
"PV_MagNoise" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

pv_magShift :: (Args '["buf"] '["stretch", "shift"] a) => a -> SDBody a Signal
pv_magShift :: a -> SDBody a Signal
pv_magShift = String
-> CalculationRate
-> Vs '["buf", "stretch", "shift"]
-> (UA "stretch" (SDBodyArgs a), UA "shift" (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
"PV_MagShift" CalculationRate
KR
   (Vs '["buf", "stretch", "shift"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "stretch", "shift"])
   (Float -> UA "stretch" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "stretch" as
stretch_ (Float
1::Float), Float -> UA "shift" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "shift" as
shift_ (Float
0::Float))

-- | "As [the number of bins] rises, so will CPU usage."
pv_magSmear :: (Args '["buf"] '["bins"] a) => a -> SDBody a Signal
pv_magSmear :: a -> SDBody a Signal
pv_magSmear = String
-> CalculationRate
-> Vs '["buf", "bins"]
-> UA "bins" (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
"PV_MagSmear" CalculationRate
KR
   (Vs '["buf", "bins"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "bins"])
   (Float -> UA "bins" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "bins" as
bins_ (Float
0::Float))

pv_magSquared :: (Args '["buf"] '[] a) => a -> SDBody a Signal
pv_magSquared :: a -> SDBody a Signal
pv_magSquared = String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults (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
"PV_MagSquared" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

pv_max :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal
pv_max :: bufA -> bufB -> SDBody' as Signal
pv_max =
   ByteString -> bufA -> bufB -> SDBody' as Signal
forall s0 (as :: [Symbol]) s1.
(ToSig s0 as, ToSig s1 as) =>
ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen ByteString
"PV_Max"

pv_min :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal
pv_min :: bufA -> bufB -> SDBody' as Signal
pv_min =
   ByteString -> bufA -> bufB -> SDBody' as Signal
forall s0 (as :: [Symbol]) s1.
(ToSig s0 as, ToSig s1 as) =>
ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen ByteString
"PV_Min"

pv_mul :: (ToSig bufA as, ToSig bufB as) => bufA -> bufB -> SDBody' as Signal
pv_mul :: bufA -> bufB -> SDBody' as Signal
pv_mul =
   ByteString -> bufA -> bufB -> SDBody' as Signal
forall s0 (as :: [Symbol]) s1.
(ToSig s0 as, ToSig s1 as) =>
ByteString -> s0 -> s1 -> SDBody' as Signal
twoArgUGen ByteString
"PV_Mul"

pv_phaseShift :: (Args '["buf", "shift"] '["integrate"] a) => a -> SDBody a Signal
pv_phaseShift :: a -> SDBody a Signal
pv_phaseShift = String
-> CalculationRate
-> Vs '["buf", "shift", "integrate"]
-> UA "integrate" (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
"PV_PhaseShift" CalculationRate
KR
   (Vs '["buf", "shift", "integrate"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "shift", "integrate"])
   (Float -> UA "integrate" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "integrate" as
integrate_ (Float
0::Float))

pv_phaseShift270 :: (Args '["buf"] '[] a) => a -> SDBody a Signal
pv_phaseShift270 :: a -> SDBody a Signal
pv_phaseShift270 = String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults (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
"PV_PhaseShift270" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

pv_phaseShift90 :: (Args '["buf"] '[] a) => a -> SDBody a Signal
pv_phaseShift90 :: a -> SDBody a Signal
pv_phaseShift90 = String
-> CalculationRate
-> Vs '["buf"]
-> NoDefaults (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
"PV_PhaseShift90" CalculationRate
KR
   (Vs '["buf"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

pv_randComb :: (Args '["buf"] '["wipe", "trigger"] a) => a -> SDBody a Signal
pv_randComb :: a -> SDBody a Signal
pv_randComb = String
-> CalculationRate
-> Vs '["buf", "wipe", "trigger"]
-> (UA "wipe" (SDBodyArgs a), UA "trigger" (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
"PV_RandComb" CalculationRate
KR
   (Vs '["buf", "wipe", "trigger"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "wipe", "trigger"])
   (Float -> UA "wipe" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "wipe" as
wipe_ (Float
0::Float), Float -> UA "trigger" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "trigger" as
trigger_ (Float
0::Float))

--- pv_randWipe ::
--- pv_randWipe =

-- Possibly "numTeeth" should be required:
-- | "Alternates blocks of bins between the two inputs."
pv_rectComb :: (Args '["buf"] '["numTeeth", "phase", "width"] a) => a -> SDBody a Signal
pv_rectComb :: a -> SDBody a Signal
pv_rectComb = String
-> CalculationRate
-> Vs '["buf", "numTeeth", "phase", "width"]
-> (UA "numTeeth" (SDBodyArgs a), UA "phase" (SDBodyArgs a),
    UA "width" (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
"PV_RandComb" CalculationRate
KR
   (Vs '["buf", "numTeeth", "phase", "width"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["buf", "numTeeth", "phase", "width"])
   (Float -> UA "numTeeth" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "numTeeth" as
numTeeth_ (Float
0::Float), Float -> UA "phase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "phase" as
phase_ (Float
0::Float), Float -> UA "width" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "width" as
width_ (Float
0.5::Float))

-- Possibly "numTeeth" should be required:
--- pv_rectComb2 ::
--- pv_rectComb2 =