module Synthesizer.Generic.Signal
(module Synthesizer.Generic.Signal,
Cut.null,
Cut.length,
Cut.empty,
Cut.cycle,
Cut.append,
Cut.concat,
Cut.take,
Cut.drop,
Cut.dropMarginRem,
Cut.splitAt,
Cut.reverse,
Cut.lengthAtLeast,
Cut.lengthAtMost,
Cut.sliceVertical,
) where
import Synthesizer.Generic.Cut (append, )
import qualified Synthesizer.Generic.Cut as Cut
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.FusionList.Signal as SigFL
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy as Vector
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Algebra.Module as Module
import qualified Algebra.Additive as Additive
import Foreign.Storable (Storable)
import Control.Monad.Trans.State (runState, runStateT, )
import Data.Function (fix, )
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Tuple.HT (mapPair, mapFst, )
import Prelude
(Bool, Int, Maybe(Just), maybe, snd,
flip, uncurry, (.), ($), id,
fmap, return, )
class Cut.Read (sig y) => Read sig y where
toList :: sig y -> [y]
toState :: sig y -> SigS.T y
foldL :: (s -> y -> s) -> s -> sig y -> s
viewL :: sig y -> Maybe (y, sig y)
viewR :: sig y -> Maybe (sig y, y)
class (Read sig y, Cut.Transform (sig y)) => Transform sig y where
cons :: y -> sig y -> sig y
takeWhile :: (y -> Bool) -> sig y -> sig y
dropWhile :: (y -> Bool) -> sig y -> sig y
span :: (y -> Bool) -> sig y -> (sig y, sig y)
map :: (y -> y) -> (sig y -> sig y)
scanL :: (y -> y -> y) -> y -> sig y -> sig y
crochetL :: (y -> s -> Maybe (y, s)) -> s -> sig y -> sig y
zipWithAppend :: (y -> y -> y) -> sig y -> sig y -> sig y
newtype LazySize = LazySize Int
defaultLazySize :: LazySize
defaultLazySize =
let (Vector.ChunkSize size) = Vector.defaultChunkSize
in LazySize size
class Transform sig y => Write sig y where
fromList :: LazySize -> [y] -> sig y
repeat :: LazySize -> y -> sig y
replicate :: LazySize -> Int -> y -> sig y
iterate :: LazySize -> (y -> y) -> y -> sig y
iterateAssociative :: LazySize -> (y -> y -> y) -> y -> sig y
unfoldR :: LazySize -> (s -> Maybe (y,s)) -> s -> sig y
instance Storable y => Read Vector.Vector y where
toList = Vector.unpack
toState = SigS.fromStorableSignal
viewL = Vector.viewL
viewR = Vector.viewR
foldL = Vector.foldl
instance Storable y => Transform Vector.Vector y where
cons = Vector.cons
takeWhile = Vector.takeWhile
dropWhile = Vector.dropWhile
span = Vector.span
map = Vector.map
scanL = Vector.scanl
crochetL = Vector.crochetL
zipWithAppend = SigSt.zipWithAppend
withStorableContext ::
(Vector.ChunkSize -> a) -> (LazySize -> a)
withStorableContext f =
\(LazySize size) -> f (Vector.ChunkSize size)
instance Storable y => Write Vector.Vector y where
fromList = withStorableContext $ \size -> Vector.pack size
repeat = withStorableContext $ \size -> Vector.repeat size
replicate = withStorableContext $ \size -> Vector.replicate size
iterate = withStorableContext $ \size -> Vector.iterate size
unfoldR = withStorableContext $ \size -> Vector.unfoldr size
iterateAssociative = withStorableContext $ \size op x -> Vector.iterate size (op x) x
instance Read [] y where
toList = id
toState = SigS.fromList
viewL = ListHT.viewL
viewR = ListHT.viewR
foldL = List.foldl
instance Transform [] y where
cons = (:)
takeWhile = List.takeWhile
dropWhile = List.dropWhile
span = List.span
map = List.map
scanL = List.scanl
crochetL = Sig.crochetL
zipWithAppend = Sig.zipWithAppend
instance Write [] y where
fromList _ = id
repeat _ = List.repeat
replicate _ = List.replicate
iterate _ = List.iterate
unfoldR _ = List.unfoldr
iterateAssociative _ = ListHT.iterateAssociative
instance Read SigFL.T y where
toList = SigFL.toList
toState = SigS.fromList . SigFL.toList
viewL = SigFL.viewL
viewR = SigFL.viewR
foldL = SigFL.foldL
instance Transform SigFL.T y where
cons = SigFL.cons
takeWhile = SigFL.takeWhile
dropWhile = SigFL.dropWhile
span = SigFL.span
map = SigFL.map
scanL = SigFL.scanL
crochetL = SigFL.crochetL
zipWithAppend = SigFL.zipWithAppend
instance Write SigFL.T y where
fromList _ = SigFL.fromList
repeat _ = SigFL.repeat
replicate _ = SigFL.replicate
iterate _ = SigFL.iterate
unfoldR _ = SigFL.unfoldR
iterateAssociative _ = SigFL.iterateAssociative
instance Read SigS.T y where
toList = SigS.toList
toState = id
viewL = SigS.viewL
viewR =
fmap (mapFst SigS.fromList) .
ListHT.viewR . SigS.toList
foldL = SigS.foldL
instance Transform SigS.T y where
cons = SigS.cons
takeWhile = SigS.takeWhile
dropWhile = SigS.dropWhile
span p =
mapPair (SigS.fromList, SigS.fromList) .
List.span p . SigS.toList
map = SigS.map
scanL = SigS.scanL
crochetL = SigS.crochetL
zipWithAppend = SigS.zipWithAppend
instance Write SigS.T y where
fromList _ = SigS.fromList
repeat _ = SigS.repeat
replicate _ = SigS.replicate
iterate _ = SigS.iterate
unfoldR _ = SigS.unfoldR
iterateAssociative _ = SigS.iterateAssociative
switchL :: (Read sig y) =>
a -> (y -> sig y -> a) -> sig y -> a
switchL nothing just =
maybe nothing (uncurry just) . viewL
mix :: (Additive.C y, Transform sig y) =>
sig y -> sig y -> sig y
mix = zipWithAppend (Additive.+)
zipWith :: (Read sig a, Transform sig b) =>
(a -> b -> b) -> (sig a -> sig b -> sig b)
zipWith h a =
crochetL
(\x0 a0 ->
do (y0,a1) <- viewL a0
Just (h y0 x0, a1))
a
delay :: (Write sig y) =>
LazySize -> y -> Int -> sig y -> sig y
delay size z n =
append (replicate size n z)
delayLoop ::
(Transform sig y) =>
(sig y -> sig y)
-> sig y
-> sig y
delayLoop proc prefix =
fix (append prefix . proc)
delayLoopOverlap ::
(Additive.C y, Write sig y) =>
Int
-> (sig y -> sig y)
-> sig y
-> sig y
delayLoopOverlap time proc xs =
fix (zipWith (Additive.+) xs .
delay defaultLazySize Additive.zero time . proc)
sum :: (Additive.C a, Read sig a) => sig a -> a
sum = foldL (Additive.+) Additive.zero
tails :: (Transform sig y) => sig y -> SigS.T (sig y)
tails =
SigS.unfoldR (fmap (\x -> (x, fmap snd (viewL x)))) . Just
mapAdjacent :: (Read sig a, Transform sig a) =>
(a -> a -> a) -> sig a -> sig a
mapAdjacent f xs0 =
let xs1 = maybe xs0 snd (viewL xs0)
in zipWith f xs0 xs1
modifyStatic :: (Transform sig a) =>
Modifier.Simple s ctrl a a -> ctrl -> sig a -> sig a
modifyStatic (Modifier.Simple state proc) control =
crochetL (\a acc -> Just (runState (proc control a) acc)) state
modifyModulated :: (Transform sig a, Read sig ctrl) =>
Modifier.Simple s ctrl a a -> sig ctrl -> sig a -> sig a
modifyModulated (Modifier.Simple state proc) control =
crochetL
(\x (acc0,cs0) ->
do (c,cs1) <- viewL cs0
let (y,acc1) = runState (proc c x) acc0
return (y,(acc1,cs1)))
(state,control)
linearComb ::
(Module.C t y, Read sig t, Read sig y) =>
sig t -> sig y -> y
linearComb ts ys =
SigS.sum (SigS.zipWith (Module.*>) (toState ts) (toState ys))
fromState :: (Write sig y) =>
LazySize -> SigS.T y -> sig y
fromState size (SigS.Cons f x) =
unfoldR size (runStateT f) x
extendConstant :: (Write sig y) =>
LazySize -> sig y -> sig y
extendConstant size xt =
maybe
xt
(append xt . repeat size . snd)
(viewR xt)
mapTails :: (Transform sig a) =>
(sig a -> a) -> sig a -> sig a
mapTails f x =
crochetL (\_ xs0 ->
do (_,xs1) <- viewL xs0
Just (f xs0, xs1))
x x
mapTailsAlt ::
(Read sig a, Write sig b) =>
LazySize -> (sig a -> b) -> sig a -> sig b
mapTailsAlt size f =
unfoldR size (\xs ->
do (_,ys) <- viewL xs
Just (f xs, ys))
zipWithTails :: (Read sig b, Transform sig a) =>
(a -> sig b -> a) -> sig a -> sig b -> sig a
zipWithTails f =
flip (crochetL (\x ys0 ->
do (_,ys) <- viewL ys0
Just (f x ys0, ys)))