{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.State.Cut (
takeUntilPause,
takeUntilInterval,
chopStorable,
chopChunkySize,
selectBool,
select,
arrange,
arrangeList,
) where
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Synthesizer.Generic.CutChunky as CutChunky
import qualified Synthesizer.Generic.Cut as Cut
import Foreign.Storable (Storable)
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified MathObj.LaurentPolynomial as Laurent
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Additive as Additive
import Control.Applicative (Applicative, )
import qualified Data.List.HT as ListHT
import qualified Data.Array as Array
import Data.Traversable (sequenceA, )
import Data.Tuple.HT (mapFst, mapSnd, )
import Data.Array (Array, Ix, (!), )
import Data.Maybe (fromMaybe, )
import qualified Synthesizer.ChunkySize as ChunkySize
import qualified Number.NonNegative as NonNegW
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE takeUntilPause #-}
takeUntilPause :: (RealRing.C a) => a -> Int -> Sig.T a -> Sig.T a
takeUntilPause :: forall a. C a => a -> Int -> T a -> T a
takeUntilPause a
y =
forall a. (a -> Bool) -> Int -> T a -> T a
takeUntilInterval ((forall a. Ord a => a -> a -> Bool
<=a
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => a -> a
abs)
{-# INLINE takeUntilInterval #-}
takeUntilInterval :: (a -> Bool) -> Int -> Sig.T a -> Sig.T a
takeUntilInterval :: forall a. (a -> Bool) -> Int -> T a -> T a
takeUntilInterval a -> Bool
p Int
n T a
xs =
forall a b. (a -> b) -> T a -> T b
Sig.map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> T a -> T a
Sig.takeWhile ((forall a. Ord a => a -> a -> Bool
<Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall a b. T a -> T b -> T (a, b)
Sig.zip T a
xs forall a b. (a -> b) -> a -> b
$
forall a. Int -> T a -> T a
Sig.drop Int
n forall a b. (a -> b) -> a -> b
$
forall a. T a -> T a -> T a
Sig.append (forall acc x. (acc -> x -> acc) -> acc -> T x -> T acc
Sig.scanL (\Int
acc a
x -> if a -> Bool
p a
x then forall a. Enum a => a -> a
succ Int
acc else Int
0) Int
0 T a
xs) forall a b. (a -> b) -> a -> b
$
forall a. a -> T a
Sig.repeat Int
0
{-# INLINE selectBool #-}
selectBool :: (Sig.T a, Sig.T a) -> Sig.T Bool -> Sig.T a
selectBool :: forall a. (T a, T a) -> T Bool -> T a
selectBool =
forall a b c. (a -> b -> c) -> T a -> T b -> T c
Sig.zipWith (\(a
xf,a
xt) Bool
c -> if Bool
c then a
xt else a
xf) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. T a -> T b -> T (a, b)
Sig.zip
{-# INLINE select #-}
select :: Ix i => Array i (Sig.T a) -> Sig.T i -> Sig.T a
select :: forall i a. Ix i => Array i (T a) -> T i -> T a
select =
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
Sig.crochetL
(\i
xi Array i (T a)
arr ->
do Array i (a, T a)
arr0 <- forall (f :: * -> *) i a.
(Applicative f, Ix i) =>
Array i (f a) -> f (Array i a)
sequenceArray (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. T a -> Maybe (a, T a)
Sig.viewL Array i (T a)
arr)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> a
fst (Array i (a, T a)
arr0forall i e. Ix i => Array i e -> i -> e
!i
xi), forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Array i (a, T a)
arr0))
{-# INLINE sequenceArray #-}
sequenceArray ::
(Applicative f, Ix i) =>
Array i (f a) -> f (Array i a)
sequenceArray :: forall (f :: * -> *) i a.
(Applicative f, Ix i) =>
Array i (f a) -> f (Array i a)
sequenceArray Array i (f a)
arr =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (forall i e. Array i e -> (i, i)
Array.bounds Array i (f a)
arr)) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (forall i e. Array i e -> [e]
Array.elems Array i (f a)
arr)
{-# INLINE arrangeList #-}
arrangeList :: (Additive.C v) =>
EventList.T NonNegW.Int (Sig.T v)
-> Sig.T v
arrangeList :: forall v. C v => T Int (T v) -> T v
arrangeList T Int (T v)
evs =
let xs :: [[v]]
xs = forall a b. (a -> b) -> [a] -> [b]
map forall y. T y -> [y]
Sig.toList (forall time body. T time body -> [body]
EventList.getBodies T Int (T v)
evs)
in case forall a b. (a -> b) -> [a] -> [b]
map forall a. T a -> a
NonNegW.toNumber (forall time body. T time body -> [time]
EventList.getTimes T Int (T v)
evs) of
Int
t:[Int]
ts -> forall a. Int -> a -> T a
Sig.replicate Int
t forall a. C a => a
zero forall a. T a -> T a -> T a
`Sig.append`
forall y. [y] -> T y
Sig.fromList (forall a. C a => [Int] -> [[a]] -> [a]
Laurent.addShiftedMany [Int]
ts [[v]]
xs)
[] -> forall a. T a
Sig.empty
{-# INLINE arrange #-}
arrange :: (Additive.C v) =>
EventList.T NonNegW.Int (Sig.T v)
-> Sig.T v
arrange :: forall v. C v => T Int (T v) -> T v
arrange T Int (T v)
evs =
let xs :: [T v]
xs = forall time body. T time body -> [body]
EventList.getBodies T Int (T v)
evs
in case forall a b. (a -> b) -> [a] -> [b]
map forall a. T a -> a
NonNegW.toNumber (forall time body. T time body -> [time]
EventList.getTimes T Int (T v)
evs) of
Int
t:[Int]
ts -> forall a. Int -> a -> T a
Sig.replicate Int
t forall a. C a => a
zero forall a. T a -> T a -> T a
`Sig.append`
forall a. C a => [Int] -> [T a] -> T a
addShiftedMany [Int]
ts [T v]
xs
[] -> forall a. T a
Sig.empty
{-# INLINE addShiftedMany #-}
addShiftedMany :: (Additive.C a) => [Int] -> [Sig.T a] -> Sig.T a
addShiftedMany :: forall a. C a => [Int] -> [T a] -> T a
addShiftedMany [Int]
ds [T a]
xss =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. C a => Int -> T a -> T a -> T a
addShifted) forall a. T a
Sig.empty (forall a b. [a] -> [b] -> [(a, b)]
zip ([Int]
dsforall a. [a] -> [a] -> [a]
++[forall a. C a => a
zero]) [T a]
xss)
{-# INLINE addShifted #-}
addShifted :: Additive.C a => Int -> Sig.T a -> Sig.T a -> Sig.T a
addShifted :: forall a. C a => Int -> T a -> T a -> T a
addShifted Int
del T a
xs T a
ys =
if Int
del forall a. Ord a => a -> a -> Bool
< Int
0
then forall a. HasCallStack => [Char] -> a
error [Char]
"State.Signal.addShifted: negative shift"
else
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
Sig.runViewL T a
xs (\s -> Maybe (a, s)
nextX s
xs2 ->
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
Sig.runViewL T a
ys (\s -> Maybe (a, s)
nextY s
ys2 ->
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
Sig.unfoldR
(\((Int
d,s
ys0),s
xs0) ->
if Int
dforall a. Eq a => a -> a -> Bool
==forall a. C a => a
zero
then
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (\(s
xs1,s
ys1) -> ((forall a. C a => a
zero,s
ys1),s
xs1)))
(forall s a t.
(s -> Maybe (a, s))
-> (t -> Maybe (a, t))
-> (a -> a -> a)
-> (s, t)
-> Maybe (a, (s, t))
Sig.zipStep s -> Maybe (a, s)
nextX s -> Maybe (a, s)
nextY forall a. C a => a -> a -> a
(+) (s
xs0, s
ys0))
else
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((,) (forall a. Enum a => a -> a
pred Int
d, s
ys0)) forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe (forall a. C a => a
zero, s
xs0) forall a b. (a -> b) -> a -> b
$ s -> Maybe (a, s)
nextX s
xs0)
((Int
del,s
ys2),s
xs2)
))
chopStorable :: Storable a => Sig.T Bool -> SigSt.T a -> [SigSt.T a]
chopStorable :: forall a. Storable a => T Bool -> T a -> [T a]
chopStorable = forall chunky. C chunky => T Bool -> chunky -> [chunky]
chop
chopChunkySize :: Sig.T Bool -> ChunkySize.T -> [ChunkySize.T]
chopChunkySize :: T Bool -> T -> [T]
chopChunkySize = forall chunky. C chunky => T Bool -> chunky -> [chunky]
chop
chop :: CutChunky.C chunky => Sig.T Bool -> chunky -> [chunky]
chop :: forall chunky. C chunky => T Bool -> chunky -> [chunky]
chop T Bool
bs =
forall y x. T y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
Sig.runViewL T Bool
bs forall a b. (a -> b) -> a -> b
$ \s -> Maybe (Bool, s)
f s
s ->
let go :: s -> [Chunk a] -> (a, [a])
go s
_ [] = (forall sig. Monoid sig => sig
Cut.empty, [])
go s
s0 (Chunk a
chunk:[Chunk a]
chunks) =
case forall chunk s.
Transform chunk =>
(s -> Maybe (Bool, s)) -> chunk -> s -> ([chunk], Maybe s)
chopChunk s -> Maybe (Bool, s)
f Chunk a
chunk s
s0 of
([Chunk a]
split, Maybe s
ms) ->
forall chunky.
C chunky =>
[Chunk chunky] -> (chunky, [chunky]) -> (chunky, [chunky])
prependChunks [Chunk a]
split forall a b. (a -> b) -> a -> b
$
case Maybe s
ms of
Maybe s
Nothing -> (forall chunky. C chunky => [Chunk chunky] -> chunky
CutChunky.fromChunks [Chunk a]
chunks, [])
Just s
s1 -> s -> [Chunk a] -> (a, [a])
go s
s1 [Chunk a]
chunks
in forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. C a => s -> [Chunk a] -> (a, [a])
go s
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chunky. C chunky => chunky -> [Chunk chunky]
CutChunky.toChunks
prependChunks ::
CutChunky.C chunky =>
[CutChunky.Chunk chunky] ->
(chunky, [chunky]) ->
(chunky, [chunky])
prependChunks :: forall chunky.
C chunky =>
[Chunk chunky] -> (chunky, [chunky]) -> (chunky, [chunky])
prependChunks [] (chunky, [chunky])
xs = (chunky, [chunky])
xs
prependChunks (Chunk chunky
chunk:[Chunk chunky]
chunks) (chunky, [chunky])
xs =
let go :: Chunk chunky -> [Chunk chunky] -> (chunky, [chunky])
go Chunk chunky
c0 [Chunk chunky]
css =
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst
(\chunky
y ->
if forall sig. Read sig => sig -> Bool
Cut.null Chunk chunky
c0
then chunky
y
else forall chunky. C chunky => [Chunk chunky] -> chunky
CutChunky.fromChunks forall a b. (a -> b) -> a -> b
$ Chunk chunky
c0 forall a. a -> [a] -> [a]
: forall chunky. C chunky => chunky -> [Chunk chunky]
CutChunky.toChunks chunky
y)
(case [Chunk chunky]
css of
[] -> (chunky, [chunky])
xs
(Chunk chunky
c1:[Chunk chunky]
cs) -> (forall sig. Monoid sig => sig
Cut.empty, forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (Chunk chunky -> [Chunk chunky] -> (chunky, [chunky])
go Chunk chunky
c1 [Chunk chunky]
cs)))
in Chunk chunky -> [Chunk chunky] -> (chunky, [chunky])
go Chunk chunky
chunk [Chunk chunky]
chunks
chopChunk ::
Cut.Transform chunk =>
(s -> Maybe (Bool, s)) ->
chunk -> s -> ([chunk], Maybe s)
chopChunk :: forall chunk s.
Transform chunk =>
(s -> Maybe (Bool, s)) -> chunk -> s -> ([chunk], Maybe s)
chopChunk s -> Maybe (Bool, s)
f chunk
vs =
let go :: Int -> s -> ([Int], Maybe s)
go Int
j s
s0 =
if Int
j forall a. Ord a => a -> a -> Bool
>= forall sig. Read sig => sig -> Int
Cut.length chunk
vs
then ([Int
j], forall a. a -> Maybe a
Just s
s0)
else
case s -> Maybe (Bool, s)
f s
s0 of
Maybe (Bool, s)
Nothing -> ([Int
j, forall sig. Read sig => sig -> Int
Cut.length chunk
vs], forall a. Maybe a
Nothing)
Just (Bool
b,s
s1) ->
(if Bool
b
then forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Int
jforall a. a -> [a] -> [a]
:)
else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
Int -> s -> ([Int], Maybe s)
go (forall a. Enum a => a -> a
succ Int
j) s
s1
in forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst
(forall a b. (a -> a -> b) -> [a] -> [b]
ListHT.mapAdjacent (\Int
from Int
to -> forall sig. Transform sig => Int -> sig -> sig
Cut.drop Int
from forall a b. (a -> b) -> a -> b
$ forall sig. Transform sig => Int -> sig -> sig
Cut.take Int
to chunk
vs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0forall a. a -> [a] -> [a]
:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> s -> ([Int], Maybe s)
go Int
0