{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.Plain.Effect.Fly where

import qualified Synthesizer.Causal.Spatial as Spatial
import qualified Synthesizer.Causal.Process as Causal

import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR
import qualified Synthesizer.Plain.Interpolation as Interpolation

import qualified Synthesizer.Plain.File as File
import System.Exit(ExitCode)

import System.Random (randomRs, mkStdGen, )

import qualified Algebra.NormedSpace.Euclidean as Euc

import NumericPrelude.Numeric
import NumericPrelude.Base


{-
  ghc -O -fvia-C --make Fly.hs && echo start && time a.out
-}

main :: IO ExitCode
main :: IO ExitCode
main =
   FilePath -> Double -> [(Double, Double)] -> IO ExitCode
forall a. C a => FilePath -> a -> [(a, a)] -> IO ExitCode
File.writeStereoToInt16 FilePath
"Fly" Double
sampleRate
      (Int -> [(Double, Double)] -> [(Double, Double)]
forall a. Int -> [a] -> [a]
take (Double -> Int
forall b. C b => Double -> b
forall a b. (C a, C b) => a -> b
round (Double
10Double -> Double -> Double
forall a. C a => a -> a -> a
*Double
sampleRate)) [(Double, Double)]
fly)

sampleRate :: Double
sampleRate :: Double
sampleRate = Double
44100

{- | stereo sound of a humming fly -}
fly :: [(Double,Double)]
fly :: [(Double, Double)]
fly =
   let pinkNoise :: Int -> Double -> y -> T y
pinkNoise Int
seed Double
freq y
range =
           Double -> T Double -> T y -> T y
forall t y. (C t, C t y) => t -> T t -> T y -> T y
Interpolation.multiRelativeZeroPadCubic (Double
0::Double)
           (Double -> T Double
forall a. a -> [a]
repeat (Double
freqDouble -> Double -> Double
forall a. C a => a -> a -> a
/Double
sampleRate))
           ((y, y) -> StdGen -> T y
forall g. RandomGen g => (y, y) -> g -> T y
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (-y
range,y
range) (Int -> StdGen
mkStdGen Int
seed))
       {- the track of a fly is composed of a slow motion over a big range
          and fast but small oscillations -}
       flyCoord :: Int -> [c]
flyCoord Int
seed = (c -> c -> c) -> [c] -> [c] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith c -> c -> c
forall a. C a => a -> a -> a
(+) (Int -> Double -> c -> [c]
forall {y}. (C Double y, Random y) => Int -> Double -> y -> T y
pinkNoise Int
seed Double
40 c
0.3)
                                   (Int -> Double -> c -> [c]
forall {y}. (C Double y, Random y) => Int -> Double -> y -> T y
pinkNoise Int
seed  Double
1 c
10)
       {- explicit signature required
          because of multi-param type class NormedEuc -}
       trajectory :: [(Double, Double, Double)]
       trajectory :: [(Double, Double, Double)]
trajectory =
          T Double -> T Double -> T Double -> [(Double, Double, Double)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (Int -> T Double
forall {c}. (C Double c, Random c, C c) => Int -> [c]
flyCoord Int
366210)
               (Int -> T Double
forall {c}. (C Double c, Random c, C c) => Int -> [c]
flyCoord Int
234298)
               (Int -> T Double
forall {c}. (C Double c, Random c, C c) => Int -> [c]
flyCoord Int
654891)

       channel :: (Double, Double, Double) -> T Double
channel (Double, Double, Double)
ear =
          let (T Double
phase,T Double
volumes) =
                 [(Double, Double)] -> (T Double, T Double)
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Double, Double)] -> (T Double, T Double))
-> [(Double, Double)] -> (T Double, T Double)
forall a b. (a -> b) -> a -> b
$ T (Double, Double, Double) (Double, Double)
-> [(Double, Double, Double)] -> [(Double, Double)]
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
Causal.apply (Double
-> Double
-> (Double, Double, Double)
-> T (Double, Double, Double) (Double, Double)
forall a v (arrow :: * -> * -> *).
(C a, C a v, Arrow arrow) =>
a -> a -> v -> arrow v (a, a)
Spatial.moveAround Double
1 Double
0.1 (Double, Double, Double)
ear) [(Double, Double, Double)]
trajectory
              -- (*sampleRate) in 'speed' and
              -- (/sampleRate) in 'freqs' neutralizes
              speeds :: T Double
speeds  = ((Double, Double, Double) -> Double)
-> [(Double, Double, Double)] -> T Double
forall a b. (a -> b) -> [a] -> [b]
map (\(Double, Double, Double)
v -> Double
250Double -> Double -> Double
forall a. C a => a -> a -> a
/Double
sampleRate Double -> Double -> Double
forall a. C a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. C a => a -> a -> a
* (Double, Double, Double) -> Double
forall a v. C a v => v -> a
Euc.norm (Double, Double, Double)
v)
                            ([(Double, Double, Double)] -> [(Double, Double, Double)]
forall v. C v => T v -> T v
FiltNR.differentiate [(Double, Double, Double)]
trajectory)
              freqs :: T Double
freqs   = (Double -> Double -> Double) -> T Double -> T Double -> T Double
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. C a => a -> a -> a
(+) T Double
speeds (T Double -> T Double
forall v. C v => T v -> T v
FiltNR.differentiate T Double
phase)
              sound :: T Double
sound   = Double -> T Double -> T Double
forall a. C a => a -> T a -> T a
Osci.freqModSaw Double
0 T Double
freqs
          in  (Double -> Double -> Double) -> T Double -> T Double -> T Double
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. C a => a -> a -> a
(*) ((Double -> Double) -> T Double -> T Double
forall a b. (a -> b) -> [a] -> [b]
map (Double
10Double -> Double -> Double
forall a. C a => a -> a -> a
*) T Double
volumes) T Double
sound

   in  T Double -> T Double -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Double, Double, Double) -> T Double
channel (-Double
1,Double
0,Double
0)) ((Double, Double, Double) -> T Double
channel (Double
1,Double
0,Double
0))