module Synthesizer.Causal.ToneModulation (
   ToneModS.interpolateCell,
   seekCell,
   oscillatorCells,
   oscillatorSuffixes,
   integrateFractional,
   integrateFractionalClip,
   -- for testing
   limitRelativeShapes,
   limitMinRelativeValues,
   ) where

import qualified Synthesizer.Basic.ToneModulation as ToneMod
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.State.ToneModulation as ToneModS
import qualified Synthesizer.Interpolation as Interpolation
import qualified Synthesizer.Causal.Oscillator.Core as Osci
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Generic.Signal as SigG

import Control.Arrow (first, (<<<), (<<^), (^<<), (&&&), (***), )
import Control.Monad.Trans.State (state, )

{- for testing in GHCi
import qualified Synthesizer.Plain.ToneModulation as ToneModL
import qualified Synthesizer.State.Signal as SigS
import Data.Tuple.HT (mapFst, mapSnd, swap, )
-}
import Data.Tuple.HT (mapFst, )

import qualified Algebra.RealField             as RealField
import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()



oscillatorCells :: (RealField.C t, SigG.Transform sig y) =>
    Interpolation.Margin ->
    Interpolation.Margin ->
    Int -> t -> sig y -> (t, Phase.T t) ->
    Causal.T (t,t) ((t,t), ToneModS.Cell sig y)
oscillatorCells :: forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, t), Cell sig y)
oscillatorCells
       Margin
marginLeap Margin
marginStep Int
periodInt t
period sig y
sampledTone (t
shape0, T t
phase) =
    Int -> t -> ((t, T t), sig y) -> ((t, t), Cell sig y)
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Int -> t -> ((t, T t), sig y) -> ((t, t), Cell sig y)
seekCell Int
periodInt t
period
     (((t, T t), sig y) -> ((t, t), Cell sig y))
-> T (t, t) ((t, T t), sig y) -> T (t, t) ((t, t), Cell sig y)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, T t), sig y)
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, T t), sig y)
oscillatorSuffixes Margin
marginLeap Margin
marginStep
            Int
periodInt t
period sig y
sampledTone (t
shape0, T t
phase)
{-
*Synthesizer.Causal.ToneModulation> let shapes = [0.3,2.4,0.2,2.1,1.2,1.5::Double]; phases = [0.43,0.72,0.91,0.37,0.42,0.22::Double]
*Synthesizer.Causal.ToneModulation> let marginLeap = Interpolation.Margin 3 1; marginStep = Interpolation.Margin 2 0
*Synthesizer.Causal.ToneModulation> mapM_ (print . mapSnd List.transpose) $ ToneModL.oscillatorCells marginLeap marginStep 5 5.3 ['a'..'z'] (2.3,shapes) (Phase.fromRepresentative 0.6, phases)
*Synthesizer.Causal.ToneModulation> mapM_ print $ SigS.toList $ oscillatorCells marginLeap marginStep 5 5.3 ['a'..'z'] (2.3, Phase.fromRepresentative 0.6) `Causal.apply` (SigS.fromList $ List.zip shapes phases)
-}


seekCell :: (RealField.C t, SigG.Transform sig y) =>
    Int -> t ->
    ((t, Phase.T t), sig y) ->
    ((t,t), ToneModS.Cell sig y)
seekCell :: forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Int -> t -> ((t, T t), sig y) -> ((t, t), Cell sig y)
seekCell Int
periodInt t
period =
    (\((t, T t)
sp,sig y
ptr) ->
       let (Int
k,(t, t)
q) = Int -> t -> (t, T t) -> (Int, (t, t))
forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
ToneMod.flattenShapePhase Int
periodInt t
period (t, T t)
sp
       in  ((t, t)
q, Int -> sig y -> Cell sig y
forall (sig :: * -> *) y.
Transform sig y =>
Int -> sig y -> Cell sig y
ToneModS.makeCell Int
periodInt (sig y -> Cell sig y) -> sig y -> Cell sig y
forall a b. (a -> b) -> a -> b
$
               Int -> sig y -> sig y
forall sig. Transform sig => Int -> sig -> sig
SigG.drop (Int -> Int
forall a. (Ord a, C a, Show a) => a -> a
ToneModS.checkNonNeg (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
periodIntInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
k) sig y
ptr))


{- |
In contrast to the counterpart of this function for plain lists,
it does not use sophisticated list transposition tricks,
but seeks through the prototype signal using 'drop'.
Since 'drop' is used in an inner loop, it must be fast.
This is true for StorableVectors.
-}
oscillatorSuffixes :: (RealField.C t, SigG.Transform sig y) =>
    Interpolation.Margin ->
    Interpolation.Margin ->
    Int -> t ->
    sig y -> (t, Phase.T t) ->
    Causal.T (t,t) ((t, Phase.T t), sig y)
oscillatorSuffixes :: forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, T t), sig y)
oscillatorSuffixes
       Margin
marginLeap Margin
marginStep Int
periodInt t
period sig y
sampledTone (t
shape0, T t
phase) =
    let margin :: Int
margin =
           Margin -> Margin -> Int -> Int
ToneMod.interpolationNumber Margin
marginLeap Margin
marginStep Int
periodInt
        ipOffset :: Int
ipOffset =
           Int
periodInt Int -> Int -> Int
forall a. C a => a -> a -> a
+
           Margin -> Margin -> Int -> Int
ToneMod.interpolationOffset Margin
marginLeap Margin
marginStep Int
periodInt
        (t
shape0min, T t t
shapeLimiter) =
           t -> t -> (t, T t t)
forall t. (C t, Ord t) => t -> t -> (t, T t t)
limitMinRelativeValues (Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral Int
ipOffset) t
shape0
        ((Int
skip0,(t, T t)
coord0), T (t, t) (Skip t)
coordinator) =
           t -> (t, T t) -> (Skip t, T (t, t) (Skip t))
forall t. C t => t -> (t, T t) -> (Skip t, T (t, t) (Skip t))
integrateFractional t
period (t
shape0min, T t
phase)
    in  (\(((Bool
b,Int
n),sig y
ptr), sp :: (t, T t)
sp@(t
_,T t
p)) ->
           (if Bool
b
              then (t
forall a. C a => a
zero, t -> T t -> T t
forall a. C a => a -> T a -> T a
Phase.increment (Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral Int
n t -> t -> t
forall a. C a => a -> a -> a
/ t
period) T t
p)
              else (t, T t)
sp,
            sig y
ptr))
        ((((Bool, Int), sig y), (t, T t)) -> ((t, T t), sig y))
-> T (t, t) (((Bool, Int), sig y), (t, T t))
-> T (t, t) ((t, T t), sig y)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
        ((((Bool, Int), sig y) -> Int -> ((Bool, Int), sig y))
-> ((Bool, Int), sig y) -> T Int ((Bool, Int), sig y)
forall acc x. (acc -> x -> acc) -> acc -> T x acc
Causal.scanL
           (\ ((Bool
_,Int
n),sig y
ptr) Int
d -> Int -> Int -> sig y -> ((Bool, Int), sig y)
forall (sig :: * -> *) y.
Transform sig y =>
Int -> Int -> sig y -> ((Bool, Int), sig y)
dropMargin Int
margin (Int
nInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
d) sig y
ptr)
           (Int -> Int -> sig y -> ((Bool, Int), sig y)
forall (sig :: * -> *) y.
Transform sig y =>
Int -> Int -> sig y -> ((Bool, Int), sig y)
dropMargin Int
margin (Int
skip0 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
ipOffset) sig y
sampledTone)
         T Int ((Bool, Int), sig y)
-> T (t, T t) (t, T t)
-> T (Skip t) (((Bool, Int), sig y), (t, T t))
forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
         (t, T t) -> T (t, T t) (t, T t)
forall x. x -> T x x
Causal.consInit (t, T t)
coord0)
        T (Skip t) (((Bool, Int), sig y), (t, T t))
-> T (t, t) (Skip t) -> T (t, t) (((Bool, Int), sig y), (t, T t))
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
        T (t, t) (Skip t)
coordinator
        T (t, t) (Skip t) -> T (t, t) (t, t) -> T (t, t) (Skip t)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
        T t t -> T (t, t) (t, t)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Causal.first T t t
shapeLimiter
{-
*Synthesizer.Causal.ToneModulation> let shapes = replicate 10 (2.6::Double); phases = cycle [0.43,0.72,0.91,0.37,0.42,0.22::Double]
*Synthesizer.Causal.ToneModulation> let marginLeap = Interpolation.Margin 3 1; marginStep = Interpolation.Margin 2 0
*Synthesizer.Causal.ToneModulation> mapM_ (print . swap . mapSnd (mapSnd (map head))) $ ToneModL.oscillatorSuffixes marginLeap marginStep 5 5.3 ['a'..'z'] (2.3,shapes) (Phase.fromRepresentative 0.6, phases)
*Synthesizer.Causal.ToneModulation> mapM_ print $ SigS.toList $ oscillatorSuffixes marginLeap marginStep 5 5.3 ['a'..'z'] (2.3, Phase.fromRepresentative 0.6) `Causal.apply` (SigS.fromList $ List.zip shapes phases)
-}

{- ToDo:
Both lengthAtMost and dropMarginRem seek through the list.
Maybe an improved version of dropMargin could avoid this.
E.g. dropMarginRem :: Int -> Int -> sig y -> (Maybe Int, sig y),
where return value (Just 0) means,
that drop could actually drop the requested number of elements,
but that we reached the end of the list.
-}
dropMargin :: (SigG.Transform sig y) =>
   Int -> Int -> sig y -> ((Bool, Int), sig y)
dropMargin :: forall (sig :: * -> *) y.
Transform sig y =>
Int -> Int -> sig y -> ((Bool, Int), sig y)
dropMargin Int
margin Int
n sig y
xs =
   (Int -> (Bool, Int)) -> (Int, sig y) -> ((Bool, Int), sig y)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((,) (Int -> sig y -> Bool
forall sig. Transform sig => Int -> sig -> Bool
SigG.lengthAtMost (Int
marginInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
n) sig y
xs)) ((Int, sig y) -> ((Bool, Int), sig y))
-> (Int, sig y) -> ((Bool, Int), sig y)
forall a b. (a -> b) -> a -> b
$
   Int -> Int -> sig y -> (Int, sig y)
forall sig. Transform sig => Int -> Int -> sig -> (Int, sig)
SigG.dropMarginRem Int
margin (Int -> Int
forall a. (Ord a, C a, Show a) => a -> a
ToneModS.checkNonNeg Int
n) sig y
xs

regroup :: (Int,t) -> Phase.T t -> ToneMod.Skip t
regroup :: forall t. (Int, t) -> T t -> Skip t
regroup (Int
d,t
s) T t
p = (Int
d, (t
s,T t
p))

integrateFractional :: (RealField.C t) =>
    t ->
    (t, Phase.T t) ->
    (ToneMod.Skip t, Causal.T (t,t) (ToneMod.Skip t))
integrateFractional :: forall t. C t => t -> (t, T t) -> (Skip t, T (t, t) (Skip t))
integrateFractional t
period (t
shape0, T t
phase) =
    let sf0 :: (Int, t)
sf0 = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction t
shape0
        -- shapeOffsets :: RealField.C t => Causal.T t (Int,t)
        shapeOffsets :: T t (Int, t)
shapeOffsets =
           (t -> State t (Int, t)) -> t -> T t (Int, t)
forall a s b. (a -> State s b) -> s -> T a b
Causal.fromState
              (\t
c -> (t -> ((Int, t), t)) -> State t (Int, t)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((t -> ((Int, t), t)) -> State t (Int, t))
-> (t -> ((Int, t), t)) -> State t (Int, t)
forall a b. (a -> b) -> a -> b
$ \t
s0 ->
                 let s1 :: (Int, t)
s1 = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction (t
s0t -> t -> t
forall a. C a => a -> a -> a
+t
c)
                 in  ((Int, t)
s1, (Int, t) -> t
forall a b. (a, b) -> b
snd (Int, t)
s1))
              ((Int, t) -> t
forall a b. (a, b) -> b
snd (Int, t)
sf0)
        scale :: (a, b) -> t
scale (a
n,b
_) = a -> t
forall a b. (C a, C b) => a -> b
fromIntegral a
n t -> t -> t
forall a. C a => a -> a -> a
/ t
period
        -- phases :: RealField.C t => Causal.T ((Int,t), t) (Phase.T t)
        phase0 :: T t
phase0 = t -> T t -> T t
forall a. C a => a -> T a -> T a
Phase.decrement ((Int, t) -> t
forall {a} {b}. C a => (a, b) -> t
scale (Int, t)
sf0) T t
phase
        phases :: T ((Int, b), t) (T t)
phases =
           T t -> T t (T t)
forall a. C a => T a -> T a (T a)
Osci.freqModSync T t
phase0
              T t (T t) -> (((Int, b), t) -> t) -> T ((Int, b), t) (T t)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ (\((Int, b)
s,t
f) -> t
f t -> t -> t
forall a. C a => a -> a -> a
- (Int, b) -> t
forall {a} {b}. C a => (a, b) -> t
scale (Int, b)
s)
    in  ((Int, t) -> T t -> Skip t
forall t. (Int, t) -> T t -> Skip t
regroup (Int, t)
sf0 T t
phase0,
         ((Int, t) -> T t -> Skip t) -> ((Int, t), T t) -> Skip t
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int, t) -> T t -> Skip t
forall t. (Int, t) -> T t -> Skip t
regroup
         (((Int, t), T t) -> Skip t)
-> T (t, t) ((Int, t), T t) -> T (t, t) (Skip t)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
         ((((Int, t), t) -> (Int, t)) -> T ((Int, t), t) (Int, t)
forall a b. (a -> b) -> T a b
Causal.map ((Int, t), t) -> (Int, t)
forall a b. (a, b) -> a
fst T ((Int, t), t) (Int, t)
-> T ((Int, t), t) (T t) -> T ((Int, t), t) ((Int, t), T t)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T ((Int, t), t) (T t)
forall {b}. T ((Int, b), t) (T t)
phases)
         T ((Int, t), t) ((Int, t), T t)
-> T (t, t) ((Int, t), t) -> T (t, t) ((Int, t), T t)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
         T t (Int, t) -> T (t, t) ((Int, t), t)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first T t (Int, t)
shapeOffsets)

{- |
Delays output by one element and shorten it by one element at the end.
-}
integrateFractionalClip :: (RealField.C t) =>
    t ->
    (t, Phase.T t) ->
    Causal.T (t,t) (ToneMod.Skip t)
integrateFractionalClip :: forall t. C t => t -> (t, T t) -> T (t, t) (Skip t)
integrateFractionalClip t
period (t
shape0, T t
phase) =
    let sf0 :: (Int, t)
sf0 = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction t
shape0
        -- shapeOffsets :: RealField.C t => Causal.T t (Int,t)
        shapeOffsets :: T t (Int, t)
shapeOffsets =
           (t -> State t (Int, t)) -> t -> T t (Int, t)
forall a s b. (a -> State s b) -> s -> T a b
Causal.fromState
              (\t
c -> (t -> ((Int, t), t)) -> State t (Int, t)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((t -> ((Int, t), t)) -> State t (Int, t))
-> (t -> ((Int, t), t)) -> State t (Int, t)
forall a b. (a -> b) -> a -> b
$ \t
s0 ->
                 let s1 :: (Int, t)
s1 = t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction (t
s0t -> t -> t
forall a. C a => a -> a -> a
+t
c)
                 in  ((Int, t)
s1, (Int, t) -> t
forall a b. (a, b) -> b
snd (Int, t)
s1))
              ((Int, t) -> t
forall a b. (a, b) -> b
snd (Int, t)
sf0)
        scale :: (a, b) -> t
scale (a
n,b
_) = a -> t
forall a b. (C a, C b) => a -> b
fromIntegral a
n t -> t -> t
forall a. C a => a -> a -> a
/ t
period
        -- phases :: RealField.C t => Causal.T ((Int,t), t) (Phase.T t)
        phases :: T ((Int, b), t) (T t)
phases =
           T t -> T t (T t)
forall a. C a => T a -> T a (T a)
Osci.freqMod
              (t -> T t -> T t
forall a. C a => a -> T a -> T a
Phase.decrement ((Int, t) -> t
forall {a} {b}. C a => (a, b) -> t
scale (Int, t)
sf0) T t
phase)
              T t (T t) -> (((Int, b), t) -> t) -> T ((Int, b), t) (T t)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ (\((Int, b)
s,t
f) -> t
f t -> t -> t
forall a. C a => a -> a -> a
- (Int, b) -> t
forall {a} {b}. C a => (a, b) -> t
scale (Int, b)
s)
    in  ((Int, t) -> T t -> Skip t) -> ((Int, t), T t) -> Skip t
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int, t) -> T t -> Skip t
forall t. (Int, t) -> T t -> Skip t
regroup
        (((Int, t), T t) -> Skip t)
-> T (t, t) ((Int, t), T t) -> T (t, t) (Skip t)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
        (((Int, t) -> T (Int, t) (Int, t)
forall x. x -> T x x
Causal.consInit (Int, t)
sf0 T (Int, t) (Int, t)
-> (((Int, t), t) -> (Int, t)) -> T ((Int, t), t) (Int, t)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ ((Int, t), t) -> (Int, t)
forall a b. (a, b) -> a
fst) T ((Int, t), t) (Int, t)
-> T ((Int, t), t) (T t) -> T ((Int, t), t) ((Int, t), T t)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T ((Int, t), t) (T t)
forall {b}. T ((Int, b), t) (T t)
phases)
        T ((Int, t), t) ((Int, t), T t)
-> T (t, t) ((Int, t), t) -> T (t, t) ((Int, t), T t)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
        T t (Int, t) -> T (t, t) ((Int, t), t)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first T t (Int, t)
shapeOffsets
{-
test to automate:
*Synthesizer.Generic.ToneModulation> let shapes = [0.3,0.4,0.2::Double]; phases = [0.43,0.72,0.91::Double]
*Synthesizer.Generic.ToneModulation> ToneMod.oscillatorCoords 9 10 (2.3,shapes) (Phase.fromRepresentative 0.6, phases)
[(2,(-6,(0.63,0.6299999999999999))),(0,(-2,(0.22999999999999998,0.53))),(0,(-4,(0.5500000000000002,4.9999999999998934e-2))),(1,(-6,(0.6600000000000001,0.2599999999999989)))]

*Synthesizer.Generic.ToneModulation> ToneModS.oscillatorCoords 9 10 (2.3, SigS.fromList shapes) (Phase.fromRepresentative 0.6, SigS.fromList phases)
StateSignal.fromList [(2,(-6,(0.63,0.6299999999999999))),(0,(-2,(0.22999999999999998,0.53))),(0,(-4,(0.5500000000000002,4.9999999999998934e-2)))]

*Synthesizer.Generic.ToneModulation> Data.Tuple.HT.mapSnd (flip Causal.apply $ SigS.fromList (zip shapes phases)) $ oscillatorCoords 9 10 (2.3, Phase.fromRepresentative 0.6)
((2,(-6,(0.63,0.6299999999999999))),StateSignal.fromList [(0,(-2,(0.22999999999999998,0.53))),(0,(-4,(0.5500000000000002,4.9999999999998934e-2))),(1,(-6,(0.6600000000000001,0.2599999999999989)))])

*Synthesizer.Generic.ToneModulation> oscillatorCoords' 9 10 (2.3, Phase.fromRepresentative 0.6) `Causal.apply` SigS.fromList (zip shapes phases)
StateSignal.fromList [(2,(-6,(0.63,0.6299999999999999))),(0,(-2,(0.22999999999999998,0.53))),(0,(-4,(0.5500000000000002,4.9999999999998934e-2)))]
-}

limitRelativeShapes :: (Ring.C t, Ord t) =>
    Interpolation.Margin ->
    Interpolation.Margin ->
    Int -> t -> (t, Causal.T t t)
limitRelativeShapes :: forall t.
(C t, Ord t) =>
Margin -> Margin -> Int -> t -> (t, T t t)
limitRelativeShapes Margin
marginLeap Margin
marginStep Int
periodInt =
    t -> t -> (t, T t t)
forall t. (C t, Ord t) => t -> t -> (t, T t t)
limitMinRelativeValues (t -> t -> (t, T t t)) -> t -> t -> (t, T t t)
forall a b. (a -> b) -> a -> b
$ Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral (Int -> t) -> Int -> t
forall a b. (a -> b) -> a -> b
$
    Margin -> Margin -> Int -> Int
ToneMod.interpolationOffset Margin
marginLeap Margin
marginStep Int
periodInt Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
periodInt

limitMinRelativeValues :: (Additive.C t, Ord t) =>
   t -> t -> (t, Causal.T t t)
limitMinRelativeValues :: forall t. (C t, Ord t) => t -> t -> (t, T t t)
limitMinRelativeValues t
xMin t
x0 =
   let x1 :: t
x1 = t
xMint -> t -> t
forall a. C a => a -> a -> a
-t
x0
   in  if t
x1t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<=t
forall a. C a => a
zero
         then (t
x0, T t t
forall a. T a a
Causal.id)
         else (t
xMin,
               (t -> t -> Maybe (t, t)) -> t -> T t t
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x y
Causal.crochetL
                  (\t
x t
lim -> (t, t) -> Maybe (t, t)
forall a. a -> Maybe a
Just ((t, t) -> Maybe (t, t)) -> (t, t) -> Maybe (t, t)
forall a b. (a -> b) -> a -> b
$
                     let d :: t
d = t
xt -> t -> t
forall a. C a => a -> a -> a
-t
lim
                     in  if t
dt -> t -> Bool
forall a. Ord a => a -> a -> Bool
>=t
forall a. C a => a
zero
                           then (t
d,t
forall a. C a => a
zero) else (t
forall a. C a => a
zero, t -> t
forall a. C a => a -> a
negate t
d)) t
x1)