{-# 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.Phase      as Phase
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 Data.Maybe (fromMaybe)

import NumericPrelude.Base
import NumericPrelude.Numeric



{-* 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 :: (RealField.C a, Trans.C a, Module.C a a) => a -> [a]
guitarRawVelo velo =
   let len  = 128::Int
       wave =
          map
            (Wave.apply (Wave.powerNormed velo))
            (take len
               (iterate (Phase.increment (1 / fromIntegral len)) zero))
       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))