{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
module Effect where

import qualified Haskore.Basic.TimeOrderedList as TimeList
import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Plain.Cut        as Cut
import qualified Synthesizer.Plain.Control    as Ctrl
import qualified Synthesizer.Plain.Noise      as Noise
import qualified Synthesizer                  as Syn

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

import System.Random(randomRs,mkStdGen)

import PreludeBase
import NumericPrelude as NP

import qualified Prelude as P


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

particles :: Double -> Double -> TimeList.T Int [Double]
particles sampleRate freq =
   let sampledDensity =
          (2000/sampleRate) *> map densityHeavy [0, (1/sampleRate) ..]
       pattern = take (round (0.8*sampleRate))
                      (Noise.randomPeeks sampledDensity)
       times   = timeDiffs pattern
       chirp   = iterate (0.001+) 0
       pitches = map ((freq*) . (2**))
                     (zipWith (+) chirp (randomRs (0,1) (mkStdGen 56)))
       amps    = map (0.4*) (map (2**) (randomRs (-2,0) (mkStdGen 721)))
   in  zipWith TimeList.Event times
               (zipWith (particle sampleRate) pitches amps)


particle :: (RealFrac a, Trans.C a, Module.C a a) => a -> a -> a -> [a]
particle sampleRate freq amp =
   let halfLife = 0.01
   in  take (round (10*halfLife*sampleRate))
            (Syn.envelope (Osci.static Osci.waveSquare 0 (freq/sampleRate))
                          (Ctrl.exponential2 (0.01*sampleRate) amp))

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

timeDiffs :: [Bool] -> [Int]
timeDiffs =
   let diffs n (True  : xs) = n : diffs 1 xs
       diffs n (False : xs) = diffs (n+1) xs
       diffs _ [] = []
   in  diffs 0
