{-# LANGUAGE
     DataKinds
   , OverloadedStrings
   #-}

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

module Vivid.UGens.Generators.Deterministic (
---     blip
---   , cosc
---   , dynKlang
     -- In Vivid.UGens.Filters:
   -- , dynKlank
     fSinOsc
   , formant
   , impulse
---   , klang
     -- In Vivid.UGens.Filters:
   -- , klank
   , lfCub
   , lfGauss
   , lfPar
   , lfPulse
   , lfSaw
   , lfTri
---   , osc
---   , oscN
---   , pmOSC
---   , pSinGrain
   , pulse
   , saw
   , sinOsc
     -- In Vivid.UGens.Generators.Chaotic:
   -- , sinOscFB
   , syncSaw
   , varSaw
     -- In Vivid.UGens.Filters:
   -- , vibrato
---   , vOsc
---   , vOsc3
   ) where

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

--- blip ::
--- blip =
--- cosc ::
--- cosc =
--- dynKlang ::
--- dynKlang =

fSinOsc :: (Args '["freq"] '["phase"] a) => a -> SDBody a Signal
fSinOsc :: a -> SDBody a Signal
fSinOsc = String
-> CalculationRate
-> Vs '["freq", "phase"]
-> UA "phase" (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
"FSinOsc" CalculationRate
AR
   (Vs '["freq", "phase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "phase"])
   (Float -> UA "phase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "phase" as
phase_ (Float
0::Float))

-- | Only runs at audio rate. All arguments must be at control rate or constant.
--   \"bwFreq\" must be greater than or equal to \"fundFreq\".
formant :: Args '["fundFreq", "formFreq", "bwFreq"] '[] a => a -> SDBody a Signal
formant :: a -> SDBody a Signal
formant = String
-> CalculationRate
-> Vs '["fundFreq", "formFreq", "bwFreq"]
-> 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
"Formant" CalculationRate
AR
   (Vs '["fundFreq", "formFreq", "bwFreq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["fundFreq", "formFreq", "bwFreq"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

impulse :: (Args '["freq"] '["phase"] a) => a -> SDBody a Signal
impulse :: a -> SDBody a Signal
impulse = String
-> CalculationRate
-> Vs '["freq", "phase"]
-> UA "phase" (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
"Impulse" CalculationRate
AR
   (Vs '["freq", "phase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "phase"])
   (Float -> UA "phase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "phase" as
phase_ (Float
0::Float))

--- klang ::
--- klang =

lfCub :: (Args '["freq"] '["iphase"] a) => a -> SDBody a Signal
lfCub :: a -> SDBody a Signal
lfCub = String
-> CalculationRate
-> Vs '["freq", "iphase"]
-> UA "iphase" (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
"LFCub" CalculationRate
AR
   (Vs '["freq", "iphase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "iphase"])
   (Float -> UA "iphase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "iphase" as
iphase_ (Float
0::Float))

lfGauss :: (Args '[] '["duration", "width", "iphase", "loop", "doneAction"] a) => a -> SDBody a Signal
lfGauss :: a -> SDBody a Signal
lfGauss = String
-> CalculationRate
-> Vs '["duration", "width", "iphase", "loop", "doneAction"]
-> (UA "duration" (SDBodyArgs a), UA "width" (SDBodyArgs a),
    UA "iphase" (SDBodyArgs a), UA "loop" (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
"LFGauss" CalculationRate
AR
   (Vs '["duration", "width", "iphase", "loop", "doneAction"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["duration", "width", "iphase", "loop", "doneAction"])
   (Float -> UA "duration" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "duration" as
duration_ (Float
1::Float), Float -> UA "width" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "width" as
width_ (Float
0.1::Float), Float -> UA "iphase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "iphase" as
iphase_ (Float
0::Float), Float -> UA "loop" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "loop" as
loop_ (Float
1::Float), Float -> UA "doneAction" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "doneAction" as
doneAction_ (Float
0::Float))

lfPar :: (Args '["freq"] '["iphase"] a) => a -> SDBody a Signal
lfPar :: a -> SDBody a Signal
lfPar = String
-> CalculationRate
-> Vs '["freq", "iphase"]
-> UA "iphase" (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
"LFPar" CalculationRate
AR
   (Vs '["freq", "iphase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "iphase"])
   (Float -> UA "iphase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "iphase" as
iphase_ (Float
0::Float))

lfPulse :: (Args '["freq"] '["iphase", "width"] a) => a -> SDBody a Signal
lfPulse :: a -> SDBody a Signal
lfPulse = String
-> CalculationRate
-> Vs '["freq", "iphase", "width"]
-> (UA "iphase" (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
"LFPulse" CalculationRate
AR
   (Vs '["freq", "iphase", "width"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "iphase", "width"])
   (Float -> UA "iphase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "iphase" as
iphase_ (Float
0::Float), Float -> UA "width" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "width" as
width_ (Float
0.5::Float))

-- | \"A non-band-limited sawtooth oscillator. Output ranges from -1 to +1.\"
lfSaw :: (Args '["freq"] '["iphase"] a) => a -> SDBody a Signal
lfSaw :: a -> SDBody a Signal
lfSaw = String
-> CalculationRate
-> Vs '["freq", "iphase"]
-> UA "iphase" (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
"LFSaw" CalculationRate
AR
   (Vs '["freq", "iphase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "iphase"])
   (Float -> UA "iphase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "iphase" as
iphase_ (Float
0::Float))

-- | \"A non-band-limited triangle oscillator. Output ranges from -1 to +1.\"
lfTri :: (Args '["freq"] '["iphase"] a) => a -> SDBody a Signal
lfTri :: a -> SDBody a Signal
lfTri = String
-> CalculationRate
-> Vs '["freq", "iphase"]
-> UA "iphase" (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
"LFTri" CalculationRate
AR
   (Vs '["freq", "iphase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "iphase"])
   (Float -> UA "iphase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "iphase" as
iphase_ (Float
0::Float))

--- osc ::
--- osc =
--- oscN ::
--- oscN =
--- pmOSC ::
--- pmOSC =
--- pSinGrain ::
--- pSinGrain =

pulse :: (Args '["freq"] '["width"] a) => a -> SDBody a Signal
pulse :: a -> SDBody a Signal
pulse = String
-> CalculationRate
-> Vs '["freq", "width"]
-> 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
"Pulse" CalculationRate
AR
   (Vs '["freq", "width"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq","width"])
   (Float -> UA "width" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "width" as
width_ (Float
0.5::Float))

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

-- | Sine wave
sinOsc :: (Args '["freq"] '["phase"] a) => a -> SDBody a Signal
sinOsc :: a -> SDBody a Signal
sinOsc = String
-> CalculationRate
-> Vs '["freq", "phase"]
-> UA "phase" (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
"SinOsc" CalculationRate
AR
   (Vs '["freq", "phase"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq","phase"])
   (Float -> UA "phase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "phase" as
phase_ (Float
0::Float))

syncSaw :: (Args '["syncFreq", "sawFreq"] '[] a) => a -> SDBody a Signal
syncSaw :: a -> SDBody a Signal
syncSaw = String
-> CalculationRate
-> Vs '["syncFreq", "sawFreq"]
-> 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
"SyncSaw" CalculationRate
AR
   (Vs '["syncFreq", "sawFreq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["syncFreq", "sawFreq"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- | Width is "duty cycle from 0 to 1"
varSaw :: (Args '["freq"] '["iphase", "width"] a) => a -> SDBody a Signal
varSaw :: a -> SDBody a Signal
varSaw = String
-> CalculationRate
-> Vs '["freq", "iphase", "width"]
-> (UA "iphase" (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
"VarSaw" CalculationRate
AR
   (Vs '["freq", "iphase", "width"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq", "iphase", "width"])
   (Float -> UA "iphase" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "iphase" as
iphase_ (Float
0::Float), Float -> UA "width" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "width" as
width_ (Float
0.5::Float))

--- vOsc ::
--- vOsc =
--- vOsc3 ::
--- vOsc3 =