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

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

import qualified Synthesizer.Dimensional.Map.Displacement as Disp

import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Sample as Sample

import qualified Synthesizer.Dimensional.Causal.Process as CausalD

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

import qualified Algebra.Module         as Module
import qualified Algebra.RealField      as RealField
import qualified Algebra.Field          as Field
import qualified Algebra.Absolute       as Absolute
-- import qualified Algebra.Ring           as Ring
-- import qualified Algebra.Additive       as Additive

-- import Algebra.Module ((*>))

import NumericPrelude.Base
-- import NumericPrelude.Numeric
import Prelude ()


type DNS v y yv = Sample.Dimensional v y yv


-- * Mixing

{-# INLINE mix #-}
mix :: (Absolute.C y, Field.C y, Module.C y yv, Dim.C v) =>
   Proc.T s u t (CausalD.T s (DNS v y yv, DNS v y yv) (DNS v y yv))
mix :: forall y yv v s u t.
(C y, C y, C y yv, C v) =>
T s u t (T s (DNS v y yv, DNS v y yv) (DNS v y yv))
mix = forall a s u t. a -> T s u t a
Proc.pure forall a b. (a -> b) -> a -> b
$ forall y yv v (arrow :: * -> * -> *).
(C y, C y, C y yv, C v, Arrow arrow) =>
T arrow (DNS v y yv, DNS v y yv) (DNS v y yv)
Disp.mix

{-# INLINE mixVolume #-}
mixVolume ::
   (Field.C y, Module.C y yv, Dim.C v) =>
   DN.T v y ->
   Proc.T s u t (CausalD.T s (DNS v y yv, DNS v y yv) (DNS v y yv))
mixVolume :: forall y yv v s u t.
(C y, C y yv, C v) =>
T v y -> T s u t (T s (DNS v y yv, DNS v y yv) (DNS v y yv))
mixVolume = forall a s u t. a -> T s u t a
Proc.pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y yv v (arrow :: * -> * -> *).
(C y, C y yv, C v, Arrow arrow) =>
T v y -> T arrow (DNS v y yv, DNS v y yv) (DNS v y yv)
Disp.mixVolume


{-# INLINE fanoutAndMixMulti #-}
fanoutAndMixMulti ::
   (RealField.C y, Module.C y yv, Dim.C v) =>
   [Proc.T s u t (CausalD.T s sample (DNS v y yv))] ->
   Proc.T s u t (CausalD.T s sample (DNS v y yv))
fanoutAndMixMulti :: forall y yv v s u t sample.
(C y, C y yv, C v) =>
[T s u t (T s sample (DNS v y yv))]
-> T s u t (T s sample (DNS v y yv))
fanoutAndMixMulti =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall y yv v (arrow :: * -> * -> *) sample.
(C y, C y yv, C v, Arrow arrow) =>
[T arrow sample (DNS v y yv)] -> T arrow sample (DNS v y yv)
Disp.fanoutAndMixMulti forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence

{-# INLINE fanoutAndMixMultiVolume #-}
fanoutAndMixMultiVolume ::
   (Field.C y, Module.C y yv, Dim.C v) =>
   DN.T v y ->
   [Proc.T s u t (CausalD.T s sample (DNS v y yv))] ->
   Proc.T s u t (CausalD.T s sample (DNS v y yv))
fanoutAndMixMultiVolume :: forall y yv v s u t sample.
(C y, C y yv, C v) =>
T v y
-> [T s u t (T s sample (DNS v y yv))]
-> T s u t (T s sample (DNS v y yv))
fanoutAndMixMultiVolume T v y
amp =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall y yv v (arrow :: * -> * -> *) sample.
(C y, C y yv, C v, Arrow arrow) =>
T v y
-> [T arrow sample (DNS v y yv)] -> T arrow sample (DNS v y yv)
Disp.fanoutAndMixMultiVolume T v y
amp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence


-- * Miscellaneous

{-# INLINE raise #-}
raise :: (Field.C y, Module.C y yv, Dim.C v) =>
   DN.T v y ->
   yv ->
   Proc.T s u t (CausalD.T s (DNS v y yv) (DNS v y yv))
raise :: forall y yv v s u t.
(C y, C y yv, C v) =>
T v y -> yv -> T s u t (T s (DNS v y yv) (DNS v y yv))
raise T v y
y yv
yv = forall a s u t. a -> T s u t a
Proc.pure (forall y yv v (arrow :: * -> * -> *).
(C y, C y yv, C v, Arrow arrow) =>
T v y -> yv -> T arrow (DNS v y yv) (DNS v y yv)
Disp.raise T v y
y yv
yv)

{-# INLINE distort #-}
distort :: (Field.C y, Module.C y yv, Dim.C v) =>
   (yv -> yv) ->
   Proc.T s u t (CausalD.T s (DNS v y y, DNS v y yv) (DNS v y yv))
distort :: forall y yv v s u t.
(C y, C y yv, C v) =>
(yv -> yv) -> T s u t (T s (DNS v y y, DNS v y yv) (DNS v y yv))
distort =
   forall a s u t. a -> T s u t a
Proc.pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y yv v (arrow :: * -> * -> *).
(C y, C y yv, C v, Arrow arrow) =>
(yv -> yv) -> T arrow (DNS v y y, DNS v y yv) (DNS v y yv)
Disp.distort