{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Generic.Interpolation (
   T, func, offset, number,
   zeroPad, constantPad, cyclicPad, extrapolationPad,
   single,
   multiRelative,
   multiRelativeZeroPad, multiRelativeConstantPad,
   multiRelativeCyclicPad, multiRelativeExtrapolationPad,
   multiRelativeZeroPadConstant, multiRelativeZeroPadLinear,
   multiRelativeZeroPadCubic,
   ) where

import qualified Synthesizer.Interpolation as Interpolation
import Synthesizer.Interpolation (T, offset, number, )
import Synthesizer.Interpolation.Module (constant, linear, cubic, )

import qualified Synthesizer.Generic.Signal  as SigG
import qualified Synthesizer.Generic.Filter.NonRecursive as FiltNR

import qualified Algebra.Module    as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.RealRing  as RealRing
import qualified Algebra.Additive  as Additive

import Data.Maybe (fromMaybe, )

import NumericPrelude.Numeric
import NumericPrelude.Base


{-* Interpolation with various padding methods -}

{-# INLINE zeroPad #-}
zeroPad :: (RealRing.C t, SigG.Write sig y) =>
   (T t y -> t -> sig y -> a) ->
   y -> T t y -> t -> sig y -> a
zeroPad :: forall t (sig :: * -> *) y a.
(C t, Write sig y) =>
(T t y -> t -> sig y -> a) -> y -> T t y -> t -> sig y -> a
zeroPad T t y -> t -> sig y -> a
interpolate y
z T t y
ip t
phase sig y
x =
   let (Int
phInt, t
phFrac) = forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase
   in  T t y -> t -> sig y -> a
interpolate T t y
ip t
phFrac
          (forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
FiltNR.delayPad y
z (forall t y. T t y -> Int
offset T t y
ip forall a. C a => a -> a -> a
- Int
phInt)
              (forall sig. Monoid sig => sig -> sig -> sig
SigG.append sig y
x (forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> y -> sig y
SigG.repeat LazySize
SigG.defaultLazySize y
z)))

{-# INLINE constantPad #-}
constantPad :: (RealRing.C t, SigG.Write sig y) =>
   (T t y -> t -> sig y -> a) ->
   T t y -> t -> sig y -> a
constantPad :: forall t (sig :: * -> *) y a.
(C t, Write sig y) =>
(T t y -> t -> sig y -> a) -> T t y -> t -> sig y -> a
constantPad T t y -> t -> sig y -> a
interpolate T t y
ip t
phase sig y
x =
   let (Int
phInt, t
phFrac) = forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase
       xPad :: Maybe (sig y)
xPad =
          do (y
xFirst,sig y
_) <- forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
SigG.viewL sig y
x
             forall (m :: * -> *) a. Monad m => a -> m a
return (forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
FiltNR.delayPad y
xFirst
                (forall t y. T t y -> Int
offset T t y
ip forall a. C a => a -> a -> a
- Int
phInt) (forall (sig :: * -> *) y. Write sig y => LazySize -> sig y -> sig y
SigG.extendConstant LazySize
SigG.defaultLazySize sig y
x))
   in  T t y -> t -> sig y -> a
interpolate T t y
ip t
phFrac
          (forall a. a -> Maybe a -> a
fromMaybe forall sig. Monoid sig => sig
SigG.empty Maybe (sig y)
xPad)


{- |
Only for finite input signals.
-}
{-# INLINE cyclicPad #-}
cyclicPad :: (RealRing.C t, SigG.Transform sig y) =>
   (T t y -> t -> sig y -> a) ->
   T t y -> t -> sig y -> a
cyclicPad :: forall t (sig :: * -> *) y a.
(C t, Transform sig y) =>
(T t y -> t -> sig y -> a) -> T t y -> t -> sig y -> a
cyclicPad T t y -> t -> sig y -> a
interpolate T t y
ip t
phase sig y
x =
   let (Int
phInt, t
phFrac) = forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase
   in  T t y -> t -> sig y -> a
interpolate T t y
ip t
phFrac
          (forall sig. Transform sig => Int -> sig -> sig
SigG.drop (forall a. C a => a -> a -> a
mod (Int
phInt forall a. C a => a -> a -> a
- forall t y. T t y -> Int
offset T t y
ip) (forall sig. Read sig => sig -> Int
SigG.length sig y
x)) (forall sig. Monoid sig => sig -> sig
SigG.cycle sig y
x))

{- |
The extrapolation may miss some of the first and some of the last points
-}
{-# INLINE extrapolationPad #-}
extrapolationPad :: (RealRing.C t, SigG.Transform sig y) =>
   (T t y -> t -> sig y -> a) ->
   T t y -> t -> sig y -> a
extrapolationPad :: forall t (sig :: * -> *) y a.
(C t, Transform sig y) =>
(T t y -> t -> sig y -> a) -> T t y -> t -> sig y -> a
extrapolationPad T t y -> t -> sig y -> a
interpolate T t y
ip t
phase =
   T t y -> t -> sig y -> a
interpolate T t y
ip (t
phase forall a. C a => a -> a -> a
- forall a b. (C a, C b) => a -> b
fromIntegral (forall t y. T t y -> Int
offset T t y
ip))
{-
  This example shows pikes, although there shouldn't be any:
   plotList (take 100 $ interpolate (Zero (0::Double)) ipCubic (-0.9::Double) (repeat 0.03) [1,0,1,0.8])
-}


{-* Interpolation of multiple values with various padding methods -}

func :: (SigG.Read sig y) =>
   T t y -> t -> sig y -> y
func :: forall (sig :: * -> *) y t. Read sig y => T t y -> t -> sig y -> y
func T t y
ip t
phase =
   forall t y. T t y -> t -> T y -> y
Interpolation.func T t y
ip t
phase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState

{-# INLINE skip #-}
skip :: (RealRing.C t, SigG.Transform sig y) =>
   T t y -> (t, sig y) -> (t, sig y)
skip :: forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> (t, sig y) -> (t, sig y)
skip T t y
ip (t
phase0, sig y
x0) =
   let (Int
n, t
frac) = forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase0
       (Int
m, sig y
x1) = forall sig. Transform sig => Int -> Int -> sig -> (Int, sig)
SigG.dropMarginRem (forall t y. T t y -> Int
number T t y
ip) Int
n sig y
x0
   in  (forall a b. (C a, C b) => a -> b
fromIntegral Int
m forall a. C a => a -> a -> a
+ t
frac, sig y
x1)

{-# INLINE single #-}
single :: (RealRing.C t, SigG.Transform sig y) =>
   T t y -> t -> sig y -> y
single :: forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> t -> sig y -> y
single T t y
ip t
phase0 sig y
x0 =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (sig :: * -> *) y t. Read sig y => T t y -> t -> sig y -> y
func T t y
ip) forall a b. (a -> b) -> a -> b
$ forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> (t, sig y) -> (t, sig y)
skip T t y
ip (t
phase0, sig y
x0)
--   curry (uncurry (func ip) . skip ip)
{-
GNUPlot.plotFunc [] (GNUPlot.linearScale 1000 (0,2)) (\t -> single linear (t::Double) [0,4,1::Double])
-}


{-* Interpolation of multiple values with various padding methods -}

{- | All values of frequency control must be non-negative. -}
{-# INLINE multiRelative #-}
multiRelative ::
   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y) =>
   T t y -> t -> sig y -> sig t -> sig y
multiRelative :: forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y) =>
T t y -> t -> sig y -> sig t -> sig y
multiRelative T t y
ip t
phase0 sig y
x0 =
   forall (sig :: * -> *) y0 y1 s.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
SigG.crochetL
      (\t
freq (t, sig y)
pos ->
          let (t
phase,sig y
x) = forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> (t, sig y) -> (t, sig y)
skip T t y
ip (t, sig y)
pos
          in  forall a. a -> Maybe a
Just (forall (sig :: * -> *) y t. Read sig y => T t y -> t -> sig y -> y
func T t y
ip t
phase sig y
x, (t
phaseforall a. C a => a -> a -> a
+t
freq,sig y
x)))
      (t
phase0,sig y
x0)


{-# INLINE multiRelativeZeroPad #-}
multiRelativeZeroPad ::
   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>
   y -> T t y -> t -> sig t -> sig y -> sig y
multiRelativeZeroPad :: forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y, Write sig y) =>
y -> T t y -> t -> sig t -> sig y -> sig y
multiRelativeZeroPad y
z T t y
ip t
phase sig t
fs sig y
x =
   forall t (sig :: * -> *) y a.
(C t, Write sig y) =>
(T t y -> t -> sig y -> a) -> y -> T t y -> t -> sig y -> a
zeroPad forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y) =>
T t y -> t -> sig y -> sig t -> sig y
multiRelative y
z T t y
ip t
phase sig y
x sig t
fs

{-# INLINE multiRelativeConstantPad #-}
multiRelativeConstantPad ::
   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>
   T t y -> t -> sig t -> sig y -> sig y
multiRelativeConstantPad :: forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y, Write sig y) =>
T t y -> t -> sig t -> sig y -> sig y
multiRelativeConstantPad T t y
ip t
phase sig t
fs sig y
x =
   forall t (sig :: * -> *) y a.
(C t, Write sig y) =>
(T t y -> t -> sig y -> a) -> T t y -> t -> sig y -> a
constantPad forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y) =>
T t y -> t -> sig y -> sig t -> sig y
multiRelative T t y
ip t
phase sig y
x sig t
fs

{-# INLINE multiRelativeCyclicPad #-}
multiRelativeCyclicPad ::
   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y) =>
   T t y -> t -> sig t -> sig y -> sig y
multiRelativeCyclicPad :: forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y) =>
T t y -> t -> sig t -> sig y -> sig y
multiRelativeCyclicPad T t y
ip t
phase sig t
fs sig y
x =
   forall t (sig :: * -> *) y a.
(C t, Transform sig y) =>
(T t y -> t -> sig y -> a) -> T t y -> t -> sig y -> a
cyclicPad forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y) =>
T t y -> t -> sig y -> sig t -> sig y
multiRelative T t y
ip t
phase sig y
x sig t
fs

{- |
The extrapolation may miss some of the first and some of the last points
-}
{-# INLINE multiRelativeExtrapolationPad #-}
multiRelativeExtrapolationPad ::
   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y) =>
   T t y -> t -> sig t -> sig y -> sig y
multiRelativeExtrapolationPad :: forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y) =>
T t y -> t -> sig t -> sig y -> sig y
multiRelativeExtrapolationPad T t y
ip t
phase sig t
fs sig y
x =
   forall t (sig :: * -> *) y a.
(C t, Transform sig y) =>
(T t y -> t -> sig y -> a) -> T t y -> t -> sig y -> a
extrapolationPad forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y) =>
T t y -> t -> sig y -> sig t -> sig y
multiRelative T t y
ip t
phase sig y
x sig t
fs
{-
  This example shows pikes, although there shouldn't be any:
   plotList (take 100 $ interpolate (Zero (0::Double)) ipCubic (-0.9::Double) (repeat 0.03) [1,0,1,0.8])
-}

{-* All-in-one interpolation functions -}

{-# INLINE multiRelativeZeroPadConstant #-}
multiRelativeZeroPadConstant ::
   (RealRing.C t, Additive.C y, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>
   t -> sig t -> sig y -> sig y
multiRelativeZeroPadConstant :: forall t y (sig :: * -> *).
(C t, C y, Transform sig t, Transform sig y, Write sig y) =>
t -> sig t -> sig y -> sig y
multiRelativeZeroPadConstant =
   forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y, Write sig y) =>
y -> T t y -> t -> sig t -> sig y -> sig y
multiRelativeZeroPad forall a. C a => a
zero forall t y. T t y
constant

{-# INLINE multiRelativeZeroPadLinear #-}
multiRelativeZeroPadLinear ::
   (RealRing.C t, Module.C t y, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>
   t -> sig t -> sig y -> sig y
multiRelativeZeroPadLinear :: forall t y (sig :: * -> *).
(C t, C t y, Transform sig t, Transform sig y, Write sig y) =>
t -> sig t -> sig y -> sig y
multiRelativeZeroPadLinear =
   forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y, Write sig y) =>
y -> T t y -> t -> sig t -> sig y -> sig y
multiRelativeZeroPad forall a. C a => a
zero forall t y. C t y => T t y
linear

{-# INLINE multiRelativeZeroPadCubic #-}
multiRelativeZeroPadCubic ::
   (RealField.C t, Module.C t y, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>
   t -> sig t -> sig y -> sig y
multiRelativeZeroPadCubic :: forall t y (sig :: * -> *).
(C t, C t y, Transform sig t, Transform sig y, Write sig y) =>
t -> sig t -> sig y -> sig y
multiRelativeZeroPadCubic =
   forall t (sig :: * -> *) y.
(C t, Transform sig t, Transform sig y, Write sig y) =>
y -> T t y -> t -> sig t -> sig y -> sig y
multiRelativeZeroPad forall a. C a => a
zero forall t y. (C t, C t y) => T t y
cubic