{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{- |
Copyright   :  (c) Henning Thielemann 2006
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes

Waveforms which are smoothed according to the oscillator frequency
in order to suppress aliasing effects.
-}
module Synthesizer.Basic.WaveSmoothed (
   T,
   fromFunction,
   fromWave,
   fromControlledWave,

   raise,
   amplify,
   distort,
   apply,

   sine,
   cosine,
   saw,
   square,
   triangle,

   Wave.Harmonic,
   Wave.harmonic,
   composedHarmonics,
   ) where


import qualified Synthesizer.Basic.Wave  as Wave
import qualified Synthesizer.Basic.Phase as Phase

import qualified Algebra.Transcendental        as Trans
import qualified Algebra.Module                as Module
import qualified Algebra.Field                 as Field
import qualified Algebra.RealRing              as RealRing
import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive

import qualified MathObj.Polynomial as Poly
import qualified Number.Complex     as Complex

import NumericPrelude.Numeric
import NumericPrelude.Base


{- * Definition and construction -}

newtype T t y = Cons {forall t y. T t y -> t -> T t -> y
decons :: t -> Phase.T t -> y}


{-# INLINE fromFunction #-}
fromFunction :: (t -> t -> y) -> (T t y)
fromFunction :: forall t y. (t -> t -> y) -> T t y
fromFunction t -> t -> y
wave =
   forall t y. (t -> T t -> y) -> T t y
Cons (\t
f T t
p -> t -> t -> y
wave t
f (forall a. T a -> a
Phase.toRepresentative T t
p))

{- |
Use this function for waves which are sufficiently smooth.
If the Nyquist frequency is exceeded the wave is simply replaced
by a constant zero wave.
-}
{-# INLINE fromWave #-}
fromWave ::
   (Field.C t, RealRing.C t, Additive.C y) =>
   Wave.T t y -> (T t y)
fromWave :: forall t y. (C t, C t, C y) => T t y -> T t y
fromWave T t y
wave =
   forall t y. (t -> T t y) -> T t y
fromControlledWaveAux (\t
f -> if forall a. C a => a -> a
abs t
f forall a. Ord a => a -> a -> Bool
>= t
1forall a. C a => a -> a -> a
/t
2 then forall a. C a => a
zero else T t y
wave)

{-# INLINE fromControlledWave #-}
fromControlledWave ::
   (Field.C t, RealRing.C t, Additive.C y) =>
   (t -> Wave.T t y) -> (T t y)
fromControlledWave :: forall t y. (C t, C t, C y) => (t -> T t y) -> T t y
fromControlledWave t -> T t y
wave =
   forall t y. (t -> T t y) -> T t y
fromControlledWaveAux (\t
f0 ->
      let f :: t
f = forall a. C a => a -> a
abs t
f0
      in  if t
f forall a. Ord a => a -> a -> Bool
>= t
1forall a. C a => a -> a -> a
/t
2
            then forall a. C a => a
zero
            else t -> T t y
wave t
f)

{-# INLINE fromControlledWaveAux #-}
fromControlledWaveAux :: (t -> Wave.T t y) -> (T t y)
fromControlledWaveAux :: forall t y. (t -> T t y) -> T t y
fromControlledWaveAux t -> T t y
wave =
   forall t y. (t -> T t -> y) -> T t y
Cons (\t
f T t
p -> forall t y. T t y -> T t -> y
Wave.apply (t -> T t y
wave t
f) T t
p)


{- * Operations on waves -}

{-# INLINE raise #-}
raise :: (Additive.C y) => y -> T t y -> T t y
raise :: forall y t. C y => y -> T t y -> T t y
raise y
y = forall y z t. (y -> z) -> T t y -> T t z
distort (y
yforall a. C a => a -> a -> a
+)

{-# INLINE amplify #-}
amplify :: (Ring.C y) => y -> T t y -> T t y
amplify :: forall y t. C y => y -> T t y -> T t y
amplify y
k = forall y z t. (y -> z) -> T t y -> T t z
distort (y
kforall a. C a => a -> a -> a
*)

{-# INLINE distort #-}
distort :: (y -> z) -> T t y -> T t z
distort :: forall y z t. (y -> z) -> T t y -> T t z
distort y -> z
g (Cons t -> T t -> y
w) = forall t y. (t -> T t -> y) -> T t y
Cons (\t
f T t
p -> y -> z
g (t -> T t -> y
w t
f T t
p))

{-# INLINE apply #-}
apply :: T t y -> (t -> Phase.T t -> y)
apply :: forall t y. T t y -> t -> T t -> y
apply = forall t y. T t y -> t -> T t -> y
decons



instance Additive.C y => Additive.C (T t y) where
   {-# INLINE zero #-}
   {-# INLINE (+) #-}
   {-# INLINE (-) #-}
   {-# INLINE negate #-}
   zero :: T t y
zero = forall t y. (t -> T t -> y) -> T t y
Cons (forall a b. a -> b -> a
const forall a. C a => a
zero)
   + :: T t y -> T t y -> T t y
(+) (Cons t -> T t -> y
w) (Cons t -> T t -> y
v) = forall t y. (t -> T t -> y) -> T t y
Cons (\t
f T t
p -> t -> T t -> y
w t
f T t
p forall a. C a => a -> a -> a
+ t -> T t -> y
v t
f T t
p)
   (-) (Cons t -> T t -> y
w) (Cons t -> T t -> y
v) = forall t y. (t -> T t -> y) -> T t y
Cons (\t
f T t
p -> t -> T t -> y
w t
f T t
p forall a. C a => a -> a -> a
- t -> T t -> y
v t
f T t
p)
   negate :: T t y -> T t y
negate = forall y z t. (y -> z) -> T t y -> T t z
distort forall a. C a => a -> a
negate


instance Module.C a y => Module.C a (T t y) where
   {-# INLINE (*>) #-}
   a
s *> :: a -> T t y -> T t y
*> T t y
w = forall y z t. (y -> z) -> T t y -> T t z
distort (a
sforall a v. C a v => a -> v -> v
*>) T t y
w




{- * Examples -}

{- ** unparameterized -}

{- | map a phase to value of a sine wave -}
{-# INLINE sine #-}
sine :: (Trans.C a, RealRing.C a) => T a a
sine :: forall a. (C a, C a) => T a a
sine = forall t y. (C t, C t, C y) => T t y -> T t y
fromWave forall a. C a => T a a
Wave.sine

{-# INLINE cosine #-}
cosine :: (Trans.C a, RealRing.C a) => T a a
cosine :: forall a. (C a, C a) => T a a
cosine = forall t y. (C t, C t, C y) => T t y -> T t y
fromWave forall a. C a => T a a
Wave.cosine


{- | saw tooth,
it's a ramp down in order to have a positive coefficient for the first partial sine
-}
{-# INLINE saw #-}
saw :: (RealRing.C a, Field.C a) => T a a
saw :: forall a. (C a, C a) => T a a
saw =
   forall t y. (C t, C t, C y) => (t -> T t y) -> T t y
fromControlledWave (\a
f -> forall a. (Ord a, C a) => a -> T a a
Wave.triangleAsymmetric (a
2forall a. C a => a -> a -> a
*a
fforall a. C a => a -> a -> a
-a
1))


{- | square -}
{-# INLINE square #-}
square :: (RealRing.C a, Field.C a) => T a a
square :: forall a. (C a, C a) => T a a
square =
   forall t y. (C t, C t, C y) => (t -> T t y) -> T t y
fromControlledWave (\a
f -> forall a. (C a, C a) => a -> T a a
Wave.trapezoid (a
1forall a. C a => a -> a -> a
-a
2forall a. C a => a -> a -> a
*a
f))


{- | triangle -}
{-# INLINE triangle #-}
triangle :: (RealRing.C a, Field.C a) => T a a
triangle :: forall a. (C a, C a) => T a a
triangle = forall t y. (C t, C t, C y) => T t y -> T t y
fromWave forall a. (Ord a, C a) => T a a
Wave.triangle



{- |
Specify the wave by its harmonics.

The function is implemented quite efficiently
by applying the Horner scheme to a polynomial with complex coefficients
(the harmonic parameters)
using a complex exponential as argument.
-}
{-# INLINE composedHarmonics #-}
composedHarmonics :: (Trans.C a, RealRing.C a) => [Wave.Harmonic a] -> T a a
composedHarmonics :: forall a. (C a, C a) => [Harmonic a] -> T a a
composedHarmonics [Harmonic a]
hs =
   let c :: [T a]
c = forall a b. (a -> b) -> [a] -> [b]
map (\Harmonic a
h -> forall a. C a => a -> a -> T a
Complex.fromPolar (forall a. Harmonic a -> a
Wave.harmonicAmplitude Harmonic a
h)
                   (a
2forall a. C a => a -> a -> a
*forall a. C a => a
pi forall a. C a => a -> a -> a
* forall a. T a -> a
Phase.toRepresentative (forall a. Harmonic a -> T a
Wave.harmonicPhase Harmonic a
h))) [Harmonic a]
hs
       -- @take (ceiling (1/(2*f)))@ would fail for small @f@ especially @f==zero@
       trunc :: b -> [b] -> [b]
trunc b
f =
          forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
<b
1forall a. C a => a -> a -> a
/b
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (a -> a) -> a -> [a]
iterate (forall a. C a => a -> a
abs b
f forall a. C a => a -> a -> a
+) forall a. C a => a
zero)
   in  forall t y. (t -> T t y) -> T t y
fromControlledWaveAux forall a b. (a -> b) -> a -> b
$ \a
f ->
          forall y z t. (y -> z) -> T t y -> T t z
Wave.distort
             (forall a. T a -> a
Complex.imag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => T a -> a -> a
Poly.evaluate (forall a. [a] -> T a
Poly.fromCoeffs (forall {b} {b}. (Ord b, C b, C b) => b -> [b] -> [b]
trunc a
f [T a]
c)))
             forall a. C a => T a (T a)
Wave.helix
{-
GNUPlot.plotFunc [] (GNUPlot.linearScale 1000 (0,1::Double)) (composedHarmonics [harmonic 0 0, harmonic 0 0, harmonic 0 0, harmonic 0.25 1])
-}