module Synthesizer.Dimensional.RateAmplitude.Piece (
step, linear, exponential, cosine, halfSine, cubic,
T, Sequence, run, runVolume, runState, runStateVolume,
(-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),
Piece.FlatPosition(..),
) where
import qualified Synthesizer.Generic.Piece as Piece
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Piecewise as Piecewise
import Synthesizer.Piecewise ((-|#), ( #|-), (=|#), ( #|=), (|#), ( #|), )
import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import Synthesizer.Dimensional.Process
(toTimeScalar, toGradientScalar, DimensionGradient, )
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.State.Signal as Sig
import qualified Number.DimensionTerm as DN
import qualified Algebra.DimensionTerm as Dim
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Field as Field
import Control.Monad (liftM3, )
import NumericPrelude.Numeric (zero, )
import NumericPrelude.Base
import Prelude ()
type T s u v sig q =
Piecewise.Piece
(DN.T u q) (DN.T v q)
(DN.T v q -> SigG.LazySize -> q ->
Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Flat q) (sig q)))
type Sequence s u v sig q =
Piecewise.T
(DN.T u q) (DN.T v q)
(DN.T v q -> SigG.LazySize -> q ->
Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Flat q) (sig q)))
{-# INLINE run #-}
run :: (Trans.C q, RealRing.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
DN.T u q ->
Sequence s u v sig q ->
Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Dimensional v q) (sig q))
run :: forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
run T u q
lazySize Sequence s u v sig q
cs =
forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T v q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
runVolume T u q
lazySize Sequence s u v sig q
cs forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\PieceData
(T u q)
(T v q)
(T v q
-> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c -> forall a. Ord a => a -> a -> a
max (forall u a. (C u, C a) => T u a -> T u a
DN.abs (forall t y sig. PieceData t y sig -> y
Piecewise.pieceY0 PieceData
(T u q)
(T v q)
(T v q
-> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c))
(forall u a. (C u, C a) => T u a -> T u a
DN.abs (forall t y sig. PieceData t y sig -> y
Piecewise.pieceY1 PieceData
(T u q)
(T v q)
(T v q
-> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c))) Sequence s u v sig q
cs
{-# INLINE runVolume #-}
runVolume ::
(Trans.C q, RealRing.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
DN.T u q ->
Sequence s u v sig q ->
DN.T v q ->
Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Dimensional v q) (sig q))
runVolume :: forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T v q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
runVolume T u q
lazySize' Sequence s u v sig q
cs T v q
amplitude =
do [q]
ts0 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t y sig. PieceData t y sig -> t
Piecewise.pieceDur) Sequence s u v sig q
cs
Int
lazySize <-
forall t u s. (C t, C u) => String -> T u t -> T s u t Int
Proc.intFromTime String
"Dimensional.Piece.runVolume" T u q
lazySize'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v q
amplitude forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Monoid sig => [sig] -> sig
SigG.concat) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\(Int
n,q
t) (Piecewise.PieceData Piece
(T u q)
(T v q)
(T v q
-> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c T v q
yi0 T v q
yi1 T u q
d) ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rate amplitude body. T rate amplitude body -> body
SigA.body) forall a b. (a -> b) -> a -> b
$
forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece Piece
(T u q)
(T v q)
(T v q
-> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c T v q
yi0 T v q
yi1 T u q
d T v q
amplitude (Int -> LazySize
SigG.LazySize Int
lazySize) q
t)
(forall t. C t => [t] -> [(Int, t)]
Piecewise.splitDurations [q]
ts0)
Sequence s u v sig q
cs
{-# INLINE runState #-}
runState :: (Trans.C q, RealRing.C q, Dim.C u, Dim.C v) =>
Sequence s u v Sig.T q ->
Proc.T s u q (SigA.R s v q q)
runState :: forall q u v s.
(C q, C q, C u, C v) =>
Sequence s u v T q -> T s u q (R s v q q)
runState = forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
run forall a. C a => a
zero
{-# INLINE runStateVolume #-}
runStateVolume ::
(Trans.C q, RealRing.C q, Dim.C u, Dim.C v) =>
Sequence s u v Sig.T q ->
DN.T v q ->
Proc.T s u q (SigA.R s v q q)
runStateVolume :: forall q u v s.
(C q, C q, C u, C v) =>
Sequence s u v T q -> T v q -> T s u q (R s v q q)
runStateVolume = forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T v q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
runVolume forall a. C a => a
zero
{-# INLINE toAmpScalar #-}
toAmpScalar ::
(Field.C a, Dim.C u) =>
DN.T u a -> DN.T u a -> a
toAmpScalar :: forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T u a
amp T u a
y =
forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T u a
y T u a
amp
{-# INLINE make #-}
make :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
Piece.T sig q -> T s u v sig q
make :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make T sig q
piece =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ T v q
y0 T v q
y1 T u q
d T v q
amplitude LazySize
lazySize q
t0 ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
d) (\q
d' ->
forall sig s y. sig -> T (Phantom s) (Flat y) sig
SigA.flatFromBody forall a b. (a -> b) -> a -> b
$
forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece T sig q
piece
(forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y0)
(forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y1)
q
d' LazySize
lazySize q
t0)
{-# INLINE step #-}
step :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q
step :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T s u v sig q
step =
forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make forall (sig :: * -> *) a. Write sig a => T sig a
Piece.step
{-# INLINE linear #-}
linear :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q
linear :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T s u v sig q
linear =
forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make forall a (sig :: * -> *). (C a, Write sig a) => T sig a
Piece.linear
{-# INLINE exponential #-}
exponential :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
DN.T v q -> T s u v sig q
exponential :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T v q -> T s u v sig q
exponential T v q
saturation =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ T v q
y0 T v q
y1 T u q
d T v q
amplitude LazySize
lazySize q
t0 ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
d) (\q
d' ->
forall sig s y. sig -> T (Phantom s) (Flat y) sig
SigA.flatFromBody forall a b. (a -> b) -> a -> b
$
forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece
(forall a (sig :: * -> *). (C a, Write sig a) => a -> T sig a
Piece.exponential (forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
saturation))
(forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y0)
(forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y1)
q
d' LazySize
lazySize q
t0)
{-# INLINE cosine #-}
cosine :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q
cosine :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T s u v sig q
cosine =
forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make forall a (sig :: * -> *). (C a, Write sig a) => T sig a
Piece.cosine
{-# INLINE halfSine #-}
halfSine :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
Piece.FlatPosition -> T s u v sig q
halfSine :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
FlatPosition -> T s u v sig q
halfSine FlatPosition
pos =
forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make (forall a (sig :: * -> *).
(C a, Write sig a) =>
FlatPosition -> T sig a
Piece.halfSine FlatPosition
pos)
{-# INLINE cubic #-}
cubic :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
DN.T (DimensionGradient u v) q ->
DN.T (DimensionGradient u v) q ->
T s u v sig q
cubic :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T (DimensionGradient u v) q
-> T (DimensionGradient u v) q -> T s u v sig q
cubic T (DimensionGradient u v) q
yd0 T (DimensionGradient u v) q
yd1 =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ T v q
y0 T v q
y1 T u q
d T v q
amplitude LazySize
lazySize q
t0 ->
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (\q
d' q
yd0' q
yd1' ->
forall sig s y. sig -> T (Phantom s) (Flat y) sig
SigA.flatFromBody forall a b. (a -> b) -> a -> b
$
forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece
(forall a (sig :: * -> *). (C a, Write sig a) => a -> a -> T sig a
Piece.cubic q
yd0' q
yd1')
(forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y0)
(forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y1)
q
d' LazySize
lazySize q
t0)
(forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
d)
(forall q u v s.
(C q, C u, C v) =>
T v q -> T (DimensionGradient u v) q -> T s u q q
toGradientScalar T v q
amplitude T (DimensionGradient u v) q
yd0)
(forall q u v s.
(C q, C u, C v) =>
T v q -> T (DimensionGradient u v) q -> T s u q q
toGradientScalar T v q
amplitude T (DimensionGradient u v) q
yd1)