{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.Filter.Delay (
   phaser,
   plane,

   -- for testing
   propAll,
   ) where

import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR
import qualified Synthesizer.Plain.Displacement as Syn
import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.Plain.Noise   as Noise
import System.Random (randomRs, mkStdGen, )

import qualified Algebra.Module    as Module
import qualified Algebra.RealField as RealField

import qualified Synthesizer.Plain.Interpolation as Interpolation

import qualified Synthesizer.Plain.Filter.Delay.ST    as DelayST
import qualified Synthesizer.Plain.Filter.Delay.List  as DelayList
import qualified Synthesizer.Plain.Filter.Delay.Block as DelayBlock

import NumericPrelude.Numeric
import NumericPrelude.Base


phaser :: (Module.C a v, RealField.C a) => a -> [a] -> [v] -> [v]
phaser :: forall a v. (C a v, C a) => a -> [a] -> [v] -> [v]
phaser a
maxDelay [a]
ts [v]
xs =
   forall a v. C a v => a -> T v -> T v
FiltNR.amplifyVector (a
0.5 forall a. a -> a -> a
`asTypeOf` forall a. [a] -> a
head [a]
ts)
      (forall v. C v => T v -> T v -> T v
Syn.mix [v]
xs
          (forall a v. (C a, C v) => T a v -> Int -> T a -> T v -> T v
DelayBlock.modulated forall t y. T t y
Interpolation.constant (forall a b. (C a, C b) => a -> b
ceiling a
maxDelay) [a]
ts [v]
xs))


plane :: Double -> [Double]
plane :: Double -> [Double]
plane Double
sampleRate =
   let maxDelay :: Double
maxDelay = Double
500
   in  forall a v. (C a v, C a) => a -> [a] -> [v] -> [v]
phaser
          Double
maxDelay
          (forall a b. (a -> b) -> [a] -> [b]
map (Double
maxDelayforall a. C a => a -> a -> a
-)
               (forall y. C y => y -> y -> T y
Ctrl.exponential2 (Double
10forall a. C a => a -> a -> a
*Double
sampleRate) Double
maxDelay))
          forall y. (C y, Random y) => T y
Noise.white


-- move to test suite ***
propSingle :: Interpolation.T Double Double -> [Bool]
propSingle :: T Double Double -> [Bool]
propSingle T Double Double
ip =
   let maxDelay :: Int
maxDelay = (Int
5::Int)
       xs :: [Double]
xs = forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (-Double
1,Double
1) (Int -> StdGen
mkStdGen Int
1037)
       ts :: [Double]
ts = forall a. Int -> [a] -> [a]
take Int
20 (forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Double
0, forall a b. (C a, C b) => a -> b
fromIntegral Int
maxDelay) (Int -> StdGen
mkStdGen Int
2330))
       pm0 :: [Double]
pm0 = forall a v. (C a, C v) => T a v -> Int -> T a -> T v -> T v
DelayST.modulated      T Double Double
ip Int
maxDelay [Double]
ts [Double]
xs
       pm1 :: [Double]
pm1 = forall a v. (C a, C v) => T a v -> Int -> T a -> T v -> T v
DelayList.modulatedRev T Double Double
ip Int
maxDelay [Double]
ts [Double]
xs
       pm2 :: [Double]
pm2 = forall a v. (C a, C v) => T a v -> Int -> T a -> T v -> T v
DelayList.modulated    T Double Double
ip Int
maxDelay [Double]
ts [Double]
xs
       pm3 :: [Double]
pm3 = forall a v. (C a, C v) => T a v -> Int -> T a -> T v -> T v
DelayBlock.modulated   T Double Double
ip Int
maxDelay [Double]
ts [Double]
xs
       approx :: a -> a -> Bool
approx a
x a
y = forall a. C a => a -> a
abs (a
xforall a. C a => a -> a -> a
-a
y) forall a. Ord a => a -> a -> Bool
< a
1e-10
       -- equal as = and (zipWith (==) as (tail as))
       -- equal [pm0, pm1 {-, pm2-}]
   in  [[Double]
pm0forall a. Eq a => a -> a -> Bool
==[Double]
pm1, [Double]
pm2forall a. Eq a => a -> a -> Bool
==[Double]
pm3, forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. (Ord a, C a, C a) => a -> a -> Bool
approx [Double]
pm1 [Double]
pm2)]

{- |
The test for constant interpolation will fail,
due to different point of views in forward and backward interpolation.
-}
propAll :: [[Bool]]
propAll :: [[Bool]]
propAll =
   forall a b. (a -> b) -> [a] -> [b]
map T Double Double -> [Bool]
propSingle forall a b. (a -> b) -> a -> b
$
      forall t y. T t y
Interpolation.constant forall a. a -> [a] -> [a]
:
      forall t y. C t y => T t y
Interpolation.linear forall a. a -> [a] -> [a]
:
      forall t y. (C t, C t y) => T t y
Interpolation.cubic forall a. a -> [a] -> [a]
:
      []