-- | 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 :: [[n]] -> [n]
sum_l = ([n] -> n) -> [[n]] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map [n] -> n
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 :: [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 {- hsc3-plot -}
-- > plot_p1_ln [sine1_p 512 (1,1)]
sine1_p :: (Enum n,Floating n) => Int -> (n,n) -> [n]
sine1_p :: 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 :: Int -> [n] -> [[n]]
sine1_l Int
n [n]
ampl = ((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) ([n] -> [n] -> [(n, n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [n
1..] [n]
ampl)

-- | 'sum_l' of 'sine1_l'.
--
-- > plot_p1_ln [sine1 256 [1,0.95 .. 0.5]]
sine1 :: (Enum n,Floating n) => Int -> [n] -> [n]
sine1 :: 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'.
--
-- > plot_p1_ln [sine1_nrm 256 [1,0.95 .. 0.5]]
sine1_nrm :: (Enum n,Floating n,Ord n) => Int -> [n] -> [n]
sine1_nrm :: 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

-- * sine2

-- | Series of /n/ sine wave partials using specified frequencies and amplitudes.
sine2_l :: (Enum n,Floating n) => Int -> [(n,n)] -> [[n]]
sine2_l :: 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'.
--
-- > plot_p1_ln [sine2 256 (zip [1,2..] [1,0.95 .. 0.5])]
-- > plot_p1_ln [sine2 256 (zip [1,1.5 ..] [1,0.95 .. 0.5])]
sine2 :: (Enum n,Floating n) => Int -> [(n,n)] -> [n]
sine2 :: 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 :: 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.
sine3_p :: (Enum n,Floating n) => Int -> (n,n,n) -> [n]
sine3_p :: 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
1)) 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 :: 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 :: 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.

> 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 :: i -> [n] -> [n]
gen_cheby i
n =
    let acos' :: p -> p
acos' p
x = if p
x p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
1 then p
0 else if p
x p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< -p
1 then p
forall n. Floating n => n
pi else p -> p
forall a. Floating a => a -> a
acos p
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 p. (Ord p, Floating p) => p -> p
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]
        mix :: [[n]] -> [n]
mix = ([n] -> n) -> [[n]] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map [n] -> n
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 (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 :: Int -> [n] -> [n]
cheby = Int -> [n] -> [n]
forall n i.
(Enum n, Floating n, Ord n, Integral i) =>
i -> [n] -> [n]
gen_cheby