{-# 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
{-# 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) = 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 -> sig y -> a
interpolate T t y
ip t
phFrac
(y -> Int -> sig y -> sig y
forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
FiltNR.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)
(sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
SigG.append sig y
x (LazySize -> y -> sig y
forall y. Storage (sig y) => LazySize -> y -> sig y
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) = 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 (sig y)
xPad =
do (y
xFirst,sig y
_) <- sig y -> Maybe (y, sig y)
forall y. Storage (sig y) => sig y -> Maybe (y, sig y)
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
SigG.viewL sig y
x
sig y -> Maybe (sig y)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (y -> Int -> sig y -> sig y
forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
FiltNR.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) (LazySize -> sig y -> sig y
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
(sig y -> Maybe (sig y) -> sig y
forall a. a -> Maybe a -> a
fromMaybe sig y
forall sig. Monoid sig => sig
SigG.empty Maybe (sig y)
xPad)
{-# 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) = 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 -> sig y -> a
interpolate T t y
ip t
phFrac
(Int -> sig y -> sig y
forall sig. Transform sig => Int -> sig -> sig
SigG.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) (sig y -> Int
forall sig. Read sig => sig -> Int
SigG.length sig y
x)) (sig y -> sig y
forall sig. Monoid sig => sig -> sig
SigG.cycle sig y
x))
{-# INLINE extrapolationPad #-}
extrapolationPad :: (RealRing.C t, SigG.Transform sig y) =>
(T t y -> t -> sig y -> a) ->
T t y -> t -> sig y -> a
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 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))
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 =
T t y -> t -> T y -> y
forall t y. T t y -> t -> T y -> y
Interpolation.func T t y
ip t
phase (T y -> y) -> (sig y -> T y) -> sig y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig y -> T y
forall y. Storage (sig y) => sig y -> T y
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) = 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, sig y
x1) = Int -> Int -> sig y -> (Int, sig y)
forall sig. Transform sig => Int -> Int -> sig -> (Int, sig)
SigG.dropMarginRem (T t y -> Int
forall t y. T t y -> Int
number T t y
ip) Int
n sig 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, 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 =
(t -> sig y -> y) -> (t, sig y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> t -> sig y -> y
forall (sig :: * -> *) y t. Read sig y => T t y -> t -> sig y -> y
func T t y
ip) ((t, sig y) -> y) -> (t, sig y) -> y
forall a b. (a -> b) -> a -> b
$ T t y -> (t, sig y) -> (t, sig y)
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)
{-# 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 =
(t -> (t, sig y) -> Maybe (y, (t, sig y)))
-> (t, sig y) -> sig t -> sig y
forall y0 y1 s.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
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) = T t y -> (t, sig y) -> (t, sig y)
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 (y, (t, sig y)) -> Maybe (y, (t, sig y))
forall a. a -> Maybe a
Just (T t y -> t -> sig y -> y
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
phaset -> t -> t
forall 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 =
(T t y -> t -> sig y -> sig t -> sig y)
-> y -> T t y -> t -> sig y -> sig t -> sig y
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 -> sig t -> sig y
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 =
(T t y -> t -> sig y -> sig t -> sig y)
-> T t y -> t -> sig y -> sig t -> sig y
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 -> sig t -> sig y
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 =
(T t y -> t -> sig y -> sig t -> sig y)
-> T t y -> t -> sig y -> sig t -> sig y
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 -> sig t -> sig y
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 multiRelativeExtrapolationPad #-}
multiRelativeExtrapolationPad ::
(RealRing.C t, SigG.Transform sig t, SigG.Transform sig y) =>
T t y -> t -> sig t -> sig y -> sig y
T t y
ip t
phase sig t
fs sig y
x =
(T t y -> t -> sig y -> sig t -> sig y)
-> T t y -> t -> sig y -> sig t -> sig y
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 -> sig t -> sig y
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 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 =
y -> T t y -> t -> sig t -> sig y -> sig y
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
forall a. C a => a
zero T t y
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 =
y -> T t y -> t -> sig t -> sig y -> sig y
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
forall a. C a => a
zero T t y
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 =
y -> T t y -> t -> sig t -> sig y -> sig y
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
forall a. C a => a
zero T t y
forall t y. (C t, C t y) => T t y
cubic