module Synthesizer.Plain.Signal where
import qualified Number.Peano as Peano
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Data.List.Match as ListMatch
import qualified Data.List as List
import Data.Tuple.HT (forcePair, mapFst, mapSnd, )
type T a = [a]
type Modifier s ctrl a b = Modifier.Simple s ctrl a b
modifyStatic ::
Modifier s ctrl a b -> ctrl -> T a -> T b
modifyStatic = Modifier.static
modifyModulated ::
Modifier s ctrl a b -> T ctrl -> T a -> T b
modifyModulated = Modifier.modulated
type ModifierInit s init ctrl a b = Modifier.Initialized s init ctrl a b
modifierInitialize ::
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
modifierInitialize = Modifier.initialize
modifyStaticInit ::
ModifierInit s init ctrl a b -> init -> ctrl -> T a -> T b
modifyStaticInit = Modifier.staticInit
modifyModulatedInit ::
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
modifyModulatedInit = Modifier.modulatedInit
unfoldR :: (acc -> Maybe (y, acc)) -> acc -> (acc, T y)
unfoldR f =
let recourse acc0 =
forcePair $
maybe
(acc0,[])
(\(y,acc1) ->
mapSnd (y:) $ recourse acc1)
(f acc0)
in recourse
reduceL :: (x -> acc -> Maybe acc) -> acc -> T x -> acc
reduceL f =
let recourse a xt =
case xt of
[] -> a
(x:xs) ->
maybe a
(\ a' -> seq a' (recourse a' xs))
(f x a)
in recourse
mapAccumL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y)
mapAccumL f =
let recourse acc0 xt =
forcePair $
case xt of
[] -> (acc0,[])
(x:xs) ->
maybe
(acc0,[])
(\(y,acc1) ->
mapSnd (y:) $ recourse acc1 xs)
(f x acc0)
in recourse
crochetL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL f a = snd . mapAccumL f a
fix1 :: y -> (T y -> T y) -> T y
fix1 pad f =
let y = f (pad:y)
in y
dropMarginRem :: Int -> Int -> T a -> (Int, T a)
dropMarginRem n m =
head .
dropMargin n m .
zipWithTails (,) (iterate pred m)
dropMargin :: Int -> Int -> T a -> T a
dropMargin n m xs =
ListMatch.drop (take m (drop n xs)) xs
lengthAtLeast :: Int -> T a -> Bool
lengthAtLeast n xs =
n<=0 || not (null (drop (n1) xs))
zipWithTails ::
(y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails f xs =
zipWith f xs . init . List.tails
zipWithRest ::
(y0 -> y0 -> y1) ->
T y0 -> T y0 ->
(T y1, (Bool, T y0))
zipWithRest f xs ys =
let len = min (List.genericLength xs) (List.genericLength ys) :: Peano.T
(prefixX,suffixX) = List.genericSplitAt len xs
(prefixY,suffixY) = List.genericSplitAt len ys
second = null suffixX
in (zipWith f prefixX prefixY,
(second, if second then suffixY else suffixX))
zipWithRest' ::
(y0 -> y0 -> y1) ->
T y0 -> T y0 ->
(T y1, (Bool, T y0))
zipWithRest' f =
let recourse xt yt =
forcePair $
case (xt,yt) of
(x:xs, y:ys) ->
mapFst (f x y :) (recourse xs ys)
([], _) -> ([], (True, yt))
(_, []) -> ([], (False, xt))
in recourse
zipWithAppend ::
(y -> y -> y) ->
T y -> T y -> T y
zipWithAppend f xs ys =
uncurry (++) $ mapSnd snd $ zipWithRest f xs ys