{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.Interpolation (
T, func, offset, number,
zeroPad, constantPad, cyclicPad, extrapolationPad,
single,
multiRelative,
multiRelativeZeroPad, multiRelativeConstantPad,
multiRelativeCyclicPad, multiRelativeExtrapolationPad,
multiRelativeZeroPadConstant, multiRelativeZeroPadLinear,
multiRelativeZeroPadCubic,
constant, linear, cubic,
piecewise, function,
Interpolation.Margin, Interpolation.margin,
singleRec,
) where
import qualified Synthesizer.Interpolation as Interpolation
import Synthesizer.Interpolation (T, offset, number, )
import Synthesizer.Interpolation.Module
(constant, linear, cubic, piecewise, function, )
import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR
import Control.Monad (guard, )
import qualified Data.List.HT as ListHT
import Data.Maybe (fromMaybe)
import qualified Algebra.Module as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base
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
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) (T y
x T y -> T y -> T y
forall a. [a] -> [a] -> [a]
++ y -> T y
forall a. a -> [a]
repeat y
z))
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. [a] -> Maybe (a, [a])
ListHT.viewL T y
x
(T y
xBody,y
xLast) <- T y -> Maybe (T y, y)
forall a. [a] -> Maybe ([a], a)
ListHT.viewR 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
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) (T y
xBody T y -> T y -> T y
forall a. [a] -> [a] -> [a]
++ y -> T y
forall a. a -> [a]
repeat y
xLast))
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 [] Maybe (T y)
xPad)
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 -> [a] -> [a]
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. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length T y
x)) (T y -> T y
forall a. HasCallStack => [a] -> [a]
cycle T y
x))
extrapolationPad :: (RealRing.C t) =>
(T t y -> t -> Sig.T y -> a) ->
T t y -> t -> Sig.T y -> a
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))
func ::
T t y -> t -> Sig.T y -> y
func :: forall t y. T t y -> t -> T 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) -> (T y -> T y) -> T y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> T y
forall y. [y] -> T y
SigS.fromList
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)
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)
singleRec :: (Ord t, Ring.C t) =>
T t y -> t -> Sig.T y -> y
singleRec :: forall t y. (Ord t, C t) => T t y -> t -> T y -> y
singleRec T t y
ip t
phase T y
x =
y -> (T y -> y) -> Maybe (T y) -> y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(T t y -> t -> T y -> y
forall t y. T t y -> t -> T y -> y
func T t y
ip t
phase T y
x)
(T t y -> t -> T y -> y
forall t y. (Ord t, C t) => T t y -> t -> T y -> y
singleRec T t y
ip (t
phase t -> t -> t
forall a. C a => a -> a -> a
- t
1))
(do (y
_,T y
xs) <- T y -> Maybe (y, T y)
forall a. [a] -> Maybe (a, [a])
ListHT.viewL T y
x
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (t
phase t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
1 Bool -> Bool -> Bool
&& Int -> T y -> Bool
forall a. Int -> T a -> Bool
Sig.lengthAtLeast (T t y -> Int
forall t y. T t y -> Int
number T t y
ip) T y
xs)
T y -> Maybe (T y)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return T y
xs)
multiRelative :: (RealRing.C t) =>
T t y -> t -> Sig.T y -> Sig.T t -> Sig.T y
multiRelative :: forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative T t y
ip t
phase0 T y
x0 =
((t, T y) -> y) -> [(t, T y)] -> T y
forall a b. (a -> b) -> [a] -> [b]
map ((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)] -> T y) -> (T t -> [(t, T y)]) -> T t -> T y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((t, T y) -> t -> (t, T y)) -> (t, T y) -> T t -> [(t, T y)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(\(t
phase,T y
x) t
freq -> 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
phase t -> t -> t
forall a. C a => a -> a -> a
+ t
freq, T y
x))
(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))
multiRelativeZeroPad :: (RealRing.C t) =>
y -> T t y -> t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeZeroPad :: forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad y
z T t y
ip t
phase T t
fs T y
x =
(T t y -> t -> T y -> T t -> T y)
-> y -> T t y -> t -> T y -> T t -> T y
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 -> T t -> T y
forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative y
z T t y
ip t
phase T y
x T t
fs
multiRelativeConstantPad :: (RealRing.C t) =>
T t y -> t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeConstantPad :: forall t y. C t => T t y -> t -> T t -> T y -> T y
multiRelativeConstantPad T t y
ip t
phase T t
fs T y
x =
(T t y -> t -> T y -> T t -> T y)
-> T t y -> t -> T y -> T t -> T y
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 -> T t -> T y
forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative T t y
ip t
phase T y
x T t
fs
multiRelativeCyclicPad :: (RealRing.C t) =>
T t y -> t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeCyclicPad :: forall t y. C t => T t y -> t -> T t -> T y -> T y
multiRelativeCyclicPad T t y
ip t
phase T t
fs T y
x =
(T t y -> t -> T y -> T t -> T y)
-> T t y -> t -> T y -> T t -> T y
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 -> T t -> T y
forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative T t y
ip t
phase T y
x T t
fs
multiRelativeExtrapolationPad :: (RealRing.C t) =>
T t y -> t -> Sig.T t -> Sig.T y -> Sig.T y
T t y
ip t
phase T t
fs T y
x =
(T t y -> t -> T y -> T t -> T y)
-> T t y -> t -> T y -> T t -> T y
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 -> T t -> T y
forall t y. C t => T t y -> t -> T y -> T t -> T y
multiRelative T t y
ip t
phase T y
x T t
fs
multiRelativeZeroPadConstant ::
(RealRing.C t, Additive.C y) => t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeZeroPadConstant :: forall t y. (C t, C y) => t -> T t -> T y -> T y
multiRelativeZeroPadConstant = y -> T t y -> t -> T t -> T y -> T y
forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad y
forall a. C a => a
zero T t y
forall t y. T t y
constant
multiRelativeZeroPadLinear ::
(RealRing.C t, Module.C t y) => t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeZeroPadLinear :: forall t y. (C t, C t y) => t -> T t -> T y -> T y
multiRelativeZeroPadLinear = y -> T t y -> t -> T t -> T y -> T y
forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad y
forall a. C a => a
zero T t y
forall t y. C t y => T t y
linear
multiRelativeZeroPadCubic ::
(RealField.C t, Module.C t y) => t -> Sig.T t -> Sig.T y -> Sig.T y
multiRelativeZeroPadCubic :: forall t y. (C t, C t y) => t -> T t -> T y -> T y
multiRelativeZeroPadCubic = y -> T t y -> t -> T t -> T y -> T y
forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad y
forall a. C a => a
zero T t y
forall t y. (C t, C t y) => T t y
cubic