module Synthesizer.Plain.Filter.Delay.Block where
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Plain.Signal as Sig
import qualified Algebra.RealField as RealField
import qualified Algebra.Additive as Additive
import Data.Array((!), Array, listArray, elems, bounds, indices, rangeSize)
import Data.List(tails)
import Test.QuickCheck ((==>), Property)
import qualified Prelude as P
import PreludeBase
import NumericPrelude
modulatedCore :: (RealField.C a, Additive.C v) =>
Interpolation.T a v -> Int -> Sig.T a -> Sig.T v -> Sig.T v
modulatedCore ip size ts =
zipWith
(\t (offset,bs) ->
let (ti,tf) = splitFraction (t)
in Interpolation.func ip tf (dropBlocksToList (size+offset+ti) bs))
ts .
suffixIndexes .
listToBlocks size
modulated :: (RealField.C a, Additive.C v) =>
Interpolation.T a v -> Int -> Sig.T a -> Sig.T v -> Sig.T v
modulated ip maxDelay ts xs =
let size = maxDelay + Interpolation.number ip
in modulatedCore ip
(size Interpolation.offset ip)
ts
(replicate size zero ++ xs)
type BlockList a = [Array Int a]
listToBlocks :: Int -> Sig.T a -> BlockList a
listToBlocks blockSize =
map (listArray (0,blockSize1)) .
takeWhile (not . null) .
iterate (drop blockSize)
dropBlocksToList :: Int -> BlockList a -> Sig.T a
dropBlocksToList number blocks =
let dropUntil remain (b:bs) =
if remain <= snd (bounds b)
then (remain, b, bs)
else dropUntil (remain rangeSize (bounds b)) bs
dropUntil remain [] = (remain, listArray (0,1) [], [])
(offset, lead, suffix) = dropUntil number blocks
in map (lead!) [offset .. (snd $ bounds lead)] ++
concatMap elems suffix
propDrop :: Int -> Int -> [Int] -> Property
propDrop size n xs =
let infXs = cycle xs
len = 1000
in size>0 && n>=0 && not (null xs) ==>
take len (drop n infXs) ==
take len (dropBlocksToList n (listToBlocks size infXs))
dropSingleBlocksToList :: Int -> BlockList a -> Sig.T a
dropSingleBlocksToList number (arr:arrs) =
map (arr!) [number .. (snd $ bounds arr)] ++
concatMap elems arrs
dropSingleBlocksToList _ [] = []
suffixIndexes :: BlockList a -> [(Int, BlockList a)]
suffixIndexes xs =
do blockSuffix <- init $ tails xs
i <- indices $ head blockSuffix
return (i,blockSuffix)