{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.ToneModulation (
Cell,
interpolateCell,
Prototype,
makePrototype,
sampledToneCell,
oscillatorCells,
seekCell,
oscillatorSuffixes,
freqsToPhases,
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
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) =
T b y -> b -> T y -> y
forall t y. T t y -> t -> T y -> y
Interpolation.func T b y
ipStep b
qStep (T y -> y) -> (Cell y -> T y) -> Cell y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(T y -> y) -> Cell y -> T y
forall a b. (a -> b) -> [a] -> [b]
map (T a y -> a -> T y -> y
forall t y. T t y -> t -> T y -> y
Interpolation.func T a y
ipLeap a
qLeap)
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 = T y -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length T y
tone
(Int
lower,Int
upper) =
Margin -> Margin -> Int -> Int -> (Int, Int)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
upper
then [Char] -> (t, t)
forall a. HasCallStack => [Char] -> a
error [Char]
"min>max"
else (Int -> t
forall a b. (C a, C b) => a -> b
fromIntegral Int
lower, Int -> t
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 = (Int, Int) -> T y -> Array Int y
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int -> Int
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) =
Int -> t -> (t, T t) -> (Int, (t, t))
forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
ToneMod.flattenShapePhase (Prototype t y -> Int
forall t y. Prototype t y -> Int
protoPeriodInt Prototype t y
p) (Prototype t y -> t
forall t y. Prototype t y -> t
protoPeriod Prototype t y
p)
((t, t) -> t -> t
forall a. Ord a => (a, a) -> a -> a
limit (Prototype t y -> (t, t)
forall t y. Prototype t y -> (t, t)
protoShapeLimits Prototype t y
p) t
shape, T t
phase)
in ((t, t)
q,
(Int -> T y) -> [Int] -> [T y]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> y) -> [Int] -> T y
forall a b. (a -> b) -> [a] -> [b]
map (Prototype t y -> Array Int y
forall t y. Prototype t y -> Array Int y
protoArray Prototype t y
p Array Int y -> Int -> y
forall i e. Ix i => Array i e -> i -> e
! ) ([Int] -> T y) -> (Int -> [Int]) -> Int -> T y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Prototype t y -> Int
forall t y. Prototype t y -> Int
protoPeriodInt Prototype t y
p Int -> Int -> Int
forall a. C a => a -> a -> a
+)) ([Int] -> [T y]) -> [Int] -> [T y]
forall a b. (a -> b) -> a -> b
$
Int -> [Int]
forall a. Enum a => a -> [a]
enumFrom (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
- Prototype t y -> Int
forall t y. Prototype t y -> Int
protoIpOffset Prototype t y
p))
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 =
(((t, T t), Cell y) -> ((t, t), Cell y))
-> [((t, T t), Cell y)] -> [((t, t), Cell y)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
forall t y.
C t =>
Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
seekCell Int
periodInt t
period) ([((t, T t), Cell y)] -> [((t, t), Cell y)])
-> [((t, T t), Cell y)] -> [((t, t), Cell y)]
forall a b. (a -> b) -> a -> b
$
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> [((t, T t), Cell y)]
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 =
(\((t, T t)
coords, Cell 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)
coords
in if Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0
then [Char] -> ((t, t), Cell y)
forall a. HasCallStack => [Char] -> a
error [Char]
"ToneModulation.oscillatorCells: k>0"
else ((t, t)
q, Int -> Cell y -> Cell y
forall a. Int -> [a] -> [a]
drop (Int
periodIntInt -> Int -> Int
forall 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 =
[T y] -> [T y]
forall a. [[a]] -> [[a]]
List.transpose ([T y] -> [T y]) -> [T y] -> [T y]
forall a b. (a -> b) -> a -> b
$
(T y -> Bool) -> [T y] -> [T y]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (T y -> Bool) -> T y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([T y] -> [T y]) -> [T y] -> [T y]
forall a b. (a -> b) -> a -> b
$
(T y -> T y) -> T y -> [T y]
forall a. (a -> a) -> a -> [a]
iterate (Int -> T y -> T y
forall a. Int -> [a] -> [a]
drop Int
periodInt) T y
sampledTone
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
(Int
skip:[Int]
skips,[(t, T t)]
coords) =
[(Int, (t, T t))] -> ([Int], [(t, T t)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, (t, T t))] -> ([Int], [(t, T t)]))
-> [(Int, (t, T t))] -> ([Int], [(t, T t)])
forall a b. (a -> b) -> a -> b
$
t -> (t, T t) -> (T t, T t) -> [(Int, (t, T t))]
forall t. C t => t -> (t, T t) -> (T t, T t) -> T (Skip t)
integrateFractional t
period
(Margin -> Margin -> Int -> T y -> (t, T t) -> (t, T t)
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 [(t, T t)] -> [[T y]] -> [((t, T t), [T y])]
forall a b. [a] -> [b] -> [(a, b)]
zip [(t, T t)]
coords ([[T y]] -> [((t, T t), [T y])]) -> [[T y]] -> [((t, T t), [T y])]
forall a b. (a -> b) -> a -> b
$
((Int, [T y]) -> [T y]) -> [(Int, [T y])] -> [[T y]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
n,[T y]
ptr) ->
if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0
then [Char] -> [T y]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [T y]) -> [Char] -> [T y]
forall a b. (a -> b) -> a -> b
$ [Char]
"ToneModulation.oscillatorCells: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"limit of shape parameter is buggy"
else [T y]
ptr) ([(Int, [T y])] -> [[T y]]) -> [(Int, [T y])] -> [[T y]]
forall a b. (a -> b) -> a -> b
$
[(Int, [T y])] -> [(Int, [T y])]
forall a. HasCallStack => [a] -> [a]
tail ([(Int, [T y])] -> [(Int, [T y])])
-> [(Int, [T y])] -> [(Int, [T y])]
forall a b. (a -> b) -> a -> b
$
((Int, [T y]) -> Int -> (Int, [T y]))
-> (Int, [T y]) -> [Int] -> [(Int, [T y])]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(\ (Int
n,[T y]
ptr0) Int
d0 -> Int -> [T y] -> (Int, [T y])
forall a. Int -> T a -> (Int, T a)
dropRem (Int
nInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
d0) [T y]
ptr0)
(Int
0,[T y]
ptrs)
((Int
skip Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
ipOffset) Int -> [Int] -> [Int]
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
nb -> b -> Bool
forall a. Ord a => a -> a -> Bool
>=b
1
then
case [a]
xt of
a
_:[a]
xs -> a -> b -> [a] -> (a, b, [a])
recourse (a -> a
forall a. Enum a => a -> a
succ a
acc) (b
nb -> b -> b
forall a. C a => a -> a -> a
-b
1) [a]
xs
[] -> (a
acc, b
n, [])
else (a
acc,b
n,[a]
xt)
in Int -> i -> [a] -> (Int, i, [a])
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 =
(t, a, [a])
-> ((a, [a]) -> (t, a, [a])) -> Maybe (a, [a]) -> (t, a, [a])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(t
acc,a
n,[a]
xt)
(t -> a -> [a] -> (t, a, [a])
recourse (t -> t
forall a. Enum a => a -> a
succ t
acc) (a
na -> a -> a
forall a. C a => a -> a -> a
-a
1) ([a] -> (t, a, [a]))
-> ((a, [a]) -> [a]) -> (a, [a]) -> (t, a, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [a]) -> [a]
forall a b. (a, b) -> b
snd)
(Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
na -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
1) Maybe () -> Maybe (a, [a]) -> Maybe (a, [a])
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
ListHT.viewL [a]
xt)
in Int -> i -> [a] -> (Int, i, [a])
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 =
i -> T a -> (Int, i, T a)
forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac i
n T a
xs (Int, i, T a) -> (Int, i, T a) -> Bool
forall a. Eq a => a -> a -> Bool
== i -> T a -> (Int, i, T a)
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
na -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
0
then
case [a]
xt of
a
_:[a]
xs -> a -> [a] -> (a, [a])
recourse (a -> a
forall a. Enum a => a -> a
pred a
n) [a]
xs
[] -> (a
n, [])
else (a
n,[a]
xt)
in Int -> [a] -> (Int, [a])
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 =
(a, [a]) -> ((a, [a]) -> (a, [a])) -> Maybe (a, [a]) -> (a, [a])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(a
n,[a]
xt)
(a -> [a] -> (a, [a])
recourse (a -> a
forall a. Enum a => a -> a
pred a
n) ([a] -> (a, [a])) -> ((a, [a]) -> [a]) -> (a, [a]) -> (a, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [a]) -> [a]
forall a b. (a, b) -> b
snd)
(Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
na -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
0) Maybe () -> Maybe (a, [a]) -> Maybe (a, [a])
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
ListHT.viewL [a]
xt)
in Int -> [a] -> (Int, [a])
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 =
Int -> T a -> (Int, T a)
forall a. Int -> T a -> (Int, T a)
dropRem Int
n T a
xs (Int, T a) -> (Int, T a) -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> T a -> (Int, T a)
forall a. Int -> T a -> (Int, T a)
dropRem' Int
n T a
xs
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 =
((Int, (t, T t)) -> Coords t) -> [(Int, (t, T t))] -> [Coords t]
forall a b. (a -> b) -> [a] -> [b]
map (((t, T t) -> (Int, (t, t))) -> (Int, (t, T t)) -> Coords t
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (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)) ([(Int, (t, T t))] -> [Coords t])
-> [(Int, (t, T t))] -> [Coords t]
forall a b. (a -> b) -> a -> b
$
t -> (t, T t) -> (T t, T t) -> [(Int, (t, T t))]
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
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 =
((Int, t) -> t -> (Int, t)) -> (Int, t) -> T t -> [(Int, t)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(\(Int
_,t
s) t
c -> t -> (Int, t)
forall b. C b => t -> (b, t)
forall a b. (C a, C b) => a -> (b, a)
splitFraction (t
st -> t -> t
forall a. C a => a -> a -> a
+t
c))
(t -> (Int, t)
forall b. C b => t -> (b, t)
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) = ((Int, t) -> t) -> [(Int, t)] -> T t
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
n,t
_) -> 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) [(Int, t)]
shapeOffsets
in T t -> T t -> T (T t)
forall a. C a => T a -> T a -> T (T a)
freqsToPhases
(t -> T t -> T t
forall a. C a => a -> T a -> T a
Phase.decrement t
s T t
phase)
((t -> t -> t) -> T t -> T t -> T t
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) T t
freqs T t
ss)
in ((Int, t) -> T t -> Skip t) -> [(Int, t)] -> T (T t) -> [Skip t]
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
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 = (T a -> a -> T a) -> T a -> T a -> [T a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl ((a -> T a -> T a) -> T a -> a -> T a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> T a -> T a
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 :: T (T t)
len = [T t] -> T (T t)
forall a. C a => [a] -> T a
Chunky.fromChunks (T y -> T t -> [T t]
forall a b. [a] -> b -> [b]
ListMatch.replicate T y
sampledTone T t
forall a. C a => a
one)
(T (T t)
minShape, T (T t)
maxShape) =
Margin -> Margin -> Int -> T (T t) -> (T (T t), T (T t))
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 = T t -> t
forall a. T a -> a
NonNeg.toNumber (T t -> t) -> (T (T t) -> T t) -> T (T t) -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (T t) -> T t
forall a. C a => T a -> a
Chunky.toNumber
toChunky :: t -> T (T t)
toChunky = T t -> T (T t)
forall a. C a => a -> T a
Chunky.fromNumber (T t -> T (T t)) -> (t -> T t) -> t -> T (T t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> T t
forall a. (Ord a, C a) => a -> T a
NonNeg.fromNumber
in (T (T t) -> t, [T (T t)] -> T t)
-> (T (T t), [T (T t)]) -> (t, T t)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T (T t) -> t
fromChunky, (T (T t) -> t) -> [T (T t)] -> T t
forall a b. (a -> b) -> [a] -> [b]
map T (T t) -> t
fromChunky) ((T (T t), [T (T t)]) -> (t, T t))
-> ((t, T t) -> (T (T t), [T (T t)])) -> (t, T t) -> (t, T t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(T (T t) -> [T (T t)] -> (T (T t), [T (T t)]))
-> (T (T t), [T (T t)]) -> (T (T t), [T (T t)])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T (T t) -> T (T t) -> [T (T t)] -> (T (T t), [T (T t)])
forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMaxRelativeValuesNonNeg T (T t)
maxShape) ((T (T t), [T (T t)]) -> (T (T t), [T (T t)]))
-> ((t, T t) -> (T (T t), [T (T t)]))
-> (t, T t)
-> (T (T t), [T (T t)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(t -> T (T t), T t -> [T (T t)])
-> (t, T t) -> (T (T t), [T (T t)])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (t -> T (T t)
toChunky, (t -> T (T t)) -> T t -> [T (T t)]
forall a b. (a -> b) -> [a] -> [b]
map t -> T (T t)
toChunky) ((t, T t) -> (T (T t), [T (T t)]))
-> ((t, T t) -> (t, T t)) -> (t, T t) -> (T (T t), [T (T t)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(t -> T t -> (t, T t)) -> (t, T t) -> (t, T t)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (t -> t -> T t -> (t, T t)
forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMinRelativeValues (T (T t) -> t
fromChunky T (T t)
minShape))
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) =
((a, a) -> Bool) -> [(a, a)] -> ([(a, a)], [(a, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
forall a. C a => a
zero)(a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, a) -> a
forall a b. (a, b) -> a
fst) (T a -> T a -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> a -> a) -> a -> T a -> T a
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl a -> a -> a
forall a. C a => a -> a -> a
(+) (a
x0a -> a -> a
forall a. C a => a -> a -> a
-a
xMin) T a
xs) (a
x0a -> T a -> T a
forall 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, [(a, a)] -> a -> T a
forall a b. [a] -> b -> [b]
ListMatch.replicate [(a, a)]
yr a
forall a. C a => a
zero T a -> T a -> T a
forall a. [a] -> [a] -> [a]
++
case [(a, a)]
zs of
[] -> []
((a, a)
z:[(a, a)]
zr) -> (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
z a -> T a -> T a
forall a. a -> [a] -> [a]
: ((a, a) -> a) -> [(a, a)] -> T a
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
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) =
(a -> Bool) -> T a -> (T a, T a)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
forall a. C a => a
zero) ((a -> a -> a) -> a -> T a -> T a
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) (a
xMaxa -> a -> a
forall a. C a => a -> a -> a
-a
x0) T a
xs)
in (a, T a) -> (a, T a)
forall a b. (a, b) -> (a, b)
forcePair ((a, T a) -> (a, T a)) -> (a, T a) -> (a, T a)
forall a b. (a -> b) -> a -> b
$
(a, T a) -> (T a -> a -> (a, T a)) -> T a -> (a, T a)
forall b a. b -> ([a] -> a -> b) -> [a] -> b
ListHT.switchR
(a
xMax, T a -> a -> T a
forall a b. [a] -> b -> [b]
ListMatch.replicate T a
xs a
forall a. C a => a
zero)
(\ T a
yl a
yr -> (a
x0, T a -> T a -> T a
forall b a. [b] -> [a] -> [a]
ListMatch.take T a
yl T a
xs T a -> T a -> T a
forall a. [a] -> [a] -> [a]
++ T a -> T a -> T a
forall b a. [b] -> [a] -> [a]
ListMatch.take T a
zs (a
yr a -> T a -> T a
forall a. a -> [a] -> [a]
: a -> T a
forall a. a -> [a]
repeat a
forall a. C a => a
zero)))
T a
ys
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) =
((Bool, a) -> Bool) -> [(Bool, a)] -> ([(Bool, a)], [(Bool, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool, a) -> Bool
forall a b. (a, b) -> a
fst (((Bool, a) -> a -> (Bool, a)) -> (Bool, a) -> T a -> [(Bool, a)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\(Bool
_,a
acc) a
d -> a -> a -> (Bool, a)
forall a. (C a, Ord a) => a -> a -> (Bool, a)
safeSub a
acc a
d) (a -> a -> (Bool, a)
forall a. (C a, Ord a) => a -> a -> (Bool, a)
safeSub a
xMax a
x0) T a
xs)
in (a, T a) -> (a, T a)
forall a b. (a, b) -> (a, b)
forcePair ((a, T a) -> (a, T a)) -> (a, T a) -> (a, T a)
forall a b. (a -> b) -> a -> b
$
(a, T a)
-> ([(Bool, a)] -> (Bool, a) -> (a, T a))
-> [(Bool, a)]
-> (a, T a)
forall b a. b -> ([a] -> a -> b) -> [a] -> b
ListHT.switchR
(a
xMax, T a -> a -> T a
forall a b. [a] -> b -> [b]
ListMatch.replicate T a
xs a
forall a. C a => a
zero)
(\ [(Bool, a)]
yl ~(Bool
_,a
yr) -> (a
x0, [(Bool, a)] -> T a -> T a
forall b a. [b] -> [a] -> [a]
ListMatch.take [(Bool, a)]
yl T a
xs T a -> T a -> T a
forall a. [a] -> [a] -> [a]
++ [(Bool, a)] -> T a -> T a
forall b a. [b] -> [a] -> [a]
ListMatch.take [(Bool, a)]
zs (a
yr a -> T a -> T a
forall a. a -> [a] -> [a]
: a -> T a
forall a. a -> [a]
repeat a
forall a. C a => a
zero)))
[(Bool, a)]
ys
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
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
b, a
aa -> a -> a
forall a. C a => a -> a -> a
-a
b)