{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.Effect.Glass (glass) where

import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Number.NonNegative as NonNeg

import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Basic.Wave       as Wave
import qualified Synthesizer.Plain.Cut        as Cut
import qualified Synthesizer.Plain.Control    as Ctrl
import qualified Synthesizer.Plain.Noise      as Noise
import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR

import System.Random(randomRs, mkStdGen)

import qualified Data.List.HT as ListHT

import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField      as RealField
import qualified Algebra.Module         as Module

import NumericPrelude.Numeric
import NumericPrelude.Base as NP


{- | We try to simulate the sound of broken glass
     as a mixture of short percussive sounds with random pitch -}
glass :: Double -> [Double]
glass :: Double -> [Double]
glass Double
sampleRate =
   T Int [Double] -> [Double]
forall v. C v => T Int (T v) -> T v
Cut.arrange (Double -> Double -> T Int [Double]
particles Double
sampleRate Double
1500)

particles :: Double -> Double -> EventList.T NonNeg.Int [Double]
particles :: Double -> Double -> T Int [Double]
particles Double
sampleRate Double
freq =
   let sampledDensity :: [Double]
sampledDensity =
          (Double
2000Double -> Double -> Double
forall a. C a => a -> a -> a
/Double
sampleRate) Double -> [Double] -> [Double]
forall a v. C a v => a -> v -> v
*> (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. C a => a -> a
densityHeavy [Double
0, (Double
1Double -> Double -> Double
forall a. C a => a -> a -> a
/Double
sampleRate) ..]
       pattern :: [Bool]
pattern = Int -> [Bool] -> [Bool]
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
0.8Double -> Double -> Double
forall a. C a => a -> a -> a
*Double
sampleRate))
                      ([Double] -> [Bool]
forall y. (C y, Random y) => T y -> [Bool]
Noise.randomPeeks [Double]
sampledDensity)
       times :: [Int]
times   = [Bool] -> [Int]
timeDiffs [Bool]
pattern
       chirp :: [Double]
chirp   = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double
0.001Double -> Double -> Double
forall a. C a => a -> a -> a
+) Double
0
       pitches :: [Double]
pitches = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Double
freqDouble -> Double -> Double
forall a. C a => a -> a -> a
*) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
2Double -> Double -> Double
forall a. C a => a -> a -> a
**))
                     ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. C a => a -> a -> a
(+) [Double]
chirp ((Double, Double) -> StdGen -> [Double]
forall g. RandomGen g => (Double, Double) -> g -> [Double]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Double
0,Double
1) (Int -> StdGen
mkStdGen Int
56)))
       amps :: [Double]
amps    = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double
0.4Double -> Double -> Double
forall a. C a => a -> a -> a
*) ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double
2Double -> Double -> Double
forall a. C a => a -> a -> a
**) ((Double, Double) -> StdGen -> [Double]
forall g. RandomGen g => (Double, Double) -> g -> [Double]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (-Double
2,Double
0) (Int -> StdGen
mkStdGen Int
721)))
   in  [(Int, [Double])] -> T Int [Double]
forall a b. [(a, b)] -> T a b
EventList.fromPairList ([(Int, [Double])] -> T Int [Double])
-> [(Int, [Double])] -> T Int [Double]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Double]] -> [(Int, [Double])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
times ([[Double]] -> [(Int, [Double])])
-> [[Double]] -> [(Int, [Double])]
forall a b. (a -> b) -> a -> b
$
       (Double -> Double -> [Double])
-> [Double] -> [Double] -> [[Double]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Double -> Double -> Double -> [Double]
forall a. (C a, C a, C a a) => a -> a -> a -> [a]
particle Double
sampleRate) [Double]
pitches [Double]
amps


particle :: (RealField.C a, Trans.C a, Module.C a a) => a -> a -> a -> [a]
particle :: forall a. (C a, C a, C a a) => a -> a -> a -> [a]
particle a
sampleRate a
freq a
amp =
   let halfLife :: a
halfLife = a
0.01
   in  Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
round (a
10a -> a -> a
forall a. C a => a -> a -> a
*a
halfLifea -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate))
            ([a] -> [a] -> [a]
forall a v. C a v => T a -> T v -> T v
FiltNR.envelopeVector
                (T a a -> a -> a -> [a]
forall a b. C a => T a b -> a -> a -> T b
Osci.static T a a
forall a. (Ord a, C a) => T a a
Wave.square a
0 (a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate))
                (a -> a -> [a]
forall y. C y => y -> y -> T y
Ctrl.exponential2 (a
0.01a -> a -> a
forall a. C a => a -> a -> a
*a
sampleRate) a
amp))

_densitySmooth, densityHeavy :: Trans.C a => a -> a
_densitySmooth :: forall a. C a => a -> a
_densitySmooth a
x = a
x a -> a -> a
forall a. C a => a -> a -> a
* a -> a
forall a. C a => a -> a
exp(-a
10a -> a -> a
forall a. C a => a -> a -> a
*a
xa -> a -> a
forall a. C a => a -> a -> a
*a
x)
densityHeavy :: forall a. C a => a -> a
densityHeavy  a
x = a
0.4 a -> a -> a
forall a. C a => a -> a -> a
* a -> a
forall a. C a => a -> a
exp (-a
4a -> a -> a
forall a. C a => a -> a -> a
*a
x)

_timeDiffs :: [Bool] -> [NonNeg.Int]
_timeDiffs :: [Bool] -> [Int]
_timeDiffs =
   let diffs :: t -> [Bool] -> [t]
diffs t
n (Bool
True  : [Bool]
xs) = t
n t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [Bool] -> [t]
diffs t
1 [Bool]
xs
       diffs t
n (Bool
False : [Bool]
xs) = t -> [Bool] -> [t]
diffs (t -> t
forall a. Enum a => a -> a
succ t
n) [Bool]
xs
       diffs t
_ [] = []
   in  Int -> [Bool] -> [Int]
forall {t}. (C t, Enum t) => t -> [Bool] -> [t]
diffs (Int -> Int
forall a. (Ord a, C a) => a -> T a
NonNeg.fromNumber Int
0)

timeDiffs :: [Bool] -> [NonNeg.Int]
timeDiffs :: [Bool] -> [Int]
timeDiffs = ([Bool] -> Int) -> [[Bool]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
forall a. (Ord a, C a) => a -> T a
NonNeg.fromNumber (Int -> Int) -> ([Bool] -> Int) -> [Bool] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Bool]] -> [Int]) -> ([Bool] -> [[Bool]]) -> [Bool] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> [Bool] -> [[Bool]]
forall a. (a -> Bool) -> [a] -> [[a]]
ListHT.segmentBefore Bool -> Bool
forall a. a -> a
id