-- | Signals & wavetables
module Sound.Sc3.Common.Buffer where

import Data.List {- base -}

import qualified Sound.Sc3.Common.Math as S {- hsc3 -}

{- | /z/ ranges from 0 (for /i/) to 1 (for /j/).

> 1.5.blend(2.0,0.50)
1.75
> 1.5.blend(2.0,0.75)
1.875

>>> blend 0.50 1.5 2
1.75

>>> blend 0.75 1.5 2
1.875
-}
blend :: Num a => a -> a -> a -> a
blend :: forall a. Num a => a -> a -> a -> a
blend a
z a
i a
j = a
i a -> a -> a
forall a. Num a => a -> a -> a
+ (a
z a -> a -> a
forall a. Num a => a -> a -> a
* (a
j a -> a -> a
forall a. Num a => a -> a -> a
- a
i))

{- | Variant of '(!!)' but values for index greater than the size of the collection will be clipped to the last index.

>>> map (\x -> clipAt x "abc") [-1,0,1,2,3]
"aabcc"
-}
clipAt :: Int -> [a] -> a
clipAt :: forall a. Int -> [a] -> a
clipAt Int
ix [a]
c = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
c else if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then [a]
c [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
0 else [a]
c [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
ix

-- | 'blendAt' with @clip@ function as argument.
blendAtBy :: (Integral i, RealFrac n) => (i -> t -> n) -> n -> t -> n
blendAtBy :: forall i n t.
(Integral i, RealFrac n) =>
(i -> t -> n) -> n -> t -> n
blendAtBy i -> t -> n
f n
ix t
c =
  let m :: i
m = n -> i
forall b. Integral b => n -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor n
ix
      m' :: n
m' = i -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
m
  in n -> n -> n -> n
forall a. Num a => a -> a -> a -> a
blend (n -> n -> n
forall a. Num a => a -> a -> a
S.absdif n
ix n
m') (i -> t -> n
f i
m t
c) (i -> t -> n
f (i
m i -> i -> i
forall a. Num a => a -> a -> a
+ i
1) t
c)

{- | @SequenceableCollection.blendAt@ returns a linearly interpolated value between the two closest indices.
Inverse operation is 'indexInBetween'.

> [2,5,6].blendAt(0.4)
3.2

>>> blendAt 0 [2,5,6]
2.0
>>> blendAt 0.4 [2,5,6]
3.2
-}
blendAt :: RealFrac a => a -> [a] -> a
blendAt :: forall a. RealFrac a => a -> [a] -> a
blendAt = (Int -> [a] -> a) -> a -> [a] -> a
forall i n t.
(Integral i, RealFrac n) =>
(i -> t -> n) -> n -> t -> n
blendAtBy Int -> [a] -> a
forall a. Int -> [a] -> a
clipAt

-- | Resampling function, /n/ is destination length, /r/ is source length, /f/ is the indexing function, /c/ is the collection.
resamp1_gen :: (Integral i, RealFrac n) => i -> i -> (i -> t -> n) -> t -> i -> n
resamp1_gen :: forall i n t.
(Integral i, RealFrac n) =>
i -> i -> (i -> t -> n) -> t -> i -> n
resamp1_gen i
n i
r i -> t -> n
f t
c =
  let n' :: n
n' = i -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n
      fwd :: n
fwd = (i -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
r n -> n -> n
forall a. Num a => a -> a -> a
- n
1) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
n' n -> n -> n
forall a. Num a => a -> a -> a
- n
1)
      gen :: a -> n
gen a
i = (i -> t -> n) -> n -> t -> n
forall i n t.
(Integral i, RealFrac n) =>
(i -> t -> n) -> n -> t -> n
blendAtBy i -> t -> n
f (a -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i n -> n -> n
forall a. Num a => a -> a -> a
* n
fwd) t
c
  in i -> n
forall {a}. Integral a => a -> n
gen

{- | @SequenceableCollection.resamp1@ returns a new collection of the desired length, with values resampled evenly-spaced from the receiver with linear interpolation.

> [1].resamp1(3) == [1,1,1]
> [1,2,3,4].resamp1(12)
> [1,2,3,4].resamp1(3) == [1,2.5,4]

>>> resamp1 3 [1]
[1.0,1.0,1.0]

>>> resamp1 7 [1,2,3,4]
[1.0,1.5,2.0,2.5,3.0,3.5,4.0]

>>> resamp1 3 [1,2,3,4]
[1.0,2.5,4.0]
-}
resamp1 :: RealFrac n => Int -> [n] -> [n]
resamp1 :: forall n. RealFrac n => Int -> [n] -> [n]
resamp1 Int
n [n]
c =
  let gen :: Int -> n
gen = Int -> Int -> (Int -> [n] -> n) -> [n] -> Int -> n
forall i n t.
(Integral i, RealFrac n) =>
i -> i -> (i -> t -> n) -> t -> i -> n
resamp1_gen Int
n ([n] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [n]
c) Int -> [n] -> n
forall a. Int -> [a] -> a
clipAt [n]
c
  in (Int -> n) -> [Int] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map Int -> n
gen [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

{- | @ArrayedCollection.normalizeSum@ ensures sum of elements is one.

> [1,2,3].normalizeSum == [1/6,1/3,0.5]

>>> normalizeSum [1,2,3] == [1/6,2/6,3/6]
True
-}
normalizeSum :: (Fractional a) => [a] -> [a]
normalizeSum :: forall a. Fractional a => [a] -> [a]
normalizeSum [a]
l = let n :: a
n = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
l in (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
n) [a]
l

-- | Variant that specifies range of input sequence separately.
normalise_rng :: Fractional n => (n, n) -> (n, n) -> [n] -> [n]
normalise_rng :: forall n. Fractional n => (n, n) -> (n, n) -> [n] -> [n]
normalise_rng (n
il, n
ir) (n
l, n
r) = (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (\n
e -> n -> n -> n -> n -> n -> n
forall a. Fractional a => a -> a -> a -> a -> a -> a
S.sc3_linlin n
e n
il n
ir n
l n
r)

{- | @ArrayedCollection.normalize@ returns a new Array with the receiver items normalized between min and max.

> [1,2,3].normalize == [0,0.5,1]
> [1,2,3].normalize(-20,10) == [-20,-5,10]

>>> normalize 0 1 [1,2,3]
[0.0,0.5,1.0]

>>> normalize (-20) 10 [1,2,3]
[-20.0,-5.0,10.0]
-}
normalize :: (Fractional n, Ord n) => n -> n -> [n] -> [n]
normalize :: forall n. (Fractional n, Ord n) => n -> n -> [n] -> [n]
normalize n
l n
r [n]
c = (n, n) -> (n, n) -> [n] -> [n]
forall n. Fractional n => (n, n) -> (n, n) -> [n] -> [n]
normalise_rng ([n] -> n
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [n]
c, [n] -> n
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [n]
c) (n
l, n
r) [n]
c

{- | List of 2-tuples of elements at distance (stride) /n/.

>>> t2_window 3 [1..9]
[(1,2),(4,5),(7,8)]
-}
t2_window :: Integral i => i -> [t] -> [(t, t)]
t2_window :: forall i t. Integral i => i -> [t] -> [(t, t)]
t2_window i
n [t]
x =
  case [t]
x of
    t
i : t
j : [t]
_ -> (t
i, t
j) (t, t) -> [(t, t)] -> [(t, t)]
forall a. a -> [a] -> [a]
: i -> [t] -> [(t, t)]
forall i t. Integral i => i -> [t] -> [(t, t)]
t2_window i
n (i -> [t] -> [t]
forall i a. Integral i => i -> [a] -> [a]
genericDrop i
n [t]
x)
    [t]
_ -> []

{- | List of 2-tuples of adjacent elements.

>>> t2_adjacent [1..6]
[(1,2),(3,4),(5,6)]

>>> t2_adjacent [1..5]
[(1,2),(3,4)]
-}
t2_adjacent :: [t] -> [(t, t)]
t2_adjacent :: forall t. [t] -> [(t, t)]
t2_adjacent = Int -> [t] -> [(t, t)]
forall i t. Integral i => i -> [t] -> [(t, t)]
t2_window (Int
2 :: Int)

{- | List of 2-tuples of overlapping elements.

>>> t2_overlap [1..4]
[(1,2),(2,3),(3,4)]
-}
t2_overlap :: [b] -> [(b, b)]
t2_overlap :: forall t. [t] -> [(t, t)]
t2_overlap [b]
x =
  case [b] -> Maybe (b, [b])
forall a. [a] -> Maybe (a, [a])
uncons [b]
x of
    Maybe (b, [b])
Nothing -> [Char] -> [(b, b)]
forall a. HasCallStack => [Char] -> a
error [Char]
"t2_overlap"
    Just (b
_, [b]
t) -> [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [b]
x [b]
t

{- | Concat of 2-tuples.

>>> t2_concat (t2_adjacent [1..6])
[1,2,3,4,5,6]

>>> t2_concat (t2_overlap [1..4])
[1,2,2,3,3,4]
-}
t2_concat :: [(a, a)] -> [a]
t2_concat :: forall a. [(a, a)] -> [a]
t2_concat [(a, a)]
x =
  case [(a, a)]
x of
    [] -> []
    (a
i, a
j) : [(a, a)]
x' -> a
i a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
j a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [(a, a)] -> [a]
forall a. [(a, a)] -> [a]
t2_concat [(a, a)]
x'

{- | A Signal is half the size of a Wavetable, each element is the sum
of two adjacent elements of the Wavetable.

>>> from_wavetable [-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]
[0.0,0.5,1.0,0.5]

>>> let s = [0,0.5,1,0.5]
>>> from_wavetable (to_wavetable s) == s
True
-}
from_wavetable :: Num n => [n] -> [n]
from_wavetable :: forall n. Num n => [n] -> [n]
from_wavetable = ((n, n) -> n) -> [(n, n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map ((n -> n -> n) -> (n, n) -> n
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry n -> n -> n
forall a. Num a => a -> a -> a
(+)) ([(n, n)] -> [n]) -> ([n] -> [(n, n)]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [n] -> [(n, n)]
forall t. [t] -> [(t, t)]
t2_adjacent

{- | A Wavetable has n * 2 elements, where n is the number of elements of the Signal.
     Each signal element e0 expands to the two elements (2 * e0 - e1, e1 - e0)
     where e1 is the next element, or zero at the final element.
     Properly wavetables are only of power of two element signals.

> Signal[0,0.5,1,0.5].asWavetable == Wavetable[-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5]

>>> to_wavetable [0,0.5,1,0.5]
[-0.5,0.5,0.0,0.5,1.5,-0.5,1.0,-0.5]
-}
to_wavetable :: Num a => [a] -> [a]
to_wavetable :: forall n. Num n => [n] -> [n]
to_wavetable = [a] -> [a]
forall n. Num n => [n] -> [n]
to_wavetable_nowrap ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
0])

{- | Shaper requires wavetables without wrap.

>>> to_wavetable_nowrap [0,0.5,1,0.5]
[-0.5,0.5,0.0,0.5,1.5,-0.5]
-}
to_wavetable_nowrap :: Num a => [a] -> [a]
to_wavetable_nowrap :: forall n. Num n => [n] -> [n]
to_wavetable_nowrap =
  let f :: (b, b) -> (b, b)
f (b
e0, b
e1) = (b
2 b -> b -> b
forall a. Num a => a -> a -> a
* b
e0 b -> b -> b
forall a. Num a => a -> a -> a
- b
e1, b
e1 b -> b -> b
forall a. Num a => a -> a -> a
- b
e0)
  in [(a, a)] -> [a]
forall a. [(a, a)] -> [a]
t2_concat ([(a, a)] -> [a]) -> ([a] -> [(a, a)]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> (a, a)) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> (a, a)
forall {b}. Num b => (b, b) -> (b, b)
f ([(a, a)] -> [(a, a)]) -> ([a] -> [(a, a)]) -> [a] -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [(a, a)]
forall t. [t] -> [(t, t)]
t2_overlap

{- | Variant of 'sineFill' that gives each component table.

>>> let t = sineGen 1024 (map recip [1, 2, 3, 5, 8, 13, 21, 34, 55]) (replicate 9 0)
>>> map length t == replicate 9 1024
True

> Sound.Sc3.Plot.plot_p1_ln t
-}
sineGen :: (Floating n, Enum n) => Int -> [n] -> [n] -> [[n]]
sineGen :: forall n. (Floating n, Enum n) => Int -> [n] -> [n] -> [[n]]
sineGen Int
n =
  let incr :: n
incr = (n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n
forall a. Floating a => a
pi) n -> n -> n
forall a. Fractional a => a -> a -> a
/ Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
      ph :: n -> [n]
ph n
partial = Int -> [n] -> [n]
forall a. Int -> [a] -> [a]
take Int
n [n
0, n
incr n -> n -> n
forall a. Num a => a -> a -> a
* n
partial ..]
      f :: n -> n -> n -> [n]
f n
h n
amp n
iph = (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (\n
z -> n -> n
forall a. Floating a => a -> a
sin (n
z n -> n -> n
forall a. Num a => a -> a -> a
+ n
iph) n -> n -> n
forall a. Num a => a -> a -> a
* n
amp) (n -> [n]
ph n
h)
  in (n -> n -> n -> [n]) -> [n] -> [n] -> [n] -> [[n]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 n -> n -> n -> [n]
f [n
1 ..]

{- | @Signal.*sineFill@ is a table generator.
     Frequencies are partials, amplitudes and initial phases are as given.
     Result is normalised.

> let a = [[21,5,34,3,2,13,1,8,55],[13,8,55,34,5,21,3,1,2],[55,34,1,3,2,13,5,8,21]]
> let t = map (\amp -> sineFill 1024 (map recip amp) (replicate 9 0)) a
> Sound.Sc3.Plot.plot_p1_ln t
-}
sineFill :: (Ord n, Floating n, Enum n) => Int -> [n] -> [n] -> [n]
sineFill :: forall n. (Ord n, Floating n, Enum n) => Int -> [n] -> [n] -> [n]
sineFill Int
n [n]
amp [n]
iph =
  let t :: [[n]]
t = Int -> [n] -> [n] -> [[n]]
forall n. (Floating n, Enum n) => Int -> [n] -> [n] -> [[n]]
sineGen Int
n [n]
amp [n]
iph
  in n -> n -> [n] -> [n]
forall n. (Fractional n, Ord n) => n -> n -> [n] -> [n]
normalize (-n
1) n
1 (([n] -> n) -> [[n]] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map [n] -> n
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([[n]] -> [[n]]
forall a. [[a]] -> [[a]]
transpose [[n]]
t))