{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.Filter.Delay.ST (modulated) where
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Algebra.RealField as RealField
import qualified Algebra.Additive as Additive
import Control.Monad.ST.Lazy(runST,strictToLazyST,ST)
import Data.Array.ST
import NumericPrelude.Numeric
import NumericPrelude.Base
modulatedAction :: (RealField.C a, Additive.C v) =>
Interpolation.T a v -> Int -> [a] -> [v] -> ST s [v]
modulatedAction :: forall a v s. (C a, C v) => T a v -> Int -> [a] -> [v] -> ST s [v]
modulatedAction T a v
ip Int
size [a]
ts [v]
xs =
let ipNum :: Int
ipNum = forall t y. T t y -> Int
Interpolation.number T a v
ip
ipFunc :: a -> [v] -> v
ipFunc = forall t y. T t y -> t -> T y -> y
Interpolation.func T a v
ip
in do STArray s Int v
arr <- forall s a. ST s a -> ST s a
strictToLazyST (forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
2forall a. C a => a -> a -> a
*Int
sizeforall a. C a => a -> a -> a
-Int
1) forall a. C a => a
zero)
:: Additive.C v => ST s (STArray s Int v)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
n,a
t,v
x) -> forall s a. ST s a -> ST s a
strictToLazyST forall a b. (a -> b) -> a -> b
$
do forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Int v
arr Int
n v
x
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Int v
arr (Int
nforall a. C a => a -> a -> a
+Int
size) v
x
let (Int
ti,a
tf) = forall a b. (C a, C b) => a -> (b, a)
splitFraction a
t
[v]
y <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Int v
arr) (forall a. Int -> [a] -> [a]
take Int
ipNum [(Int
nforall a. C a => a -> a -> a
+Int
ti) ..])
forall (m :: * -> *) a. Monad m => a -> m a
return (if Int
tiforall a. Ord a => a -> a -> Bool
<Int
0
then forall a. HasCallStack => [Char] -> a
error [Char]
"negative delay"
else
if Int
size forall a. Ord a => a -> a -> Bool
< Int
tiforall a. C a => a -> a -> a
+Int
ipNum
then forall a. HasCallStack => [Char] -> a
error [Char]
"too much delay"
else a -> [v] -> v
ipFunc a
tf [v]
y))
(forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (forall a. [a] -> [a]
cycle [(Int
sizeforall a. C a => a -> a -> a
-Int
1),(Int
sizeforall a. C a => a -> a -> a
-Int
2)..Int
0]) [a]
ts [v]
xs)
modulated :: (RealField.C a, Additive.C v) =>
Interpolation.T a v -> Int -> [a] -> [v] -> [v]
modulated :: forall a v. (C a, C v) => T a v -> Int -> [a] -> [v] -> [v]
modulated T a v
ip Int
maxDelay [a]
ts [v]
xs =
let offset :: Int
offset = forall t y. T t y -> Int
Interpolation.offset T a v
ip
in forall a. Int -> [a] -> [a]
drop Int
offset
(forall a. (forall s. ST s a) -> a
runST
(forall a v s. (C a, C v) => T a v -> Int -> [a] -> [v] -> ST s [v]
modulatedAction
T a v
ip (Int
maxDelay forall a. C a => a -> a -> a
+ forall t y. T t y -> Int
Interpolation.number T a v
ip)
(forall a. Int -> a -> [a]
replicate Int
offset forall a. C a => a
zero forall a. [a] -> [a] -> [a]
++ [a]
ts) [v]
xs))