{-# LANGUAGE NoImplicitPrelude #-}
{- |
<http://en.wikipedia.org/wiki/Particle_displacement>
-}
module Synthesizer.Generic.Displacement where

import qualified Synthesizer.Generic.Signal as SigG

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.
    In opposition to 'zipWith' the result has the length of the longer signal. -}
mix :: (Additive.C v, SigG.Transform sig v) =>
   sig v -> sig v -> sig v
mix :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> sig v -> sig v
mix = sig v -> sig v -> sig v
forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> sig v -> sig v
SigG.mix

{- relict from Prelude98's Num
mixMono :: Ring.C a => [a] -> [a] -> [a]
mixMono [] x  = x
mixMono x  [] = x
mixMono (x:xs) (y:ys) = x+y : mixMono xs ys
-}

{-| Mix one or more signals. -}
mixMulti :: (Additive.C v, SigG.Transform sig v) =>
   [sig v] -> sig v
mixMulti :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
[sig v] -> sig v
mixMulti = (sig v -> sig v -> sig v) -> sig v -> [sig v] -> sig v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl sig v -> sig v -> sig v
forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> sig v -> sig v
mix sig v
forall sig. Monoid sig => sig
SigG.empty


{-| Add a number to all of the signal values.
    This is useful for adjusting the center of a modulation. -}
raise :: (Additive.C v, SigG.Transform sig v) =>
   v -> sig v -> sig v
raise :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
v -> sig v -> sig v
raise v
x = (v -> v) -> sig v -> sig v
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (v -> v -> v
forall a. C a => a -> a -> a
(+) v
x)


-- * Distortion

{- |
In "Synthesizer.Basic.Distortion" you find a collection
of appropriate distortion functions.
-}
distort :: (SigG.Read sig c, SigG.Transform sig v) =>
   (c -> v -> v) -> sig c -> sig v -> sig v
distort :: forall (sig :: * -> *) c v.
(Read sig c, Transform sig v) =>
(c -> v -> v) -> sig c -> sig v -> sig v
distort = (c -> v -> v) -> sig c -> sig v -> sig v
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
SigG.zipWith


-- * Preprocessing of control curves

{-# INLINE mapLinear #-}
mapLinear :: (Ring.C a, SigG.Transform sig a) =>
   a ->
   a ->
   sig a ->
   sig a
mapLinear :: forall a (sig :: * -> *).
(C a, Transform sig a) =>
a -> a -> sig a -> sig a
mapLinear a
depth a
center =
   (a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (\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, SigG.Transform sig a) =>
   a ->
   a ->
   sig a ->
   sig a
mapExponential :: forall a (sig :: * -> *).
(C a, Transform sig a) =>
a -> a -> sig a -> sig a
mapExponential a
depth a
center =
   -- SigG.map ((center*) . (depth**))
   -- should be faster
   let logDepth :: a
logDepth = a -> a
forall a. C a => a -> a
log a
depth
   in  (a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map ((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
*))