-- | Implementaion 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 = forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 {- hsc3-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) = 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 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (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 = forall n. Num n => [[n]] -> [n]
sum_l forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall n. (Fractional n, Ord n) => [n] -> [n]
nrm_u forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Num a => [a] -> [a]
Buffer.to_wavetable forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> b) -> [a] -> [b]
map (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 = forall n. Num n => [[n]] -> [n]
sum_l forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall n. (Fractional n, Ord n) => [n] -> [n]
nrm_u forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (Enum n, Floating n) => Int -> [n] -> [n]
sine1 Int
n

-- * sine3

-- | Sine wave table at specified frequency, amplitude and phase.
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 = (forall n. Floating n => n
Math.two_pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
- n
0)) forall a. Num a => a -> a -> a
* n
pfreq -- the table should not arrive back at zero
    in forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
(*) n
ampl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
sin) (forall a. Int -> [a] -> [a]
take Int
n [n
phase, n
phase 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 = forall a b. (a -> b) -> [a] -> [b]
map (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 = forall n. Num n => [[n]] -> [n]
sum_l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (Enum n, Floating n) => Int -> [(n, n, n)] -> [[n]]
sine3_l Int
n

-- * cheby

{- | Generate Chebyshev waveshaping table, see b_gen_cheby.

> Sound.Sc3.Plot.plot_p1_ln [gen_cheby 256 [1, 0, 1, 1, 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 forall a. Ord a => a -> a -> Bool
> a
1 then a
0 else if a
x forall a. Ord a => a -> a -> Bool
< -a
1 then forall n. Floating n => n
pi else forall a. Floating a => a -> a
acos a
x
        c :: a -> a -> a
c a
k a
x = forall a. Floating a => a -> a
cos (a
k forall a. Num a => a -> a -> a
* forall {a}. (Ord a, Floating a) => a -> a
acos' a
x)
        ix :: [n]
ix = [-n
1, -n
1 forall a. Num a => a -> a -> a
+ (n
2 forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n forall a. Num a => a -> a -> a
- n
1)) .. n
1] -- increment?
        mix :: [[n]] -> [n]
mix = forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose
        c_normalize :: [b] -> [b]
c_normalize [b]
x = let m :: b
m = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => a -> a
abs [b]
x) in forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
* forall a. Fractional a => a -> a
recip b
m) [b]
x
    in forall n. (Fractional n, Ord n) => [n] -> [n]
c_normalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[n]] -> [n]
mix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\n
k n
a -> forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
* n
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = forall a. Num a => [a] -> [a]
Buffer.to_wavetable_nowrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (Enum n, Floating n, Ord n) => Int -> [n] -> [n]
cheby Int
n