{-# 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 = T a v -> Int
forall t y. T t y -> Int
Interpolation.number T a v
ip
ipFunc :: a -> [v] -> v
ipFunc = T a v -> a -> [v] -> v
forall t y. T t y -> t -> T y -> y
Interpolation.func T a v
ip
in do STArray s Int v
arr <- ST s (STArray s Int v) -> ST s (STArray s Int v)
forall s a. ST s a -> ST s a
strictToLazyST ((Int, Int) -> v -> ST s (STArray s Int v)
forall i. Ix i => (i, i) -> v -> ST s (STArray s i v)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
2Int -> Int -> Int
forall a. C a => a -> a -> a
*Int
sizeInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) v
forall a. C a => a
zero)
:: Additive.C v => ST s (STArray s Int v)
((Int, a, v) -> ST s v) -> [(Int, a, v)] -> ST s [v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Int
n,a
t,v
x) -> ST s v -> ST s v
forall s a. ST s a -> ST s a
strictToLazyST (ST s v -> ST s v) -> ST s v -> ST s v
forall a b. (a -> b) -> a -> b
$
do STArray s Int v -> Int -> v -> ST s ()
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
STArray s Int v -> Int -> v -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Int v
arr (Int
nInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
size) v
x
let (Int
ti,a
tf) = a -> (Int, a)
forall b. C b => a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
t
[v]
y <- (Int -> ST s v) -> [Int] -> ST s [v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (STArray s Int v -> Int -> ST s v
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Int v
arr) (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
ipNum [(Int
nInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
ti) ..])
v -> ST s v
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Int
tiInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0
then [Char] -> v
forall a. HasCallStack => [Char] -> a
error [Char]
"negative delay"
else
if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tiInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
ipNum
then [Char] -> v
forall a. HasCallStack => [Char] -> a
error [Char]
"too much delay"
else a -> [v] -> v
ipFunc a
tf [v]
y))
([Int] -> [a] -> [v] -> [(Int, a, v)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 ([Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
cycle [(Int
sizeInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1),(Int
sizeInt -> Int -> Int
forall 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 = T a v -> Int
forall t y. T t y -> Int
Interpolation.offset T a v
ip
in Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop Int
offset
((forall s. ST s [v]) -> [v]
forall a. (forall s. ST s a) -> a
runST
(T a v -> Int -> [a] -> [v] -> ST s [v]
forall a v s. (C a, C v) => T a v -> Int -> [a] -> [v] -> ST s [v]
modulatedAction
T a v
ip (Int
maxDelay Int -> Int -> Int
forall a. C a => a -> a -> a
+ T a v -> Int
forall t y. T t y -> Int
Interpolation.number T a v
ip)
(Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
offset a
forall a. C a => a
zero [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ts) [v]
xs))