{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Instrument where

import Synthesizer.Plain.Displacement (mixMulti, )
import Synthesizer.Plain.Control (exponential2)
import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Basic.Wave       as Wave
import qualified Synthesizer.Plain.Noise      as Noise
import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1
import qualified Synthesizer.Plain.Filter.Recursive.Allpass    as Allpass
import qualified Synthesizer.Plain.Filter.Recursive.Universal  as UniFilter
import qualified Synthesizer.Plain.Filter.Recursive.Moog       as Moog
import qualified Synthesizer.Plain.Filter.Recursive.Comb       as Comb
import qualified Synthesizer.Plain.Filter.Recursive    as FiltR
import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR
import qualified Synthesizer.Plain.Interpolation as Interpolation
import Data.List(zipWith4)

import System.Random

import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module         as Module
import qualified Algebra.RealField      as RealField
import qualified Algebra.Field          as Field
import qualified Algebra.Ring           as Ring

import NumericPrelude.Numeric
import NumericPrelude.Base



{-| Create a sound of a slightly changed frequency
    just as needed for a simple stereo sound. -}
stereoPhaser :: Ring.C a =>
       (a -> [b])  {- ^ A function mapping a frequency to a signal. -}
    -> a           {- ^ The factor to the frequency, should be close to 1. -}
    -> a           {- ^ The base (undeviated) frequency of the sound. -}
    -> [b]
stereoPhaser :: forall a b. C a => (a -> [b]) -> a -> a -> [b]
stereoPhaser a -> [b]
sound a
dif a
freq = a -> [b]
sound (a
freqa -> a -> a
forall a. C a => a -> a -> a
*a
dif)



allpassPlain :: (RealField.C a, Trans.C a, Module.C a a) =>
                   a -> a -> a -> a -> [a]
allpassPlain :: forall a. (C a, C a, C a a) => a -> a -> a -> a -> [a]
allpassPlain a
sampleRate a
halfLife a
k a
freq =
    Int -> T (Parameter a) -> T a -> T a
forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
Allpass.cascade Int
10
        ((a -> Parameter a) -> T a -> T (Parameter a)
forall a b. (a -> b) -> [a] -> [b]
map a -> Parameter a
forall a. a -> Parameter a
Allpass.Parameter (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
halfLifea -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
k))
        (a -> a -> T a
forall a. (C a, C a, C a a) => a -> a -> [a]
simpleSaw a
sampleRate a
freq)

allpassDown :: (RealField.C a, Trans.C a, Module.C a a) =>
                  a -> Int -> a -> a -> a -> [a]
allpassDown :: forall a. (C a, C a, C a a) => a -> Int -> a -> a -> a -> [a]
allpassDown a
sampleRate Int
order a
halfLife a
filterfreq a
freq =
    let x :: [a]
x = a -> a -> [a]
forall a. (C a, C a, C a a) => a -> a -> [a]
simpleSaw a
sampleRate a
freq
    in  (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
0.3a -> a -> a
forall a. C a => a -> a -> a
*) ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(+) [a]
x
            (Int -> T (Parameter a) -> [a] -> [a]
forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
Allpass.cascade Int
order
                ((a -> Parameter a) -> [a] -> T (Parameter a)
forall a b. (a -> b) -> [a] -> [b]
map (Int -> a -> Parameter a
forall a. C a => Int -> a -> Parameter a
Allpass.flangerParameter Int
order)
                     (a -> a -> [a]
forall y. C y => y -> y -> T y
exponential2 (a
halfLifea -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) (a
filterfreqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))
                [a]
x))


moogDown, moogReso ::
   (RealField.C a, Trans.C a, Module.C a a) =>
      a -> Int -> a -> a -> a -> [a]
moogDown :: forall a. (C a, C a, C a a) => a -> Int -> a -> a -> a -> [a]
moogDown a
sampleRate Int
order a
halfLife a
filterfreq a
freq =
    Int -> T (Parameter a) -> T a -> T a
forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
Moog.lowpass Int
order
        ((Pole a -> Parameter a) -> [Pole a] -> T (Parameter a)
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pole a -> Parameter a
forall a. C a => Int -> Pole a -> Parameter a
Moog.parameter Int
order) ((a -> Pole a) -> T a -> [Pole a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> Pole a
forall a. a -> a -> Pole a
FiltR.Pole a
10)
            (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
halfLifea -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) (a
filterfreqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))))
        (a -> a -> T a
forall a. (C a, C a, C a a) => a -> a -> [a]
simpleSaw a
sampleRate a
freq)

moogReso :: forall a. (C a, C a, C a a) => a -> Int -> a -> a -> a -> [a]
moogReso a
sampleRate Int
order a
halfLife a
filterfreq a
freq =
    Int -> T (Parameter a) -> T a -> T a
forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
Moog.lowpass Int
order
        ((Pole a -> Parameter a) -> [Pole a] -> T (Parameter a)
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pole a -> Parameter a
forall a. C a => Int -> Pole a -> Parameter a
Moog.parameter Int
order) ((a -> a -> Pole a) -> T a -> T a -> [Pole a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> Pole a
forall a. a -> a -> Pole a
FiltR.Pole
            (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
halfLifea -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
100)
            (a -> T a
forall a. a -> [a]
repeat (a
filterfreqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))))
        (a -> a -> T a
forall a. (C a, C a, C a a) => a -> a -> [a]
simpleSaw a
sampleRate a
freq)

bell :: (Trans.C a, RealField.C a) => a -> a -> [a]
bell :: forall a. (C a, C a) => a -> a -> [a]
bell a
sampleRate a
freq =
    let halfLife :: a
halfLife = a
0.5
    in  (a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\a
x a
y a
z -> (a
xa -> a -> a
forall a. C a => a -> a -> a
+a
ya -> a -> a
forall a. C a => a -> a -> a
+a
z)a -> a -> a
forall a. C a => a -> a -> a
/a
3)
            (a -> a -> a -> a -> [a]
forall a. (C a, C a) => a -> a -> a -> a -> [a]
bellHarmonic a
sampleRate a
1 a
halfLife a
freq)
            (a -> a -> a -> a -> [a]
forall a. (C a, C a) => a -> a -> a -> a -> [a]
bellHarmonic a
sampleRate a
4 a
halfLife a
freq)
            (a -> a -> a -> a -> [a]
forall a. (C a, C a) => a -> a -> a -> a -> [a]
bellHarmonic a
sampleRate a
7 a
halfLife a
freq)

bellHarmonic :: (Trans.C a, RealField.C a) => a -> a -> a -> a -> [a]
bellHarmonic :: forall a. (C a, C a) => a -> a -> a -> a -> [a]
bellHarmonic a
sampleRate a
n a
halfLife a
freq =
    (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(*) (a -> [a] -> [a]
forall a. (C a, C a) => a -> T a -> T a
Osci.freqModSine a
0 ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
modu -> a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRatea -> a -> a
forall a. C a => a -> a -> a
*a
na -> a -> a
forall a. C a => a -> a -> a
*(a
1a -> a -> a
forall a. C a => a -> a -> a
+a
0.005a -> a -> a
forall a. C a => a -> a -> a
*a
modu))
                                    (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
0 (a
5.0a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))))
                (a -> a -> [a]
forall y. C y => y -> y -> T y
exponential2 (a
halfLifea -> a -> a
forall a. C a => a -> a -> a
/a
na -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
1)


fastBell, squareBell, moogGuitar, moogGuitarSoft, simpleSaw, fatSaw ::
    (RealField.C a, Trans.C a, Module.C a a) => a -> a -> [a]

fastBell :: forall a. (C a, C a, C a a) => a -> a -> [a]
fastBell a
sampleRate a
freq =
    (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(*) (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
0 (a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))
                (a -> a -> [a]
forall y. C y => y -> y -> T y
exponential2 (a
0.2a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
1)

filterSaw :: (Module.C a a, Trans.C a, RealField.C a) =>
             a -> a -> a -> [a]
filterSaw :: forall a. (C a a, C a, C a) => a -> a -> a -> [a]
filterSaw a
sampleRate a
filterFreq a
freq =
    (Result a -> a) -> [Result a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\Result a
r -> Result a -> a
forall a. Result a -> a
UniFilter.lowpass Result a
r a -> a -> a
forall a. C a => a -> a -> a
* a
0.1)
        (T (Parameter a) -> [a] -> [Result a]
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T (Result v)
UniFilter.run ((a -> Parameter a) -> [a] -> T (Parameter a)
forall a b. (a -> b) -> [a] -> [b]
map (Pole a -> Parameter a
forall a. C a => Pole a -> Parameter a
UniFilter.parameter (Pole a -> Parameter a) -> (a -> Pole a) -> a -> Parameter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Pole a
forall a. a -> a -> Pole a
FiltR.Pole a
10)
                        (a -> a -> [a]
forall y. C y => y -> y -> T y
exponential2 (a
0.1a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) (a
filterFreqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))
                   (a -> a -> [a]
forall a. C a => a -> a -> T a
Osci.staticSaw a
0 (a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))

squareBell :: forall a. (C a, C a, C a a) => a -> a -> [a]
squareBell a
sampleRate a
freq = T (Parameter a) -> T a -> T a
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
Filt1.lowpass
         ((a -> Parameter a) -> T a -> T (Parameter a)
forall a b. (a -> b) -> [a] -> [b]
map a -> Parameter a
forall a. C a => a -> Parameter a
Filt1.parameter
              (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
sampleRatea -> a -> a
forall a. C a => a -> a -> a
/a
10) (a
4000a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))
--       (Osci.freqModSample Interpolation.cubic [0, 0.7, -0.3, 0.7, 0, -0.7, 0.3, -0.7] 0
         (T a a -> T a -> a -> T a -> T a
forall a b. C a => T a b -> [b] -> a -> T a -> [b]
Osci.freqModSample T a a
forall t y. C t y => T t y
Interpolation.linear [a
0, a
0.5, a
0.6, a
0.8, a
0, -a
0.5, -a
0.6, -a
0.8] a
0
                  ((a -> a) -> T a -> T a
forall a b. (a -> b) -> [a] -> [b]
map (\a
modu -> a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRatea -> a -> a
forall a. C a => a -> a -> a
*(a
1a -> a -> a
forall a. C a => a -> a -> a
+a
modua -> a -> a
forall a. C a => a -> a -> a
/a
100))
                       (a -> a -> T a
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
0 (a
5.0a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))))

fmBell :: (RealField.C a, Trans.C a) => a -> a -> a -> a -> [a]
fmBell :: forall a. (C a, C a) => a -> a -> a -> a -> [a]
fmBell a
sampleRate a
depth a
freqRatio a
freq =
   let modul :: T a
modul = T a -> T a -> T a
forall a. C a => T a -> T a -> T a
FiltNR.envelope (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
0.2a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
depth)
                        (a -> a -> T a
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
0 (a
freqRatioa -> a -> a
forall a. C a => a -> a -> a
*a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))
       env :: T a
env   = a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
0.5a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
1
   in  T a -> T a -> T a
forall a. C a => T a -> T a -> T a
FiltNR.envelope T a
env (a -> T a -> T a
forall a. (C a, C a) => a -> T a -> T a
Osci.phaseModSine (a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate) T a
modul)

moogGuitar :: forall a. (C a, C a, C a a) => a -> a -> [a]
moogGuitar a
sampleRate a
freq =
   let moogOrder :: Int
moogOrder = Int
4
       filterControl :: [Parameter a]
filterControl =
          (Pole a -> Parameter a) -> [Pole a] -> [Parameter a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pole a -> Parameter a
forall a. C a => Int -> Pole a -> Parameter a
Moog.parameter Int
moogOrder)
              ((a -> Pole a) -> [a] -> [Pole a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> Pole a
forall a. a -> a -> Pole a
FiltR.Pole a
10) (a -> a -> [a]
forall y. C y => y -> y -> T y
exponential2
                               (a
0.5a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate)
                               (a
4000a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))
       tone :: [a]
tone = a -> [a] -> [a]
forall a. C a => a -> T a -> T a
Osci.freqModSaw a
0 ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
modu -> a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRatea -> a -> a
forall a. C a => a -> a -> a
*(a
1a -> a -> a
forall a. C a => a -> a -> a
+a
0.005a -> a -> a
forall a. C a => a -> a -> a
*a
modu))
                                (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
0 (a
5.0a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))
   in  Int -> [Parameter a] -> [a] -> [a]
forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
Moog.lowpass Int
moogOrder [Parameter a]
filterControl [a]
tone

moogGuitarSoft :: forall a. (C a, C a, C a a) => a -> a -> [a]
moogGuitarSoft a
sampleRate a
freq =
   T a -> T a -> T a
forall a. C a => T a -> T a -> T a
FiltNR.envelope ((a -> a) -> T a -> T a
forall a b. (a -> b) -> [a] -> [b]
map (a
1a -> a -> a
forall a. C a => a -> a -> a
-) (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
0.003a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
1))
            (a -> a -> T a
forall a. (C a, C a, C a a) => a -> a -> [a]
moogGuitar a
sampleRate a
freq)



{-| low pass with resonance -}
filterSweep :: (Field.C v, Module.C a v, Trans.C a, RealField.C a) =>
                  a -> a -> [v] -> [v]
filterSweep :: forall v a. (C v, C a v, C a, C a) => a -> a -> [v] -> [v]
filterSweep a
sampleRate a
phase =
    (Result v -> v) -> [Result v] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (\Result v
r -> Result v -> v
forall a. Result a -> a
UniFilter.lowpass Result v
r v -> v -> v
forall a. C a => a -> a -> a
/ v
2) ([Result v] -> [v]) -> ([v] -> [Result v]) -> [v] -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    T (Parameter a) -> [v] -> [Result v]
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T (Result v)
UniFilter.run
        ((a -> Parameter a) -> [a] -> T (Parameter a)
forall a b. (a -> b) -> [a] -> [b]
map (\a
freq ->
                Pole a -> Parameter a
forall a. C a => Pole a -> Parameter a
UniFilter.parameter (a -> a -> Pole a
forall a. a -> a -> Pole a
FiltR.Pole a
10 ((a
1800a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)a -> a -> a
forall a. C a => a -> a -> a
*a
2a -> a -> a
forall a. C a => a -> a -> a
**a
freq)))
             (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
phase (a
1a -> a -> a
forall a. C a => a -> a -> a
/a
16a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))
        )


fatSawChordFilter, fatSawChord ::
   (RealField.C a, Trans.C a, Module.C a a) => a -> a -> [a]

fatSawChordFilter :: forall a. (C a, C a, C a a) => a -> a -> [a]
fatSawChordFilter a
sampleRate a
freq =
    (Result a -> a) -> [Result a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\Result a
r -> Result a -> a
forall a. Result a -> a
UniFilter.lowpass Result a
r a -> a -> a
forall a. C a => a -> a -> a
/ a
2)
        (T (Parameter a) -> [a] -> [Result a]
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T (Result v)
UniFilter.run (a -> T (Parameter a)
forall a. (C a, C a) => a -> [Parameter a]
filterDown a
sampleRate)
                   (a -> a -> [a]
forall a. (C a, C a, C a a) => a -> a -> [a]
fatSawChord a
sampleRate a
freq))

fatSawChord :: forall a. (C a, C a, C a a) => a -> a -> [a]
fatSawChord a
sampleRate a
freq =
    (a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\a
x a
y a
z -> (a
xa -> a -> a
forall a. C a => a -> a -> a
+a
ya -> a -> a
forall a. C a => a -> a -> a
+a
z)a -> a -> a
forall a. C a => a -> a -> a
/a
3)
             (a -> a -> [a]
forall a. (C a, C a, C a a) => a -> a -> [a]
fatSaw a
sampleRate (a
1  a -> a -> a
forall a. C a => a -> a -> a
*a
freq))
             (a -> a -> [a]
forall a. (C a, C a, C a a) => a -> a -> [a]
fatSaw a
sampleRate (a
5a -> a -> a
forall a. C a => a -> a -> a
/a
4a -> a -> a
forall a. C a => a -> a -> a
*a
freq))
             (a -> a -> [a]
forall a. (C a, C a, C a a) => a -> a -> [a]
fatSaw a
sampleRate (a
3a -> a -> a
forall a. C a => a -> a -> a
/a
2a -> a -> a
forall a. C a => a -> a -> a
*a
freq))

filterDown :: (RealField.C a, Trans.C a) => a -> [UniFilter.Parameter a]

filterDown :: forall a. (C a, C a) => a -> [Parameter a]
filterDown a
sampleRate =
    (Pole a -> Parameter a) -> [Pole a] -> [Parameter a]
forall a b. (a -> b) -> [a] -> [b]
map Pole a -> Parameter a
forall a. C a => Pole a -> Parameter a
UniFilter.parameter ([Pole a] -> [Parameter a]) -> [Pole a] -> [Parameter a]
forall a b. (a -> b) -> a -> b
$
    (a -> Pole a) -> [a] -> [Pole a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> Pole a
forall a. a -> a -> Pole a
FiltR.Pole a
10) ([a] -> [Pole a]) -> [a] -> [Pole a]
forall a b. (a -> b) -> a -> b
$
    a -> a -> [a]
forall y. C y => y -> y -> T y
exponential2 (a
sampleRatea -> a -> a
forall a. C a => a -> a -> a
/a
3) (a
4000a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)

simpleSaw :: forall a. (C a, C a, C a a) => a -> a -> [a]
simpleSaw a
sampleRate a
freq = 
    a -> a -> T a
forall a. C a => a -> a -> T a
Osci.staticSaw a
0 (a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)

{-| accumulate multiple similar saw sounds and observe the increase of volume
    The oscillator @osc@ must accept relative frequencies. -}
modulatedWave :: (Trans.C a, RealField.C a) =>
   a -> (a -> [a] -> [a]) -> a -> a -> a -> a -> a -> [a]
modulatedWave :: forall a.
(C a, C a) =>
a -> (a -> [a] -> [a]) -> a -> a -> a -> a -> a -> [a]
modulatedWave a
sampleRate a -> [a] -> [a]
osc a
freq a
start a
depth a
phase a
speed =
   a -> [a] -> [a]
osc a
start ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRatea -> a -> a
forall a. C a => a -> a -> a
*(a
1a -> a -> a
forall a. C a => a -> a -> a
+a
xa -> a -> a
forall a. C a => a -> a -> a
*a
depth))
                  (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
phase (a
speeda -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))

accumulatedSaws :: (Random a, Trans.C a, RealField.C a) => a -> a -> [[a]]
accumulatedSaws :: forall a. (Random a, C a, C a) => a -> a -> [[a]]
accumulatedSaws a
sampleRate a
freq =
   let starts :: [a]
starts = (a, a) -> StdGen -> [a]
forall g. RandomGen g => (a, a) -> g -> [a]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (a
0,a
1)     (Int -> StdGen
mkStdGen Int
48251)
       depths :: [a]
depths = (a, a) -> StdGen -> [a]
forall g. RandomGen g => (a, a) -> g -> [a]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (a
0,a
0.02)  (Int -> StdGen
mkStdGen Int
12354)
       phases :: [a]
phases = (a, a) -> StdGen -> [a]
forall g. RandomGen g => (a, a) -> g -> [a]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (a
0,a
1)     (Int -> StdGen
mkStdGen Int
74389)
       speeds :: [a]
speeds = (a, a) -> StdGen -> [a]
forall g. RandomGen g => (a, a) -> g -> [a]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (a
0.1,a
0.3) (Int -> StdGen
mkStdGen Int
03445)
       saws :: [[a]]
saws   = (a -> a -> a -> a -> [a]) -> [a] -> [a] -> [a] -> [a] -> [[a]]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 (a -> (a -> [a] -> [a]) -> a -> a -> a -> a -> a -> [a]
forall a.
(C a, C a) =>
a -> (a -> [a] -> [a]) -> a -> a -> a -> a -> a -> [a]
modulatedWave a
sampleRate a -> [a] -> [a]
forall a. C a => a -> T a -> T a
Osci.freqModSaw a
freq)
                         [a]
starts [a]
depths [a]
phases [a]
speeds
   in  ([a] -> [a] -> [a]) -> [[a]] -> [[a]]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(+)) [[a]]
saws

choirWave :: Field.C a => [a]
choirWave :: forall a. C a => [a]
choirWave =
   [a
0.702727421560071, a
0.7378359559947721, a
0.7826845805704197, a
0.6755514176072053,
   a
0.4513448069764686, a
0.3272995923197175, a
0.3404887595570093, a
0.41416011004660863,
   a
0.44593673999775735, a
0.4803528740412951, a
0.48761174828621334, a
0.44076701468836754,
   a
0.39642906530439503, a
0.35467843549395706, a
0.38054627445988315, a
0.3888748481589558,
   a
0.35303993804564215, a
0.3725196582177455, a
0.44980257249714667, a
0.5421204370443772,
   a
0.627630436752643, a
0.6589491426946169, a
0.619819155051891, a
0.5821754728547365,
   a
0.5495877076869761, a
0.5324446834830168, a
0.47242861142812065, a
0.3686685958119909,
   a
0.2781440436733245, a
0.2582500464201269, a
0.1955614176372372, a
0.038373557320540604,
   -a
0.13132155046556182, -a
0.21867394831598339, -a
0.24302145520904606, -a
0.3096437514614372,
   -a
0.44774961666697943, -a
0.5889830267579028, -a
0.7168993833444837, -a
0.816723038671071,
   -a
0.8330283834679535, -a
0.8384077057999397, -a
0.8834813451725689, -a
0.9159391171556484,
   -a
0.9189751669797644, -a
0.8932026446626791, -a
0.8909164153221475, -a
0.9716732300637536,
   -a
1, -a
0.9253833606736654, -a
0.8568630538844477, -a
0.863932337623625,
   -a
0.857811827480001, -a
0.8131204084064676, -a
0.7839286071242304, -a
0.7036632045472225,
   -a
0.5824648346845637, -a
0.46123726085299827, -a
0.41391985851146285, -a
0.45323938111069567,
   -a
0.5336689022602625, -a
0.5831307769323063, -a
0.5693896103843189, -a
0.48596981886424745,
   -a
0.35791155598992863, -a
0.2661471984133689, -a
0.24158092840946802, -a
0.23965213828744264,
   -a
0.23421368394531547, -a
0.25130667896294306, -a
0.3116359503337366, -a
0.31263345635966144,
   -a
0.1879031874103659, -a
0.00020936838180399674, a
0.18567090309156153, a
0.2713525359068149,
   a
0.2979908042971701, a
0.2957704726566382, a
0.28820375086489286, a
0.364513508557745,
   a
0.4520234711163569, a
0.43210542988077005, a
0.4064955825278379, a
0.4416784798648095,
   a
0.5240917981530765, a
0.6496469543088884, a
0.7658103369723797, a
0.8012776441058732,
   a
0.7824042138292476, a
0.752678361663059, a
0.760211176708886, a
0.7308266231622353]


choir :: (Random a, Trans.C a, RealField.C a) => a -> a -> [a]
choir :: forall a. (Random a, C a, C a) => a -> a -> [a]
choir a
sampleRate a
freq =
   let starts :: [a]
starts = (a, a) -> StdGen -> [a]
forall g. RandomGen g => (a, a) -> g -> [a]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (a
0,a
1)     (Int -> StdGen
mkStdGen Int
48251)
       depths :: [a]
depths = (a, a) -> StdGen -> [a]
forall g. RandomGen g => (a, a) -> g -> [a]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (a
0,a
0.02)  (Int -> StdGen
mkStdGen Int
12354)
       phases :: [a]
phases = (a, a) -> StdGen -> [a]
forall g. RandomGen g => (a, a) -> g -> [a]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (a
0,a
1)     (Int -> StdGen
mkStdGen Int
74389)
       speeds :: [a]
speeds = (a, a) -> StdGen -> [a]
forall g. RandomGen g => (a, a) -> g -> [a]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (a
0.1,a
0.3) (Int -> StdGen
mkStdGen Int
03445)
       voices :: [[a]]
voices = (a -> a -> a -> a -> [a]) -> [a] -> [a] -> [a] -> [a] -> [[a]]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 (a -> (a -> [a] -> [a]) -> a -> a -> a -> a -> a -> [a]
forall a.
(C a, C a) =>
a -> (a -> [a] -> [a]) -> a -> a -> a -> a -> a -> [a]
modulatedWave a
sampleRate
                            (T a a -> [a] -> a -> [a] -> [a]
forall a b. C a => T a b -> [b] -> a -> T a -> [b]
Osci.freqModSample T a a
forall t y. T t y
Interpolation.constant [a]
forall a. C a => [a]
choirWave) a
freq)
                         [a]
starts [a]
depths [a]
phases [a]
speeds
   in  (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. C a => a -> a -> a
*a
0.2) ((([a] -> [a] -> [a]) -> [[a]] -> [[a]]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. C a => a -> a -> a
(+)) [[a]]
voices) [[a]] -> Int -> [a]
forall a. HasCallStack => [a] -> Int -> a
!! Int
10)


fatSaw :: forall a. (C a, C a, C a a) => a -> a -> [a]
fatSaw a
sampleRate a
freq =
    {- a simplified version of modulatedWave -}
    let partial :: a -> a -> a -> [a]
partial a
depth a
modPhase a
modFreq =
           a -> [a] -> [a]
forall a. (C a, C a a) => a -> [a] -> [a]
osciDoubleSaw a
sampleRate
              ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> a
freqa -> a -> a
forall a. C a => a -> a -> a
*(a
1a -> a -> a
forall a. C a => a -> a -> a
+a
xa -> a -> a
forall a. C a => a -> a -> a
*a
depth))
                   (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
modPhase (a
modFreqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))
    in  (a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (((((a -> a -> a
forall a. C a => a -> a -> a
/a
3)(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)((a -> a) -> a -> a) -> (a -> a -> a) -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a -> a
forall a. C a => a -> a -> a
(+))(a -> a -> a) -> (a -> a) -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)((a -> a) -> a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a -> a
forall a. C a => a -> a -> a
(+))
            (a -> a -> a -> [a]
partial a
0.00311 a
0.0 a
20)
            (a -> a -> a -> [a]
partial a
0.00532 a
0.3 a
17)
            (a -> a -> a -> [a]
partial a
0.00981 a
0.9  a
6)

osciDoubleSaw :: (RealField.C a, Module.C a a) => a -> [a] -> [a]
osciDoubleSaw :: forall a. (C a, C a a) => a -> [a] -> [a]
osciDoubleSaw a
sampleRate =
    T a a -> [a] -> a -> [a] -> [a]
forall a b. C a => T a b -> [b] -> a -> T a -> [b]
Osci.freqModSample T a a
forall t y. C t y => T t y
Interpolation.linear [-a
1, -a
0.2, a
0.5, -a
0.5, a
0.2, a
1.0] a
0
      ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)


{-| A tone with a waveform with roughly the dependency x -> x**p,
    where the waveform is normalized to constant quadratic norm -}
osciSharp :: (RealField.C a, Trans.C a) => a -> a -> [a]
osciSharp :: forall a. (C a, C a) => a -> a -> [a]
osciSharp a
sampleRate a
freq =
   let --control = iterate (+ (-1/sampleRate)) 4
       control :: T a
control = a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
0.01a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
10
   in  (a -> T a a) -> a -> a -> T a -> T a
forall a c b. C a => (c -> T a b) -> a -> a -> T c -> T b
Osci.shapeMod a -> T a a
forall a. (C a, C a) => a -> T a a
Wave.powerNormed2 a
0 (a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate) T a
control

{-| Build a saw sound from its harmonics and modulate it.
    Different to normal modulation
    I modulate each harmonic with the same depth rather than a proportional one. -}
osciAbsModSaw :: (RealField.C a, Trans.C a) => a -> a -> [a]
osciAbsModSaw :: forall a. (C a, C a) => a -> a -> [a]
osciAbsModSaw a
sampleRate a
freq =
   let ratios :: [a]
ratios     = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral [(Int
1::Int)..Int
20]
       harmonic :: a -> [a]
harmonic a
n = a -> [a] -> [a]
forall a. C a => a -> T a -> T a
FiltNR.amplify (a
0.25a -> a -> a
forall a. C a => a -> a -> a
/a
n)
          (a -> [a] -> [a]
forall a. (C a, C a) => a -> T a -> T a
Osci.freqModSine a
0 ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
na -> a -> a
forall a. C a => a -> a -> a
+a
0.03a -> a -> a
forall a. C a => a -> a -> a
*a
x)a -> a -> a
forall a. C a => a -> a -> a
*a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)
                              (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
0 (a
1a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))))
   in  [[a]] -> [a]
forall v. C v => [T v] -> T v
mixMulti ((a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [a]
harmonic [a]
ratios)

{-| Short pulsed Noise.white,
    i.e. Noise.white amplified with pulses of varying H\/L ratio. -}
pulsedNoise :: (Ring.C a, Random a, RealField.C a, Trans.C a) =>
       a
   ->  a   {-^ frequency of the pulses, interesting ones are around 100 Hz and below -}
   -> [a]
pulsedNoise :: forall a. (C a, Random a, C a, C a) => a -> a -> [a]
pulsedNoise a
sampleRate a
freq =
   (a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\a
thr0 a
thr1 a
x -> if a
thr0a -> a -> a
forall a. C a => a -> a -> a
+a
1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< (a
thr1a -> a -> a
forall a. C a => a -> a -> a
+a
1)a -> a -> a
forall a. C a => a -> a -> a
*a
0.2 then a
x else a
0)
            (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
0 (a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)) (a -> a -> [a]
forall a. (C a, C a) => a -> a -> T a
Osci.staticSine a
0 (a
0.1a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)) [a]
forall y. (C y, Random y) => T y
Noise.white

noiseBass :: (Ring.C a, Random a, RealField.C a, Trans.C a, Module.C a a) =>
       a
   ->  a
   -> [a]
noiseBass :: forall a. (C a, Random a, C a, C a, C a a) => a -> a -> [a]
noiseBass a
sampleRate a
freq =
   let y :: T a
y  = T a -> T a -> T a
forall a. C a => T a -> T a -> T a
FiltNR.envelope (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
0.1a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
1) T a
forall y. (C y, Random y) => T y
Noise.white
       ks :: T a
ks = Int -> (T a -> T a) -> T a -> T a
forall v. C v => Int -> (T v -> T v) -> T v -> T v
Comb.runProc (a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
round (a
sampleRatea -> a -> a
forall a. C a => a -> a -> a
/a
freq))
               (T (Parameter a) -> T a -> T a
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
Filt1.lowpass
                   (Parameter a -> T (Parameter a)
forall a. a -> [a]
repeat (a -> Parameter a
forall a. C a => a -> Parameter a
Filt1.parameter (a
2000a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)))) T a
y
   in  T a
ks

{-| Drum sound using the Karplus-Strong-Algorithm
    This is a Noise.white enveloped by an exponential2
    which is piped through the Karplus-Strong machine
    for generating some frequency.
    The whole thing is then frequency modulated
    to give a falling frequency. -}
electroTom :: (Ring.C a, Random a, RealField.C a, Trans.C a, Module.C a a) =>
   a -> [a]
electroTom :: forall a. (C a, Random a, C a, C a, C a a) => a -> [a]
electroTom a
sampleRate =
   let y :: T a
y  = T a -> T a -> T a
forall a. C a => T a -> T a -> T a
FiltNR.envelope (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
0.1a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
1) T a
forall y. (C y, Random y) => T y
Noise.white
       ks :: T a
ks = Int -> (T a -> T a) -> T a -> T a
forall v. C v => Int -> (T v -> T v) -> T v -> T v
Comb.runProc (a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
round (a
sampleRatea -> a -> a
forall a. C a => a -> a -> a
/a
30))
                     (T (Parameter a) -> T a -> T a
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
Filt1.lowpass
                         (Parameter a -> T (Parameter a)
forall a. a -> [a]
repeat (Parameter a -> T (Parameter a)) -> Parameter a -> T (Parameter a)
forall a b. (a -> b) -> a -> b
$ a -> Parameter a
forall a. C a => a -> Parameter a
Filt1.parameter (a
1000a -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))) T a
y
   in  a -> T a -> T a -> T a
forall t y. (C t, C t y) => t -> T t -> T y -> T y
Interpolation.multiRelativeZeroPadLinear a
0 (a -> a -> T a
forall y. C y => y -> y -> T y
exponential2 (a
0.3a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
1) T a
ks