{-# LANGUAGE NoImplicitPrelude #-}
{- |
Tone generators with measures for band-limitation.

They are not exactly band-limiting because this would cause infinite lag.
Instead we use only cubic interpolation polynomials.
This still incurs a small lag.

<https://youtu.be/lpM4Tawq-XU>
-}
module Synthesizer.Plain.Oscillator.BandLimited where

import qualified Synthesizer.Plain.Signal as Sig

import qualified Algebra.RealField as RealField

import NumericPrelude.Numeric
import NumericPrelude.Base



{-
sinc approximation, that could be used for band-limited oscillators:

GP.plotFuncs [] (GP.linearScale 1000 (-2,2::Double)) [\x -> if x<0 then (if x< -1 then (x+1)*(x+2)*(x+2) else 1-x*x*2-x*x*x) else (if x<1 then 1-x*x*2+x*x*x else -(x-1)*(x-2)*(x-2)), \x -> if x==0 then 1 else sin (pi*x)/(pi*x)]

Has the same tangent as sinc-pi at point 1.

Cf.
DSP.Filter.FIR.PolyInterp
Integral Sine: gsl_sf_Si
-}



{- | impulse train with static frequency -}
staticImpulses :: (RealField.C a) => a -> a -> Sig.T a
staticImpulses :: forall a. C a => a -> a -> T a
staticImpulses a
phase = a -> T a -> T a
forall a. C a => a -> T a -> T a
freqModImpulses a
phase (T a -> T a) -> (a -> T a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T a
forall a. a -> [a]
repeat

{- | impulse train with modulated frequency -}
freqModImpulses :: (RealField.C a) => a -> Sig.T a -> Sig.T a
freqModImpulses :: forall a. C a => a -> T a -> T a
freqModImpulses a
phase =
   (\ ~(~(a
_,[a]
remaining),[a]
xs) -> [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
remaining) (((a, [a]), [a]) -> [a]) -> ([a] -> ((a, [a]), [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (a -> (a, [a]) -> Maybe (a, (a, [a])))
-> (a, [a]) -> [a] -> ((a, [a]), [a])
forall x acc y.
(x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y)
Sig.mapAccumL
      (\a
freq (a
p0,[a]
xs0) ->
         let p1 :: a
p1 = a
p0a -> a -> a
forall a. C a => a -> a -> a
+a
freq
             (a
p2, [a]
xs1) =
               if a
p1a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
1
               then
                  let p1frac :: a
p1frac=a -> a
forall a. C a => a -> a
fraction a
p1
                      t :: a
t=a
p1fraca -> a -> a
forall a. C a => a -> a -> a
/a
freq
                      t_2 :: a
t_2  = a
ta -> a -> a
forall a. C a => a -> a -> a
*a
t;         y0 :: a
y0 =  a
t_2a -> a -> a
forall a. C a => a -> a -> a
*(a
ta -> a -> a
forall a. C a => a -> a -> a
-a
1)
                      t1_2 :: a
t1_2 = (a
ta -> a -> a
forall a. C a => a -> a -> a
-a
1)a -> a -> a
forall a. C a => a -> a -> a
*(a
ta -> a -> a
forall a. C a => a -> a -> a
-a
1); y3 :: a
y3 = -a
t1_2a -> a -> a
forall a. C a => a -> a -> a
*a
t
                  in (a
p1frac, [a]
xs0 [a] -> [a] -> [a]
forall a. C a => a -> a -> a
+ [a
y0, a
1a -> a -> a
forall a. C a => a -> a -> a
-a
t1_2a -> a -> a
forall a. C a => a -> a -> a
+a
y3, a
1a -> a -> a
forall a. C a => a -> a -> a
-a
t_2a -> a -> a
forall a. C a => a -> a -> a
+a
y0, a
y3])
               else (a
p1, [a]
xs0)
             (a
x3,[a]
xs3) =
               case [a]
xs1 of
                  [] -> (a
0,[])
                  a
x2:[a]
xs2 -> (a
x2,[a]
xs2)
         in (a, (a, [a])) -> Maybe (a, (a, [a]))
forall a. a -> Maybe a
Just ((a, (a, [a])) -> Maybe (a, (a, [a])))
-> (a, (a, [a])) -> Maybe (a, (a, [a]))
forall a b. (a -> b) -> a -> b
$ (a
x3, (a
p2,[a]
xs3)))
      (a
phase,[])