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

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

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


import qualified Synthesizer.State.NoiseCustom as Noise
import qualified Synthesizer.State.Signal as Sig

import qualified Synthesizer.RandomKnuth as Knuth

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Rate.Dirac as Dirac
import qualified Synthesizer.Dimensional.Process as Proc

import Synthesizer.Dimensional.Process (($#), )

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim
import Number.DimensionTerm ((&*&))

import qualified Algebra.Algebraic          as Algebraic
import qualified Algebra.Field              as Field

import System.Random (Random, RandomGen, mkStdGen)

import NumericPrelude.Numeric
import NumericPrelude.Base as P



{-# INLINE white #-}
{- The Field.C constraint could be replaced by Ring.C
   if Noise instead of faster NoiseCustom would be used -}
white :: (Field.C yv, Random yv, Algebraic.C q, Dim.C u, Dim.C v) =>
      DN.T (Dim.Recip u) q
          {-^ width of the frequency band -}
   -> DN.T v q
          {-^ volume caused by the given frequency band -}
   -> Proc.T s u q (SigA.R s v q yv)
          {-^ noise -}
white :: forall yv q u v s.
(C yv, Random yv, C q, C u, C v) =>
T (Recip u) q -> T v q -> T s u q (R s v q yv)
white =
   -- FIXME: there was a bug in GHC-6.4's standard random generator where genRange returned minBound::Int as lower bound but actually generated numbers were always positive
   -- this is fixed in GHC-6.6 and thus the standard generator can be used
   forall yv g q u v s.
(C yv, Random yv, RandomGen g, C q, C u, C v) =>
g -> T (Recip u) q -> T v q -> T s u q (R s v q yv)
whiteGen (Int -> T
Knuth.cons Int
6746)
--   whiteGen (mkStdGen 6746)

{-# INLINE whiteGen #-}
whiteGen ::
   (Field.C yv, Random yv, RandomGen g, Algebraic.C q, Dim.C u, Dim.C v) =>
      g   {-^ random generator, can be used to choose a seed -}
   -> DN.T (Dim.Recip u) q
          {-^ width of the frequency band -}
   -> DN.T v q
          {-^ volume caused by the given frequency band -}
   -> Proc.T s u q (SigA.R s v q yv)
          {-^ noise -}
whiteGen :: forall yv g q u v s.
(C yv, Random yv, RandomGen g, C q, C u, C v) =>
g -> T (Recip u) q -> T v q -> T s u q (R s v q yv)
whiteGen g
gen T (Recip u) q
bandWidth T v q
volume =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
Proc.toFrequencyScalar T (Recip u) q
bandWidth) forall a b. (a -> b) -> a -> b
$ \q
bw ->
   forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody
      (forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale (forall a. C a => a -> a
sqrt forall a b. (a -> b) -> a -> b
$ q
3 forall a. C a => a -> a -> a
/ q
bw) T v q
volume)
      (forall y g. (C y, Random y, RandomGen g) => g -> T y
Noise.whiteGen g
gen)


{-# INLINE whiteBandEnergy #-}
whiteBandEnergy :: (Field.C yv, Random yv, Algebraic.C q, Dim.C u, Dim.C v) =>
      DN.T (Dim.Mul u (Dim.Sqr v)) q
          {-^ energy per frequency band -}
   -> Proc.T s u q (SigA.R s v q yv)
          {-^ noise -}
whiteBandEnergy :: forall yv q u v s.
(C yv, Random yv, C q, C u, C v) =>
T (Mul u (Sqr v)) q -> T s u q (R s v q yv)
whiteBandEnergy = forall yv g q u v s.
(C yv, Random yv, RandomGen g, C q, C u, C v) =>
g -> T (Mul u (Sqr v)) q -> T s u q (R s v q yv)
whiteBandEnergyGen (Int -> StdGen
mkStdGen Int
6746)

{-# INLINE whiteBandEnergyGen #-}
whiteBandEnergyGen ::
   (Field.C yv, Random yv, RandomGen g, Algebraic.C q, Dim.C u, Dim.C v) =>
      g   {-^ random generator, can be used to choose a seed -}
   -> DN.T (Dim.Mul u (Dim.Sqr v)) q
          {-^ energy per frequency band -}
   -> Proc.T s u q (SigA.R s v q yv)
          {-^ noise -}
whiteBandEnergyGen :: forall yv g q u v s.
(C yv, Random yv, RandomGen g, C q, C u, C v) =>
g -> T (Mul u (Sqr v)) q -> T s u q (R s v q yv)
whiteBandEnergyGen g
gen T (Mul u (Sqr v)) q
energy =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall u s t. C u => T s u t (T (Recip u) t)
Proc.getSampleRate forall a b. (a -> b) -> a -> b
$ \T (Recip u) q
rate ->
   forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody
      (forall u a. (C u, C a) => T (Sqr u) a -> T u a
DN.sqrt forall a b. (a -> b) -> a -> b
$ forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale q
3 forall a b. (a -> b) -> a -> b
$
       forall u v a. (C u, C v) => (u -> v) -> T u a -> T v a
DN.rewriteDimension
          (forall u. C u => Mul Scalar u -> u
Dim.identityLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u0 u1 v.
(C u0, C u1, C v) =>
(u0 -> u1) -> Mul u0 v -> Mul u1 v
Dim.applyLeftMul forall u. C u => Mul (Recip u) u -> Scalar
Dim.cancelLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           forall u0 u1 u2.
(C u0, C u1, C u2) =>
Mul u0 (Mul u1 u2) -> Mul (Mul u0 u1) u2
Dim.associateLeft) forall a b. (a -> b) -> a -> b
$
       T (Recip u) q
rate forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*& T (Mul u (Sqr v)) q
energy)
      (forall y g. (C y, Random y, RandomGen g) => g -> T y
Noise.whiteGen g
gen)


{-
The Field.C q constraint could be lifted to Ring.C
if we would use direct division instead of toFrequencyScalar.
-}
{-# INLINE randomPeeks #-}
randomPeeks ::
   (Field.C q, Random q, Ord q, Dim.C u) =>
    Proc.T s u q (
       SigA.R s (Dim.Recip u) q q
          {- v instantaneous densities (frequency),
               @p@ means that there is about one peak
               in the time range of @1\/p@. -}
    -> SigA.R s (Dim.Recip u) q q)
          {- ^ Every occurrence is represented by a peak of area 1.
               If you smooth the input and the output signal to the same degree
               they should be rather similar. -}
randomPeeks :: forall q u s.
(C q, Random q, Ord q, C u) =>
T s u q (R s (Recip u) q q -> R s (Recip u) q q)
randomPeeks =
   forall q u g s.
(C q, Random q, Ord q, C u, RandomGen g) =>
g -> T s u q (R s (Recip u) q q -> R s (Recip u) q q)
randomPeeksGen (Int -> StdGen
mkStdGen Int
876)


{-# INLINE randomPeeksGen #-}
randomPeeksGen ::
   (Field.C q, Random q, Ord q, Dim.C u,
    RandomGen g) =>
       g  {- ^ random generator, can be used to choose a seed -}
    -> Proc.T s u q (
         SigA.R s (Dim.Recip u) q q
          {- v momentary densities (frequency),
               @p@ means that there is about one peak
               in the time range of @1\/p@. -}
      -> SigA.R s (Dim.Recip u) q q)
          {- ^ Every occurrence is represented by a peak of area 1. -}
randomPeeksGen :: forall q u g s.
(C q, Random q, Ord q, C u, RandomGen g) =>
g -> T s u q (R s (Recip u) q q -> R s (Recip u) q q)
randomPeeksGen g
g =
   forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall a b. (a -> b) -> a -> b
$ \ R s (Recip u) q q
dens ->
      do q
freq <- forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
Proc.toFrequencyScalar (forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude R s (Recip u) q q
dens)
         forall q u (sig :: * -> *) s.
(C q, C u, Functor sig) =>
T s
  u
  q
  (T s sig -> T (Phantom s) (Numeric (T (Recip u) q)) (sig q))
Dirac.toAmplitudeSignal forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
$#
            (forall s (sig :: * -> *). sig Bool -> T s sig
Dirac.Cons forall a b. (a -> b) -> a -> b
$
             forall a b c. (a -> b -> c) -> T a -> T b -> T c
Sig.zipWith forall a. Ord a => a -> a -> Bool
(<)
                (forall y g. (C y, Random y, RandomGen g) => (y, y) -> g -> T y
Noise.randomRs (q
0, forall a. C a => a -> a
recip q
freq) g
g)
                (forall rate amplitude body. T rate amplitude body -> body
SigA.body R s (Recip u) q q
dens))