Displacement.hs

{- |
Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Amplitude.Displacement (
   mix, mixVolume,
   mixMulti, mixMultiVolume,
   raise, distort,
   ) where

import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind

import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA
import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

-- import Number.DimensionTerm ((&*&))

import qualified Synthesizer.State.Displacement as Disp
import qualified Synthesizer.State.Signal  as Sig

import qualified Algebra.Module         as Module
import qualified Algebra.Field          as Field
import qualified Algebra.Real           as Real
-- import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive

import Algebra.Module ((*>))

import PreludeBase
import NumericPrelude
import Prelude ()


{- * Mixing -}

{- |
Mix two signals.
In contrast to 'zipWith' the result has the length of the longer signal.
-}
{-# INLINE mix #-}
mix ::
   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>
      SigA.R s u y yv
   -> SigA.R s u y yv
   -> SigA.R s u y yv
mix x y =
   mixVolume (DN.abs (SigA.amplitude x) + DN.abs (SigA.amplitude y)) x y

{-# INLINE mixVolume #-}
mixVolume ::
   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>
      DN.T u y
   -> SigA.R s u y yv
   -> SigA.R s u y yv
   -> SigA.R s u y yv
mixVolume v x y =
   let z = SigA.fromSamples v
              (SigA.vectorSamples (toAmplitudeScalar z) x +
               SigA.vectorSamples (toAmplitudeScalar z) y)
   in  z

{- |
Mix one or more signals.
-}
{-# INLINE mixMulti #-}
mixMulti ::
   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>
      [SigA.R s u y yv]
   ->  SigA.R s u y yv
mixMulti x =
   mixMultiVolume (sum (map (DN.abs . SigA.amplitude) x)) x

{-# INLINE mixMultiVolume #-}
mixMultiVolume ::
   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>
      DN.T u y
   -> [SigA.R s u y yv]
   ->  SigA.R s u y yv
mixMultiVolume v x =
   let z = SigA.fromSamples v
              (foldr (\y -> (SigA.vectorSamples (toAmplitudeScalar z) y +)) Sig.empty x)
   in  z

{- |
Add a number to all of the signal values.
This is useful for adjusting the center of a modulation.
-}
{-# INLINE raise #-}
raise :: (Ind.C w, Field.C y, Module.C y yv, Dim.C u) =>
      DN.T u y
   -> yv
   -> w (SigA.S u y) yv
   -> w (SigA.S u y) yv
raise y' yv x =
   SigA.processSamples
      (Disp.raise (toAmplitudeScalar x y' *> yv)) x

{- |
Distort the signal using a flat function.
The first signal gives the scaling of the function.
If the scaling is c and the input sample is y,
then @c * f(y/c)@ is output.
This way we can use an (efficient) flat function
and have a simple, yet dimension conform, way of controlling the distortion.
E.g. if the distortion function is @tanh@
then the value @c@ controls the saturation level.
-}
{-# INLINE distort #-}
distort :: (Field.C y, Module.C y yv, Dim.C u) =>
      (yv -> yv)
   -> SigA.R s u y y
   -> SigA.R s u y yv
   -> SigA.R s u y yv
distort f cs xs =
   SigA.processSamples
      (Sig.zipWith
          (\c y -> c *> f (recip c *> y))
          (SigA.scalarSamples (toAmplitudeScalar xs) cs)) xs