{-# LANGUAGE
     DataKinds
   , FlexibleContexts
   , OverloadedStrings
   #-}

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

module Vivid.UGens.Filters.Linear (
     apf
   , bpf
   , bpz2
   , brf
   , brz2
---   , changed
   , decay
   , decay2
---   , dynKlank
   , fos
   , formlet
   , hpf
   , hpz1
   , hpz2
   , integrator
   , klank
   , lag
   , lag2
   , lag3
   , leakDC
   , lpf
   , lpz1
   , lpz2
   , midEQ
   , onePole
   , oneZero
   , rhpf
   , rlpf
   , ramp
   , resonz
   , ringz
   , sos
   , slope
   , twoPole
   , twoZero
---   , varLag
   ) where

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

import Control.Monad (forM)
import qualified Data.ByteString.UTF8 as UTF8
import Data.Monoid
import Data.Proxy

-- import Data.ByteString (ByteString)

apf :: (Args '["in"] '["freq", "radius"] a) => a -> SDBody a Signal
apf :: a -> SDBody a Signal
apf = String
-> CalculationRate
-> Vs '["in", "freq", "radius"]
-> (UA "freq" (SDBodyArgs a), UA "radius" (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
"APF" CalculationRate
AR
   (Vs '["in", "freq", "radius"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "radius"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "radius" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "radius" as
radius_ (Float
0.8::Float))

-- | Band-pass filter
-- 
--   Rq: bandwidth / cutofffreq
bpf :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal
bpf :: a -> SDBody a Signal
bpf = String
-> CalculationRate
-> Vs '["in", "freq", "rq"]
-> (UA "freq" (SDBodyArgs a), UA "rq" (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
"BPF" CalculationRate
AR
   (Vs '["in", "freq", "rq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "rq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "rq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rq" as
rq_ (Float
1::Float))

bpz2 :: (Args '["in"] '[] a) => a -> SDBody a Signal
bpz2 :: a -> SDBody a Signal
bpz2 = String
-> CalculationRate
-> Vs '["in"]
-> 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
"BPZ2" CalculationRate
AR
   (Vs '["in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

brf :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal
brf :: a -> SDBody a Signal
brf = String
-> CalculationRate
-> Vs '["in", "freq", "rq"]
-> (UA "freq" (SDBodyArgs a), UA "rq" (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
"BRF" CalculationRate
AR
   (Vs '["in", "freq", "rq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "rq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "rq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rq" as
rq_ (Float
1::Float))

brz2 :: (Args '["in"] '[] a) => a -> SDBody a Signal
brz2 :: a -> SDBody a Signal
brz2 = String
-> CalculationRate
-> Vs '["in"]
-> 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
"BRZ2" CalculationRate
AR
   (Vs '["in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

--- changed ::
--- changed =

decay :: (Args '["in"] '["decaySecs"] a) => a -> SDBody a Signal
decay :: a -> SDBody a Signal
decay = String
-> CalculationRate
-> Vs '["in", "decaySecs"]
-> UA "decaySecs" (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
"Decay" CalculationRate
AR
   (Vs '["in", "decaySecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "decaySecs"])
   (Float -> UA "decaySecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "decaySecs" as
decayTime_ (Float
1::Float))

decay2 :: (Args '["in"] '["attackSecs", "decaySecs"] a) => a -> SDBody a Signal
decay2 :: a -> SDBody a Signal
decay2 = String
-> CalculationRate
-> Vs '["in", "attackSecs", "decaySecs"]
-> (UA "attackSecs" (SDBodyArgs a), UA "decaySecs" (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
"Decay2" CalculationRate
AR
   (Vs '["in", "attackSecs", "decaySecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "attackSecs", "decaySecs"])
   (Float -> UA "attackSecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "attackSecs" as
attackTime_ (Float
0.01::Float), Float -> UA "decaySecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "decaySecs" as
decayTime_ (Float
1::Float))

--- dynKlank ::
--- dynKlank =

fos :: (Args '["in"] '["a0", "a1", "b1"] a) => a -> SDBody a Signal
fos :: a -> SDBody a Signal
fos = String
-> CalculationRate
-> Vs '["in", "a0", "a1", "b1"]
-> (UA "a0" (SDBodyArgs a), UA "a1" (SDBodyArgs a),
    UA "b1" (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
"FOS" CalculationRate
AR
   (Vs '["in", "a0", "a1", "b1"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "a0", "a1", "b1"])
   (Float -> UA "a0" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a0" as
a0_ (Float
0::Float), Float -> UA "a1" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a1" as
a1_ (Float
0::Float), Float -> UA "b1" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "b1" as
b1_ (Float
0::Float))

formlet :: (Args '["in"] '["freq", "attackSecs", "decaySecs"] a) => a -> SDBody a Signal
formlet :: a -> SDBody a Signal
formlet = String
-> CalculationRate
-> Vs '["in", "freq", "attackSecs", "decaySecs"]
-> (UA "freq" (SDBodyArgs a), UA "attackSecs" (SDBodyArgs a),
    UA "decaySecs" (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
"Formlet" CalculationRate
AR
   (Vs '["in", "freq", "attackSecs", "decaySecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "attackSecs", "decaySecs"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "attackSecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "attackSecs" as
attackTime_ (Float
1::Float), Float -> UA "decaySecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "decaySecs" as
decayTime_ (Float
1::Float))

-- | High-pass filter
hpf :: (Args '["in"] '["freq"] a) => a -> SDBody a Signal
hpf :: a -> SDBody a Signal
hpf = String -> a -> SDBody a Signal
forall a.
Args '["in"] '["freq"] a =>
String -> a -> SDBody a Signal
passFilter String
"HPF"

hpz1 :: (Args '["in"] '[] a) => a -> SDBody a Signal
hpz1 :: a -> SDBody a Signal
hpz1 = String
-> CalculationRate
-> Vs '["in"]
-> 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
"HPZ1" CalculationRate
AR
   (Vs '["in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

hpz2 :: Args '["in"] '[] a => a -> SDBody a Signal
hpz2 :: a -> SDBody a Signal
hpz2 = String
-> CalculationRate
-> Vs '["in"]
-> 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
"HPZ2" CalculationRate
AR
   (Vs '["in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

integrator :: Args '["in"] '["coef"] a => a -> SDBody a Signal
integrator :: a -> SDBody a Signal
integrator = String
-> CalculationRate
-> Vs '["in", "coef"]
-> UA "coef" (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
"Integrator" CalculationRate
AR
   (Vs '["in", "coef"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "coef"])
   (Float -> UA "coef" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "coef" as
coef_ (Float
1::Float))


-- todo: i want either 'freqScale' or a way to pass in params to the list of frequencies

-- | \"Klank is a bank of fixed frequency resonators which can be used to simulate the resonant modes of an object. Each mode is given a ring time, which is the time for the mode to decay by 60 dB\"
-- 
--   The 'in_' argument is \"the excitation input to the resonant filter bank\"
-- 
--   Each tuple in the list argument is a triple of frequency, amplitude, and ring time
-- 
--   Can only run in 'AR'
klank :: (Args '["in"] '["freqScale", "freqOffset", "decayScale"] a, ToSig freq (SDBodyArgs a), ToSig amp (SDBodyArgs a), ToSig ring (SDBodyArgs a)) => a -> [(freq, amp, ring)] -> SDBody a Signal
klank :: a -> [(freq, amp, ring)] -> SDBody a Signal
klank a
args [(freq, amp, ring)]
resonators = do
   Signal
in' <- a -> Proxy "in" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
uaArgVal a
args (Proxy "in"
forall k (t :: k). Proxy t
Proxy::Proxy "in")
   Signal
freqscale <-  Integer -> a -> Proxy "freqScale" -> SDBody a Signal
forall as (aToLookUp :: Symbol) defaultVal (proxy :: Symbol -> *).
(FromUA as, KnownSymbol aToLookUp,
 ToSig defaultVal (SDBodyArgs as)) =>
defaultVal -> as -> proxy aToLookUp -> SDBody as Signal
uaArgValWDefault Integer
1 a
args (Proxy "freqScale"
forall k (t :: k). Proxy t
Proxy::Proxy "freqScale")
   Signal
freqoffset <- Integer -> a -> Proxy "freqOffset" -> SDBody a Signal
forall as (aToLookUp :: Symbol) defaultVal (proxy :: Symbol -> *).
(FromUA as, KnownSymbol aToLookUp,
 ToSig defaultVal (SDBodyArgs as)) =>
defaultVal -> as -> proxy aToLookUp -> SDBody as Signal
uaArgValWDefault Integer
0 a
args (Proxy "freqOffset"
forall k (t :: k). Proxy t
Proxy::Proxy "freqOffset")
   Signal
decayscale <- Integer -> a -> Proxy "decayScale" -> SDBody a Signal
forall as (aToLookUp :: Symbol) defaultVal (proxy :: Symbol -> *).
(FromUA as, KnownSymbol aToLookUp,
 ToSig defaultVal (SDBodyArgs as)) =>
defaultVal -> as -> proxy aToLookUp -> SDBody as Signal
uaArgValWDefault Integer
1 a
args (Proxy "decayScale"
forall k (t :: k). Proxy t
Proxy::Proxy "decayScale")
   [[Signal]]
resonators' <- [(freq, amp, ring)]
-> ((freq, amp, ring)
    -> StateT
         ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
         Identity
         [Signal])
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     [[Signal]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(freq, amp, ring)]
resonators (((freq, amp, ring)
  -> StateT
       ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
       Identity
       [Signal])
 -> StateT
      ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
      Identity
      [[Signal]])
-> ((freq, amp, ring)
    -> StateT
         ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
         Identity
         [Signal])
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     [[Signal]]
forall a b. (a -> b) -> a -> b
$ \(freq
freq, amp
amp, ring
ring) -> do
      Signal
f <- freq -> SDBody a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig freq
freq
      Signal
a <- amp -> SDBody a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig amp
amp
      Signal
r <- ring -> SDBody a Signal
forall s (args :: [Symbol]).
ToSig s args =>
s -> SDBody' args Signal
toSig ring
ring
      [Signal]
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     [Signal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Signal
f, Signal
a, Signal
r]
   let outs :: [Signal]
outs = [
            Signal
in'
          , Signal
freqscale
          , Signal
freqoffset
          , Signal
decayscale
          ] [Signal] -> [Signal] -> [Signal]
forall a. Semigroup a => a -> a -> a
<> [[Signal]] -> [Signal]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Signal]]
resonators'
   UGen -> SDBody a Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addMonoUGen (UGen -> SDBody a Signal) -> UGen -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ UGenName -> CalculationRate -> [Signal] -> Int -> UGen
UGen (ByteString -> UGenName
UGName_S (String -> ByteString
UTF8.fromString String
"Klank")) CalculationRate
AR [Signal]
outs Int
1

{-
3 "Klank" - AR (1 outputs)
  UGOut: (2,0) -- "excitation input" thing
  Constant: 1.0 (index 3) -- freqscale
  Constant: 0.0 (index 4) -- freqoffset
  Constant: 1.0 (index 5) -- decayscale

  Constant: 220.0 (index 6) -- frequency
  Constant: 0.5 (index 7)   -- amplitude
  Constant: 1.0 (index 8)   -- rungTime

  Constant: 440.0 (index 9)
  Constant: 1.0 (index 8)
  Constant: 1.0 (index 8)

  Constant: 880.0 (index 10)
  Constant: 0.5 (index 7)
  Constant: 1.0 (index 8)
-}

-- | The \"lagSecs\" arg is the same as the \"lagTime\" arg in SC
--   (you can use 'Vivid.UGens.Args.lagTime_' if you like)
--
--   The calculation rate of this is whatever its \"in\" is (cool, right?)
lag :: Args '["in"] '["lagSecs"] a => a -> SDBody a Signal
lag :: a -> SDBody a Signal
lag a
as = do
   CalculationRate -> SDBody a Signal
makeThing (CalculationRate -> SDBody a Signal)
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
-> SDBody a Signal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Signal
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
forall (args :: [Symbol]). Signal -> SDBody' args CalculationRate
getCalcRate (Signal
 -> StateT
      ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
      Identity
      CalculationRate)
-> SDBody a Signal
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> Proxy "in" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
uaArgVal a
as (Proxy "in"
forall k (t :: k). Proxy t
Proxy::Proxy "in")
 where
   makeThing :: CalculationRate -> SDBody a Signal
makeThing CalculationRate
calcRate = ((a -> SDBody a Signal) -> a -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ a
as) ((a -> SDBody a Signal) -> SDBody a Signal)
-> (a -> SDBody a Signal) -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ String
-> CalculationRate
-> Vs '["in", "lagSecs"]
-> UA "lagSecs" (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
"Lag" CalculationRate
calcRate
      (Vs '["in", "lagSecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "lagSecs"])
      (Float -> UA "lagSecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "lagSecs" as
lagSecs_ (Float
0.1::Float))

-- | 'lag2 (in_ x)' is equal to 'lag (in_ (lag (in_ x)))'
--
--   The calculation rate of this is whatever its \"in\" is
lag2 :: (Args '["in"] '["lagSecs"] a) => a -> SDBody a Signal
lag2 :: a -> SDBody a Signal
lag2 a
as =
   CalculationRate -> SDBody a Signal
makeThing (CalculationRate -> SDBody a Signal)
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
-> SDBody a Signal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Signal
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
forall (args :: [Symbol]). Signal -> SDBody' args CalculationRate
getCalcRate (Signal
 -> StateT
      ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
      Identity
      CalculationRate)
-> SDBody a Signal
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> Proxy "in" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
uaArgVal a
as (Proxy "in"
forall k (t :: k). Proxy t
Proxy::Proxy "in")
 where
   makeThing :: CalculationRate -> SDBody a Signal
makeThing CalculationRate
calcRate = ((a -> SDBody a Signal) -> a -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ a
as) ((a -> SDBody a Signal) -> SDBody a Signal)
-> (a -> SDBody a Signal) -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ String
-> CalculationRate
-> Vs '["in", "lagSecs"]
-> UA "lagSecs" (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
"Lag2" CalculationRate
calcRate
      (Vs '["in", "lagSecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "lagSecs"])
      (Float -> UA "lagSecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "lagSecs" as
lagTime_ (Float
0.1::Float))

-- | 'lag3 (in_ x)' is equal to 'lag (in_ $ lag (in_ $ lag (in_ x)))'
--
--   The calculation rate of this is whatever its \"in\" is
lag3 :: (Args '["in"] '["lagSecs"] a) => a -> SDBody a Signal
lag3 :: a -> SDBody a Signal
lag3 a
as =
   CalculationRate -> SDBody a Signal
makeThing (CalculationRate -> SDBody a Signal)
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
-> SDBody a Signal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Signal
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
forall (args :: [Symbol]). Signal -> SDBody' args CalculationRate
getCalcRate (Signal
 -> StateT
      ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
      Identity
      CalculationRate)
-> SDBody a Signal
-> StateT
     ([Int], SynthDef (SDBodyArgs a), VarSet (SDBodyArgs a))
     Identity
     CalculationRate
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> Proxy "in" -> SDBody a Signal
forall as (aToLookUp :: Symbol) (proxy :: Symbol -> *).
(FromUA as, Elem aToLookUp (UAsArgs as), KnownSymbol aToLookUp) =>
as -> proxy aToLookUp -> SDBody as Signal
uaArgVal a
as (Proxy "in"
forall k (t :: k). Proxy t
Proxy::Proxy "in")
 where
   makeThing :: CalculationRate -> SDBody a Signal
makeThing CalculationRate
calcRate = ((a -> SDBody a Signal) -> a -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ a
as) ((a -> SDBody a Signal) -> SDBody a Signal)
-> (a -> SDBody a Signal) -> SDBody a Signal
forall a b. (a -> b) -> a -> b
$ String
-> CalculationRate
-> Vs '["in", "lagSecs"]
-> UA "lagSecs" (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
"Lag3" CalculationRate
calcRate
      (Vs '["in", "lagSecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "lagSecs"])
      (Float -> UA "lagSecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "lagSecs" as
lagTime_ (Float
0.1::Float))

-- | Note the default for both AR and KR are the same: 0.995. In SC lang, the KR
--   one defaults to 0.9.
leakDC :: (Args '["in"] '["coef"] a) => a -> SDBody a Signal
leakDC :: a -> SDBody a Signal
leakDC = String
-> CalculationRate
-> Vs '["in", "coef"]
-> UA "coef" (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
"LeakDC" CalculationRate
AR
   (Vs '["in", "coef"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "coef"])
   (Float -> UA "coef" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "coef" as
coef_ (Float
0.995::Float))

-- also look at RLPF:
-- | Low-pass filter
lpf :: (Args '["in"] '["freq"] a) => a -> SDBody a Signal
lpf :: a -> SDBody a Signal
lpf = String -> a -> SDBody a Signal
forall a.
Args '["in"] '["freq"] a =>
String -> a -> SDBody a Signal
passFilter String
"LPF"

lpz1 :: (Args '["in"] '[] a) => a -> SDBody a Signal
lpz1 :: a -> SDBody a Signal
lpz1 = String
-> CalculationRate
-> Vs '["in"]
-> 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
"LPZ1" CalculationRate
AR
   (Vs '["in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

lpz2 :: (Args '["in"] '[] a) => a -> SDBody a Signal
lpz2 :: a -> SDBody a Signal
lpz2 = String
-> CalculationRate
-> Vs '["in"]
-> 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
"LPZ2" CalculationRate
AR
   (Vs '["in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- | 'Db' is the boost or attenuation of the signal in decibels
midEQ :: (Args '["in", "freq", "db"] '["rq"] a) => a -> SDBody a Signal
midEQ :: a -> SDBody a Signal
midEQ = String
-> CalculationRate
-> Vs '["in", "freq", "rq", "db"]
-> UA "rq" (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
"MidEQ" CalculationRate
AR
   (Vs '["in", "freq", "rq", "db"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "rq", "db"])
   (Float -> UA "rq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rq" as
rq_ (Float
1::Float))

passFilter :: (Args '["in"] '["freq"] a) => String -> a -> SDBody a Signal
passFilter :: String -> a -> SDBody a Signal
passFilter String
filterName = String
-> CalculationRate
-> Vs '["in", "freq"]
-> UA "freq" (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
filterName CalculationRate
AR
   (Vs '["in", "freq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float))

onePole :: (Args '["in"] '["coef"] a) => a -> SDBody a Signal
onePole :: a -> SDBody a Signal
onePole = String
-> CalculationRate
-> Vs '["in", "coef"]
-> UA "coef" (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
"OnePole" CalculationRate
AR
   (Vs '["in", "coef"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "coef"])
   (Float -> UA "coef" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "coef" as
coef_ (Float
0.5::Float))

oneZero :: (Args '["in"] '["coef"] a) => a -> SDBody a Signal
oneZero :: a -> SDBody a Signal
oneZero = String
-> CalculationRate
-> Vs '["in", "coef"]
-> UA "coef" (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
"OneZero" CalculationRate
AR
   (Vs '["in", "coef"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "coef"])
   (Float -> UA "coef" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "coef" as
coef_ (Float
0.5::Float))

rhpf :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal
rhpf :: a -> SDBody a Signal
rhpf = String
-> CalculationRate
-> Vs '["in", "freq", "rq"]
-> (UA "freq" (SDBodyArgs a), UA "rq" (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
"RHPF" CalculationRate
AR
   (Vs '["in", "freq", "rq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "rq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "rq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rq" as
rq_ (Float
1::Float))

rlpf :: (Args '["in"] '["freq", "rq"] a) => a -> SDBody a Signal
rlpf :: a -> SDBody a Signal
rlpf = String
-> CalculationRate
-> Vs '["in", "freq", "rq"]
-> (UA "freq" (SDBodyArgs a), UA "rq" (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
"RLPF" CalculationRate
AR
   (Vs '["in", "freq", "rq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "rq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "rq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "rq" as
rq_ (Float
1::Float))

ramp :: (Args '["in"] '["lagSecs"] a) => a -> SDBody a Signal
ramp :: a -> SDBody a Signal
ramp = String
-> CalculationRate
-> Vs '["in", "lagSecs"]
-> UA "lagSecs" (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
"Ramp" CalculationRate
AR
   (Vs '["in", "lagSecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "lagSecs"])
   (Float -> UA "lagSecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "lagSecs" as
lagTime_ (Float
0.1::Float))

resonz :: (Args '["in"] '["freq", "bwr"] a) => a -> SDBody a Signal
resonz :: a -> SDBody a Signal
resonz = String
-> CalculationRate
-> Vs '["in", "freq", "bwr"]
-> (UA "freq" (SDBodyArgs a), UA "bwr" (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
"Resonz" CalculationRate
AR
   (Vs '["in", "freq", "bwr"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "bwr"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "bwr" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "bwr" as
bwr_ (Float
1::Float))

ringz :: (Args '["in"] '["freq", "decaySecs"] a) => a -> SDBody a Signal
ringz :: a -> SDBody a Signal
ringz = String
-> CalculationRate
-> Vs '["in", "freq", "decaySecs"]
-> (UA "freq" (SDBodyArgs a), UA "decaySecs" (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
"Ringz" CalculationRate
AR
   (Vs '["in", "freq", "decaySecs"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "decaySecs"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "decaySecs" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "decaySecs" as
decaySecs_ (Float
1::Float))

slope :: (Args '["in"] '[] a) => a -> SDBody a Signal
slope :: a -> SDBody a Signal
slope = String
-> CalculationRate
-> Vs '["in"]
-> 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
"Slope" CalculationRate
AR
   (Vs '["in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

sos :: (Args '["in"] '["a0", "a1", "a2", "b1", "b2"] a) => a -> SDBody a Signal
sos :: a -> SDBody a Signal
sos = String
-> CalculationRate
-> Vs '["in", "a0", "a1", "a2", "b1", "b2"]
-> (UA "a0" (SDBodyArgs a), UA "a1" (SDBodyArgs a),
    UA "a2" (SDBodyArgs a), UA "b1" (SDBodyArgs a),
    UA "b2" (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
"SOS" CalculationRate
AR
   (Vs '["in", "a0", "a1", "a2", "b1", "b2"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "a0", "a1", "a2", "b1", "b2"])
   (Float -> UA "a0" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a0" as
a0_ (Float
0::Float), Float -> UA "a1" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a1" as
a1_ (Float
0::Float), Float -> UA "a2" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a2" as
a2_ (Float
0::Float), Float -> UA "b1" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "b1" as
b1_ (Float
0::Float), Float -> UA "b2" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "b2" as
b2_ (Float
0::Float))

twoPole :: (Args '["in"] '["freq", "radius"] a) => a -> SDBody a Signal
twoPole :: a -> SDBody a Signal
twoPole = String
-> CalculationRate
-> Vs '["in", "freq", "radius"]
-> (UA "freq" (SDBodyArgs a), UA "radius" (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
"TwoPole" CalculationRate
AR
   (Vs '["in", "freq", "radius"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "radius"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "radius" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "radius" as
radius_ (Float
0.8::Float))

twoZero :: (Args '["in"] '["freq", "radius"] a) => a -> SDBody a Signal
twoZero :: a -> SDBody a Signal
twoZero = String
-> CalculationRate
-> Vs '["in", "freq", "radius"]
-> (UA "freq" (SDBodyArgs a), UA "radius" (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
"TwoZero" CalculationRate
AR
   (Vs '["in", "freq", "radius"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "freq", "radius"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
440::Float), Float -> UA "radius" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "radius" as
radius_ (Float
0.8::Float))

--- varLag ::
--- varLag =