Noise.hs

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

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

-}
module Synthesizer.Inference.Monad.Signal.Noise
  (white,
   whiteGen,
   randomPeeks) where


import qualified UniqueLogicNP.Explicit.Process    as Process
import qualified UniqueLogicNP.Explicit.Expression as Expr
import qualified Synthesizer.Inference.Monad.Signal     as SigI
import qualified UniqueLogicNP.Explicit.System     as IS

import qualified Synthesizer.Physical.Signal as SigP
import qualified Synthesizer.Plain.Noise as Noise

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



white :: (Ring.C v, Random v, Algebraic.C q) =>
      q  {-^ width of the frequency band -}
   -> q  {-^ volume caused by the given frequency band -}
   -> SigI.Process a q v
         {-^ noise -}
white = whiteGen (mkStdGen 6746)

whiteGen :: (Ring.C v, Random v, 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 -}
   -> SigI.Process a q v
         {-^ noise -}
whiteGen gen bandWidth volume =
   do sampleRate <- Process.newVariable
      amplitude  <- Process.fromExpr
         (sqrt (3 * Expr.fromAtom sampleRate / Expr.constant bandWidth)
            * Expr.constant volume)
      SigI.returnCons sampleRate amplitude (Noise.whiteGen gen)


randomPeeks :: (Field.C a, Random a, Ord a,
                Field.C q, OccScalar.C a q) =>
      SigI.T a q a  {- ^ momentary densities (frequency),
                         @p@ means that there is about one peak
                         in the time range of @1\/p@. -}
   -> SigI.Process a q Bool
                    {- ^ Every occurence of 'True' represents a peak. -}
randomPeeks dens =
   do amp <- SigI.toFrequencyScalar dens (SigI.amplitudeExpr dens)
      SigI.returnCons (SigP.sampleRate dens) (IS.constant 1)
          (zipWith (<)
              (randomRs (0, recip amp) (mkStdGen 876))
              (SigP.samples dens))