{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
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
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))
{-# 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)
{-# 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
{-# 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
{-# 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))
{-# 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))
{-# 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
{-# 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
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