Displacement.hs

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

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

import qualified Synthesizer.Amplitude.Signal as SigV

import Synthesizer.Amplitude.Signal (toAmplitudeScalar)

import qualified Synthesizer.Plain.Displacement as Synthesizer

import qualified Algebra.OccasionallyScalar as OccScalar
import qualified Algebra.Module         as Module
-- import qualified Algebra.Transcendental as Trans
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. -}
mix ::
   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>
      SigV.T y y' yv
   -> SigV.T y y' yv
   -> SigV.T y y' yv
mix x y =
   mixVolume (abs (SigV.amplitude x) + abs (SigV.amplitude y)) x y

mixVolume ::
   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>
      y'
   -> SigV.T y y' yv
   -> SigV.T y y' yv
   -> SigV.T y y' yv
mixVolume v x y =
   let z = SigV.Cons v
              (toAmplitudeScalar z (SigV.amplitude x) *> SigV.samples x +
               toAmplitudeScalar z (SigV.amplitude y) *> SigV.samples y)
   in  z

{-| Mix one or more signals. -}
mixMulti ::
   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>
      [SigV.T y y' yv]
   ->  SigV.T y y' yv
mixMulti x =
   mixMultiVolume (sum (map (abs . SigV.amplitude) x)) x

mixMultiVolume ::
   (Real.C y', Field.C y', Module.C y yv, OccScalar.C y y') =>
      y'
   -> [SigV.T y y' yv]
   ->  SigV.T y y' yv
mixMultiVolume v x =
   let z = SigV.Cons v
              (foldr (\y -> (toAmplitudeScalar z (SigV.amplitude y) *>
                             SigV.samples y +)) [] x)
   in  z

{-| Add a number to all of the signal values.
    This is useful for adjusting the center of a modulation. -}
raise :: (Field.C y', Module.C y yv, OccScalar.C y y') =>
      y'
   -> yv
   -> SigV.T y y' yv
   -> SigV.T y y' yv
raise y' yv x =
   SigV.Cons (SigV.amplitude x)
      (Synthesizer.raise (toAmplitudeScalar x y' *> yv) (SigV.samples x))