{-# LANGUAGE NoImplicitPrelude #-} module Synthesizer.Filter.Example where import qualified Synthesizer.Filter.OneWay as OneWay import qualified Synthesizer.Filter.TwoWay as TwoWay import qualified Synthesizer.Filter.Composition as Composition import qualified Synthesizer.Filter.Graph as Graph import qualified Synthesizer.Plain.Interpolation as Interpolation import Synthesizer.Filter.Basic (apply, ) import Synthesizer.Filter.Composition (T(..)) 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] -> Composition.T TwoWay.T Double a a guitarCompShort past = Feedback (Prim (TwoWay.Past past)) (Parallel [ Serial [Prim (TwoWay.Delay 1), Prim (TwoWay.Mask [0.6519177892575342, 0.2331904728998289])], Serial [Prim (TwoWay.Delay 126), Prim (TwoWay.Mask [0.08253506238277844, 0.2369601607320473, 0.18367848836060044, -0.06422525077173147, -0.31836517142623727])]]) guitarCompLong past = Feedback (Prim (TwoWay.Past past)) ( Serial [Prim (TwoWay.Delay 122), Prim (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 = TwoWay.future (TwoWay.delay (length gi) (apply (guitarCompLong (reverse gi)) (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 = TwoWay.future (TwoWay.delay len (apply (guitarCompLong wave) (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 = Composition.T TwoWay.T Double Double Double {-| a simple lowpass used to create an exponential2 -} --expo :: (RealField.C a, Module.C a a) => TwoWay.Signal a expo :: TwoWay.Signal Double expo = let _flt1 = Feedback (Serial [Prim (OneWay.Delay ([0] `asTypeOf` past))]) (Serial [Prim (OneWay.Mask ([0.9] `asTypeOf` past))]) _flt2 = (Prim (TwoWay.Mask ([0.5] `asTypeOf` past))) :: CompositionDouble flt3 = (Feedback (Serial []) (Prim (TwoWay.Delay 1))) :: CompositionDouble TwoWay.Signal past future = apply flt3 (TwoWay.Signal [] [1]) in TwoWay.Signal past (take 10 future) type GraphDouble f = Graph.T f Int Double Double Double simpleGraph :: TwoWay.Signal Double simpleGraph = let out = Graph.apply (Graph.fromList [(0, []), (1, [(0, TwoWay.Delay (-1))]), (2, [(1, TwoWay.Mask [0.95])])] :: GraphDouble TwoWay.T) (Graph.signalFromList [(0, TwoWay.Signal [] [1])]) in fromMaybe (error "requested output of non-existing socket") (Graph.lookupSignal out (2::Int)) expoGraphTwoWay :: [Double] expoGraphTwoWay = let out = Graph.apply (Graph.fromList [(0, [(2, TwoWay.Past [1])]), (1, [(0, TwoWay.Delay 1)]), (2, [(1, TwoWay.Mask [0.95])])] :: GraphDouble TwoWay.T) (Graph.signalFromList [(0, TwoWay.Signal [] [])]) in TwoWay.take 20 $ TwoWay.delay 10 (fromMaybe (error "requested output of non-existing socket") (Graph.lookupSignal out (0::Int))) expoGraph :: [Double] expoGraph = let out = Graph.apply (Graph.fromList [(0, [(1, OneWay.Delay [0])]), (1, [(0, OneWay.Mask [0.99])])] :: GraphDouble OneWay.T) (Graph.signalFromList [(0, [1])]) in fromMaybe (error "requested output of non-existing socket") (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 (TwoWay.Mask [vol])) (Serial [Prim (TwoWay.Mask [gain]), Prim (TwoWay.Past []), Prim (TwoWay.ModFracDelay Interpolation.linear (TwoWay.Signal [] control))]) :: CompositionDouble in TwoWay.future (apply flt (TwoWay.Signal sawPast sawFuture))