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 opposition 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
              (toAmplitudeScalar z (SigA.amplitude x) *> SigA.samples x +
               toAmplitudeScalar z (SigA.amplitude y) *> SigA.samples 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 -> (toAmplitudeScalar z (SigA.amplitude y) *>
                             SigA.samples 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

{-# 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