-- |  Drums of the Korg Mini Pops 7 drum machine (recoded from 	Iain McCurdy).
module Csound.Catalog.Drum.MiniPops(
	MpSpec(..),

	bass, snare1, snare2, rimShot, cymbal1, cymbal2, bongo1, bongo2, bongo3, 
	claves, cowbell, guiro, maracas, quijada, tamb,

	-- * Generic
	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,

	-- * Sample
	bd, sn1, sn2, rim, cym1, cym2, bon1, bon2, bon3, cl, cow, gro, mar, qj, tam, 

	-- ** Generic
	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

-- dur = 1.7
-- cps = 64
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

-- cps = 800
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

-- cps = 1700
-- dur = 0.005
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

-- dur = 0.304
-- cps = 6000
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])

-- dur = 0.2
-- cps = 630
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

-- dur = 0.2
-- cps = 400
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

-- dur = 1.229
-- cps = 194
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]

-------------------------------------------------------
-- Sampler

mkSam = limSam 1

-- | Bass drum
bd :: Sam
bd = mkSam bass

-- | Snare 1
sn1 :: Sam
sn1 = mkSam snare1

-- | Snare 2
sn2 :: Sam
sn2 = mkSam snare2

-- | Rim shot
rim :: Sam
rim = mkSam rimShot

-- | Cymbal 1
cym1 :: Sam
cym1 = mkSam cymbal1

-- | Cymbal 2
cym2 :: Sam
cym2 = mkSam cymbal2

-- | Bongo 1
bon1 :: Sam
bon1 = mkSam bongo1

-- | Bongo 2
bon2 :: Sam
bon2 = mkSam bongo2

-- | Bongo 3
bon3 :: Sam
bon3 = mkSam bongo3

-- | Claves
cl :: Sam
cl = mkSam claves

-- | Cowbell
cow :: Sam
cow = mkSam cowbell

-- | Guiro
gro :: Sam
gro = mkSam guiro

-- | Maracas
mar :: Sam
mar = mkSam maracas

-- | Quijada
qj :: Sam
qj = mkSam quijada

-- | Tambourine
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'