{-# 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 =
(t -> T t -> y) -> T t y
forall t y. (t -> T t -> y) -> T t y
Cons (\t
f T t
p -> t -> t -> y
wave t
f (T t -> t
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 =
(t -> T t y) -> T t y
forall t y. (t -> T t y) -> T t y
fromControlledWaveAux (\t
f -> if t -> t
forall a. C a => a -> a
abs t
f t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
1t -> t -> t
forall a. C a => a -> a -> a
/t
2 then T t y
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 =
(t -> T t y) -> T t y
forall t y. (t -> T t y) -> T t y
fromControlledWaveAux (\t
f0 ->
let f :: t
f = t -> t
forall a. C a => a -> a
abs t
f0
in if t
f t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
1t -> t -> t
forall a. C a => a -> a -> a
/t
2
then T t y
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 =
(t -> T t -> y) -> T t y
forall t y. (t -> T t -> y) -> T t y
Cons (\t
f T t
p -> T t y -> T t -> y
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 = (y -> y) -> T t y -> T t y
forall y z t. (y -> z) -> T t y -> T t z
distort (y
yy -> y -> y
forall 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 = (y -> y) -> T t y -> T t y
forall y z t. (y -> z) -> T t y -> T t z
distort (y
ky -> y -> y
forall 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) = (t -> T t -> z) -> T t z
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 = T t y -> t -> T t -> y
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 = (t -> T t -> y) -> T t y
forall t y. (t -> T t -> y) -> T t y
Cons ((T t -> y) -> t -> T t -> y
forall a b. a -> b -> a
const T t -> y
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) = (t -> T t -> y) -> T t y
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 y -> y -> y
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) = (t -> T t -> y) -> T t y
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 y -> y -> y
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 = (y -> y) -> T t y -> T t y
forall y z t. (y -> z) -> T t y -> T t z
distort y -> y
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 = (y -> y) -> T t y -> T t y
forall y z t. (y -> z) -> T t y -> T t z
distort (a
sa -> y -> y
forall 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 = T a a -> T a a
forall t y. (C t, C t, C y) => T t y -> T t y
fromWave T a a
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 = T a a -> T a a
forall t y. (C t, C t, C y) => T t y -> T t y
fromWave T a a
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 =
(a -> T a a) -> T a a
forall t y. (C t, C t, C y) => (t -> T t y) -> T t y
fromControlledWave (\a
f -> a -> T a a
forall a. (Ord a, C a) => a -> T a a
Wave.triangleAsymmetric (a
2a -> a -> a
forall a. C a => a -> a -> a
*a
fa -> a -> a
forall 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 =
(a -> T a a) -> T a a
forall t y. (C t, C t, C y) => (t -> T t y) -> T t y
fromControlledWave (\a
f -> a -> T a a
forall a. (C a, C a) => a -> T a a
Wave.trapezoid (a
1a -> a -> a
forall a. C a => a -> a -> a
-a
2a -> a -> a
forall 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 = T a a -> T a a
forall t y. (C t, C t, C y) => T t y -> T t y
fromWave T a a
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 = (Harmonic a -> T a) -> [Harmonic a] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map (\Harmonic a
h -> a -> a -> T a
forall a. C a => a -> a -> T a
Complex.fromPolar (Harmonic a -> a
forall a. Harmonic a -> a
Wave.harmonicAmplitude Harmonic a
h)
(a
2a -> a -> a
forall a. C a => a -> a -> a
*a
forall a. C a => a
pi a -> a -> a
forall a. C a => a -> a -> a
* T a -> a
forall a. T a -> a
Phase.toRepresentative (Harmonic a -> T a
forall a. Harmonic a -> T a
Wave.harmonicPhase Harmonic a
h))) [Harmonic a]
hs
trunc :: b -> [b] -> [b]
trunc b
f =
((b, b) -> b) -> [(b, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, b) -> b
forall a b. (a, b) -> b
snd ([(b, b)] -> [b]) -> ([b] -> [(b, b)]) -> [b] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b) -> Bool) -> [(b, b)] -> [(b, b)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<b
1b -> b -> b
forall a. C a => a -> a -> a
/b
2) (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
forall a b. (a, b) -> a
fst) ([(b, b)] -> [(b, b)]) -> ([b] -> [(b, b)]) -> [b] -> [(b, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((b -> b) -> b -> [b]
forall a. (a -> a) -> a -> [a]
iterate (b -> b
forall a. C a => a -> a
abs b
f b -> b -> b
forall a. C a => a -> a -> a
+) b
forall a. C a => a
zero)
in (a -> T a a) -> T a a
forall t y. (t -> T t y) -> T t y
fromControlledWaveAux ((a -> T a a) -> T a a) -> (a -> T a a) -> T a a
forall a b. (a -> b) -> a -> b
$ \a
f ->
(T a -> a) -> T a (T a) -> T a a
forall y z t. (y -> z) -> T t y -> T t z
Wave.distort
(T a -> a
forall a. T a -> a
Complex.imag (T a -> a) -> (T a -> T a) -> T a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (T a) -> T a -> T a
forall a. C a => T a -> a -> a
Poly.evaluate ([T a] -> T (T a)
forall a. [a] -> T a
Poly.fromCoeffs (a -> [T a] -> [T a]
forall {b} {b}. (Ord b, C b, C b) => b -> [b] -> [b]
trunc a
f [T a]
c)))
T a (T a)
forall a. C a => T a (T a)
Wave.helix