{-# LANGUAGE NoImplicitPrelude #-}
{- |
Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes

-}
module Synthesizer.SampleRateContext.Noise
  (white,    whiteBandEnergy,    randomPeeks,
   whiteGen, whiteBandEnergyGen, randomPeeksGen,
   ) where


import qualified Synthesizer.Plain.Noise as Noise

import qualified Synthesizer.SampleRateContext.Signal as SigC
import qualified Synthesizer.SampleRateContext.Rate as Rate

import qualified Algebra.OccasionallyScalar as OccScalar
import qualified Algebra.Algebraic          as Algebraic
import qualified Algebra.Field              as Field
import qualified Algebra.Ring               as Ring

import System.Random (Random, RandomGen, randomRs, mkStdGen)

import NumericPrelude
import PreludeBase as P



{- |
Uniformly distributed white noise.
The volume is given by two values:
The width of a frequency band and the volume caused by it.
The width of a frequency band must be given
in order to achieve independence from sample rate.

See 'whiteBandEnergy'.
-}
white :: (Ring.C yv, Random yv, Algebraic.C q') =>
      q'  {-^ width of the frequency band -}
   -> q'  {-^ volume caused by the given frequency band -}
   -> Rate.T t q' -> SigC.T y q' yv
          {-^ noise -}
white = whiteGen (mkStdGen 6746)

whiteGen :: (Ring.C yv, Random yv, RandomGen g, Algebraic.C q') =>
      g   {-^ random generator, can be used to choose a seed -}
   -> q'  {-^ width of the frequency band -}
   -> q'  {-^ volume caused by the given frequency band -}
   -> Rate.T t q' -> SigC.T y q' yv
         {-^ noise -}
whiteGen gen bandWidth volume sr =
   SigC.Cons
      (sqrt (3 * bandWidth / Rate.toNumber sr) * volume)
      (Noise.whiteGen gen)


{-|
Uniformly distributed white noise.
Instead of an amplitude you must specify a value
that is like an energy per frequency band.
It makes no sense to specify an amplitude
because if you keep the same signal amplitude
while increasing the sample rate by a factor of four
the amplitude of the frequency spectrum halves.
Thus deep frequencies would be damped
when higher frequencies enter.

Example:
If your signal is a function from time to voltage,
the amplitude must have the unit @volt^2*second@,
which can be also viewed as @volt^2\/hertz@.

Note that the energy is proportional to the square of the signal amplitude.
In order to double the noise amplitude,
you must increase the energy by a factor of four.

Using this notion of amplitude
the behaviour amongst several frequency filters
is quite consistent but a problem remains:
When the noise is quantised
then noise at low sample rates and noise at high sample rates
behave considerably different.
This indicates that quantisation should not just pick values,
but it should average over the hold periods.
-}
whiteBandEnergy :: (Ring.C yv, Random yv, Algebraic.C q') =>
      q'  {-^ energy per frequency band -}
   -> Rate.T t q' -> SigC.T y q' yv
          {-^ noise -}
whiteBandEnergy = whiteBandEnergyGen (mkStdGen 6746)

whiteBandEnergyGen :: (Ring.C yv, Random yv, RandomGen g, Algebraic.C q') =>
      g   {-^ random generator, can be used to choose a seed -}
   -> q'  {-^ energy per frequency band -}
   -> Rate.T t q' -> SigC.T y q' yv
         {-^ noise -}
whiteBandEnergyGen gen energy sr =
   SigC.Cons (sqrt (3 * Rate.toNumber sr * energy)) (Noise.whiteGen gen)


{-
The Field.C q constraint could be lifted to Ring.C
if we would use direct division instead of toFrequencyScalar.
-}
randomPeeks ::
   (Field.C q, Random q, Ord q,
    Field.C q', OccScalar.C q q') =>
       Rate.T q q'
    -> SigC.T q q' q  {- ^ momentary densities (frequency),
                           @p@ means that there is about one peak
                           in the time range of @1\/p@. -}
    -> [Bool]
                      {- ^ Every occurence of 'True' represents a peak. -}
randomPeeks =
   randomPeeksGen (mkStdGen 876)

randomPeeksGen ::
   (Field.C q, Random q, Ord q,
    Field.C q', OccScalar.C q q',
    RandomGen g) =>
       g  {-^ random generator, can be used to choose a seed -}
    -> Rate.T q q'
    -> SigC.T q q' q  {- ^ momentary densities (frequency),
                           @p@ means that there is about one peak
                           in the time range of @1\/p@. -}
    -> [Bool]
                      {- ^ Every occurence of 'True' represents a peak. -}
randomPeeksGen g sr dens =
   let amp = SigC.toFrequencyScalar sr (SigC.amplitude dens)
   in  zipWith (<)
          (randomRs (0, recip amp) g)
          (SigC.samples dens)