{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.State.Interpolation (
   zeroPad,
   constantPad,
   cyclicPad,
   extrapolationPad,

   skip,
   single,

   -- imported in State.Filter.Delay
   delayPad,
   ) where

import Synthesizer.Interpolation (T, offset, number, func, )

import qualified Synthesizer.State.Signal  as Sig

import Data.Maybe (fromMaybe)

import qualified Algebra.RealRing  as RealRing

import NumericPrelude.Numeric
import NumericPrelude.Base


{-* Interpolation with various padding methods -}

{-# INLINE zeroPad #-}
zeroPad :: (RealRing.C t) =>
   (T t y -> t -> Sig.T y -> a) ->
   y -> T t y -> t -> Sig.T y -> a
zeroPad :: forall t y a.
C t =>
(T t y -> t -> T y -> a) -> y -> T t y -> t -> T y -> a
zeroPad T t y -> t -> T y -> a
interpolate y
z T t y
ip t
phase T y
x =
   let (Int
phInt, t
phFrac) = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase
   in  T t y -> t -> T y -> a
interpolate T t y
ip t
phFrac
          (y -> Int -> T y -> T y
forall y. y -> Int -> T y -> T y
delayPad y
z (T t y -> Int
forall t y. T t y -> Int
offset T t y
ip Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
phInt) (T y -> T y -> T y
forall a. T a -> T a -> T a
Sig.append T y
x (y -> T y
forall a. a -> T a
Sig.repeat y
z)))

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


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

{- |
The extrapolation may miss some of the first and some of the last points
-}
{-# INLINE extrapolationPad #-}
extrapolationPad :: (RealRing.C t) =>
   (T t y -> t -> Sig.T y -> a) ->
   T t y -> t -> Sig.T y -> a
extrapolationPad :: forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
extrapolationPad T t y -> t -> T y -> a
interpolate T t y
ip t
phase =
   T t y -> t -> T y -> a
interpolate T t y
ip (t
phase t -> t -> t
forall a. C a => a -> a -> a
- Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral (T t y -> Int
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])
-}


{-* Helper methods for interpolation of multiple nodes -}

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

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


{-* Helper functions -}

{-# INLINE delayPad #-}
delayPad :: y -> Int -> Sig.T y -> Sig.T y
delayPad :: forall y. y -> Int -> T y -> T y
delayPad y
z Int
n =
   if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0
     then Int -> T y -> T y
forall a. Int -> T a -> T a
Sig.drop (Int -> Int
forall a. C a => a -> a
negate Int
n)
     else T y -> T y -> T y
forall a. T a -> T a -> T a
Sig.append (Int -> y -> T y
forall a. Int -> a -> T a
Sig.replicate Int
n y
z)