{-# LANGUAGE DataKinds #-}

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

module Vivid.UGens.Generators.Chaotic (
     cuspL
   , cuspN
---   , fbSineC
---   , fbSineL
---   , fbSineN
---   , gbmanL
---   , gbmanN
---   , henonC
---   , henonL
---   , henonN
---   , latoocarfianC
---   , latoocarfianL
---   , latoocarfianN
   , linCongC
   , linCongL
   , linCongN
---   , logistic
---   , lorenzL
---   , quadC
---   , quadL
---   , quadN
---   , sinOscFB
---   , standardL
---   , standardN
   ) where

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

-- | "A linear-interpolating sound generator based on the difference equation:
-- 
--   x[n+1] = a - b * sqrt(abs(x[n]))"
-- 
--   Only has an AR instance
cuspL :: (Args '[] '["freq", "a", "b", "xi"] a) => a -> SDBody a Signal
cuspL :: a -> SDBody a Signal
cuspL = String
-> CalculationRate
-> Vs '["freq", "a", "b", "xi"]
-> (UA "freq" (SDBodyArgs a), UA "a" (SDBodyArgs a),
    UA "b" (SDBodyArgs a), UA "xi" (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
"CuspL" CalculationRate
AR
   (Vs '["freq", "a", "b", "xi"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "a", "b", "xi"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
22050::Float), Float -> UA "a" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a" as
a_ (Float
1::Float), Float -> UA "b" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "b" as
b_ (Float
1.9::Float), Float -> UA "xi" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "xi" as
xi_ (Float
0::Float))

-- | "A non-interpolating sound generator based on the difference equation:
-- 
--    x[n+1] = a - b * sqrt(abs(x[n]))"
-- 
--    Only has an AR instance.
cuspN :: (Args '[] '["freq", "a", "b", "xi"] a) => a -> SDBody a Signal
cuspN :: a -> SDBody a Signal
cuspN = String
-> CalculationRate
-> Vs '["freq", "a", "b", "xi"]
-> (UA "freq" (SDBodyArgs a), UA "a" (SDBodyArgs a),
    UA "b" (SDBodyArgs a), UA "xi" (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
"CuspN" CalculationRate
AR
   (Vs '["freq", "a", "b", "xi"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "a", "b", "xi"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
22050::Float), Float -> UA "a" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a" as
a_ (Float
1::Float), Float -> UA "b" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "b" as
b_ (Float
1.9::Float), Float -> UA "xi" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "xi" as
xi_ (Float
0::Float))

--- fbSineC ::
--- fbSineC =
--- fbSineL ::
--- fbSineL =
--- fbSineN ::
--- fbSineN =
--- gbmanL ::
--- gbmanL =
--- gbmanN ::
--- gbmanN =
--- henonC ::
--- henonC =
--- henonL ::
--- henonL =
--- henonN ::
--- henonN =
--- latoocarfianC ::
--- latoocarfianC =
--- latoocarfianL ::
--- latoocarfianL =
--- latoocarfianN ::
--- latoocarfianN =

-- | "A cubic-interpolating sound generator based on the difference equation:
-- 
--   x[n+1] = (a * x[n] + c) % m
-- 
--   The output signal is automatically scaled to a range of [-1, 1]."
--  
--   Only has a "AR" method
linCongC :: (Args '[] '["freq", "a", "c", "m", "xi"] a) => a -> SDBody a Signal
linCongC :: a -> SDBody a Signal
linCongC = String
-> CalculationRate
-> Vs '["freq", "a", "c", "m", "xi"]
-> (UA "freq" (SDBodyArgs a), UA "a" (SDBodyArgs a),
    UA "c" (SDBodyArgs a), UA "m" (SDBodyArgs a),
    UA "xi" (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
"LinCongC" CalculationRate
AR
   (Vs '["freq", "a", "c", "m", "xi"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "a", "c", "m", "xi"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
22050::Float), Float -> UA "a" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a" as
a_ (Float
1.1::Float), Float -> UA "c" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "c" as
c_ (Float
0.13::Float), Float -> UA "m" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "m" as
m_ (Float
1::Float), Float -> UA "xi" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "xi" as
xi_ (Float
0::Float))

-- | "A linear-interpolating sound generator based on the difference equation:
-- 
--   x[n+1] = (a * x[n] + c) % m
-- 
--   The output signal is automatically scaled to a range of [-1, 1]."
-- 
--   Only has a "AR" method
linCongL :: (Args '[] '["freq", "a", "c", "m", "xi"] a) => a -> SDBody a Signal
linCongL :: a -> SDBody a Signal
linCongL = String
-> CalculationRate
-> Vs '["freq", "a", "c", "m", "xi"]
-> (UA "freq" (SDBodyArgs a), UA "a" (SDBodyArgs a),
    UA "c" (SDBodyArgs a), UA "m" (SDBodyArgs a),
    UA "xi" (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
"LinCongL" CalculationRate
AR
   (Vs '["freq", "a", "c", "m", "xi"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "a", "c", "m", "xi"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
22050::Float), Float -> UA "a" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a" as
a_ (Float
1.1::Float), Float -> UA "c" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "c" as
c_ (Float
0.13::Float), Float -> UA "m" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "m" as
m_ (Float
1::Float), Float -> UA "xi" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "xi" as
xi_ (Float
0::Float))

-- | "A non-interpolating sound generator based on the difference equation:
-- 
--   x[n+1] = (a * x[n] + c) % m
-- 
--   The output signal is automatically scaled to a range of [-1, 1]."
-- 
--   Only has a "AR" method
linCongN :: (Args '[] '["freq", "a", "c", "m", "xi"] a) => a -> SDBody a Signal
linCongN :: a -> SDBody a Signal
linCongN = String
-> CalculationRate
-> Vs '["freq", "a", "c", "m", "xi"]
-> (UA "freq" (SDBodyArgs a), UA "a" (SDBodyArgs a),
    UA "c" (SDBodyArgs a), UA "m" (SDBodyArgs a),
    UA "xi" (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
"LinCongN" CalculationRate
AR
   (Vs '["freq", "a", "c", "m", "xi"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "a", "c", "m", "xi"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
22050::Float), Float -> UA "a" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "a" as
a_ (Float
1.1::Float), Float -> UA "c" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "c" as
c_ (Float
0.13::Float), Float -> UA "m" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "m" as
m_ (Float
1::Float), Float -> UA "xi" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "xi" as
xi_ (Float
0::Float))

--- logistic ::
--- logistic =
--- lorenzL ::
--- lorenzL =
--- quadC ::
--- quadC =
--- quadL ::
--- quadL =
--- quadN ::
--- quadN =
--- sinOscFB ::
--- sinOscFB =
--- standardL ::
--- standardL =
--- standardN ::
--- standardN =