module Synthesizer.State.Cut (
takeUntilPause,
takeUntilInterval,
selectBool,
select,
arrange,
arrangeList,
) where
import qualified Synthesizer.State.Signal as Sig
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified MathObj.LaurentPolynomial as Laurent
import qualified Algebra.Real as Real
import qualified Algebra.Additive as Additive
import qualified Data.Array as Array
import Data.Array (Array, Ix, (!), elems, )
import Control.Applicative (Applicative, )
import Data.Traversable (sequenceA, )
import Data.Tuple.HT (mapSnd, )
import qualified Number.NonNegative as NonNeg
import PreludeBase
import NumericPrelude
takeUntilPause :: (Real.C a) => a -> Int -> Sig.T a -> Sig.T a
takeUntilPause y =
takeUntilInterval ((<=y) . abs)
takeUntilInterval :: (a -> Bool) -> Int -> Sig.T a -> Sig.T a
takeUntilInterval p n xs =
Sig.map fst $
Sig.takeWhile ((<n) . snd) $
Sig.zip xs $
Sig.drop n $
Sig.append (Sig.scanL (\acc x -> if p x then succ acc else 0) 0 xs) $
Sig.repeat 0
selectBool :: (Sig.T a, Sig.T a) -> Sig.T Bool -> Sig.T a
selectBool =
Sig.zipWith (\(xf,xt) c -> if c then xt else xf) .
uncurry Sig.zip
select :: Ix i => Array i (Sig.T a) -> Sig.T i -> Sig.T a
select =
Sig.crochetL
(\xi arr ->
do arr0 <- sequenceArray (fmap Sig.viewL arr)
return (fst (arr0!xi), fmap snd arr0))
sequenceArray ::
(Applicative f, Ix i) =>
Array i (f a) -> f (Array i a)
sequenceArray arr =
fmap (Array.listArray (Array.bounds arr)) $
sequenceA (Array.elems arr)
arrangeList :: (Additive.C v) =>
EventList.T NonNeg.Int (Sig.T v)
-> Sig.T v
arrangeList evs =
let xs = map Sig.toList (EventList.getBodies evs)
in case map NonNeg.toNumber (EventList.getTimes evs) of
t:ts -> Sig.replicate t zero `Sig.append`
Sig.fromList (Laurent.addShiftedMany ts xs)
[] -> Sig.empty
arrange :: (Additive.C v) =>
EventList.T NonNeg.Int (Sig.T v)
-> Sig.T v
arrange evs =
let xs = EventList.getBodies evs
in case map NonNeg.toNumber (EventList.getTimes evs) of
t:ts -> Sig.replicate t zero `Sig.append`
addShiftedMany ts xs
[] -> Sig.empty
addShiftedMany :: (Additive.C a) => [Int] -> [Sig.T a] -> Sig.T a
addShiftedMany ds xss =
foldr (uncurry addShifted) Sig.empty (zip (ds++[zero]) xss)
addShifted :: Additive.C a => Int -> Sig.T a -> Sig.T a -> Sig.T a
addShifted del xs ys =
if del < 0
then error "State.Signal.addShifted: negative shift"
else
Sig.unfoldR
(\((d,ys0),xs0) ->
if d==zero
then
fmap
(mapSnd (\(xs1,ys1) -> ((zero,ys1),xs1)))
(Sig.zipStep (+) (xs0, ys0))
else
Just $ mapSnd ((,) (pred d, ys0)) $
Sig.switchL (zero, xs0) (,) xs0)
((del,ys),xs)