-- | Windowing functions.
module Sound.Sc3.Common.Math.Window where

-- * Type and conversion

-- | A function from a (0, 1) normalised input to an output.
type Window x = x -> x

-- | A discrete rendering of a 'Window'.
type Table x = [x]

{- | Format for table.
     Closed indicates the end point should be equal to the start point.
     Open indicates it should be one place short.
     Guarded indicates that an extra place should be added that closes the table, ie. the table has one place more than requested.
     When using a table with an oscillator we want an Open or Guarded table, since the point following the end point is the start point.
-}
data TableFormat = TableClosed | TableOpen | TableGuarded deriving (TableFormat -> TableFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableFormat -> TableFormat -> Bool
$c/= :: TableFormat -> TableFormat -> Bool
== :: TableFormat -> TableFormat -> Bool
$c== :: TableFormat -> TableFormat -> Bool
Eq, Int -> TableFormat -> ShowS
[TableFormat] -> ShowS
TableFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableFormat] -> ShowS
$cshowList :: [TableFormat] -> ShowS
show :: TableFormat -> String
$cshow :: TableFormat -> String
showsPrec :: Int -> TableFormat -> ShowS
$cshowsPrec :: Int -> TableFormat -> ShowS
Show)

{- | Generate an /n/ element table from a (0, 1) normalised window function /f/.
     The cycle argument decides if the end point should be equal to the start point, or one place short.
     When using a table with an oscillator we want the latter, since the point following the end point is the start point.
-}
window_table :: (Integral n,Fractional a,Enum a) => TableFormat -> n -> Window a -> Table a
window_table :: forall n a.
(Integral n, Fractional a, Enum a) =>
TableFormat -> n -> Window a -> Table a
window_table TableFormat
fmt n
n Window a
f =
  let k :: a
k = a
1 forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n forall a. Num a => a -> a -> a
- (if TableFormat
fmt forall a. Eq a => a -> a -> Bool
== TableFormat
TableClosed then a
1 else a
0))
  in forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral (if TableFormat
fmt forall a. Eq a => a -> a -> Bool
== TableFormat
TableGuarded then n
n forall a. Num a => a -> a -> a
+ n
1 else n
n)) (forall a b. (a -> b) -> [a] -> [b]
map Window a
f [a
0, a
k ..])

-- | window_table of TableClosed.
window_table_closed :: (Integral n,Fractional a,Enum a) => n -> Window a -> Table a
window_table_closed :: forall n a.
(Integral n, Fractional a, Enum a) =>
n -> Window a -> Table a
window_table_closed = forall n a.
(Integral n, Fractional a, Enum a) =>
TableFormat -> n -> Window a -> Table a
window_table TableFormat
TableClosed

-- * Math

-- | /n/ ^ 2.
square :: Num a => a -> a
square :: forall a. Num a => a -> a
square a
x = a
x forall a. Num a => a -> a -> a
* a
x

-- * Window functions

-- | Gaussian window, θ <= 0.5.
gaussian :: Floating a => a -> Window a
gaussian :: forall a. Floating a => a -> Window a
gaussian a
theta a
i = forall a. Floating a => a -> a
exp (- (a
0.5 forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
square ((a
i forall a. Num a => a -> a -> a
- a
0.5) forall a. Fractional a => a -> a -> a
/ (a
theta forall a. Num a => a -> a -> a
* a
0.5))))

-- | Hann raised cosine window.
hann :: Floating a => Window a
hann :: forall a. Floating a => a -> a
hann a
i = a
0.5 forall a. Num a => a -> a -> a
* (a
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
cos (a
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* a
i))

-- | Hamming raised cosine window.
hamming :: Floating a => Window a
hamming :: forall a. Floating a => a -> a
hamming a
i = a
0.54 forall a. Num a => a -> a -> a
- a
0.46 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (a
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* a
i)

-- | Unit ('id') window, also known as a Dirichlet window.
rectangular :: Window a
rectangular :: forall a. Window a
rectangular = forall a. Window a
id

-- | 'sin' window.
sine :: Floating a => Window a
sine :: forall a. Floating a => a -> a
sine a
i = forall a. Floating a => a -> a
sin (a
i forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi)

{- | Triangular window, ie. Bartlett window with zero end-points.

> let n = 2 ^ 7
> Sound.Sc3.Plot.plot_p1_ln (map (\fmt -> window_table fmt n triangular) [TableClosed, TableOpen])
> Sound.Sc3.Plot.plot_p1_ln (map (\fmt -> window_table fmt n triangular) [TableClosed, TableGuarded])
-}
triangular :: Fractional a => Window a
triangular :: forall a. Fractional a => Window a
triangular a
i = a
2 forall a. Num a => a -> a -> a
* (a
0.5 forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs (a
i forall a. Num a => a -> a -> a
- a
0.5))

-- * Tables

{- | 'window_table_closed' . 'gaussian'.

> Sound.Sc3.Plot.plot_p1_ln [gaussian_table 1024 0.25, gaussian_table 1024 0.5]
-}
gaussian_table :: (Integral n, Floating b, Enum b) => n -> b -> [b]
gaussian_table :: forall n b. (Integral n, Floating b, Enum b) => n -> b -> [b]
gaussian_table n
n = forall n a.
(Integral n, Fractional a, Enum a) =>
n -> Window a -> Table a
window_table_closed n
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> Window a
gaussian

{- | 'window_table_closed' . 'hamming'.

> Sound.Sc3.Plot.plot_p1_ln [hann_table 128, hamming_table 128]
-}
hamming_table :: Int -> [Double]
hamming_table :: Int -> [Double]
hamming_table Int
n = forall n a.
(Integral n, Fractional a, Enum a) =>
n -> Window a -> Table a
window_table_closed Int
n forall a. Floating a => a -> a
hamming

{- | 'window_table_closed' . 'hann'.

> Sound.Sc3.Plot.plot_p1_ln [hann_table (2 ^ 7)]
-}
hann_table :: Int -> [Double]
hann_table :: Int -> [Double]
hann_table Int
n = forall n a.
(Integral n, Fractional a, Enum a) =>
n -> Window a -> Table a
window_table_closed Int
n forall a. Floating a => a -> a
hann

{- | 'window_table_closed' . 'sine'.

> Sound.Sc3.Plot.plot_p1_ln [sine_table (2 ^ 7)]
-}
sine_table :: (Integral n, Floating b, Enum b) => n -> [b]
sine_table :: forall n b. (Integral n, Floating b, Enum b) => n -> [b]
sine_table n
n = forall n a.
(Integral n, Fractional a, Enum a) =>
n -> Window a -> Table a
window_table_closed n
n forall a. Floating a => a -> a
sine

{- | 'window_table_closed' . 'triangular'.

> Sound.Sc3.Plot.plot_p1_ln [triangular_table (2 ^ 8)]
-}
triangular_table :: (Integral n, Fractional b, Enum b) => n -> [b]
triangular_table :: forall n b. (Integral n, Fractional b, Enum b) => n -> [b]
triangular_table n
n = forall n a.
(Integral n, Fractional a, Enum a) =>
n -> Window a -> Table a
window_table_closed n
n forall a. Fractional a => Window a
triangular