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
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
])])
guitarRaw :: (Field.C a, Module.C a a) => [a]
guitarRaw =
let gi = guitarInit
y = Filter.TwoWay.future
(Filter.TwoWay.delay (length gi)
(apply (guitarCompLong (reverse gi))
(Filter.TwoWay.Signal [] [])))
in y
guitarRawSimple :: (Field.C a, Module.C a a) => [a]
guitarRawSimple =
let gi = guitarInit
y = gi ++ drop (length gi)
(FiltNR.delay 128 (Filt1.lowpass
(repeat (Filt1.Parameter (0.4 `asTypeOf` head y))) y))
in y
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
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
type CompositionDouble =
Filter.Composition.T Filter.TwoWay.T Double Double Double
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))
flangedSaw :: Double -> [Double]
flangedSaw sampleRate =
let
flangeFreq = 1000
flangeRange = 2
sawFreq = 440
gain = 0.6
vol = 0.5
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))
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))