{-# 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
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