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

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

module Vivid.UGens.Generators.Stochastic (
     brownNoise
   , clipNoise
---   , coinGate
---   , crackle
   , dust
   , dust2
---   , gendy1
---   , gendy2
---   , gendy3
   , grayNoise
   , lfClipNoise
   , lfdClipNoise
   , lfdNoise0
   , lfdNoise1
   , lfdNoise3
   , lfNoise0
   , lfNoise1
   , lfNoise2
   , pinkNoise
---   , randID
---   , randSeed
     -- In Vivid.UGens.Filters.Pitch:
   -- , vibrato
   , whiteNoise
   ) where

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

-- | \"Generates noise whose spectrum falls off in power by 6 dB per octave.\"
brownNoise :: SDBody' a Signal
brownNoise :: SDBody' a Signal
brownNoise = UGen -> SDBody' a Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addUGen (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 ByteString
"BrownNoise") CalculationRate
AR [] Int
1

-- | \"Generates noise whose values are either -1 or 1. This produces the maximum energy for the least peak to peak amplitude.\"
clipNoise :: SDBody' a Signal
clipNoise :: SDBody' a Signal
clipNoise = UGen -> SDBody' a Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addUGen (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 ByteString
"ClipNoise") CalculationRate
AR [] Int
1

--- coinGate ::
--- coinGate =
--- crackle ::
--- crackle =

-- | \"Generates random impulses from -1 to +1.\"
dust :: (Args '["density"] '[] a) => a -> SDBody a Signal
dust :: a -> SDBody a Signal
dust = String
-> CalculationRate
-> Vs '["density"]
-> 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
"Dust" CalculationRate
AR
   (Vs '["density"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["density"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

-- | \"Generates random impulses from -1 to +1.\"
dust2 :: (Args '["density"] '[] a) => a -> SDBody a Signal
dust2 :: a -> SDBody a Signal
dust2 = String
-> CalculationRate
-> Vs '["density"]
-> 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
"Dust2" CalculationRate
AR
   (Vs '["density"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["density"])
   NoDefaults (SDBodyArgs a)
forall (args :: [Symbol]). NoDefaults args
NoDefaults

--- gendy1 ::
--- gendy1 =
--- gendy2 ::
--- gendy2 =
--- gendy3 ::
--- gendy3 =

-- | \"Generates noise which results from flipping random bits in a word. This type of noise has a high RMS level relative to its peak to peak level. The spectrum is emphasized towards lower frequencies.\"
grayNoise :: SDBody' a Signal
grayNoise :: SDBody' a Signal
grayNoise = UGen -> SDBody' a Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addUGen (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 ByteString
"GrayNoise") CalculationRate
AR [] Int
1

-- | E.g.
-- 
--   > play $ 0.1 ~* lfClipNoise (freq_ $ xLine (start_ 1e3, end_ 1e4, secs_ 10))
lfClipNoise :: (Args '[] '["freq"] a) => a -> SDBody a Signal
lfClipNoise :: a -> SDBody a Signal
lfClipNoise = String
-> CalculationRate
-> Vs '["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
"LFClipNoise" CalculationRate
AR
   (Vs '["freq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
500::Float))

-- | \"Like LFClipNoise, it generates the values -1 or +1 at a rate given by the freq argument, with two differences:
--      \" - no time quantization
--      \" - fast recovery from low freq values
--   \" If you don't need very high or very low freqs, or use fixed freqs, LFDClipNoise is more efficient."
lfdClipNoise :: (Args '[] '["freq"] a) => a -> SDBody a Signal
lfdClipNoise :: a -> SDBody a Signal
lfdClipNoise = String
-> CalculationRate
-> Vs '["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
"LFDClipNoise" CalculationRate
AR
   (Vs '["freq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
500::Float))

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

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

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

-- | Freq is \"approximate rate at which to generate random values\"
lfNoise0 :: (Args '[] '["freq"] a) => a -> SDBody a Signal
lfNoise0 :: a -> SDBody a Signal
lfNoise0 = String
-> CalculationRate
-> Vs '["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
"LFNoise0" CalculationRate
AR
   (Vs '["freq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
500::Float))

-- | Freq is \"approximate rate at which to generate random values\"
lfNoise1 :: (Args '[] '["freq"] a) => a -> SDBody a Signal
lfNoise1 :: a -> SDBody a Signal
lfNoise1 = String
-> CalculationRate
-> Vs '["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
"LFNoise1" CalculationRate
AR
   (Vs '["freq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
500::Float))

-- | Freq is \"approximate rate at which to generate random values\"
lfNoise2 :: (Args '[] '["freq"] a) => a -> SDBody a Signal
lfNoise2 :: a -> SDBody a Signal
lfNoise2 = String
-> CalculationRate
-> Vs '["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
"LFNoise2" CalculationRate
AR
   (Vs '["freq"]
forall (a :: [Symbol]). Vs a
Vs::Vs '["freq"])
   (Float -> UA "freq" (SDBodyArgs a)
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (Float
500::Float))

-- | \"Generates noise whose spectrum falls off in power by 3 dB per octave. This gives equal power over the span of each octave. This version gives 8 octaves of pink noise.\"
pinkNoise :: SDBody' a Signal
pinkNoise :: SDBody' a Signal
pinkNoise = UGen -> SDBody' a Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addUGen (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 ByteString
"PinkNoise") CalculationRate
AR [] Int
1

--- randID ::
--- randID =
--- randSeed ::
--- randSeed =

-- | \"Generates noise whose spectrum has equal power at all frequencies.\"
whiteNoise :: SDBody' a Signal
whiteNoise :: SDBody' a Signal
whiteNoise = UGen -> SDBody' a Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addUGen (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 ByteString
"WhiteNoise") CalculationRate
AR [] Int
1