-- | The Heartbeat by Julie Friedman (without crackle)
module Main where
import Csound.Base
linenIdur :: Sig -> D -> D -> Sig
linenIdur a rise dec = linen a (idur * rise) idur (idur * dec)
--------------------------------------
crackle amp cps att dec = (a3 * kpan, a3 * (1 - kpan))
where a1 = k1 * osc (sig cps)
k1 = linen (sig amp) att idur dec
kpan = 0.5 * (1 + osc (5 * sig idur))
a2 = fof a1 (a1 + sig cps) (a1 * sig amp / 50) k1 200 0.003 0.017 0.005 20 f1 f2 cps
arev = reverb2 a2 5 1
a3 = 0.2 * (a2 + arev)
f1 = sines [1] -- SINE WAVE
f2 = sines [1, 0.5, 0.3, 0.25, 0.2, 0.167, 0.14, 0.111] -- SAWTOOTH
heartbeat :: D -> Sig
heartbeat amp = phi amp 0.0024 f12 + phi amp 0.0078 f13
where phi amp dec tab = oscili (sig amp * linseg [1, idur, dec]) 4 tab
f12 = sines2 [(10, 1), (16, 1.5), (22, 2), (23, 1.5)]
f13 = sines2 [(25, 1), (29, 0.5), (32, 0.2)]
monoPluck :: D -> D -> D -> D -> Sig
monoPluck amp cps pick plk = a3
where repluck' freq a = repluck plk (sig amp) freq (sig pick) 0.5 a
a1 = 0.5 * (
repluck' (cps - 1) (osc $ sig $ cps - 2)
+ repluck' (cps + 1) (osc $ sig $ cps + 2))
a2 = linenIdur (a1/2) 0.2 0.8
arev = reverb2 a2 1.5 1
a3 = (a2 + 0.6 * arev) / 1.6
chorusel amp cps rise dec = (ar1, ar2)
where k1 = linen (sig amp) rise idur dec
k2 = linseg [1, idur, 0]
k3 = kr $ osc 2
k4 = kr $ 0.5 * osc 2
inote = cpspch cps
as = fmap (\(d, a, f) -> k1 * f (sig (inote + d) + a)) [
(-1, k3, saw),
(1, k4, f9),
(-0.5, 0, f9),
(0.5, 0, saw),
(-2, k4, saw),
(2, k3, f9),
(-1.5, k3, saw),
(1.5, k3, f9),
(-0.25, 0, f9),
(0.25, 0, saw),
(-0.8, k4, saw),
(0.8, k4, f9)]
ars = zipWith3 (\a k d -> withInits (areson a k d) (1::D)) as (k2:(k2*k3):repeat k2) (fmap (sig . double) $ [10, 20 .. 80] ++ [50, 60 .. 80])
meanArs = (/ 5.5) . sum . fmap (ars !!)
asig1 = meanArs [0, 3, 5, 7, 8]
asig2 = meanArs [1, 2, 4, 6, 9]
asig3 = 0.5 * (ars !! 10 + ars !! 11)
ar1 = 0.5 * (asig1 + asig3)
ar2 = 0.5 * (asig2 + asig3)
f9 phs = oscil 1 phs $ sines
[ 0.28, 1, 0.74, 0.66, 0.78, 0.48, 0.05, 0.33, 0.12
, 0.08, 0.01, 0.54, 0.19, 0.08, 0.05, 0.16, 0.01
, 0.11, 0.3, 0.02, 0.2]
instr1 :: D -> Sig2
instr1 amp = (a, a)
where a = 0.8 * heartbeat amp
instrPluck :: (D, D) -> Sig2
instrPluck (amp, pan) = (sig pan * a, (sig $ 1 - pan) * a)
where a = monoPluck 0.5 (cpspch 8) 0.8 0.3
instrChorusel :: (D, D, D, D) -> Sig2
instrChorusel (cps, pan, a, b) = chorusel cps pan a b
instrCrackle :: D -> Sig2
instrCrackle cps = crackle (0.5::D) cps 12 20
scoBeat = sco (onArg instr1) $ del 2 $ loopBy 32 $ mel [0.25 *| melTemp [0.5, 0.3], rest 1.5]
scoPluck = sco (onArg instrPluck) $ del 8 $ mel $ take n $ zipWith (\amp pan -> 0.5 *| temp (amp, pan))
(fmap double $ [0, (v/40) .. v] ++ repeat v) (cycle [0.2, 0.8])
where v = 0.6
dur = 65
n = floor $ (dur - 8)/0.5
scoChorusel = sco (onArg instrChorusel) $ har $ unroll =<< [
(0, 15, (0.4, [7, 7.07, 6, 8], 10, 5)),
(18, 17, (0.27, [6, 7, 7.07, 8.02, 8.03, 5], 9, 6)),
(34, 21, (0.35, [6], 8, 8)),
(40, 15, (0.35, [6.07], 7, 7)),
(48, 7, (0.35, [7.05], 3.5, 3.5)),
(55, 10, (0.35, [7, 8, 7.07, 6], 5, 8))]
where unroll (t, dur, (amp, cps, rise, dec)) = [del t $ str dur $ temp (amp, c, rise, dec) | c <- cps]
scoCrackle = sco (onArg instrCrackle) $ har [
str 8 $ temp 100,
del 13 $ str 5 $ temp 50]
main = dac $ mix $ har [
scoBeat,
scoChorusel,
scoPluck,
rest 0
]