-- |  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, dur)
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' :: D -> a -> SE a
addDur' dt x = xtratim dt >> return x

addDur :: a -> SE a
addDur = addDur' 0.1

toDrum :: Sig -> SE Sig
toDrum a = rndAmp =<< addDur a

defSpec :: D -> D -> MpSpec
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, rndCps :: D -> D -> SE D

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 :: Sig -> Sig -> Sig
rezz cps bw = reson (mpulse 1 0) cps (cps * bw) `withD` 2

bass :: SE Sig
bass = bass' bdSpec

bdSpec :: MpSpec
bdSpec = defSpec 0.43 64

bass' :: MpSpec -> SE Sig
bass' spec = pureBass' =<< rndSpec spec

-- dur = 1.7
-- cps = 64
pureBass' :: MpSpec -> SE Sig
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 :: SE Sig
snare1 = snare1' snSpec1

snSpec1 :: MpSpec
snSpec1 = defSpec 0.38 800

snare1' :: MpSpec -> SE Sig
snare1' spec = pureSnare1' =<< rndSpec spec

-- cps = 800
pureSnare1' :: MpSpec -> SE Sig
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 :: SE Sig
snare2 = snare2' snSpec2

snSpec2 :: MpSpec
snSpec2 = defSpec 0.4 800

snare2' :: MpSpec -> SE Sig
snare2' spec = pureSnare2' =<< rndSpec spec

pureSnare2' :: MpSpec -> SE Sig
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 :: SE Sig
rimShot = rimShot' rimSpec

rimSpec :: MpSpec
rimSpec = defSpec 0.005 1700

rimShot' :: MpSpec -> SE Sig
rimShot' spec = pureRimShot' =<< rndSpec spec

-- cps = 1700
-- dur = 0.005
pureRimShot' :: MpSpec -> SE Sig
pureRimShot' spec = toDrum $ mul (fadeOut dur) $ asig
  where
    dur = mpDur spec
    cps = sig $ mpCps spec

    asig1 = osc' 0.2 cps
    asig2 = reson asig1 cps 1500 `withD` 2
    asig  = bhp 500 (asig1 + asig2 * 0.4 * 0.3)

cymbal1 :: SE Sig
cymbal1 = cymbal1' cymSpec1

cymSpec1 :: MpSpec
cymSpec1 = defSpec 0.304 6000

cymbal1' :: MpSpec -> SE Sig
cymbal1' spec = pureCymbal1' =<< rndSpec spec

-- dur = 0.304
-- cps = 6000
pureCymbal1' :: MpSpec -> SE Sig
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 :: SE Sig
cymbal2 = cymbal2' cymSpec2

cymSpec2 :: MpSpec
cymSpec2 = defSpec 1.404 1000

cymbal2' :: MpSpec -> SE Sig
cymbal2' spec = pureCymbal2' =<< rndSpec spec

pureCymbal2' :: MpSpec -> SE Sig
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 :: SE Sig
bongo1 = bongo1' bonSpec1

bonSpec1 :: MpSpec
bonSpec1 = defSpec 0.2 630

bongo1' :: MpSpec -> SE Sig
bongo1' spec = pureBongo1' =<< rndSpec spec

pureBongo1' :: MpSpec -> SE Sig
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 :: SE Sig
bongo2 = bongo2' bonSpec2

bonSpec2 :: MpSpec
bonSpec2 = defSpec 0.2 400

bongo2' :: MpSpec -> SE Sig
bongo2' spec = pureBongo2' =<< rndSpec spec

-- dur = 0.2
-- cps = 400
pureBongo2' :: MpSpec -> SE Sig
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 :: SE Sig
bongo3 = bongo3' bonSpec3

bonSpec3 :: MpSpec
bonSpec3 = defSpec 1.229 194

bongo3' :: MpSpec -> SE Sig
bongo3' spec = pureBongo3' =<< rndSpec spec

-- dur = 1.229
-- cps = 194
pureBongo3' :: MpSpec -> SE Sig
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 :: SE Sig
claves = claves' clSpec

clSpec :: MpSpec
clSpec = defSpec 0.186 400

claves' :: MpSpec -> SE Sig
claves' spec = pureClaves' =<< rndSpec spec

pureClaves' :: MpSpec -> SE Sig
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 :: SE Sig
cowbell = cowbell' cowSpec

cowSpec :: MpSpec
cowSpec = defSpec 0.3 850

cowbell' :: MpSpec -> SE Sig
cowbell' spec = pureCowbell' =<< rndSpec spec

pureCowbell' :: MpSpec -> SE Sig
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 :: SE Sig
guiro = guiro' groSpec

groSpec :: MpSpec
groSpec = defSpec 0.256 66

guiro' :: MpSpec -> SE Sig
guiro' spec = pureGuiro' =<< rndSpec spec

pureGuiro' :: MpSpec -> SE Sig
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 :: SE Sig
maracas = maracas' marSpec

marSpec :: MpSpec
marSpec = defSpec 0.05 5000

maracas' :: MpSpec -> SE Sig
maracas' spec = pureMaracas' =<< rndSpec spec

pureMaracas' :: MpSpec -> SE Sig
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
    aenv =  transeg [1,dur,-4,0]


quijada :: SE Sig
quijada = quijada' qjSpec

qjSpec :: MpSpec
qjSpec = defSpec 0.817 550

quijada' :: MpSpec -> SE Sig
quijada' spec = pureQuijada' =<< rndSpec spec

pureQuijada' :: MpSpec -> SE Sig
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 :: SE Sig
tamb = tamb' tamSpec

tamSpec :: MpSpec
tamSpec = defSpec 0.271 7000

tamb', pureTamb' :: MpSpec -> SE Sig

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 :: SE Sig -> Sam
mkSam = limSam 4

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

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

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

-- | Rim shot
rim :: Sam
rim = limSam 1 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' :: (t -> SE Sig) -> t -> Sam
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'