1 {-# LANGUAGE DataKinds #-}
3 import Data.List (unfoldr)
7 import qualified Deque.Strict as DQ
10 :: (StdGen -> Maybe (Pulse, StdGen)) -- ^ how to initialize each entry of the initial buffer
11 -> (StdGen -> Pulse -> Pulse -> (Pulse, StdGen)) -- ^ slide step
12 -> Int -- ^ sample rate
13 -> (Hz -> Sound 'I Pulse) -- ^ instrument
14 karplusStrong genPulse f sampleRate freq =
15 let -- we generate s[0], ..., s[T-1]
16 waveTable = take waveTableLen $ unfoldr genPulse gen
17 -- construct our deque with those elements
18 deque0 = DQ.fromConsAndSnocLists waveTable []
20 slide (dq, g) = case DQ.uncons dq of
22 | Just a' <- DQ.head as ->
23 let (new_a, g') = f g a a' in
24 (a, (DQ.snoc new_a as, g'))
26 in unfoldrSoundPulse slide (deque0, gen)
28 where waveTableLen = floor (fromIntegral sampleRate / freq) :: Int
33 let sampleRate = 44100
35 attenuate a b = 0.995*(a+b)/2
36 centeredPulse g = case randomR (-0.5, 0.5) g of
37 (a, g') -> Just (Pulse a, g')
39 guitar = karplusStrong centeredPulse (\_gen a a' -> (attenuate a a', _gen)) sampleRate
40 snare = karplusStrong (\g -> Just (0.5, g))
41 (\gen a a' -> case random gen of
43 let v = attenuate a a'
44 in (if b then v else negate v, gen')
48 sound1 = setDuration 2 $ asNote guitar a3
49 sound2 = simpleReverb 0.01 sound1
50 sound3 = setDuration 2 $ parallel [ asNote guitar x | x <- [c3, e3, g3] ]
51 sound4 = simpleReverb 0.01 sound3
54 sound5 = setDuration 0.3 $ asNote snare a3
59 [ ([c3, g3], [c4, d4+1])
60 , ([a2+1, g3], [c4, d4+1])
61 , ([g2+1, f3], [g4, f4])
62 , ([f2, d3+1], [f4, d4+1])
64 gtr = repeatSound 2 $ sequentially
65 [ repeatSound 4 $ parallel
66 -- we play the notes from 'l' in parallel, followed by the
67 -- notes from 'r' in sequence
68 [ setDuration 0.9 (parallel [ asNote guitar x | x <- l ])
69 , setDuration 0.3 silence >>> sequentially (map (setDuration 0.3 . asNote guitar) r)
73 dr1 = repeatSound 48 (setDuration 0.6 sound5)
74 dr2 = repeatSound 96 (reduce 0.8 sound5)
75 dr3 = repeatSound 32 (amplify 1.2 $ setDuration 0.75 silence >>> setDuration 0.15 sound5)
76 in setDuration 2 silence >>> parallel [gtr, dr1, dr2, dr3]
78 -- all the sounds from this post
79 sounds = [sound1, sound2, sound3, sound4, sound5, sound6]
81 mapM_ (play sampleRate 1) sounds
82 sequence_ [ saveWav ("karplus_strong_" ++ show n ++ ".wav") (fromIntegral sampleRate) s | (n, s) <- zip [(1 :: Int)..] sounds ]