synthesizer-0.0.3: src/Filter/Example.hs
{-# OPTIONS -fno-implicit-prelude #-}
module Filter.Example where
import Filter.Basic
import qualified Filter.OneWay
import qualified Filter.TwoWay
import Filter.Composition
import qualified Filter.Graph
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1
import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Real as Real
import Data.Maybe (fromMaybe)
import PreludeBase
import NumericPrelude
{-* Reconstruction of the sound of a plucked guitar string -}
guitarInit :: Field.C a => [a]
guitarInit = map (/128) (
1 : 1 : 1 : 1 : 1 : 1 : 1 : 1 :
1 : 2 : 2 : 2 : 2 : 2 : 2 : 2 :
2 : 2 : 2 : 2 : 2 : 2 : 2 : 2 :
2 : 2 : 2 : 3 : 3 : 3 : 3 : 3 :
3 : 3 : 3 : 3 : 3 : 3 : 3 : 3 :
3 : 3 : 3 : 4 : 4 : 4 : 4 : 4 :
4 : 4 : 4 : 4 : 4 : 4 : 4 : 4 :
5 : 5 : 5 : 5 : 5 : 5 : 5 : 5 :
6 : 6 : 6 : 7 : 7 : 8 : 8 : 9 :
10 : 11 : 12 : 13 : 14 : 15 : 15 : 16 :
17 : 17 : 17 : 18 : 18 : 18 : 18 : 18 :
18 : 18 : 18 : 17 : 17 : 16 : 16 : 15 :
15 : 14 : 14 : 14 : 13 : 13 : 14 : 14 :
15 : 16 : 17 : 18 : 19 : 20 : 22 : 23 :
25 : 27 : 30 : 32 : 35 : 37 : 39 : 41 :
43 : 45 : 47 : 48 : 49 : 49 : 48 : 46 :
41 : 34 : 24 : 11 : -6 : -26 : -48 : -72 :
-96 : -114 : -128 : -128 : -128 : -128 : -128 : -128 :
-128 : -125 : -110 : -93 : -75 : -57 : -41 : -27 :
-17 : -10 : -6 : -4 : -2 : -2 : -2 : -2 :
-2 : -3 : -4 : -4 : -5 : -6 : -7 : -8 :
-9 : -10 : -11 : -12 : -12 : -12 : -13 : -13 :
-13 : -13 : -13 : -13 : -12 : -12 : -11 : -10 :
-9 : -9 : -8 : -8 : -7 : -6 : -6 : -5 :
-5 : -5 : -5 : -4 : -4 : -4 : -4 : -4 :
-4 : -4 : -4 : -4 : -4 : -5 : -7 : -8 :
-8 : -9 : -10 : -11 : -12 : -13 : -13 : -14 :
-14 : -14 : -13 : -10 : -7 : -2 : 5 : 15 :
26 : 37 : 49 : 61 : 73 : 83 : 92 : 99 :
105 : 109 : 111 : 112 : 110 : 105 : 99 : 90 :
80 : 71 : 63 : 57 : 52 : 49 : 47 : 47 :
48 : 49 : 51 : 51 : 52 : 52 : 50 : 48 :
42 : 34 : 22 : 7 : -12 : -32 : -56 : -78 :
-96 : -114 : -127 : -128 : -128 : -128 : -128 : -128 :
-128 : -118 : -102 : -83 : -67 : -50 : -37 : -26 :
-17 : -12 : -8 : -5 : -3 : -3 : -2 : -2 :
-2 : -3 : -4 : -4 : -6 : -7 : -8 : -10 :
-11 : -12 : -12 : -13 : [])
guitarCompShort, guitarCompLong ::
Field.C a => [a] -> Filter.Composition.T Filter.TwoWay.T Double a a
guitarCompShort past = Feedback (Prim (Filter.TwoWay.Past past)) (Parallel [
Serial [Prim (Filter.TwoWay.Delay 1),
Prim (Filter.TwoWay.Mask [0.6519177892575342, 0.2331904728998289])],
Serial [Prim (Filter.TwoWay.Delay 126),
Prim (Filter.TwoWay.Mask [0.08253506238277844,
0.2369601607320473, 0.18367848836060044,
-0.06422525077173147, -0.31836517142623727])]])
guitarCompLong past = Feedback (Prim (Filter.TwoWay.Past past)) (
Serial [Prim (Filter.TwoWay.Delay 122),
Prim (Filter.TwoWay.Mask [
-0.23742303494466988,
0.020278040917954415,
0.12495333789385828,
0.16125537461091102,
0.1993410924766678,
0.24673057006071691,
0.25438881375430467,
0.1424676847770117,
0.03848071949084291,
-0.016618282409355676,
-0.04517323927531556,
-0.0061713683480988475,
0.11137126130878339
])])
{-| Reconstruct the guitar sound from the sampled initial wave
and the analysed feedback factors.
This sounds pretty like the sampled sound. -}
guitarRaw :: (Field.C a, Module.C a a) => [a]
guitarRaw =
let gi = guitarInit -- assert monomorphism
y = Filter.TwoWay.future
(Filter.TwoWay.delay (length gi)
(apply (guitarCompLong (reverse gi))
(Filter.TwoWay.Signal [] [])))
in y
{-| Reconstruct the guitar sound from the sampled initial wave
but with simple smoothing on feedback.
This sounds more statically. -}
guitarRawSimple :: (Field.C a, Module.C a a) => [a]
guitarRawSimple =
let gi = guitarInit -- assert monomorphism
y = gi ++ drop (length gi)
(FiltNR.delay 128 (Filt1.lowpass
(repeat (Filt1.Parameter (0.4 `asTypeOf` head y))) y))
in y
{-| Reconstruct the guitar sound with the analysed feedback factors
but with an synthetic initial wave.
The sharpness of the initial wave can be controlled.
This is used to implement various velocities. -}
guitarRawVelo :: (Real.C a, Trans.C a, Module.C a a) => a -> [a]
guitarRawVelo velo =
let len = 128::Int
wave =
map (Wave.power01Normed velo)
(take len (iterate (+ 2 / fromIntegral len) (-1)))
y = Filter.TwoWay.future
(Filter.TwoWay.delay len
(apply (guitarCompLong wave)
(Filter.TwoWay.Signal [] [])))
in y
{-| Resample the reconstructed string sound
so that notes can be played. -}
guitar :: (RealField.C a, Module.C a a) => a -> [a]
guitar freq =
let srcFreq = 128 * freq
in Interpolation.multiRelativeZeroPadLinear 0
(repeat (srcFreq `asTypeOf` freq)) guitarRawSimple
{-* Tests for FilterGraphs -}
type CompositionDouble =
Filter.Composition.T Filter.TwoWay.T Double Double Double
{-| a simple lowpass used to create an exponential2 -}
--expo :: (RealField.C a, Module.C a a) => Filter.TwoWay.Signal a
expo :: Filter.TwoWay.Signal Double
expo =
let _flt1 = Feedback (Serial [Prim (Filter.OneWay.Delay ([0] `asTypeOf` past))])
(Serial [Prim (Filter.OneWay.Mask
([0.9] `asTypeOf` past))])
_flt2 = (Prim (Filter.TwoWay.Mask ([0.5] `asTypeOf` past)))
:: CompositionDouble
flt3 = (Feedback (Serial [])
(Prim (Filter.TwoWay.Delay 1)))
:: CompositionDouble
Filter.TwoWay.Signal past future = apply flt3 (Filter.TwoWay.Signal [] [1])
in Filter.TwoWay.Signal past (take 10 future)
type GraphDouble f = Filter.Graph.T f Int Double Double Double
simpleGraph :: Filter.TwoWay.Signal Double
simpleGraph =
let out =
Filter.Graph.apply
(Filter.Graph.fromList
[(0, []),
(1, [(0, Filter.TwoWay.Delay (-1))]),
(2, [(1, Filter.TwoWay.Mask [0.95])])] ::
GraphDouble Filter.TwoWay.T)
(Filter.Graph.signalFromList
[(0, Filter.TwoWay.Signal [] [1])])
in fromMaybe (error "requested output of non-existing socket")
(Filter.Graph.lookupSignal out (2::Int))
expoGraphTwoWay :: [Double]
expoGraphTwoWay =
let out =
Filter.Graph.apply
(Filter.Graph.fromList
[(0, [(2, Filter.TwoWay.Past [1])]),
(1, [(0, Filter.TwoWay.Delay 1)]),
(2, [(1, Filter.TwoWay.Mask [0.95])])] ::
GraphDouble Filter.TwoWay.T)
(Filter.Graph.signalFromList
[(0, Filter.TwoWay.Signal [] [])])
in Filter.TwoWay.take 20 $ Filter.TwoWay.delay 10
(fromMaybe (error "requested output of non-existing socket")
(Filter.Graph.lookupSignal out (0::Int)))
expoGraph :: [Double]
expoGraph =
let out =
Filter.Graph.apply
(Filter.Graph.fromList
[(0, [(1, Filter.OneWay.Delay [0])]),
(1, [(0, Filter.OneWay.Mask [0.99])])] ::
GraphDouble Filter.OneWay.T)
(Filter.Graph.signalFromList
[(0, [1])])
in fromMaybe (error "requested output of non-existing socket")
(Filter.Graph.lookupSignal out (0::Int))
{-| make recursive flanger with help of the two way interpolation -}
flangedSaw :: Double -> [Double]
flangedSaw sampleRate =
let {- The flanger's principal filter frequency will vary between
flangeFreq * 2**flangeRange and flangeFreq / 2**flangeRange -}
flangeFreq = 1000
flangeRange = 2
sawFreq = 440
gain = 0.6
vol = 0.5
{- 'control' contains the feedback times -}
control = map (\c -> sampleRate/flangeFreq * 2**(-flangeRange*c))
(map sin (iterate (pi/(0.5*sampleRate)+) 0))
sawPast = Osci.freqModSaw 0 (repeat (-sawFreq/sampleRate))
sawFuture = Osci.freqModSaw 0 (repeat ( sawFreq/sampleRate))
--lowNoise = amplify vol noise
flt = Feedback
(Prim (Filter.TwoWay.Mask [vol]))
(Serial [Prim (Filter.TwoWay.Mask [gain]),
Prim (Filter.TwoWay.Past []),
Prim (Filter.TwoWay.ModFracDelay
Interpolation.linear
(Filter.TwoWay.Signal [] control))])
:: CompositionDouble
in Filter.TwoWay.future
(apply flt (Filter.TwoWay.Signal sawPast sawFuture))