{-# LANGUAGE DataKinds #-}

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

module Vivid.UGens.Filters.Nonlinear (
     ball
     -- In Vivid.UGens.Filters.Pitch:
   -- , freqShift
   , hasher
---   , hilbert
---   , hilbertFIR
   , mantissaMask
   , median
   , slew
   , spring
   , tBall
   ) where

import Vivid.SC.SynthDef.Types (CalculationRate(..))
import Vivid.SynthDef ({- SDBody, -} Signal)
import Vivid.UGens.Args
import Vivid.SynthDef.FromUA
import Vivid.SynthDef.TypesafeArgs

ball :: (Args '["in"] '["g", "damp", "friction"] a) => a -> SDBody a Signal
ball :: a -> SDBody a Signal
ball = String
-> CalculationRate
-> Vs '["in", "g", "damp", "friction"]
-> (UA "g" (SDBodyArgs a), UA "damp" (SDBodyArgs a),
    UA "friction" (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
"Ball" CalculationRate
AR
   (Vs '["in", "g", "damp", "friction"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "g", "damp", "friction"])
   (Float -> UA "g" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "g" as
g_ (Float
1::Float), Float -> UA "damp" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "damp" as
damp_ (Float
0::Float), Float -> UA "friction" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "friction" as
friction_ (Float
0.01::Float))

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

-- returns 2 channels -- also only has an AR instance
--- hilbert ::
--- hilbert =
--see "hilbert":
--- hilbertFIR ::
--- hilbertFIR =

mantissaMask :: (Args '["in"] '["bits"] a) => a -> SDBody a Signal
mantissaMask :: a -> SDBody a Signal
mantissaMask = String
-> CalculationRate
-> Vs '["in", "bits"]
-> UA "bits" (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
"MantissaMask" CalculationRate
AR
   (Vs '["in", "bits"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "bits"])
   (Float -> UA "bits" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "bits" as
bits_ (Float
3::Float))

median :: (Args '["in"] '["length"] a) => a -> SDBody a Signal
median :: a -> SDBody a Signal
median = String
-> CalculationRate
-> Vs '["length", "in"]
-> UA "length" (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
"Median" CalculationRate
AR
   (Vs '["length", "in"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["length", "in"])
   (Float -> UA "length" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "length" as
length_ (Float
3::Float))

slew :: (Args '["in"] '["up", "dn"] a) => a -> SDBody a Signal
slew :: a -> SDBody a Signal
slew = String
-> CalculationRate
-> Vs '["in", "up", "dn"]
-> (UA "up" (SDBodyArgs a), UA "dn" (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
"Slew" CalculationRate
AR
   (Vs '["in", "up", "dn"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "up", "dn"])
   (Float -> UA "up" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "up" as
up_ (Float
1::Float), Float -> UA "dn" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "dn" as
dn_ (Float
1::Float))

spring :: (Args '["in"] '["spring", "damp"] a) => a -> SDBody a Signal
spring :: a -> SDBody a Signal
spring = String
-> CalculationRate
-> Vs '["in", "spring", "damp"]
-> (UA "spring" (SDBodyArgs a), UA "damp" (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
"Spring" CalculationRate
AR
   (Vs '["in", "spring", "damp"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "spring", "damp"])
   (Float -> UA "spring" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "spring" as
spring_ (Float
1::Float), Float -> UA "damp" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "damp" as
damp_ (Float
0::Float))

tBall :: (Args '["in"] '["g", "damp", "friction"] a) => a -> SDBody a Signal
tBall :: a -> SDBody a Signal
tBall = String
-> CalculationRate
-> Vs '["in", "g", "damp", "friction"]
-> (UA "g" (SDBodyArgs a), UA "damp" (SDBodyArgs a),
    UA "friction" (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
"TBall" CalculationRate
AR
   (Vs '["in", "g", "damp", "friction"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["in", "g", "damp", "friction"])
   (Float -> UA "g" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "g" as
g_ (Float
10::Float), Float -> UA "damp" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "damp" as
damp_ (Float
0::Float), Float -> UA "friction" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "friction" as
friction_ (Float
0.01::Float))