{- | Implementation of server b_gen routines.

The naming scheme is: _p generates one partial, _l generates a list
of partials, _nrm is the unit normalised form.
-}
module Sound.Sc3.Common.Buffer.Gen where

import Data.List {- base -}

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

-- | Sum (mix) multiple tables into one.
sum_l :: Num n => [[n]] -> [n]
sum_l :: forall n. Num n => [[n]] -> [n]
sum_l = ([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]) -> ([[n]] -> [[n]]) -> [[n]] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[n]] -> [[n]]
forall a. [[a]] -> [[a]]
transpose

-- | Unit normalisation.
nrm_u :: (Fractional n, Ord n) => [n] -> [n]
nrm_u :: forall n. (Fractional n, Ord n) => [n] -> [n]
nrm_u = n -> n -> [n] -> [n]
forall n. (Fractional n, Ord n) => n -> n -> [n] -> [n]
Buffer.normalize (-n
1) n
1

-- * sine1

{- | 'sine3_p' with zero phase.

> import Sound.Sc3.Plot
> plot_p1_ln [sine1_p 512 (1, 1)]
-}
sine1_p :: (Enum n, Floating n) => Int -> (n, n) -> [n]
sine1_p :: forall n. (Enum n, Floating n) => Int -> (n, n) -> [n]
sine1_p Int
n (n
pfreq, n
ampl) = Int -> (n, n, n) -> [n]
forall n. (Enum n, Floating n) => Int -> (n, n, n) -> [n]
sine3_p Int
n (n
pfreq, n
ampl, n
0)

-- | Series of sine wave harmonics using specified amplitudes.
sine1_l :: (Enum n, Floating n) => Int -> [n] -> [[n]]
sine1_l :: forall n. (Enum n, Floating n) => Int -> [n] -> [[n]]
sine1_l Int
n = (n -> n -> [n]) -> [n] -> [n] -> [[n]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((n, n) -> [n]) -> n -> n -> [n]
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Int -> (n, n) -> [n]
forall n. (Enum n, Floating n) => Int -> (n, n) -> [n]
sine1_p Int
n)) [n
1 ..]

{- | 'sum_l' of 'sine1_l'.

> plot_p1_ln [sine1 256 [1, 0.95 .. 0.5]]
-}
sine1 :: (Enum n, Floating n) => Int -> [n] -> [n]
sine1 :: forall n. (Enum n, Floating n) => Int -> [n] -> [n]
sine1 Int
n = [[n]] -> [n]
forall n. Num n => [[n]] -> [n]
sum_l ([[n]] -> [n]) -> ([n] -> [[n]]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [n] -> [[n]]
forall n. (Enum n, Floating n) => Int -> [n] -> [[n]]
sine1_l Int
n

{- | 'nrm_u' of 'sine1_l'.

> Sound.Sc3.Plot.plot_p1_ln [sine1_nrm 256 [1, 0.95 .. 0.5]]
> Sound.Sc3.Plot.plot_p1_ln [sine1_nrm 256 [1, 1/2, 1/3, 1/4, 1/5]]
-}
sine1_nrm :: (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
sine1_nrm :: forall n. (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
sine1_nrm Int
n = [n] -> [n]
forall n. (Fractional n, Ord n) => [n] -> [n]
nrm_u ([n] -> [n]) -> ([n] -> [n]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [n] -> [n]
forall n. (Enum n, Floating n) => Int -> [n] -> [n]
sine1 Int
n

-- | Variant that generates a wavetable (without guard point) suitable for the Shaper Ugen.
sine1Tbl :: (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
sine1Tbl :: forall n. (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
sine1Tbl Int
n = [n] -> [n]
forall a. Num a => [a] -> [a]
Buffer.to_wavetable ([n] -> [n]) -> ([n] -> [n]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [n] -> [n]
forall n. (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
sine1_nrm Int
n

-- * sine2

-- | Series of /n/ sine wave partials using specified frequencies and amplitudes.
sine2_l :: (Enum n, Floating n) => Int -> [(n, n)] -> [[n]]
sine2_l :: forall n. (Enum n, Floating n) => Int -> [(n, n)] -> [[n]]
sine2_l Int
n = ((n, n) -> [n]) -> [(n, n)] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (n, n) -> [n]
forall n. (Enum n, Floating n) => Int -> (n, n) -> [n]
sine1_p Int
n)

{- | 'sum_l' of 'sine2_l'.

> Sound.Sc3.Plot.plot_p1_ln [sine2 256 (zip [1, 2..] [1, 0.95 .. 0.5])]
> Sound.Sc3.Plot.plot_p1_ln [sine2 256 (zip [1, 1.5 ..] [1, 0.95 .. 0.5])]
-}
sine2 :: (Enum n, Floating n) => Int -> [(n, n)] -> [n]
sine2 :: forall n. (Enum n, Floating n) => Int -> [(n, n)] -> [n]
sine2 Int
n = [[n]] -> [n]
forall n. Num n => [[n]] -> [n]
sum_l ([[n]] -> [n]) -> ([(n, n)] -> [[n]]) -> [(n, n)] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(n, n)] -> [[n]]
forall n. (Enum n, Floating n) => Int -> [(n, n)] -> [[n]]
sine2_l Int
n

-- | 'nrm_u' of 'sine2_l'.
sine2_nrm :: (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
sine2_nrm :: forall n. (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
sine2_nrm Int
n = [n] -> [n]
forall n. (Fractional n, Ord n) => [n] -> [n]
nrm_u ([n] -> [n]) -> ([n] -> [n]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [n] -> [n]
forall n. (Enum n, Floating n) => Int -> [n] -> [n]
sine1 Int
n

-- * sine3

{- | Sine wave table at specified frequency, amplitude and phase.
The table does not arrive back at the starting point.

>>> map (round . (* 100)) (sine3_p 8 (1, 1, 0))
[0,71,100,71,0,-71,-100,-71]
-}
sine3_p :: (Enum n, Floating n) => Int -> (n, n, n) -> [n]
sine3_p :: forall n. (Enum n, Floating n) => Int -> (n, n, n) -> [n]
sine3_p Int
n (n
pfreq, n
ampl, n
phase) =
  let incr :: n
incr = (n
forall n. Floating n => n
Math.two_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 n -> n -> n
forall a. Num a => a -> a -> a
- n
0)) n -> n -> n
forall a. Num a => a -> a -> a
* n
pfreq
  in (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (n -> n -> n
forall a. Num a => a -> a -> a
(*) n
ampl (n -> n) -> (n -> n) -> n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> n
forall a. Floating a => a -> a
sin) (Int -> [n] -> [n]
forall a. Int -> [a] -> [a]
take Int
n [n
phase, n
phase n -> n -> n
forall a. Num a => a -> a -> a
+ n
incr ..])

-- | 'map' of 'sine3_p'.
sine3_l :: (Enum n, Floating n) => Int -> [(n, n, n)] -> [[n]]
sine3_l :: forall n. (Enum n, Floating n) => Int -> [(n, n, n)] -> [[n]]
sine3_l Int
n = ((n, n, n) -> [n]) -> [(n, n, n)] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (n, n, n) -> [n]
forall n. (Enum n, Floating n) => Int -> (n, n, n) -> [n]
sine3_p Int
n)

{- | 'sum_l' of 'sine3_l'.

> plot_p1_ln [sine3 256 (zip3 [1,1.5 ..] [1,0.95 .. 0.5] [0,pi/7..])]
-}
sine3 :: (Enum n, Floating n) => Int -> [(n, n, n)] -> [n]
sine3 :: forall n. (Enum n, Floating n) => Int -> [(n, n, n)] -> [n]
sine3 Int
n = [[n]] -> [n]
forall n. Num n => [[n]] -> [n]
sum_l ([[n]] -> [n]) -> ([(n, n, n)] -> [[n]]) -> [(n, n, n)] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(n, n, n)] -> [[n]]
forall n. (Enum n, Floating n) => Int -> [(n, n, n)] -> [[n]]
sine3_l Int
n

-- * cheby

{- | Generate Chebyshev waveshaping table, see b_gen_cheby.
Cf. <https://www.csounds.com/manual/html/GEN13.html>

> import Sound.Sc3.Plot
> let p x = plot_p1_ln [gen_cheby 512 x]

> p [1, 0, 1, 1, 0, 1]
> p [100, -50, -33, 25, 20, -16.7, -14.2, 12.5, 11.1, -10, -9.09, 8.333, 7.69, -7.14, -6.67, 6.25, 5.88, -5.55, -5.26, 5]
> p [100, 0, -33, 0, 20, 0, -14.2, 0, 11.1, 0, -9.09, 0, 7.69, 0, -6.67, 0, 5.88, 0, -5.26]
> p [100, 0, -11.11, 0, 4, 0, -2.04, 0, 1.23, 0, -0.826, 0, 0.59, 0, -0.444, 0, 0.346, 0, -0.277]
> p [1, -0.8, 0, 0.6, 0, 0, 0, 0.4, 0, 0, 0, 0, 0.1, -0.2, -0.3, 0.5]
> p [0, 0, -0.1, 0, 0.3, 0, -0.5, 0, 0.7, 0, -0.9, 0, 1, 0, -1, 0]
> p [0, 0, 0, 0, 0, 0, -1, 0, 1, 0, 0, -0.1, 0, 0.1, 0, -0.2, 0.3, 0, -0.7, 0, 0.2, 0, -0.1]
> p [5, 0, 3, 0, 1]
-}
gen_cheby :: (Enum n, Floating n, Ord n, Integral i) => i -> [n] -> [n]
gen_cheby :: forall n i.
(Enum n, Floating n, Ord n, Integral i) =>
i -> [n] -> [n]
gen_cheby i
n =
  let acos' :: a -> a
acos' a
x = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1 then a
0 else if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< -a
1 then a
forall n. Floating n => n
pi else a -> a
forall a. Floating a => a -> a
acos a
x
      c :: a -> a -> a
c a
k a
x = a -> a
forall a. Floating a => a -> a
cos (a
k a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall {a}. (Ord a, Floating a) => a -> a
acos' a
x)
      ix :: [n]
ix = [-n
1, -n
1 n -> n -> n
forall a. Num a => a -> a -> a
+ (n
2 n -> n -> n
forall a. Fractional a => a -> a -> a
/ (i -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n n -> n -> n
forall a. Num a => a -> a -> a
- n
1)) .. n
1] -- increment?
      mix :: [[n]] -> [n]
mix = ([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]) -> ([[n]] -> [[n]]) -> [[n]] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[n]] -> [[n]]
forall a. [[a]] -> [[a]]
transpose
      c_normalize :: [b] -> [b]
c_normalize [b]
x = let m :: b
m = [b] -> b
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map b -> b
forall a. Num a => a -> a
abs [b]
x) in (b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b -> b -> b
forall a. Num a => a -> a -> a
* b -> b
forall a. Fractional a => a -> a
recip b
m) [b]
x
  in [n] -> [n]
forall n. (Fractional n, Ord n) => [n] -> [n]
c_normalize ([n] -> [n]) -> ([n] -> [n]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[n]] -> [n]
mix ([[n]] -> [n]) -> ([n] -> [[n]]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> [n]) -> [n] -> [n] -> [[n]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\n
k n
a -> (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map ((n -> n -> n
forall a. Num a => a -> a -> a
* n
a) (n -> n) -> (n -> n) -> n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> n -> n
forall {a}. (Floating a, Ord a) => a -> a -> a
c n
k) [n]
ix) [n
1 ..]

-- | Type specialised 'gen_cheby'.
cheby :: (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
cheby :: forall n. (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
cheby = Int -> [n] -> [n]
forall n i.
(Enum n, Floating n, Ord n, Integral i) =>
i -> [n] -> [n]
gen_cheby

-- | Variant that generates a wavetable (without guard point) suitable for the Shaper Ugen.
chebyShaperTbl :: (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
chebyShaperTbl :: forall n. (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
chebyShaperTbl Int
n = [n] -> [n]
forall a. Num a => [a] -> [a]
Buffer.to_wavetable_nowrap ([n] -> [n]) -> ([n] -> [n]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [n] -> [n]
forall n. (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
cheby Int
n