{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Causal.Displacement where

import qualified Control.Arrow as A

import qualified Algebra.Transcendental        as Trans
import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive

import NumericPrelude.Numeric
import NumericPrelude.Base


-- * Mixing

{-|
Mix two signals.
Unfortunately we have to use 'zipWith' semantic here,
that is the result is as long as the shorter of both inputs.
-}
{-# INLINE mix #-}
mix :: (Additive.C v, A.Arrow arrow) => arrow (v,v) v
mix :: forall v (arrow :: * -> * -> *).
(C v, Arrow arrow) =>
arrow (v, v) v
mix = ((v, v) -> v) -> arrow (v, v) v
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr ((v -> v -> v) -> (v, v) -> v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry v -> v -> v
forall a. C a => a -> a -> a
(+))


{-|
Add a number to all of the signal values.
This is useful for adjusting the center of a modulation.
-}
{-# INLINE raise #-}
raise :: (Additive.C v, A.Arrow arrow) => v -> arrow v v
raise :: forall v (arrow :: * -> * -> *).
(C v, Arrow arrow) =>
v -> arrow v v
raise v
x = (v -> v) -> arrow v v
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr (v
xv -> v -> v
forall a. C a => a -> a -> a
+)


-- * Distortion
{-|
In "Synthesizer.Basic.Distortion" you find a collection
of appropriate distortion functions.
-}
{-# INLINE distort #-}
distort :: (A.Arrow arrow) => (c -> a -> a) -> arrow (c,a) a
distort :: forall (arrow :: * -> * -> *) c a.
Arrow arrow =>
(c -> a -> a) -> arrow (c, a) a
distort c -> a -> a
f = ((c, a) -> a) -> arrow (c, a) a
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr ((c -> a -> a) -> (c, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry c -> a -> a
f)

-- * Preprocessing of control curves

{-# INLINE mapLinear #-}
mapLinear :: (Ring.C a, A.Arrow arrow) =>
   a ->
   a ->
   arrow a a
mapLinear :: forall a (arrow :: * -> * -> *).
(C a, Arrow arrow) =>
a -> a -> arrow a a
mapLinear a
depth a
center =
   (a -> a) -> arrow a a
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr (\a
x -> a
centera -> a -> a
forall a. C a => a -> a -> a
*(a
forall a. C a => a
onea -> a -> a
forall a. C a => a -> a -> a
+a
xa -> a -> a
forall a. C a => a -> a -> a
*a
depth))

{-# INLINE mapExponential #-}
mapExponential :: (Trans.C a, A.Arrow arrow) =>
   a ->
   a ->
   arrow a a
mapExponential :: forall a (arrow :: * -> * -> *).
(C a, Arrow arrow) =>
a -> a -> arrow a a
mapExponential a
depth a
center =
   -- Sig.map ((center*) . (depth**))
   -- should be faster
   let logDepth :: a
logDepth = a -> a
forall a. C a => a -> a
log a
depth
   in  (a -> a) -> arrow a a
forall b c. (b -> c) -> arrow b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr ((a
centera -> a -> a
forall a. C a => a -> a -> a
*) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. C a => a -> a
exp (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
logDeptha -> a -> a
forall a. C a => a -> a -> a
*))