{-# 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 =
   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
2000forall a. C a => a -> a -> a
/Double
sampleRate) forall a v. C a v => a -> v -> v
*> forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => a -> a
densityHeavy [Double
0, (Double
1forall a. C a => a -> a -> a
/Double
sampleRate) ..]
       pattern :: [Bool]
pattern = forall a. Int -> [a] -> [a]
take (forall a b. (C a, C b) => a -> b
round (Double
0.8forall a. C a => a -> a -> a
*Double
sampleRate))
                      (forall y. (C y, Random y) => T y -> [Bool]
Noise.randomPeeks [Double]
sampledDensity)
       times :: [Int]
times   = [Bool] -> [Int]
timeDiffs [Bool]
pattern
       chirp :: [Double]
chirp   = forall a. (a -> a) -> a -> [a]
iterate (Double
0.001forall a. C a => a -> a -> a
+) Double
0
       pitches :: [Double]
pitches = forall a b. (a -> b) -> [a] -> [b]
map ((Double
freqforall a. C a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
2forall a. C a => a -> a -> a
**))
                     (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. C a => a -> a -> a
(+) [Double]
chirp (forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Double
0,Double
1) (Int -> StdGen
mkStdGen Int
56)))
       amps :: [Double]
amps    = forall a b. (a -> b) -> [a] -> [b]
map (Double
0.4forall a. C a => a -> a -> a
*) (forall a b. (a -> b) -> [a] -> [b]
map (Double
2forall a. C a => a -> a -> a
**) (forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (-Double
2,Double
0) (Int -> StdGen
mkStdGen Int
721)))
   in  forall a b. [(a, b)] -> T a b
EventList.fromPairList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
times forall a b. (a -> b) -> a -> b
$
       forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (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  forall a. Int -> [a] -> [a]
take (forall a b. (C a, C b) => a -> b
round (a
10forall a. C a => a -> a -> a
*a
halfLifeforall a. C a => a -> a -> a
*a
sampleRate))
            (forall a v. C a v => T a -> T v -> T v
FiltNR.envelopeVector
                (forall a b. C a => T a b -> a -> a -> T b
Osci.static forall a. (Ord a, C a) => T a a
Wave.square a
0 (a
freqforall a. C a => a -> a -> a
/a
sampleRate))
                (forall y. C y => y -> y -> T y
Ctrl.exponential2 (a
0.01forall 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 forall a. C a => a -> a -> a
* forall a. C a => a -> a
exp(-a
10forall a. C a => a -> a -> a
*a
xforall a. C a => a -> a -> a
*a
x)
densityHeavy :: forall a. C a => a -> a
densityHeavy  a
x = a
0.4 forall a. C a => a -> a -> a
* forall a. C a => a -> a
exp (-a
4forall 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 forall a. a -> [a] -> [a]
: t -> [Bool] -> [t]
diffs t
1 [Bool]
xs
       diffs t
n (Bool
False : [Bool]
xs) = t -> [Bool] -> [t]
diffs (forall a. Enum a => a -> a
succ t
n) [Bool]
xs
       diffs t
_ [] = []
   in  forall {t}. (C t, Enum t) => t -> [Bool] -> [t]
diffs (forall a. (Ord a, C a) => a -> T a
NonNeg.fromNumber Int
0)

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