module Csound.Catalog.Drum.MiniPops(
MpSpec(..),
bass, snare1, snare2, rimShot, cymbal1, cymbal2, bongo1, bongo2, bongo3,
claves, cowbell, guiro, maracas, quijada, tamb,
bass', bdSpec, snare1', snSpec1, snare2', snSpec2, rimShot', rimSpec,
cymbal1', cymSpec1, cymbal2', cymSpec2, bongo1', bonSpec1, bongo2', bonSpec2, bongo3', bonSpec3,
claves', clSpec, cowbell', cowSpec, guiro', groSpec, maracas', marSpec, quijada', qjSpec, tamb', tamSpec,
bd, sn1, sn2, rim, cym1, cym2, bon1, bon2, bon3, cl, cow, gro, mar, qj, tam,
bd', sn1', sn2', rim', cym1', cym2', bon1', bon2', bon3', cl', cow', gro', mar', qj', tam'
) where
import Csound.Base hiding (guiro)
import Csound.Sam
data MpSpec = MpSpec {
mpDur :: D
, mpCps :: D
, mpRnd :: Maybe D }
rndAmp :: Sig -> SE Sig
rndAmp a = do
k <- birnd 0.09
return $ a * (1 + sig k)
addDur' dt x = xtratim dt >> return x
addDur = addDur' 0.1
toDrum :: Sig -> SE Sig
toDrum a = rndAmp =<< addDur a
defSpec dur cps = MpSpec
{ mpDur = dur
, mpCps = cps
, mpRnd = Just 0.085 }
rndVal :: D -> D -> D -> SE D
rndVal total amount x = do
k <- birnd amount
return $ x + k * total
rndDur amt x = rndVal x amt x
rndCps amt x = rndVal x (amt / 10) x
rndSpec :: MpSpec -> SE MpSpec
rndSpec spec = do
dur <- rndDur'
cps <- rndCps'
return $ spec
{ mpDur = dur
, mpCps = cps }
where
rndDur' = (maybe return rndDur $ (mpRnd spec)) $ mpDur spec
rndCps' = (maybe return rndCps $ (mpRnd spec)) $ mpCps spec
rezz cps bw = reson (mpulse 1 0) cps (cps * bw) `withD` 2
bass = bass' bdSpec
bdSpec = defSpec 0.43 64
bass' spec = pureBass' =<< rndSpec spec
pureBass' spec = toDrum aout
where
dur = mpDur spec
cps = sig $ mpCps spec
aout = mul (env * 225 * fadeOut dur) $ lp1 500 $ rezz cps 0.001
env = transeg [1, dur, -14, 0]
snare1 = snare1' snSpec1
snSpec1 = defSpec 0.38 800
snare1' spec = pureSnare1' =<< rndSpec spec
pureSnare1' spec = toDrum =<< (mul (fadeOut dur) $ aout)
where
dur = mpDur spec
cps = mpCps spec
anoise = pink
asig = fmap (\x -> reson x 6250 9000 `withD` 1) anoise
aenv = transeg [1, dur ,-5 , 0]
asig1 = at (bhp 3000) $ mul aenv asig
xdur = 0.006
astrike = osc (transeg [cps,xdur,-4,60])
aenv2 = transeg [1,xdur,-2,0]
astrike1 = aenv2 * astrike
aout = fmap ((0.7 * astrike1) + ) $ mul 2 $ asig1
snare2 = snare2' snSpec2
snSpec2 = defSpec 0.4 800
snare2' spec = pureSnare2' =<< rndSpec spec
pureSnare2' spec = toDrum =<< (mul (fadeOut dur) $ aout)
where
dur = mpDur spec
cps = mpCps spec
anoise = pink
asig = fmap (\x -> butbp x 5200 5200 `withD` 1) anoise
aenv = transeg [1, dur ,-8 , 0]
asig1 = at (bhp 3000) $ mul aenv asig
xdur = 0.005
astrike = osc (transeg [cps,xdur,-4,cps / 4])
aenv2 = transeg [1,xdur,-2,0]
astrike1 = aenv2 * astrike
aout = fmap ((0.5 * astrike1) + ) $ mul 2.3 $ asig1
rimShot = rimShot' rimSpec
rimSpec = defSpec 0.005 1700
rimShot' spec = pureRimShot' =<< rndSpec spec
pureRimShot' spec = toDrum $ mul (fadeOut dur) $ asig
where
dur = mpDur spec
cps = sig $ mpCps spec
aenv = expon 1 dur 0.0001
asig1 = osc' 0.2 cps
asig2 = reson asig1 cps 1500 `withD` 2
asig = bhp 500 (asig1 + asig2 * 0.4 * 0.3)
cymbal1 = cymbal1' cymSpec1
cymSpec1 = defSpec 0.304 6000
cymbal1' spec = pureCymbal1' =<< rndSpec spec
pureCymbal1' spec = (toDrum =<< ) $ mul (fadeOut dur) $ do
anoise <- white
let asig1 = blp 14000 $ reson (anoise*aenv) icf (icf*0.7) `withD` 1
asig2 = bhp 6000 $ (asig1 + anoise * 0.001)
return $ 0.25 * aenv * asig2
where
dur = mpDur spec
cps = sig $ mpCps spec
aenv = transeg [1,dur,-2,0]
icf = cps
cymbal2 = cymbal2' cymSpec2
cymSpec2 = defSpec 1.404 1000
cymbal2' spec = pureCymbal2' =<< rndSpec spec
pureCymbal2' spec = (toDrum =<< ) $ mul (fadeOut dur) $ do
anoise <- white
let asig = mul aenv $ bhp 6000 $ mul aenv $ lp1 12000 $ reson (anoise * aenv) icf (icf * 0.9) `withD` 1
return $ astrike * 0.2 + asig * 1.5
where
dur = mpDur spec
cps = mpCps spec
icf = sig $ cps * 5
aenv = transeg [1,dur,-2,0]
xdur = 0.004
aenv2 = transeg [1,xdur,-2,0]
astrike = mul aenv2 $ osc (transeg [cps,xdur,-4,0.4*cps])
bongo1 = bongo1' bonSpec1
bonSpec1 = defSpec 0.2 630
bongo1' spec = pureBongo1' =<< rndSpec spec
pureBongo1' spec = toDrum $ mul (fadeOut dur) $ asig
where
dur = mpDur spec
cps = sig $ mpCps spec
asig = mul (4 * aenv ) $ blp 8000 $ bhp 300 $ rezz cps 0.03
aenv = transeg [1,dur,13,0]
bongo2 = bongo2' bonSpec2
bonSpec2 = defSpec 0.2 400
bongo2' spec = pureBongo2' =<< rndSpec spec
pureBongo2' spec = toDrum $ mul (fadeOut dur) $ asig
where
dur = mpDur spec
cps = mpCps spec
kcps = expon cps dur (cps * 0.975)
aenv = transeg [1,dur-0.005,0,0.1,0.005,0, 0]
asig = mul (4 * aenv) $ bhp 100 $ lp1 5000 $ rezz kcps 0.03
bongo3 = bongo3' bonSpec3
bonSpec3 = defSpec 1.229 194
bongo3' spec = pureBongo3' =<< rndSpec spec
pureBongo3' spec = toDrum $ mul (fadeOut dur) $ asig
where
dur = mpDur spec
cps = sig $ mpCps spec
aenv = transeg [0, 0.001, -2, 1, dur-0.001, -2, 0]
kbw = linseg [0.05,0.01,0.008]
asig = mul (5 * aenv) $ blp 11000 $ rezz cps kbw
claves = claves' clSpec
clSpec = defSpec 0.186 400
claves' spec = pureClaves' =<< rndSpec spec
pureClaves' spec = toDrum aout
where
dur = mpDur spec
cps = sig $ mpCps spec
aenv = linseg [1, dur, 0]
asig1 = rezz cps 0.025
asig2 = rezz (cps * 5.45) 0.03
aout = mul (3.2 * aenv * fadeOut dur) $ asig1 + 1.3 * asig2
cowbell = cowbell' cowSpec
cowSpec = defSpec 0.3 850
cowbell' spec = pureCowbell' =<< rndSpec spec
pureCowbell' spec = toDrum asig
where
dur = mpDur spec
cps = sig $ mpCps spec
asig = mul (aenv * 3 * fadeOut dur) $ bhp 100 $
rezz cps 0.007
+ 0.8 * rezz (cps * 5.537) 0.03
aenv = linseg [1, dur, 0]
guiro = guiro' groSpec
groSpec = defSpec 0.256 66
guiro' spec = pureGuiro' =<< rndSpec spec
pureGuiro' spec = toDrum asig
where
dur = mpDur spec
cps = mpCps spec
aenv = linseg [0,0.001,1,dur-0.111,0.6,0.1,1,0.01,0]
asig = mul (3 * aenv * fadeOut dur) $ bhp 1000 $ reson (0.1 * sqr kcps) 4300 3000 `withD` 1
kcps = transeg [cps,dur,2,(1.1 * cps)]
maracas = maracas' marSpec
marSpec = defSpec 0.05 5000
maracas' spec = pureMaracas' =<< rndSpec spec
pureMaracas' spec = toDrum =<< do
asig <- noise 1 0.04
return $ mul (0.35 * aenv * fadeOut dur) $ bhp 2000 $ reson asig 9000 4000 `withD` 2
where
dur = mpDur spec
cps = sig $ mpCps spec
aenv = transeg [1,dur,-4,0]
quijada = quijada' qjSpec
qjSpec = defSpec 0.817 550
quijada' spec = pureQuijada' =<< rndSpec spec
pureQuijada' spec = toDrum $ bhp cps $ mul (6 * fadeOut dur) $ phi dur (1/22.7272) + phi (dur * 0.39) (1/13.1579)
where
dur = mpDur spec
cps = sig $ mpCps spec
phi dt freq = mul kenv $ reson (mpulse 1 freq) 2727 400 `withD` 1
where kenv = transeg [0.8,0.05,1, 1,dt-0.05,-6,0]
tamb = tamb' tamSpec
tamSpec = defSpec 0.271 7000
tamb' spec = pureTamb' =<< rndSpec spec
pureTamb' spec = toDrum =<< do
anoise <- noise 1 0
return $ mul (1.5 * aenv * fadeOut dur)
$ reson (bhp cps $ (+ (anoise * 0.1 * aenv)) $ reson (anoise * aenv) 4600 100 `withD` 2) 9000 3000 `withD` 1
where
dur = mpDur spec
cps = sig $ mpCps spec
aenv = transeg [1,dur,-8,0]
mkSam = limSam 4
bd :: Sam
bd = mkSam bass
sn1 :: Sam
sn1 = mkSam snare1
sn2 :: Sam
sn2 = limSam 2 snare2
rim :: Sam
rim = limSam 1 rimShot
cym1 :: Sam
cym1 = mkSam cymbal1
cym2 :: Sam
cym2 = mkSam cymbal2
bon1 :: Sam
bon1 = mkSam bongo1
bon2 :: Sam
bon2 = mkSam bongo2
bon3 :: Sam
bon3 = mkSam bongo3
cl :: Sam
cl = mkSam claves
cow :: Sam
cow = mkSam cowbell
gro :: Sam
gro = mkSam guiro
mar :: Sam
mar = mkSam maracas
qj :: Sam
qj = mkSam quijada
tam :: Sam
tam = mkSam tamb
mkSam' f spec = mkSam $ f spec
bd' :: MpSpec -> Sam
bd' = mkSam' bass'
sn1' :: MpSpec -> Sam
sn1' = mkSam' snare1'
sn2' :: MpSpec -> Sam
sn2' = mkSam' snare2'
rim' :: MpSpec -> Sam
rim' = mkSam' rimShot'
cym1' :: MpSpec -> Sam
cym1' = mkSam' cymbal1'
cym2' :: MpSpec -> Sam
cym2' = mkSam' cymbal2'
bon1' :: MpSpec -> Sam
bon1' = mkSam' bongo1'
bon2' :: MpSpec -> Sam
bon2' = mkSam' bongo2'
bon3' :: MpSpec -> Sam
bon3' = mkSam' bongo3'
cl' :: MpSpec -> Sam
cl' = mkSam' claves'
cow' :: MpSpec -> Sam
cow' = mkSam' cowbell'
gro' :: MpSpec -> Sam
gro' = mkSam' guiro'
mar' :: MpSpec -> Sam
mar' = mkSam' maracas'
qj' :: MpSpec -> Sam
qj' = mkSam' quijada'
tam' :: MpSpec -> Sam
tam' = mkSam' tamb'