{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Generic.Filter.Delay (
   static,
   staticPad,
   staticPos,
   staticNeg,
   modulated,
   ) where

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

import qualified Algebra.RealField as RealField
import qualified Algebra.Additive  as Additive

import NumericPrelude.Numeric



{- * Shift -}

{-# INLINE static #-}
static ::
   (Additive.C y, SigG.Write sig y) =>
   Int -> sig y -> sig y
static :: forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
static = Int -> sig y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
FiltNR.delay

{-# INLINE staticPad #-}
staticPad ::
   (SigG.Write sig y) =>
   y -> Int -> sig y -> sig y
staticPad :: forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
staticPad = y -> Int -> sig y -> sig y
forall (sig :: * -> *) y. Write sig y => y -> Int -> sig y -> sig y
FiltNR.delayPad

{-# INLINE staticPos #-}
staticPos ::
   (Additive.C y, SigG.Write sig y) =>
   Int -> sig y -> sig y
staticPos :: forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
staticPos = Int -> sig y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
FiltNR.delayPos

{-# INLINE staticNeg #-}
staticNeg ::
   (SigG.Write sig y) =>
   Int -> sig y -> sig y
staticNeg :: forall (sig :: * -> *) y. Write sig y => Int -> sig y -> sig y
staticNeg = Int -> sig y -> sig y
forall (sig :: * -> *) y. Transform sig y => Int -> sig y -> sig y
FiltNR.delayNeg




{-# INLINE modulatedCore #-}
modulatedCore ::
   (RealField.C t, Additive.C y, SigG.Read sig t, SigG.Transform sig t, SigG.Transform sig y) =>
   Interpolation.T t y -> Int ->
   sig t -> sig y -> sig y
modulatedCore :: forall t y (sig :: * -> *).
(C t, C y, Read sig t, Transform sig t, Transform sig y) =>
T t y -> Int -> sig t -> sig y -> sig y
modulatedCore T t y
ip Int
size =
   (t -> sig y -> y) -> sig t -> sig y -> sig y
forall (sig :: * -> *) a b c.
(Transform sig a, Transform sig b, Transform sig c) =>
(a -> sig b -> c) -> sig a -> sig b -> sig c
SigG.zipWithTails
      (\t
t -> T t y -> t -> sig y -> y
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> t -> sig y -> y
Interpolation.single T t y
ip (Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral Int
size t -> t -> t
forall a. C a => a -> a -> a
+ t
t))


{- |
This is essentially different for constant interpolation,
because this function "looks forward"
whereas the other two variants "look backward".
For the symmetric interpolation functions
of linear and cubic interpolation, this does not really matter.
-}
{-# INLINE modulated #-}
modulated ::
   (RealField.C t, Additive.C y,
    SigG.Read sig t, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>
   Interpolation.T t y -> Int ->
   sig t -> sig y -> sig y
modulated :: forall t y (sig :: * -> *).
(C t, C y, Read sig t, Transform sig t, Transform sig y,
 Write sig y) =>
T t y -> Int -> sig t -> sig y -> sig y
modulated T t y
ip Int
minDev sig t
ts sig y
xs =
   let size :: Int
size = T t y -> Int
forall t y. T t y -> Int
Interpolation.number T t y
ip Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
minDev
   in  T t y -> Int -> sig t -> sig y -> sig y
forall t y (sig :: * -> *).
(C t, C y, Read sig t, Transform sig t, Transform sig y) =>
T t y -> Int -> sig t -> sig y -> sig y
modulatedCore T t y
ip
          (Int
size Int -> Int -> Int
forall a. C a => a -> a -> a
- T t y -> Int
forall t y. T t y -> Int
Interpolation.offset T t y
ip)
          sig t
ts
          (Int -> sig y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
staticPos Int
size sig y
xs)