{-# 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) = 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
(forall y. y -> Int -> T y -> T 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) (T y
x forall a. [a] -> [a] -> [a]
++ 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) = forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase
xPad :: Maybe (T y)
xPad =
do (y
xFirst,T y
_) <- forall a. [a] -> Maybe (a, [a])
ListHT.viewL T y
x
(T y
xBody,y
xLast) <- forall a. [a] -> Maybe ([a], a)
ListHT.viewR T y
x
forall (m :: * -> *) a. Monad m => a -> m a
return (forall y. y -> Int -> T y -> T 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) (T y
xBody forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat y
xLast))
in T t y -> t -> T y -> a
interpolate T t y
ip t
phFrac
(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) = 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
(forall a. Int -> [a] -> [a]
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 (t :: * -> *) a. Foldable t => t a -> Int
length T y
x)) (forall a. [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 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))
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 =
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 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) = forall a b. (C a, C b) => a -> (b, a)
splitFraction t
phase0
(Int
m, T y
x1) = forall a. Int -> Int -> T a -> (Int, T a)
Sig.dropMarginRem (forall t y. T t y -> Int
number T t y
ip) Int
n T y
x0
in (forall a b. (C a, C b) => a -> b
fromIntegral Int
m 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 =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall t y. T t y -> t -> T y -> y
func T t y
ip) forall a b. (a -> b) -> a -> b
$ 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 =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall t y. T t y -> t -> T y -> y
func T t y
ip t
phase T y
x)
(forall t y. (Ord t, C t) => T t y -> t -> T y -> y
singleRec T t y
ip (t
phase forall a. C a => a -> a -> a
- t
1))
(do (y
_,T y
xs) <- forall a. [a] -> Maybe (a, [a])
ListHT.viewL T y
x
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (t
phase forall a. Ord a => a -> a -> Bool
>= t
1 Bool -> Bool -> Bool
&& forall a. Int -> T a -> Bool
Sig.lengthAtLeast (forall t y. T t y -> Int
number T t y
ip) T y
xs)
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 =
forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall t y. T t y -> t -> T y -> y
func T t y
ip)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(\(t
phase,T y
x) t
freq -> forall t y. C t => T t y -> (t, T y) -> (t, T y)
skip T t y
ip (t
phase forall a. C a => a -> a -> a
+ t
freq, T y
x))
(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 =
forall t y a.
C t =>
(T t y -> t -> T y -> a) -> y -> T t y -> t -> T y -> a
zeroPad 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 =
forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
constantPad 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 =
forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
cyclicPad 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 =
forall t y a.
C t =>
(T t y -> t -> T y -> a) -> T t y -> t -> T y -> a
extrapolationPad 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 = forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad forall a. C a => a
zero 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 = forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad forall a. C a => a
zero 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 = forall t y. C t => y -> T t y -> t -> T t -> T y -> T y
multiRelativeZeroPad forall a. C a => a
zero forall t y. (C t, C t y) => T t y
cubic