{-# LANGUAGE NoImplicitPrelude #-}
{- |
Copyright   :  (c) Henning Thielemann 2006
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes


Avoid importing this module.
Better use functions from
"Synthesizer.Plain.Oscillator" and
"Synthesizer.Basic.Wave"

Input data is interpreted as samples of data on a cylinder
in the following form:

> |*          |
> |   *       |
> |      *    |
> |         * |
> | *         |
> |    *      |
> |       *   |
> |          *|
> |  *        |
> |     *     |
> |        *  |


> -----------
> *
>     *
>         *
>  *
>      *
>          *
>   *
>       *
>           *
>    *
>        *
> -----------

We have to interpolate in the parallelograms.

-}
module Synthesizer.Plain.ToneModulation (
   Cell,
   interpolateCell,

   Prototype,
   makePrototype,
   sampledToneCell,

   oscillatorCells,
   seekCell,
   oscillatorSuffixes,

   -- this function fits better in the Oscillator module
   freqsToPhases,

   -- for testing
   dropFrac,
   dropRem,
   propDropFrac,
   propDropRem,
   oscillatorCoords,
   integrateFractional,
   limitRelativeShapes,
   limitMinRelativeValues,
   limitMaxRelativeValues,
   limitMaxRelativeValuesNonNeg,
   ) where

import qualified Synthesizer.Basic.ToneModulation as ToneMod
import qualified Synthesizer.Basic.Phase as Phase

import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Interpolation as Interpolation
import Synthesizer.Interpolation (Margin, )

import Control.Monad (guard, )

import qualified Data.List       as List
import qualified Data.List.HT    as ListHT
import qualified Data.List.Match as ListMatch
import Data.Array (Array, (!), listArray, )
import Data.Tuple.HT (mapPair, mapSnd, forcePair, )
import Data.Ord.HT (limit, )

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

import qualified Number.NonNegative       as NonNeg
import qualified Number.NonNegativeChunky as Chunky

import NumericPrelude.Numeric
import NumericPrelude.Base



-- * general helpers

type Cell y = Sig.T (Sig.T y)

interpolateCell ::
   Interpolation.T a y ->
   Interpolation.T b y ->
   (a, b) ->
   Cell y -> y
interpolateCell :: forall a y b. T a y -> T b y -> (a, b) -> Cell y -> y
interpolateCell T a y
ipLeap T b y
ipStep (a
qLeap,b
qStep) =
   forall t y. T t y -> t -> T y -> y
Interpolation.func T b y
ipStep b
qStep forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> b) -> [a] -> [b]
map (forall t y. T t y -> t -> T y -> y
Interpolation.func T a y
ipLeap a
qLeap)


-- * array based shape variable wave

data Prototype t y =
   Prototype {
      forall t y. Prototype t y -> Margin
protoMarginLeap,
      forall t y. Prototype t y -> Margin
protoMarginStep  :: Margin,
      forall t y. Prototype t y -> Int
protoIpOffset    :: Int,
      forall t y. Prototype t y -> t
protoPeriod      :: t,
      forall t y. Prototype t y -> Int
protoPeriodInt   :: Int,
      forall t y. Prototype t y -> (t, t)
protoShapeLimits :: (t,t),
      forall t y. Prototype t y -> Array Int y
protoArray       :: Array Int y
   }


makePrototype :: (RealField.C t) =>
   Margin ->
   Margin ->
   Int -> t -> Sig.T y -> Prototype t y
makePrototype :: forall t y.
C t =>
Margin -> Margin -> Int -> t -> T y -> Prototype t y
makePrototype Margin
marginLeap Margin
marginStep Int
periodInt t
period T y
tone =
   let ipOffset :: Int
ipOffset =
          Margin -> Margin -> Int -> Int
ToneMod.interpolationOffset Margin
marginLeap Margin
marginStep Int
periodInt
       len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length T y
tone
       (Int
lower,Int
upper) =
          forall t. C t => Margin -> Margin -> Int -> t -> (t, t)
ToneMod.shapeLimits Margin
marginLeap Margin
marginStep Int
periodInt Int
len
       limits :: (t, t)
limits =
          if Int
lower forall a. Ord a => a -> a -> Bool
> Int
upper
            then forall a. HasCallStack => [Char] -> a
error [Char]
"min>max"
            else (forall a b. (C a, C b) => a -> b
fromIntegral Int
lower, forall a b. (C a, C b) => a -> b
fromIntegral Int
upper)

   in  Prototype {
          protoMarginLeap :: Margin
protoMarginLeap  = Margin
marginLeap,
          protoMarginStep :: Margin
protoMarginStep  = Margin
marginStep,
          protoIpOffset :: Int
protoIpOffset    = Int
ipOffset,
          protoPeriod :: t
protoPeriod      = t
period,
          protoPeriodInt :: Int
protoPeriodInt   = Int
periodInt,
          protoShapeLimits :: (t, t)
protoShapeLimits = (t, t)
limits,
          protoArray :: Array Int y
protoArray       = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall a. Enum a => a -> a
pred Int
len) T y
tone
       }

sampledToneCell :: (RealField.C t) =>
   Prototype t y -> t -> Phase.T t -> ((t,t), Cell y)
sampledToneCell :: forall t y. C t => Prototype t y -> t -> T t -> ((t, t), Cell y)
sampledToneCell Prototype t y
p t
shape T t
phase =
   let (Int
n, (t, t)
q) =
          forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
ToneMod.flattenShapePhase (forall t y. Prototype t y -> Int
protoPeriodInt Prototype t y
p) (forall t y. Prototype t y -> t
protoPeriod Prototype t y
p)
             (forall a. Ord a => (a, a) -> a -> a
limit (forall t y. Prototype t y -> (t, t)
protoShapeLimits Prototype t y
p) t
shape, T t
phase)
   in  ((t, t)
q,
        forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall t y. Prototype t y -> Array Int y
protoArray Prototype t y
p forall i e. Ix i => Array i e -> i -> e
! ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate (forall t y. Prototype t y -> Int
protoPeriodInt Prototype t y
p forall a. C a => a -> a -> a
+)) forall a b. (a -> b) -> a -> b
$
        forall a. Enum a => a -> [a]
enumFrom (Int
n forall a. C a => a -> a -> a
- forall t y. Prototype t y -> Int
protoIpOffset Prototype t y
p))


{-
  M = ((1,1)^T, (periodRound, period-periodRound)^T)

  equation for the line
   0 = (nStep - offset ipStep) +
       (nLeap - offset ipLeap) * periodInt

   <(1,periodInt), (offset ipStep, offset ipLeap)>
        = <(1,periodInt), (nStep,nLeap)>
   d = <a,x>
     = <a,M^-1*M*x>
     = <(M^-T)*a,M*x>
     = <(M^-T)*a,y>
   b = (M^-T)*a
   required:
      y0 such that y1=0
      y0 such that y1=period

   The line {x : d = <a,x>} converted to (shape,phase) coordinates
   has constant shape and meets all phases.
-}



-- * lazy oscillator


oscillatorCells :: (RealField.C t) =>
    Margin ->
    Margin ->
    Int -> t ->
    Sig.T y -> (t, Sig.T t) -> (Phase.T t, Sig.T t) -> Sig.T ((t,t), Cell y)
oscillatorCells :: forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, t), Cell y)
oscillatorCells
       Margin
marginLeap Margin
marginStep Int
periodInt t
period T y
sampledTone (t, T t)
shapes (T t, T t)
freqs =
    forall a b. (a -> b) -> [a] -> [b]
map (forall t y.
C t =>
Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
seekCell Int
periodInt t
period) forall a b. (a -> b) -> a -> b
$
    forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, T t), Cell y)
oscillatorSuffixes
        Margin
marginLeap Margin
marginStep Int
periodInt t
period T y
sampledTone (t, T t)
shapes (T t, T t)
freqs

seekCell :: (RealField.C t) =>
    Int -> t ->
    ((t, Phase.T t), Cell y) -> ((t,t), Cell y)
seekCell :: forall t y.
C t =>
Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
seekCell Int
periodInt t
period =
    {- n will be zero within the data.
       We would need it only for extrapolation at the end.
       But this does not happen, since we limit the shape control parameter accordingly.
    -}
    (\((t, T t)
coords, Cell y
ptr) ->
       let (Int
k,(t, t)
q) = forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
ToneMod.flattenShapePhase Int
periodInt t
period (t, T t)
coords
       in  if Int
kforall a. Ord a => a -> a -> Bool
>Int
0
             then forall a. HasCallStack => [Char] -> a
error [Char]
"ToneModulation.oscillatorCells: k>0"
             else ((t, t)
q, forall a. Int -> [a] -> [a]
drop (Int
periodIntforall a. C a => a -> a -> a
+Int
k) Cell y
ptr))

oscillatorSuffixes :: (RealField.C t) =>
    Margin ->
    Margin ->
    Int -> t -> Sig.T y ->
    (t, Sig.T t) -> (Phase.T t, Sig.T t) ->
    Sig.T ((t, Phase.T t), Cell y)
oscillatorSuffixes :: forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, T t), Cell y)
oscillatorSuffixes
       Margin
marginLeap Margin
marginStep Int
periodInt t
period T y
sampledTone (t, T t)
shapes (T t, T t)
freqs =
    let ptrs :: [T y]
ptrs =
           forall a. [[a]] -> [[a]]
List.transpose forall a b. (a -> b) -> a -> b
$
           forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$
           forall a. (a -> a) -> a -> [a]
iterate (forall a. Int -> [a] -> [a]
drop Int
periodInt) T y
sampledTone
        ipOffset :: Int
ipOffset =
           Int
periodInt forall a. C a => a -> a -> a
+
           Margin -> Margin -> Int -> Int
ToneMod.interpolationOffset Margin
marginLeap Margin
marginStep Int
periodInt
{- I tried to switch integrateFractional and limitRelativeShapes
   in order to have a position where I can easily add phase distortion.
   However, limitting skip values after integrateFractional
   does not work this way, since once we start setting skip values to zero,
   we had to clear the fractional parts of the shape coordinate, too.
        (firstSkip:allSkips,coords) =
           unzip $
           integrateFractional period shapes freqs
        (skip,skips) =
           limitRelativeShapes marginLeap marginStep
              periodInt sampledTone (firstSkip,allSkips)
-}
        (Int
skip:[Int]
skips,[(t, T t)]
coords) =
           forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$
           forall t. C t => t -> (t, T t) -> (T t, T t) -> T (Skip t)
integrateFractional t
period
              (forall t y.
(C t, Ord t) =>
Margin -> Margin -> Int -> T y -> (t, T t) -> (t, T t)
limitRelativeShapes Margin
marginLeap Margin
marginStep Int
periodInt T y
sampledTone (t, T t)
shapes)
              (T t, T t)
freqs
    in  forall a b. [a] -> [b] -> [(a, b)]
zip [(t, T t)]
coords forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (\(Int
n,[T y]
ptr) ->
               if Int
nforall a. Ord a => a -> a -> Bool
>Int
0
                 then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"ToneModulation.oscillatorCells: " forall a. [a] -> [a] -> [a]
++
                              [Char]
"limit of shape parameter is buggy"
                 else [T y]
ptr) forall a b. (a -> b) -> a -> b
$
        forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$
        forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
           {- since we clip the coordinates before calling oscillatorCells
              we do not need 'dropRem', since 'drop' would never go beyond the list end -}
           (\ (Int
n,[T y]
ptr0) Int
d0 -> forall a. Int -> T a -> (Int, T a)
dropRem (Int
nforall a. C a => a -> a -> a
+Int
d0) [T y]
ptr0)
           (Int
0,[T y]
ptrs)
           ((Int
skip forall a. C a => a -> a -> a
- Int
ipOffset) forall a. a -> [a] -> [a]
: [Int]
skips)

dropFrac :: RealField.C i => i -> Sig.T a -> (Int, i, Sig.T a)
dropFrac :: forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac =
   let recourse :: a -> b -> [a] -> (a, b, [a])
recourse a
acc b
n [a]
xt =
          if b
nforall a. Ord a => a -> a -> Bool
>=b
1
            then
               case [a]
xt of
                  a
_:[a]
xs -> a -> b -> [a] -> (a, b, [a])
recourse (forall a. Enum a => a -> a
succ a
acc) (b
nforall a. C a => a -> a -> a
-b
1) [a]
xs
                  [] -> (a
acc, b
n, [])
            else (a
acc,b
n,[a]
xt)
   in  forall {b} {a} {a}.
(Ord b, C b, Enum a) =>
a -> b -> [a] -> (a, b, [a])
recourse Int
0

dropFrac' :: RealField.C i => i -> Sig.T a -> (Int, i, Sig.T a)
dropFrac' :: forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac' =
   let recourse :: t -> a -> [a] -> (t, a, [a])
recourse t
acc a
n [a]
xt =
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe
             (t
acc,a
n,[a]
xt)
             (t -> a -> [a] -> (t, a, [a])
recourse (forall a. Enum a => a -> a
succ t
acc) (a
nforall a. C a => a -> a -> a
-a
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
             (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
nforall a. Ord a => a -> a -> Bool
>=a
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. [a] -> Maybe (a, [a])
ListHT.viewL [a]
xt)
   in  forall {t} {a} {a}.
(Enum t, C a, Ord a) =>
t -> a -> [a] -> (t, a, [a])
recourse Int
0

propDropFrac :: (RealField.C i, Eq a) => i -> Sig.T a -> Bool
propDropFrac :: forall i a. (C i, Eq a) => i -> T a -> Bool
propDropFrac i
n T a
xs =
   forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac i
n T a
xs forall a. Eq a => a -> a -> Bool
== forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac' i
n T a
xs



dropRem :: Int -> Sig.T a -> (Int, Sig.T a)
dropRem :: forall a. Int -> T a -> (Int, T a)
dropRem =
   let recourse :: a -> [a] -> (a, [a])
recourse a
n [a]
xt =
          if a
nforall a. Ord a => a -> a -> Bool
>a
0
            then
               case [a]
xt of
                  a
_:[a]
xs -> a -> [a] -> (a, [a])
recourse (forall a. Enum a => a -> a
pred a
n) [a]
xs
                  [] -> (a
n, [])
            else (a
n,[a]
xt)
   in  forall {a} {a}. (Ord a, C a, Enum a) => a -> [a] -> (a, [a])
recourse

dropRem' :: Int -> Sig.T a -> (Int, Sig.T a)
dropRem' :: forall a. Int -> T a -> (Int, T a)
dropRem' =
   let recourse :: a -> [a] -> (a, [a])
recourse a
n [a]
xt =
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe
             (a
n,[a]
xt)
             (a -> [a] -> (a, [a])
recourse (forall a. Enum a => a -> a
pred a
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
             (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
nforall a. Ord a => a -> a -> Bool
>a
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. [a] -> Maybe (a, [a])
ListHT.viewL [a]
xt)
   in  forall {a} {a}. (Enum a, Ord a, C a) => a -> [a] -> (a, [a])
recourse

propDropRem :: (Eq a) => Int -> Sig.T a -> Bool
propDropRem :: forall a. Eq a => Int -> T a -> Bool
propDropRem Int
n T a
xs =
   forall a. Int -> T a -> (Int, T a)
dropRem Int
n T a
xs forall a. Eq a => a -> a -> Bool
== forall a. Int -> T a -> (Int, T a)
dropRem' Int
n T a
xs

{-
*Synthesizer.Plain.ToneModulation> Test.QuickCheck.quickCheck (\n xs -> propDropRem n (xs::[Int]))
OK, passed 100 tests.
*Synthesizer.Plain.ToneModulation> Test.QuickCheck.quickCheck (\n xs -> propDropFrac (n::Rational) (xs::[Int]))
OK, passed 100 tests.
-}


oscillatorCoords :: (RealField.C t) =>
    Int -> t -> (t, Sig.T t) -> (Phase.T t, Sig.T t) -> Sig.T (ToneMod.Coords t)
oscillatorCoords :: forall t. C t => Int -> t -> (t, T t) -> (T t, T t) -> T (Coords t)
oscillatorCoords Int
periodInt t
period (t, T t)
shapes (T t, T t)
freqs =
   forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
ToneMod.flattenShapePhase Int
periodInt t
period)) forall a b. (a -> b) -> a -> b
$
   forall t. C t => t -> (t, T t) -> (T t, T t) -> T (Skip t)
integrateFractional t
period (t, T t)
shapes (T t, T t)
freqs
{-
mapM print $ take 30 $ let period = 1/0.07::Double in oscillatorCoords (round period) period 0 0 (repeat 0.1) (repeat 0.01)

*Synthesizer.Plain.Oscillator> mapM print $ take 30 $ let period = 1/0.07::Rational in oscillatorCoords (round period) period 0 0 (repeat 1) (repeat 0.07)

*Synthesizer.Plain.Oscillator> mapM print $ take 30 $ let period = 1/0.07::Rational in oscillatorCoords (round period) period 0 0 (repeat 0.25) (repeat 0.0175)
-}


integrateFractional :: (RealField.C t) =>
    t -> (t, Sig.T t) -> (Phase.T t, Sig.T t) -> Sig.T (ToneMod.Skip t)
integrateFractional :: forall t. C t => t -> (t, T t) -> (T t, T t) -> T (Skip t)
integrateFractional t
period (t
shape0, T t
shapes) (T t
phase, T t
freqs) =
    let shapeOffsets :: [(Int, t)]
shapeOffsets =
           forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
              (\(Int
_,t
s) t
c -> forall a b. (C a, C b) => a -> (b, a)
splitFraction (t
sforall a. C a => a -> a -> a
+t
c))
              (forall a b. (C a, C b) => a -> (b, a)
splitFraction t
shape0) T t
shapes
        phases :: T (T t)
phases =
           let (t
s:T t
ss) = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
n,t
_) -> forall a b. (C a, C b) => a -> b
fromIntegral Int
n forall a. C a => a -> a -> a
/ t
period) [(Int, t)]
shapeOffsets
           in  forall a. C a => T a -> T a -> T (T a)
freqsToPhases
                  (forall a. C a => a -> T a -> T a
Phase.decrement t
s T t
phase)  -- phase - s
                  (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) T t
freqs T t
ss)
    in  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
           (\(Int
d,t
s) T t
p -> (Int
d, (t
s,T t
p)))
           [(Int, t)]
shapeOffsets
           T (T t)
phases


-- this function fits better in the Oscillator module
{- |
Convert a list of phase steps into a list of momentum phases
phase is a number in the interval [0,1)
freq contains the phase steps
-}
freqsToPhases :: RealRing.C a => Phase.T a -> Sig.T a -> Sig.T (Phase.T a)
freqsToPhases :: forall a. C a => T a -> T a -> T (T a)
freqsToPhases T a
phase T a
freq = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. C a => a -> T a -> T a
Phase.increment) T a
phase T a
freq



limitRelativeShapes :: (Ring.C t, Ord t) =>
    Margin ->
    Margin ->
    Int -> Sig.T y -> (t, Sig.T t) -> (t, Sig.T t)
limitRelativeShapes :: forall t y.
(C t, Ord t) =>
Margin -> Margin -> Int -> T y -> (t, T t) -> (t, T t)
limitRelativeShapes Margin
marginLeap Margin
marginStep Int
periodInt T y
sampledTone =
    let -- len = List.genericLength sampledTone
        len :: T (T t)
len = forall a. C a => [a] -> T a
Chunky.fromChunks (forall a b. [a] -> b -> [b]
ListMatch.replicate T y
sampledTone forall a. C a => a
one)
        (T (T t)
minShape, T (T t)
maxShape) =
           forall t. C t => Margin -> Margin -> Int -> t -> (t, t)
ToneMod.shapeLimits Margin
marginLeap Margin
marginStep Int
periodInt T (T t)
len
        fromChunky :: T (T t) -> t
fromChunky = forall a. T a -> a
NonNeg.toNumber   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => T a -> a
Chunky.toNumber
        toChunky :: t -> T (T t)
toChunky   = forall a. C a => a -> T a
Chunky.fromNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Ord a, C a) => a -> T a
NonNeg.fromNumber
    in  forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T (T t) -> t
fromChunky, forall a b. (a -> b) -> [a] -> [b]
map T (T t) -> t
fromChunky) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMaxRelativeValuesNonNeg T (T t)
maxShape) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (t -> T (T t)
toChunky, forall a b. (a -> b) -> [a] -> [b]
map t -> T (T t)
toChunky) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMinRelativeValues (T (T t) -> t
fromChunky T (T t)
minShape))
{-
*Synthesizer.Plain.Oscillator> let ip = Interpolation.linear in limitRelativeShapes ip ip 13 (take 100 $ iterate (1+) (0::Double)) (0::Double, cycle [0.5,1.5])
(13.0,[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5,1.5,0.5*** Exception: Numeric.NonNegative.Chunky.-: negative number
-}


limitMinRelativeValues :: (Additive.C a, Ord a) =>
   a -> a -> Sig.T a -> (a, Sig.T a)
limitMinRelativeValues :: forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMinRelativeValues a
xMin a
x0 T a
xs =
   let ([(a, a)]
ys,[(a, a)]
zs) =
          forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Ord a => a -> a -> Bool
<forall a. C a => a
zero)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (forall a b. [a] -> [b] -> [(a, b)]
zip (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. C a => a -> a -> a
(+) (a
x0forall a. C a => a -> a -> a
-a
xMin) T a
xs) (a
x0forall a. a -> [a] -> [a]
:T a
xs))
   in  case [(a, a)]
ys of
          [] -> (a
x0,T a
xs)
          ((a, a)
_:[(a, a)]
yr) -> (a
xMin, forall a b. [a] -> b -> [b]
ListMatch.replicate [(a, a)]
yr forall a. C a => a
zero forall a. [a] -> [a] -> [a]
++
              case [(a, a)]
zs of
                 [] -> []
                 ((a, a)
z:[(a, a)]
zr) -> forall a b. (a, b) -> a
fst (a, a)
z forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, a)]
zr)

limitMaxRelativeValues :: (Additive.C a, Ord a) =>
   a -> a -> Sig.T a -> (a, Sig.T a)
limitMaxRelativeValues :: forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMaxRelativeValues a
xMax a
x0 T a
xs =
   let (T a
ys,T a
zs) =
          forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Ord a => a -> a -> Bool
>forall a. C a => a
zero) (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) (a
xMaxforall a. C a => a -> a -> a
-a
x0) T a
xs)
   in  forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
       forall b a. b -> ([a] -> a -> b) -> [a] -> b
ListHT.switchR
          (a
xMax, forall a b. [a] -> b -> [b]
ListMatch.replicate T a
xs forall a. C a => a
zero)
          (\ T a
yl a
yr -> (a
x0, forall b a. [b] -> [a] -> [a]
ListMatch.take T a
yl T a
xs forall a. [a] -> [a] -> [a]
++ forall b a. [b] -> [a] -> [a]
ListMatch.take T a
zs (a
yr forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat forall a. C a => a
zero)))
          T a
ys

{- |
Avoids negative numbers and thus can be used with Chunky numbers.
-}
limitMaxRelativeValuesNonNeg :: (Additive.C a, Ord a) =>
   a -> a -> Sig.T a -> (a, Sig.T a)
limitMaxRelativeValuesNonNeg :: forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMaxRelativeValuesNonNeg a
xMax a
x0 T a
xs =
   let ([(Bool, a)]
ys,[(Bool, a)]
zs) =
          forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall a b. (a, b) -> a
fst (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\(Bool
_,a
acc) a
d -> forall a. (C a, Ord a) => a -> a -> (Bool, a)
safeSub a
acc a
d) (forall a. (C a, Ord a) => a -> a -> (Bool, a)
safeSub a
xMax a
x0) T a
xs)
   in  forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
       forall b a. b -> ([a] -> a -> b) -> [a] -> b
ListHT.switchR
          (a
xMax, forall a b. [a] -> b -> [b]
ListMatch.replicate T a
xs forall a. C a => a
zero)
          (\ [(Bool, a)]
yl ~(Bool
_,a
yr) -> (a
x0, forall b a. [b] -> [a] -> [a]
ListMatch.take [(Bool, a)]
yl T a
xs forall a. [a] -> [a] -> [a]
++ forall b a. [b] -> [a] -> [a]
ListMatch.take [(Bool, a)]
zs (a
yr forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat forall a. C a => a
zero)))
          [(Bool, a)]
ys
{-
*Synthesizer.Plain.Oscillator> limitMaxRelativeValuesNonNeg (let inf = 1+inf in inf) (0::Chunky.T NonNeg.Rational) (repeat 2.5)
-}

safeSub :: (Additive.C a, Ord a) => a -> a -> (Bool, a)
safeSub :: forall a. (C a, Ord a) => a -> a -> (Bool, a)
safeSub a
a a
b = (a
aforall a. Ord a => a -> a -> Bool
>=a
b, a
aforall a. C a => a -> a -> a
-a
b)