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