diff --git a/csound-catalog.cabal b/csound-catalog.cabal --- a/csound-catalog.cabal +++ b/csound-catalog.cabal @@ -1,5 +1,5 @@ Name: csound-catalog -Version: 0.2.2 +Version: 0.3.0 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE @@ -27,15 +27,19 @@ Library Ghc-Options: -Wall Build-Depends: - base >= 4, base < 5, transformers >= 0.3, csound-expression >= 4.3 + base >= 4, base < 5, transformers >= 0.3, csound-expression >= 4.8.3, csound-sampler >=0.0.6.3 Hs-Source-Dirs: src/ Exposed-Modules: Csound.Catalog Csound.Catalog.Drum + Csound.Catalog.Drum.Hm + Csound.Catalog.Drum.Tr808 + Csound.Catalog.Drum.MiniPops Csound.Catalog.Effect Csound.Catalog.Envelope Csound.Catalog.Reson Csound.Catalog.Wave + Csound.Patch Other-Modules: Csound.Catalog.Wave.Woodwind Csound.Catalog.Wave.WoodwindAlg @@ -47,4 +51,8 @@ Csound.Catalog.Wave.TrappedInConvert Csound.Catalog.Wave.Amsterdam Csound.Catalog.Wave.Misc + Csound.Catalog.Wave.Sean + Csound.Catalog.Wave.Flavio + Csound.Catalog.Wave.Thor + Csound.Catalog.Wave.Bitwig diff --git a/src/Csound/Catalog.hs b/src/Csound/Catalog.hs --- a/src/Csound/Catalog.hs +++ b/src/Csound/Catalog.hs @@ -12,7 +12,7 @@ , module Csound.Catalog.Effect , module Csound.Catalog.Envelope , module Csound.Catalog.Reson - , module Csound.Catalog.Wave + , module Csound.Catalog.Wave ) where import Csound.Catalog.Drum diff --git a/src/Csound/Catalog/Drum.hs b/src/Csound/Catalog/Drum.hs --- a/src/Csound/Catalog/Drum.hs +++ b/src/Csound/Catalog/Drum.hs @@ -1,156 +1,76 @@ -- | A gallery of the percussive sounds. module Csound.Catalog.Drum( - -- * Subtractive - dumb, dumbBass, pluckSnare, sortaKnockSweep, metalBoink, + -- * Hans Mikelson Drum kit + hmBd1, hmBd2, hmBd3, hmSn1, hmSn2, hmSweeo, hmBoink, hmOhh, hmChh, hmCr, hmClap, - -- * Fullkit + -- * Tr808 Drum kit + trBd, trSn, trOhh, trChh, trHtom, trMtom, trLtom, trCym, trCl, trRim, trMar, trHcon, trMcon, trLcon, - -- ** Non-pitched drums - snare, openHihat, closedHihat, + -- * Korg MiniPops Drum kit + mpBd, mpSn1, mpSn2, mpRim, mpCym1, mpCym2, mpBon1, mpBon2, mpBon3, mpCl, mpCow, mpGro, mpMar, mpQj, mpTam, - -- ** Pitched drums - -- - -- The instrument turns a pitch (in Hz) to the signal. - bassDrum, crash, handClap + -- * Csound percussive models kit + boo, gro, sbells, tam, cab, crun, shake, spaper, ) where import Csound.Base - --- subtractive - -bpb :: Sig -> Sig -> Sig -> Sig -bpb cfq q asig = balance (bp cfq q asig) asig - --- | A \"dumb\" drum. -dumb :: SE Sig -dumb = fmap (bpb 1000 100) $ rand $ expseg [0.0001, 0.01, 1, 0.04, 0.01] - -dumbBass :: SE Sig -dumbBass = fmap (bpb kfreqenv (kfreqenv / 8)) $ rand $ expseg [0.0001, 0.01, 1, 0.08, 0.01] - where kfreqenv = expseg [50, 0.01, 200, 0.08, 50] - -pluckSnare :: Sig -pluckSnare = pluck kampenv4 kptchenv 50 (elins [1, 1]) 4 `withDs` [0.8, 3] - where - kampenv4 = linseg [0, 0.001, 1, xdur - 0.21, 1, 0.02, 0] - kptchenv = linseg [100, 0.01, 300, 0.2, 200, 0.01, 200] - xdur = 1.25 - - -sortaKnockSweep :: SE Sig -sortaKnockSweep = - fmap (resonsBy bpb - [ (kfreqenv41, kfreqenv41 / 8) - , (kfreqenv42, kfreqenv42 / 4) - ] - ) $ rand kampenv4 - where - kfreqenv41 = expseg [ 50, 0.01, 200, 0.08, 50] - kfreqenv42 = linseg [ 150, 0.01, 1000, 0.08, 250] - kampenv4 = linseg [ 0, 0.01, 1, 0.08, 0, 0.01, 0] - -metalBoink :: Sig -metalBoink = foscil kampenv61 30 1 6.726 kampenv62 sine - where - kampenv61 = expseg [ 0.01, 0.01, 1, 0.2, 0.1, 0.1, 0.001 ] - kampenv62 = linseg [ 1, 0.1, 10, 0.1, 0.5, 0.01, 1 ] - --- fullkit +import Csound.Sam -bassDrum :: D -> Sig -bassDrum cps= env * osc (sig cps * kgliss * 0.5) - where env = linseg [0, 0.00245, 1, 0.1225, 0] - kgliss = expseg [10, 0.625, 1, 0.25, 1] +import qualified Csound.Catalog.Drum.Hm as H +import qualified Csound.Catalog.Drum.Tr808 as T +import qualified Csound.Catalog.Drum.MiniPops as M -openHihat :: SE Sig -openHihat = hihat $ linseg [0, 0.004, 1, 0.121, 0] - -closedHihat :: SE Sig -closedHihat = hihat $ linseg [0, 0.00245, 1, 0.1225, 0] - -hihat :: Sig -> SE Sig -hihat kenv = do - asig <- rand kenv - let a1 = moogvcf (butbp asig cf (cf / 2)) cf 0.7 - a2 = comb a1 0.5 (1/cpspch(8)) - return $ a2 * 0.05 + a1 * 0.93 - where cf = cpspch (5.08 + 8) - -snare :: SE Sig -snare = do - asound <- rand 1 - let as1 = butbp asound 210 55 - return $ kenv2 * (as1 * 0.9 + asound * 0.8 * kenv1) - where - kenv1 = linseg [0, 0.00176, 1, 0.1232, 0] - kenv2 = expseg [0.01, 0.0002, 1, 0.0297, 0.01, 0.09, 0.01] - --- | Recommended values cpspch(13.03) - cpspch(13.10) -crash :: D -> SE Sig -crash cps = do - asig <- rand 1 - return $ 0.5 * (0.5 * aall + resonator (aall + asig * kenv2)) - where - kenv2 = expseg [0.001, 0.0466, 1, 3.95, 0.001] - - resonator asig = 0.7 * a1 + 0.6 * kenv18 * a2 - where - flt a = butbp asig (sig $ a * cps) (sig $ 0.5 * cps) - a1 = sum $ fmap flt [1, 2.1, 2.8] - a2 = comb a1 0.5 (0.5 / cps) - kenv18 = expseg [0.01, 0.02, 1, 3.98, 0.01] - - harm k amp hs = k * amp * mean (fmap (osc . sig . ( * cps)) hs) - - aall = sum $ zipWith3 harm weights envelopes harmonics - - harmonics = - [ [1, 0.89, 1.12341] - , [2.24, 2.4 * 0.98, 2.14 * 1.02] - , [3.312, 3.513312*0.89, 3.123312*1.11] - , [4.89, 5.89*0.89, 6.89 * 1.03] - , [5.12, 5.5612*1.02, 7.7312 * 0.998] - , [6.97, 6.97 * 1.02, 6.97 * 0.98] - , [7.89, 7.89 * 1.02, 7.89 * 0.98] - , [1.25, 1.125 * 1.004, 1.134 * 0.996] - ] - - weights = replicate 7 0.2 ++ [0.1] - - envelopes = fmap (\(a, b) -> expseg [0.01, a, 1, b, 0.01]) - [ (0.0274, 3.972) - , (0.0264, 3.973) - , (0.0209, 3.979) - , (0.0248, 3.975) - , (0.0283, 3.971) - , (0.0330, 3.966) - , (0.0396, 3.960) - , (0.0209, 3.979) - ] - -handClap :: D -> SE Sig -handClap cps = fmap onNoise $ rand 1 - where - kenv1 = expseg [1.25, 0.03, 0.0001] - kenv2 = expseg [0.001, 0.005, 1, 0.35, 0.001] +hmBd1 = H.bd1 +hmBd2 = H.bd2 +hmBd3 = H.bd3 +hmSn1 = H.sn1 +hmSn2 = H.sn2 +hmSweeo = H.sweep +hmBoink = H.boink +hmOhh = H.ohh +hmChh = H.chh +hmCr = H.cr +hmClap = H.clap - onNoise asig = aout - where - anoise1 = kenv1 * asig - anoise2 = kenv2 * asig +trBd = T.bd +trSn = T.sn +trOhh = T.ohh +trChh = T.chh +trHtom = T.htom +trMtom = T.mtom +trLtom = T.ltom +trCym = T.cym +trCl = T.cl +trRim = T.rim +trMar = T.mar +trHcon = T.hcon +trMcon = T.mcon +trLcon = T.lcon - adel1 = anoise1 - adel2 = delaySig 0.01 anoise1 - adel3 = delaySig 0.02 anoise1 - adel4 = delaySig 0.03 anoise2 - - aout = mean - [ rz adel1 2 - , rz adel2 3 - , rz adel3 4 - , rz adel4 5.5 - ] +mpBd = M.bd +mpSn1 = M.sn1 +mpSn2 = M.sn2 +mpRim = M.rim +mpCym1 = M.cym1 +mpCym2 = M.cym2 +mpBon1 = M.bon1 +mpBon2 = M.bon2 +mpBon3 = M.bon3 +mpCl = M.cl +mpCow = M.cow +mpGro = M.gro +mpMar = M.mar +mpQj = M.qj +mpTam = M.tam - rz x y = resonz x (sig $ cps * y) (sig $ cps * 5.5) +mkSam = limSam 1 +boo = mkSam $ bamboo 1 0.01 +gro = mkSam $ guiro 1 0.01 +sbells = mkSam $ sleighbells 1 0.01 +tam = mkSam $ tambourine 1 0.01 +cab = mkSam $ cabasa 1 0.01 +crun = mkSam $ crunch 1 0.1 +shake cps = mkSam $ shaker 1 cps 8 0.999 100 `withD` 0 +spaper = mkSam $ sandpaper 1 0.01 diff --git a/src/Csound/Catalog/Drum/Hm.hs b/src/Csound/Catalog/Drum/Hm.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Drum/Hm.hs @@ -0,0 +1,197 @@ +-- | Drums defined by Hans Mikelson. +module Csound.Catalog.Drum.Hm( + -- * Subtractive + dumb, dumbBass, pluckSnare, sortaKnockSweep, metalBoink, + + -- * Fullkit + + -- ** Non-pitched drums + snare, openHihat, closedHihat, + + -- ** Pitched drums + -- + -- The instrument turns a pitch (in Hz) to the signal. + bassDrum, crash, handClap, + bassDrum', crash', handClap', + + -- * Sampler + bd1, bd2, sn1, sweep, boink, sn2, ohh, chh, bd3, cr, clap +) where + +import Csound.Base +import Csound.Sam + +-- subtractive + +bpb :: Sig -> Sig -> Sig -> Sig +bpb cfq q asig = balance (bp cfq q asig) asig + +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 + +-- | A \"dumb\" drum. +dumb :: SE Sig +dumb = (toDrum =<<) $ fmap (bpb 1000 100) $ rand $ expseg [0.0001, 0.01, 1, 0.04, 0.01] + +dumbBass :: SE Sig +dumbBass = (toDrum =<<) $ fmap (bpb kfreqenv (kfreqenv / 8)) $ rand $ expseg [0.0001, 0.01, 1, 0.08, 0.01] + where kfreqenv = expseg [50, 0.01, 200, 0.08, 50] + +pluckSnare :: SE Sig +pluckSnare = toDrum $ pluck kampenv4 kptchenv 50 (elins [1, 1]) 4 `withDs` [0.8, 3] + where + kampenv4 = linseg [0, 0.001, 1, xdur - 0.21, 1, 0.02, 0] + kptchenv = linseg [100, 0.01, 300, 0.2, 200, 0.01, 200] + xdur = 1.25 + + +sortaKnockSweep :: SE Sig +sortaKnockSweep = (toDrum =<<) $ + fmap (resonsBy bpb + [ (kfreqenv41, kfreqenv41 / 8) + , (kfreqenv42, kfreqenv42 / 4) + ] + ) $ rand kampenv4 + where + kfreqenv41 = expseg [ 50, 0.01, 200, 0.08, 50] + kfreqenv42 = linseg [ 150, 0.01, 1000, 0.08, 250] + kampenv4 = linseg [ 0, 0.01, 1, 0.08, 0, 0.01, 0] + +metalBoink :: SE Sig +metalBoink = toDrum $ foscil kampenv61 30 1 6.726 kampenv62 sine + where + kampenv61 = expseg [ 0.01, 0.01, 1, 0.2, 0.1, 0.1, 0.001 ] + kampenv62 = linseg [ 1, 0.1, 10, 0.1, 0.5, 0.01, 1 ] + +-- fullkit + +bassDrum = bassDrum' 64 + +bassDrum' :: D -> SE Sig +bassDrum' cps = toDrum $ env * osc (sig cps * kgliss * 0.5) + where env = linseg [0, 0.00245, 1, 0.1225, 0] + kgliss = expseg [10, 0.625, 1, 0.25, 1] + + +openHihat :: SE Sig +openHihat = hihat $ linseg [0, 0.004, 1, 0.121, 0] + +closedHihat :: SE Sig +closedHihat = hihat $ linseg [0, 0.00245, 1, 0.1225, 0] + +hihat :: Sig -> SE Sig +hihat kenv = toDrum =<< do + asig <- rand kenv + let a1 = moogvcf (butbp asig cf (cf / 2)) cf 0.7 + a2 = comb a1 0.5 (1/cpspch(8)) + return $ a2 * 0.05 + a1 * 0.93 + where cf = cpspch (5.08 + 8) + +snare :: SE Sig +snare = toDrum =<< do + asound <- rand 1 + let as1 = butbp asound 210 55 + return $ kenv2 * (as1 * 0.9 + asound * 0.8 * kenv1) + where + kenv1 = linseg [0, 0.00176, 1, 0.1232, 0] + kenv2 = expseg [0.01, 0.0002, 1, 0.0297, 0.01, 0.09, 0.01] + +crash = crash' $ cpspch 13.05 + +-- | Recommended values cpspch(13.03) - cpspch(13.10) +crash' :: D -> SE Sig +crash' cps = toDrum =<< do + asig <- rand 1 + return $ 0.5 * (0.5 * aall + resonator (aall + asig * kenv2)) + where + kenv2 = expseg [0.001, 0.0466, 1, 3.95, 0.001] + + resonator asig = 0.7 * a1 + 0.6 * kenv18 * a2 + where + flt a = butbp asig (sig $ a * cps) (sig $ 0.5 * cps) + a1 = sum $ fmap flt [1, 2.1, 2.8] + a2 = comb a1 0.5 (0.5 / cps) + kenv18 = expseg [0.01, 0.02, 1, 3.98, 0.01] + + harm k amp hs = k * amp * mean (fmap (osc . sig . ( * cps)) hs) + + aall = sum $ zipWith3 harm weights envelopes harmonics + + harmonics = + [ [1, 0.89, 1.12341] + , [2.24, 2.4 * 0.98, 2.14 * 1.02] + , [3.312, 3.513312*0.89, 3.123312*1.11] + , [4.89, 5.89*0.89, 6.89 * 1.03] + , [5.12, 5.5612*1.02, 7.7312 * 0.998] + , [6.97, 6.97 * 1.02, 6.97 * 0.98] + , [7.89, 7.89 * 1.02, 7.89 * 0.98] + , [1.25, 1.125 * 1.004, 1.134 * 0.996] + ] + + weights = replicate 7 0.2 ++ [0.1] + + envelopes = fmap (\(a, b) -> expseg [0.01, a, 1, b, 0.01]) + [ (0.0274, 3.972) + , (0.0264, 3.973) + , (0.0209, 3.979) + , (0.0248, 3.975) + , (0.0283, 3.971) + , (0.0330, 3.966) + , (0.0396, 3.960) + , (0.0209, 3.979) + ] + +handClap = handClap' 400 + +handClap' :: D -> SE Sig +handClap' cps = (toDrum =<< ) $ fmap onNoise $ rand 1 + where + kenv1 = expseg [1.25, 0.03, 0.0001] + kenv2 = expseg [0.001, 0.005, 1, 0.35, 0.001] + + onNoise asig = aout + where + anoise1 = kenv1 * asig + anoise2 = kenv2 * asig + + adel1 = anoise1 + adel2 = delaySig 0.01 anoise1 + adel3 = delaySig 0.02 anoise1 + adel4 = delaySig 0.03 anoise2 + + aout = mean + [ rz adel1 2 + , rz adel2 3 + , rz adel3 4 + , rz adel4 5.5 + ] + + rz x y = resonz x (sig $ cps * y) (sig $ cps * 5.5) + +-------------------------------------------------- +-- sampler + +mkSam = limSam 1 + +bd1 = mkSam dumb +bd2 = mkSam dumbBass + +sn1 = mkSam pluckSnare +sweep = mkSam sortaKnockSweep +boink = mkSam metalBoink + +sn2 = mkSam snare +ohh = mkSam openHihat +chh = mkSam closedHihat + +bd3 = mkSam bassDrum +cr = mkSam crash +clap = mkSam handClap diff --git a/src/Csound/Catalog/Drum/MiniPops.hs b/src/Csound/Catalog/Drum/MiniPops.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Drum/MiniPops.hs @@ -0,0 +1,444 @@ +-- | 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' diff --git a/src/Csound/Catalog/Drum/Tr808.hs b/src/Csound/Catalog/Drum/Tr808.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Drum/Tr808.hs @@ -0,0 +1,555 @@ +-- | Drums of the Korg TR-808 drum machine (recoded from Iain McCurdy). +module Csound.Catalog.Drum.Tr808( + TrSpec(..), + + bass, bass2, snare, openHiHat, closedHiHat, + lowTom, midTom, highTom, cymbal, claves, rimShot, + maraca, highConga, midConga, lowConga, + + -- * Generic + bass', bass2', bdSpec, bdSpec2, snare', snSpec, openHiHat', ohSpec, closedHiHat', chSpec, + lowTom', ltSpec, midTom', mtSpec, highTom', htSpec, cymbal', cymSpec, claves', clSpec, rimShot', rimSpec, + maraca', marSpec, highConga', hcSpec, midConga', mcSpec, lowConga', lcSpec, + + -- * Sampler + bd, bd2, sn, ohh, chh, htom, mtom, ltom, cym, cl, rim, mar, hcon, mcon, lcon, + + -- ** Generic + bd', bd2', sn', ohh', chh', htom', mtom', ltom', cym', cl', rim', mar', hcon', mcon', lcon' + +) where + +import Control.Monad + +import Csound.Base +import Csound.Sam + +-- don't forget to update the gen-opcodes and the hackage opcodes + +rndAmp :: Sig -> SE Sig +rndAmp a = do + k <- birnd 0.09 + return $ a * (1 + sig k) + +data TrSpec = TrSpec { + trDur :: D + , trTune :: D + , trCps :: D + , trRnd :: Maybe D + } + +cpsSpec cps = TrSpec + { trDur = 0.8 + , trTune = 0 + , trCps = cps + , trRnd = 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 +rndTune amt x = rndVal 0.7 amt x + +rndSpec ::TrSpec -> SE TrSpec +rndSpec spec = do + dur <- rndDur' + tune <- rndTune' + cps <- rndCps' + return $ spec + { trDur = dur + , trTune = tune + , trCps = cps } + where + rndDur' = (maybe return rndDur $ (trRnd spec)) $ trDur spec + rndTune' = (maybe return rndTune $ (trRnd spec)) $ trTune spec + rndCps' = (maybe return rndCps $ (trRnd spec)) $ trCps spec + +bdSpec = TrSpec + { trDur = 0.95 + , trTune = 1 + , trCps = 55 + , trRnd = Just 0.05 } + +addDur' dt x = xtratim dt >> return x +addDur = addDur' 0.1 + +bass = bass' bdSpec + +bass' spec = pureBass' =<< rndSpec spec + +pureBass' :: TrSpec -> SE Sig +pureBass' spec = rndAmp =<< addDur amix + where + dur = trDur spec + cps = trCps spec + + kmul = transegr [0.2, dur * 0.5, -15, 0.01, dur * 0.5, 0, 0] dur 0 0 + kbend = transegr [0.5, 1.2, -4, 0, 1, 0, 0] dur 0 0 + asig = gbuzz 0.5 (sig cps * semitone kbend) 20 1 kmul cosine + aenv = transeg [1, dur - 0.004, -6, 0] + att = linseg [0, 0.004, 1] + asig1 = asig * aenv * att + + aenv1 = linseg [1, 0.07, 0] + acps = expsega [8 * cps,0.07,0.001] + aimp = oscili aenv1 acps sine + amix = asig1 * 0.7 + aimp * 0.25 + +bdSpec2 = TrSpec + { trDur = 1.3 + , trTune = 1 + , trCps = 57 + , trRnd = Just 0.05 } + +bass2 = bass2' bdSpec2 + +bass2' spec = pureBass2' =<< rndSpec spec + +pureBass2' :: TrSpec -> SE Sig +pureBass2' spec = (rndAmp <=< addDur) $ compr $ mul (expsegr [1, 0.6 * dur, 0.1, 0.4 * dur, 0.001] (0.4 * dur) 0.001) $ + fosc 1 2 (0.5 * xeg 0.01 0.1 0.2 0.5) (cps * semitone (expseg [12, 0.01, 27, 0.3, 0.001])) + where + compr x = dam x 0.65 2.4 2.3 0.05 0.1 + dur = trDur spec + cps = sig $ trCps spec + + +snSpec = cpsSpec 342 + +snare = snare' snSpec + +snare' spec = pureSnare' =<< rndSpec spec + +-- sound consists of two sine tones, an octave apart and a noise signal +pureSnare' :: TrSpec -> SE Sig +pureSnare' spec = rndAmp =<< addDur =<< (apitch + anoise) + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + iNseDur = dur * 0.3 + iPchDur = dur * 0.1 + + -- sine tones component + aenv1 = expsegr [1, iPchDur, 0.0001] iNseDur 0.0001 + apitch1 = rndOsc (sig cps) + apitch2 = rndOsc (0.5 * sig cps) + apitch = mul (0.75 * aenv1) (apitch1 + apitch2) + + -- noise component + aenv2 = expon 1 iNseDur 0.0005 + kcf = expsegr [5000, 0.1, 3000] iNseDur 0.0001 + anoise = mul aenv2 $ do + x <- noise 0.75 0 + return $ blp kcf $ bhp 1000 $ bbp (10000 * octave (sig tune)) 10000 x + +ohSpec = cpsSpec 296 +chSpec = cpsSpec 296 + +openHiHat = openHiHat' ohSpec +closedHiHat = closedHiHat' chSpec + +openHiHat' :: TrSpec -> SE Sig +openHiHat' spec = genHiHat (linsegr [1, (dur/2) - 0.05, 0.1, 0.05, 0] dur 0) spec + where dur = trDur spec + +closedHiHat' :: TrSpec -> SE Sig +closedHiHat' spec = genHiHat (expsega [1, (dur / 2), 0.001]) spec + where dur = trDur spec + +-- sound consists of 6 pulse oscillators mixed with a noise component +-- cps = 296 +genHiHat :: Sig -> TrSpec -> SE Sig +genHiHat pitchedEnv spec = rndAmp =<< addDur =<< (amix1 + anoise) + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + halfDur = dur * 0.5 + + -- pitched element + harmonics = [1.0, 0.962, 1.233, 1.175,1.419, 2.821] + amix = mul 0.5 $ fmap sum $ mapM (rndPw 0.25 . sig . (* (cps * octave tune))) harmonics + amix1 = mul pitchedEnv $ at (\asig -> bhp 5000 $ bhp 5000 $ reson asig (5000 * octave (sig tune)) 5000 `withD` 1) amix + + -- noise element + kcf = expseg [20000, 0.7, 9000, halfDur-0.1, 9000] + anoise = mul pitchedEnv $ do + x <- noise 0.8 0 + return $ bhp 8000 $ blp kcf x + +htSpec = cpsSpec 200 +mtSpec = cpsSpec 133 +ltSpec = cpsSpec 90 + +lowTom = lowTom' ltSpec +midTom = midTom' mtSpec +highTom = highTom' htSpec + +-- cps = 200 +highTom' :: TrSpec -> SE Sig +highTom' = genTom 0.5 (400, 100, 1000) + +-- cps = 133 +midTom' :: TrSpec -> SE Sig +midTom' = genTom 0.6 (400, 100, 600) + +-- cps = 90 +lowTom' :: TrSpec -> SE Sig +lowTom' = genTom 0.6 (40, 100, 600) + +genTom :: D -> (Sig, Sig, Sig) -> TrSpec -> SE Sig +genTom durDt (resonCf, hpCf, lpCf) spec = rndAmp =<< addDur =<< (asig + anoise) + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + ifrq = cps * octave tune + halfDur = durDt * dur + + -- sine tone signal + aAmpEnv = transeg [1, halfDur, -10, 0.001] + afmod = expsega [5, 0.125/ifrq, 1] + asig = mul (-aAmpEnv) $ rndOsc (sig ifrq * afmod) + + -- noise signal + aEnvNse = transeg [1, halfDur, -6 , 0.001] + otune = sig $ octave tune + anoise = mul aEnvNse $ do + x <- noise 1 0.4 + return $ blp (lpCf * otune) $ bhp (hpCf * otune) $ reson x (resonCf * otune) 800 `withD` 1 + +cymSpec = cpsSpec 296 + +cymbal = cymbal' cymSpec + +-- sound consists of 6 pulse oscillators mixed with a noise component +-- cps = 296 +cymbal' :: TrSpec -> SE Sig +cymbal' spec = rndAmp =<< addDur =<< (fmap (amix1 + ) anoise) + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + fullDur = dur * 2 + + -- pitched element + harmonics = [1.0, 0.962, 1.233, 1.175,1.419, 2.821] + aenv = expon 1 fullDur 0.0001 + amix = mul 0.5 $ sum $ fmap (pw 0.25 . sig . (* (cps * octave tune))) harmonics + amix1 = mul aenv $ blp 12000 $ blp 12000 $ bhp 10000 $ reson amix (5000 * octave (sig tune)) 5000 `withD` 1 + + -- noise element + aenv2 = expsega [1,0.3,0.07,fullDur-0.1,0.00001] + kcf = expseg [14000, 0.7, 7000, fullDur-0.1, 5000] + anoise = mul aenv2 $ do + x <- noise 0.8 0 + return $ bhp 8000 $ blp kcf x + +clSpec = cpsSpec 2500 + +claves = claves' clSpec + +-- cps = 2500 +claves' :: TrSpec -> SE Sig +claves' spec = rndAmp =<< addDur =<< asig + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + ifrq = cps * octave tune + dt = 0.045 * dur + aenv = expsega [1, dt, 0.001] + afmod = expsega [3,0.00005,1] + asig = mul (- 0.4 * (aenv-0.001)) $ rndOsc (sig ifrq * afmod) + +rimSpec = cpsSpec 1700 + +rimShot = rimShot' rimSpec + +rimShot' spec = pureRimShot' =<< rndSpec spec + +-- cps = 1700 +pureRimShot' :: TrSpec -> SE Sig +pureRimShot' spec = rndAmp =<< addDur =<< (mul 0.8 $ aring + anoise) + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + fullDur = 0.027 * dur + + -- ring + aenv1 = expsega [1,fullDur,0.001] + ifrq1 = sig $ cps * octave tune + aring = mul (0.5 * (aenv1 - 0.001)) $ at (bbp ifrq1 (ifrq1 * 8)) $ rndOscBy tabTR808RimShot ifrq1 + + -- noise + aenv2 = expsega [1, 0.002, 0.8, 0.005, 0.5, fullDur-0.002-0.005, 0.0001] + kcf = expsegr [4000, fullDur, 20] fullDur 20 + anoise = mul (aenv2 - 0.001) $ fmap (blp kcf) $ noise 1 0 + + tabTR808RimShot = setSize 1024 $ sines [0.971,0.269,0.041,0.054,0.011,0.013,0.08,0.0065,0.005,0.004,0.003,0.003,0.002,0.002,0.002,0.002,0.002,0.001,0.001,0.001,0.001,0.001,0.002,0.001,0.001] + +cowSpec = cpsSpec 562 + +cowbell = cowbell' cowSpec + +-- cps = 562 +cowbell' :: TrSpec -> SE Sig +cowbell' spec = rndAmp =<< addDur =<< ares + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + ifrq1 = sig $ cps * octave tune + ifrq2 = 1.5 * ifrq1 + fullDur = 0.7 * dur + ishape = -30 + ipw = 0.5 + kenv1 = transeg [1,fullDur*0.3,ishape,0.2, fullDur*0.7,ishape,0.2] + kenv2 = expon 1 fullDur 0.0005 + kenv = kenv1 * kenv2 + amix = mul 0.65 $ rndPw 0.5 ifrq1 + rndPw 0.5 ifrq2 + iLPF2 = 10000 + kcf = expseg [12000,0.07,iLPF2,1,iLPF2] + alpf = at (blp kcf) amix + abpf = at (\x -> reson x ifrq2 25) amix + ares = mul (0.08 * kenv) $ at dcblock2 $ mul (0.06 * kenv1) abpf + mul 0.5 alpf + mul 0.9 amix + +-- TODO clap + +{- +instr 112 ;CLAP + krelease release ;SENSE RELEASE OF THIS NOTE ('1' WHEN RELEASED, OTHERWISE ZERO) + chnset 1-krelease,"Act12" ;TURN ON ACTIVE LIGHT WHEN NOTE STARTS, TURN IT OFF WHEN NOTE ENDS + iTimGap = 0.01 ;GAP BETWEEN EVENTS DURING ATTACK PORTION OF CLAP + idur1 = 0.02 ;DURING OF THE THREE INITIAL 'CLAPS' + idur2 = 2*i(gkdur12) ;DURATION OF THE FOURTH, MAIN, CLAP + idens = 8000 ;DENSITY OF THE NOISE SIGNAL USED TO FORM THE CLAPS + iamp1 = 0.5 ;AMPLITUDE OF AUDIO BEFORE BANDPASS FILTER IN OUTPUT + iamp2 = 1 ;AMPLITUDE OF AUDIO AFTER BANDPASS FILTER IN OUTPUT + if frac(p1)==0 then ;IF THIS IS THE INITIAL NOTE (p1 WILL BE AN INTEGER) + ; del. dur env.shape + event_i "i", p1+0.1, 0, idur1, p4 ;CALL THIS INSTRUMENT 4 TIMES. ADD A FRACTION ONTO p1 TO BE ABLE TO DIFFERENTIATE THESE SUBSEQUENT NOTES + event_i "i", p1+0.1, iTimGap, idur1, p4 + event_i "i", p1+0.1, iTimGap*2, idur1, p4 + event_i "i", p1+0.1, iTimGap*3, idur2, p4 + else + kenv transeg 1,p3,-25,0 ;AMPLITUDE ENVELOPE + iamp random 0.7,1 ;SLIGHT RANDOMISATION OF AMPLITUDE + anoise pinkish kenv*iamp + iBPF = 1100*octave(i(gktune12)) ;FREQUENCY OF THE BANDPASS FILTER + ibw = 2000*octave(i(gktune12)) ;BANDWIDTH OF THE BANDPASS FILTER + iHPF = 1000 ;FREQUENCY OF A HIGHPASS FILTER + iLPF = 1 ;SCALER FOR FREQUENCY OF A LOWPASS FILTER + kcf expseg 8000,0.07,1700,1,800,2,500,1,500 ;CREATE CUTOFF FREQUENCY ENVELOPE + asig butlp anoise,kcf*iLPF ;LOWPASS FILTER THE SOUND + asig buthp asig,iHPF ;HIGHPASS FILTER THE SOUND + ares reson asig,iBPF,ibw,1 ;BANDPASS FILTER THE SOUND (CREATE A NEW SIGNAL) + asig dcblock2 (asig*iamp1)+(ares*iamp2) ;MIX BANDPASS FILTERED AND NON-BANDPASS FILTERED SOUND ELEMENTS + asig = asig*p4*i(gklevel12)*1.75*gklevel ;SCALE AMPLITUDE + aL,aR pan2 asig,i(gkpan12) ;PAN MONOPHONIC SIGNAL + outs aL,aR ;SEND AUDIO TO OUTPUTS + endif +endin +-} + +{- +clap :: D -> D -> D -> Sig +clap dur tune cps = + where + iTimGap = 0.01 +-} + +marSpec = cpsSpec 450 + +maraca = maraca' marSpec + +maraca' :: TrSpec -> SE Sig +maraca' spec = rndAmp =<< addDur =<< anoise + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + fullDur = 0.07* dur + otune = sig $ octave tune + iHPF = limit (6000 * otune) 20 (sig getSampleRate / 2) + iLPF = limit (12000 * otune) 20 (sig getSampleRate / 3) + aenv = expsega [0.4,0.014* dur,1,0.01 * dur, 0.05, 0.05 * dur, 0.001] + anoise = mul aenv $ fmap (blp iLPF . bhp iHPF) $ noise 0.75 0 + +hcSpec = cpsSpec 420 +mcSpec = cpsSpec 310 +lcSpec = cpsSpec 227 + +highConga = highConga' hcSpec +midConga = midConga' mcSpec +lowConga = lowConga' lcSpec + +-- high conga +-- cps = 420 +highConga' :: TrSpec -> SE Sig +highConga' = genConga 0.22 + +-- cps = 310 +midConga' :: TrSpec -> SE Sig +midConga' = genConga 0.33 + +-- cps = 227 +lowConga' :: TrSpec -> SE Sig +lowConga' = genConga 0.41 + +genConga :: D -> TrSpec -> SE Sig +genConga dt spec = rndAmp =<< addDur =<< asig + where + dur = trDur spec + tune = trTune spec + cps = trCps spec + + ifrq = cps * octave tune + fullDur = dt * dur + aenv = transeg [0.7,1/ifrq,1,1,fullDur,-6,0.001] + afmod = expsega [3,0.25/ifrq,1] + asig = mul (-0.25 * aenv) $ rndOsc (sig ifrq * afmod) + + +----------------------------------------------------- +-- sampler + +mkSam = limSam 1 + +-- | Bass drum +bd :: Sam +bd = mkSam bass + +bd2 :: Sam +bd2 = mkSam bass2 + +-- | Snare +sn :: Sam +sn = mkSam snare + +-- | Open hi-hat +ohh :: Sam +ohh = mkSam openHiHat + +-- | Closed hi-hat +chh :: Sam +chh = mkSam closedHiHat + +-- | High tom +htom :: Sam +htom = mkSam highTom + +-- | Middle tom +mtom :: Sam +mtom = mkSam midTom + +-- | Low tom +ltom :: Sam +ltom = mkSam lowTom + +-- | Cymbal +cym :: Sam +cym = mkSam cymbal + +-- | Claves +cl :: Sam +cl = mkSam claves + +-- | Rim shot +rim :: Sam +rim = mkSam rimShot + +-- | Maracas +mar :: Sam +mar = mkSam maraca + +-- | High conga +hcon :: Sam +hcon = mkSam highConga + +-- | Middle conga +mcon :: Sam +mcon = mkSam midConga + +-- | Low conga +lcon :: Sam +lcon = mkSam lowConga + +-- generic sam + +mkSam' f spec = mkSam $ f spec + +-- | Bass drum +bd' :: TrSpec -> Sam +bd' = mkSam' bass' + +bd2' :: TrSpec -> Sam +bd2' = mkSam' bass2' + +-- | Snare +sn' :: TrSpec -> Sam +sn' = mkSam' snare' + +-- | Open hi-hat +ohh' :: TrSpec -> Sam +ohh' = mkSam' openHiHat' + +-- | Closed hi-hat +chh' :: TrSpec -> Sam +chh' = mkSam' closedHiHat' + +-- | High tom +htom' :: TrSpec -> Sam +htom' = mkSam' highTom' + +-- | Middle tom +mtom' :: TrSpec -> Sam +mtom' = mkSam' midTom' + +-- | Low tom +ltom' :: TrSpec -> Sam +ltom' = mkSam' lowTom' + +-- | Cymbal +cym' :: TrSpec -> Sam +cym' = mkSam' cymbal' + +-- | Claves +cl' :: TrSpec -> Sam +cl' = mkSam' claves' + +-- | Rim shot +rim' :: TrSpec -> Sam +rim' = mkSam' rimShot' + +-- | Maracas +mar' :: TrSpec -> Sam +mar' = mkSam' maraca' + +-- | High conga +hcon' :: TrSpec -> Sam +hcon' = mkSam' highConga' + +-- | Middle conga +mcon' :: TrSpec -> Sam +mcon' = mkSam' midConga' + +-- | Low conga +lcon' :: TrSpec -> Sam +lcon' = mkSam' lowConga' + + diff --git a/src/Csound/Catalog/Effect.hs b/src/Csound/Catalog/Effect.hs --- a/src/Csound/Catalog/Effect.hs +++ b/src/Csound/Catalog/Effect.hs @@ -85,12 +85,12 @@ -- nightReverb :: Int -> D -> D -> D -> Sig -> SE (Sig, Sig) nightReverb n igain ipitchmod itone asig = do - afiltRefs <- mapM newSERef $ replicate n 0 - afilts1 <- mapM readSERef afiltRefs + afiltRefs <- mapM newRef $ replicate n 0 + afilts1 <- mapM readRef afiltRefs let apj = (2 / fromIntegral n) * sum afilts1 adels <- sequence $ zipWith3 (del apj) idels ks afilts1 - zipWithM_ (\ref x -> writeSERef ref $ filt x) afiltRefs adels - afilts2 <- mapM readSERef afiltRefs + zipWithM_ (\ref x -> writeRef ref $ filt x) afiltRefs adels + afilts2 <- mapM readRef afiltRefs return (mean $ odds afilts2, mean $ evens afilts2) where idels = cycle $ fmap ( / getSampleRate) [2473, 2767, 3217, 3557, 3907, 4127, 2143, 1933] diff --git a/src/Csound/Catalog/Reson.hs b/src/Csound/Catalog/Reson.hs --- a/src/Csound/Catalog/Reson.hs +++ b/src/Csound/Catalog/Reson.hs @@ -79,7 +79,7 @@ onNormDur <- noise (osciln 1 (1 / dt) decayShape 1) 0 return $ guardedTuple - [ (sig dt <* 0.001, onLowDur) + [ (sig dt `lessThan` 0.001, onLowDur) , (sig dt >=* 1, onHighDur) ] onNormDur where diff --git a/src/Csound/Catalog/Wave.hs b/src/Csound/Catalog/Wave.hs --- a/src/Csound/Catalog/Wave.hs +++ b/src/Csound/Catalog/Wave.hs @@ -59,8 +59,42 @@ maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH, femaleA, femaleE, femaleIY, femaleO, femaleOO, + -- * Sean Costello + RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec, + snowCrackle, + fmDrone, fmDrones, + tenorOsc, sopranoOsc, + + -- * Flavio + amFlavio, fmFlavio, simpleSust, simpleFading, + + -- * Thor + cathedralOrgan, cathedralOrganFx, hammondOrgan, + + amPiano, + + pwBass, pwHarpsichord, pwEnsemble, + + simpleBass, + + EpianoOsc(..), epiano, + + noisyChoir, thorWind, mildWind, boom, windWall, + + razorPad, razorLead, + + -- * Bitwig + + pwPad, triPad, triPadFx, + Accordeon(..), accordeon, accordeonFx, + + -- * Pads + polySynthFx, polySynth, + dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, + -- * Other instruments - okComputer + okComputer, deepBass + ) where import Csound.Base @@ -73,6 +107,11 @@ import Csound.Catalog.Wave.Deserted import Csound.Catalog.Wave.TheHeartbeat import Csound.Catalog.Wave.TrappedInConvert + +import Csound.Catalog.Wave.Sean +import Csound.Catalog.Wave.Flavio +import Csound.Catalog.Wave.Thor +import Csound.Catalog.Wave.Bitwig import Csound.Catalog.Wave.Misc diff --git a/src/Csound/Catalog/Wave/Amsterdam.hs b/src/Csound/Catalog/Wave/Amsterdam.hs --- a/src/Csound/Catalog/Wave/Amsterdam.hs +++ b/src/Csound/Catalog/Wave/Amsterdam.hs @@ -16,6 +16,6 @@ -- * cps - the frequency of the note tibetan :: Int -> Sig -> D -> Sig tibetan n off cps = chorusPitch n (2 * off * fromIntegral n) (oscBy wave) (sig cps) - where wave = ifB (cps <* 230) (waveBy 5) (ifB (cps <* 350) (waveBy 3) (waveBy 1)) + where wave = ifB (cps `lessThan` 230) (waveBy 5) (ifB (cps `lessThan` 350) (waveBy 3) (waveBy 1)) waveBy x = sines $ [0.3, 0, 0, 0] ++ replicate x 0.1 diff --git a/src/Csound/Catalog/Wave/Bitwig.hs b/src/Csound/Catalog/Wave/Bitwig.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Bitwig.hs @@ -0,0 +1,51 @@ +module Csound.Catalog.Wave.Bitwig( + pwPad, triPad, triPadFx, + Accordeon(..), accordeon, accordeonFx +) where + +import Csound.Base + +--------------------------------------------------- +-- wind pads + +triPadFx :: Sig2 -> SE Sig2 +triPadFx a = mixAt 0.5 smallHall2 $ at (chorus 0.2 0.3 0.25) (return a :: SE Sig2) + +triPad x = mul (1.5 * fades 0.3 0.5) $ at (mlp (x * 5) 0.15) $ do + lfo <- rand 1.2 + mul 0.5 $ rndTri (x + 1.5 * lfo) + rndTri (x * cent 8) + +pwPad :: Sig -> SE Sig +pwPad x = mul (fades 0.3 0.95) $ at (mlp (x * 5) 0.15) $ do + let lfo = uosc 4 + return $ mul 0.5 $ pw (0.2 + 0.4 * lfo) x + tri (x * cent 8) + +pwPadMidi = mul 0.5 $ mixAt 0.5 smallHall2 $ at (chorus 0.2 0.3 0.25) $ at fromMono $ midi $ onMsg pwPad + +--------------------------------------------------- +-- accordeon + +osc4 freq1 freq2 freq3 freq4 a b cps = cfd4 a b (saw (cps * freq1)) (sqr (cps * freq2)) (saw (cps * freq3)) (sqr (cps * freq4)) +mlpTrack cps center q = mlp (cps + 6500 * center) q + +data Accordeon = Accordeon + { accordeonFreq1 :: Sig + , accordeonFreq2 :: Sig + , accordeonFreq3 :: Sig + , accordeonFreq4 :: Sig + } + +instance Default Accordeon where + def = Accordeon 1 0.5 2.01 2 + +accordeon :: Accordeon -> Sig -> SE Sig2 +accordeon spec cps = fmap fromMono $ liftA2 (\a b -> mul vcaEg $ mlpTrack (cps * 2) (0.5 * vcfEg) 0.1 $ f a b cps) (rndPointer 6 (0.3, 0.2)) (rndPointer 10 (0.4, 0.1)) + where + vcaEg = leg 0.01 0.3 0.5 0.3 + vcfEg = leg 0.05 0.3 0.2 0.2 + rndPointer' a dt b cps (x, y) = fmap (\r -> x + y * linseg [0, 0.01, a, dt, b] * r) (randi 1 cps) + rndPointer = rndPointer' 1 5 0.35 + f = osc4 (accordeonFreq1 spec) (accordeonFreq2 spec) (accordeonFreq3 spec) (accordeonFreq4 spec) + +accordeonFx :: Sig2 -> SE Sig2 +accordeonFx a = at smallHall2 $ mixAt 0.35 (echo 0.25 0.55) (return a :: SE Sig2) diff --git a/src/Csound/Catalog/Wave/Flavio.hs b/src/Csound/Catalog/Wave/Flavio.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Flavio.hs @@ -0,0 +1,63 @@ +module Csound.Catalog.Wave.Flavio( + amFlavio, fmFlavio, simpleSust, simpleFading +) where + +import Data.List +import Control.Monad + +import Csound.Base + +icero = 0.000001 +icasi = 0.0001 + +-- epiano-s + +-- irel1 = 16 +amFlavio irel1 cps = aout + where + irel1 = 16 + iamf = 1 + irel2 = irel1 * 0.7 + kamp = expsegr [icero, 0.05, 1, 1, 0.7, irel1, icasi, irel2, icero] irel2 icero + aam = kamp * osc (iamf * cps) + aout = aam * osc cps + +-- irel1 = 6, ifm = (2, 7), +fmFlavio irel1 ifm cps = aout + where + irel2 = irel1 * 0.5 + idec = 1 + iatt = 0.01 + + (iidx1, iidx2, iidx3, iidx4, iidx5) = (4, 4, 4, 4, 3) + + kamp = expsegr [icero, iatt, 1, idec, 0.7, irel1, icasi, irel2, icero] irel2 icero + kidx = linsegr [iidx1, iatt, iidx2, idec, iidx3, irel1, iidx4, irel2, iidx5] irel2 iidx5 + + afrq = kidx * osc (ifm * cps) + aout = kamp * osc (cps * (1 + afrq)) + + +simpleSust = genSimple 0.25 0.1 +simpleFading = genSimple icasi icero + +genSimple isust1 isust2 irel (amp, dcps) = do + aleft <- fmap pure $ random 1 (11 * sig amp) + aright <- fmap pure $ random 1 (10.5 * sig amp) + return (aleft, aright) + where + cps = sig dcps + pure ichr = aout + where + irel1 = irel * (0.5 + amp) + iatt = 0.01 + idec = 1 + irel2 = 0.75 * irel1 + + -- kamp = expsegr [1, idec, 0.7, irel1, icasi, irel2, icero] irel2 icero + kamp = expsegr [1, idec, 0.7, irel1, isust1, irel2, isust2] irel2 icero + kcf = 2 * sig amp * linsegr [3000, irel1 + 1, 500] irel2 500 + a3 = kamp * (osc (cps - ichr) + osc (cps - ichr))* 0.5 + + aout = blp kcf a3 + diff --git a/src/Csound/Catalog/Wave/Misc.hs b/src/Csound/Catalog/Wave/Misc.hs --- a/src/Csound/Catalog/Wave/Misc.hs +++ b/src/Csound/Catalog/Wave/Misc.hs @@ -1,5 +1,7 @@ module Csound.Catalog.Wave.Misc ( - okComputer + okComputer, polySynthFx, polySynth, + dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, + deepBass ) where import Csound.Base @@ -14,3 +16,54 @@ where go anoise = osc (samphold anoise kgate) kgate = kr $ oscil 1 cps (elins [1, 0, 0]) + + +polySynth x = mul (fades 0.01 0.15) $ at (mlp 5500 0.12) $ at (filt 2 br 18000 0.3) $ uni rndSaw x + uni rndSaw (x * cent 14) + (mul 0.2 $ at (lp 400 0.1) white) + where uni = multiHz 2 (cent 50) + +polySynthFx :: SE Sig -> SE Sig2 +polySynthFx = mixAt 0.25 largeHall2 . mixAt 0.25 (echo 0.25 0.65) . at (chorus 0.07 1.25 0.25) . at fromMono + +uni = multiHz 2 (cent 50) + +dreamPad = genDreamPadInstr mkOsc + where mkOsc vibLfo1 vibLfo2 x = uni rndSaw (vibLfo1 x) + uni rndSaw (vibLfo2 $ x * cent 14) + +underwaterPad = genDreamPadInstr mkOsc + where mkOsc vibLfo1 vibLfo2 x = uni rndTri (vibLfo1 x) + uni rndTri (vibLfo2 $ x * cent 14) + +lightIsTooBrightPad = genDreamPadInstr mkOsc + where mkOsc vibLfo1 vibLfo2 x = uni rndSaw (vibLfo1 x) + uni rndSaw (vibLfo2 $ x * cent 14) + mul 0.3 (mul (uosc 0.25) (rndTri (vibLfo2 $ x * 7 * cent 4)) + mul (isawSeq [1, 0.5, 0.25] 6 * uosc 0.17) (rndTri (vibLfo2 $ x * 13)) + mul (sqrSeq [1, 0.5, 0.25, 0.1] 8 * uosc 0.28) (rndOsc (vibLfo2 $ x * 9 * cent 3))) + +whaleSongPad = genDreamPadInstr mkOsc + where mkOsc vibLfo1 vibLfo2 x = uni rndTri (vibLfo1 x) + uni rndTri (vibLfo2 $ x * cent 14) + uni rndTri (vibLfo2 $ 3 * x * cent 14) + mul 0.15 (uni rndTri (vibLfo2 $ 7 * x * cent 14)) + mul 0.15 (uni rndTri ((vibLfo2 $ 11 * x * cent 14) + 400 * uosc 0.2)) + +genDreamPadInstr mkOsc brightness x = do + a1 <- oscs + a2 <- nois + return $ mul (fades 0.85 0.95) $ fx1 (a2 + a1) + fx2 a1 + where + fx1 = filt 2 mlp (filtLfo1 (700 + brightness * 2500)) 0.26 + fx2 = mlp (filtLfo2 (1200 + brightness * 2500)) 0.32 + + -- saw + oscs = mkOsc vibLfo1 vibLfo2 x + + -- underwater + -- oscs = uni rndTri (vibLfo1 x) + uni rndTri (vibLfo2 $ x * cent 14) -- + uni rndTri (vibLfo2 $ 3 * x * cent 14) + + -- wales howling + -- oscs = uni rndTri (vibLfo1 x) + uni rndTri (vibLfo2 $ x * cent 14) + uni rndTri (vibLfo2 $ 3 * x * cent 14) + mul 0.15 (uni rndTri (vibLfo2 $ 7 * x * cent 14)) + mul 0.15 (uni rndTri ((vibLfo2 $ 11 * x * cent 14) + 400 * uosc 0.2)) + nois = mul 0.35 $ at (lp 2400 0.1) white + + uni = multiHz 2 (cent 50) + lfo1 y x = x * (1 + y * osc (0.35 + 0.05 * osc 0.1)) + lfo2 y x = x * (1 + y * osc (0.22 + 0.043 * osc 0.14)) + + filtLfo1 = lfo1 0.18 + filtLfo2 = lfo2 0.13 + + vibLfo1 = lfo1 0.005 + vibLfo2 = lfo2 0.007 + +deepBass x = mul 0.5 $ at (hp1 45) $ at (\x -> dam x 0.45 2 2 0.01 0.01) $ mul (xeg 0.005 0.6 1 0.05) $ sum [(filt 2 lp 275 0.25) (saw $ x * 0.5), osc (x * 0.5)] diff --git a/src/Csound/Catalog/Wave/Sean.hs b/src/Csound/Catalog/Wave/Sean.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Sean.hs @@ -0,0 +1,202 @@ +{-# Language FlexibleContexts #-} +module Csound.Catalog.Wave.Sean( + RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec, + snowCrackle, + fmDrone, fmDrones, + tenorOsc, sopranoOsc +) where + +import Data.List +import Control.Monad + +import Csound.Base hiding (formant) + +data RissetBellSpec = RissetBellSpec + { rissetBellRands :: [D] + , rissetBellRandShifts :: [D] + , rissetBellDurs :: [D] + , rissetBellAmps :: [Sig] + , rissetBellFreqs :: [Sig] + , rissetBellFreqShifts :: [Sig] + } + +rissetBell :: RissetBellSpec -> (D, D) -> D -> Sig -> Sig -> SE Sig +rissetBell spec (from, to) dur amp cps = ares + where + idurs = fmap (dur * ) (rissetBellDurs spec) + ifreqs = fmap (cps * ) (rissetBellFreqs spec) + ifreqDt = (rissetBellFreqShifts spec) + iamps = fmap (amp * ) (rissetBellAmps spec) + irands = (rissetBellRands spec) + irandDt = (rissetBellRandShifts spec) + + partial iamp ifreq ifreqDt idur irand irandDt = do + amod <- randi iamp (linseg [from * irand + irandDt, idur, to * irand + irandDt]) + return $ mul amod $ osc (ifreq + ifreqDt) + + env = expsegr [1, dur, 0.001] dur 0.001 + ares = mul 0.75 $ fmap sum $ zipWithM (\(iamp, ifreq, ifreqDt) (idur, irand, irandDt) -> partial iamp ifreq ifreqDt idur irand irandDt) (zip3 iamps ifreqs ifreqDt) (zip3 idurs irands irandDt) + +timpaniSpec = RissetBellSpec + { rissetBellDurs = [0.087, 0.5, 0.804, 0.065, 0.325, 0.54, 1, 0.195, 0.108, 0.89, 0.075] + , rissetBellFreqs = [0.8, 1.00, 1.5, 1.65, 1.97, 2, 2.44, 2.86, 2.71, 2.91, 3.27] + , rissetBellFreqShifts = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] + , rissetBellAmps = [1, 2.52, 1.83, 0.55, 1.47, 1.67, 0.62, 0.5, 0.52, 0.55, 0.33] + , rissetBellRands = [0.56, 0.56, 0.92, 0.92, 1.19, 1.7, 2, 2.74, 3, 3.75, 4.07] + , rissetBellRandShifts = [0, 1, 0, 1.7, 0, 0, 0, 0, 0, 0, 0] } + +timpani :: (D, D) -> D -> Sig -> Sig -> SE Sig +timpani (from, to) dur amp cps = mul env $ rissetBell timpaniSpec (from, to) dur amp cps + where env = expsegr [1, dur, 0.001] dur 0.001 + + +noiseBellSpec = RissetBellSpec + { rissetBellDurs =[1, 0.9, 0.65, 0.55, 0.325, 0.35, 0.25, 0.2, 0.15, 0.1, 0.075] + , rissetBellFreqs = [0.56, 0.56, 0.92, 0.92, 1.19, 1.7, 3, 2.74, 3, 3.75, 4.07] + , rissetBellFreqShifts = [0, 1, 0, 1.7, 0, 0, 0, 0, 0, 0, 0] + , rissetBellAmps = [1, 0.67, 1.35, 1.8, 2.67, 1.67, 1.46, 1.33, 1.33, 0.75, 1.33] + , rissetBellRands = [0.56, 0.56, 0.92, 0.92, 1.19, 1.7, 2, 2.74, 3, 3.75, 4.07] + , rissetBellRandShifts = [0, 1, 0, 1.7, 0, 0, 0, 0, 0, 0, 0] } + +-- | > dac $ noiseBell (31, 125) 2.3 0.2 2900 +noiseBell :: (D, D) -> D -> Sig -> Sig -> SE Sig +noiseBell (from, to) dur amp cps = mul env $ rissetBell noiseBellSpec (from, to) dur amp cps + where env = expsegr [1, dur, 0.001] dur 0.001 + +------------------------------------------------------------------------ + +-- | speed ~ 10 - 20 +-- +-- > snowCrackle speed +snowCrackle :: Sig -> Sig +snowCrackle speed = mlp 1200 0.1 $ mouseDrum speed (3 + 2 * uosc 0.1) (160 + 100 * uosc 0.13) + where + mouseDrum :: Sig -> Sig -> Sig -> Sig + mouseDrum freq index cps = + sched instr $ withDur dur $ fmap (\[a, b] -> (a, b)) $ randList 2 $ dust freq + where + dur = 0.049 + instr (rndCps, rndIndex) = return $ + mouseDrumGrain dur + (cps + 10 * sig (2 * rndCps - 1)) + (index + 0.01 * sig (2 * rndIndex - 1)) + + mouseDrumGrain dur icarfreq index = aosc + where + iratio = 1.416 + idev = imodfreq * index + imodfreq = icarfreq * iratio + amod = mul (idev * imodfreq) $ osc imodfreq + kenv = expsegr [1, dur, 0.001] dur 0.001 + aosc = mul kenv $ osc (icarfreq + amod) + +------------------------------------------------------------------------ + +fmDronePartial amod' index idev kamp1 ifreq1 (a1, a2, a3, a4) = ares + where + aosc1 = mul (idev * kamp1) $ osc (ifreq1 * a1) + aosc2 = osc (ifreq1 * a2 + aosc1 + amod') + aosc3 = osc (ifreq1 * a3 + aosc1 + amod') + aosc4 = osc (a4 + aosc1 + amod') + ares = 0.5 * kamp1 * sum [aosc2, aosc3, aosc4] + +scDrone = fmDrone 3 +scDrones = fmDrones 3 + +pulseIndex ns speed = 1 + 7 * seqSqr [seqDesc ns] speed + +fmPulse ns speed = fmDrone (pulseIndex ns speed) (0.05, 0.5) +fmPulses amps harms ns speed = fmDrones (pulseIndex ns speed) amps harms (0.05, 0.5) + +-- | > dac $ fmDrone 3 (20, 5) 110 +fmDrone index (iatt, irel) cps = (aout1, aout2) + where + ifreq1 = cps + iamp = 0.39 + idev = index * ifreq1 + kamp1 = leg iatt 0 1 irel + + f a1 a2 a3 a4 = iamp * fmDronePartial 0 index idev kamp1 ifreq1 (a1, a2, a3, a4) + + aout1 = f 1 0.998 1.5007 0.1 + aout2 = f 0.99 0.987 1.498 0.13 + +fmDrones index amps harms (iatt, irel) cps = aout + where + iamp = 0.39 + kamp1 = leg iatt 0 1 irel + + f amp h = do + let ifreq1 = h * cps + idev = index * ifreq1 + + a1 <- randomSig 1 0.03 + a2 <- randomSig 0.998 0.025 + a3 <- randomSig 1.5 0.004 + a4 <- randomSig 0.1 0.03 + return $ amp * fmDronePartial 0 index idev kamp1 ifreq1 (a1, a2, a3, a4) + + ares = fmap sum $ zipWithM f amps harms + aout = liftA2 (,) ares ares + +randomD :: D -> D -> SE D +randomD val dev = fmap ir $ random (sig $ val - dev) (sig $ val + dev) + +randomSig :: Sig -> Sig -> SE Sig +randomSig val dev = random (val - dev) (val + dev) + +gaussD :: D -> D -> SE D +gaussD val dev = fmap ((+ val) . ir) $ gauss (sig val) + +gaussSig :: Sig -> Sig -> SE Sig +gaussSig val dev = fmap ((+ val)) $ gauss val + +randiDev :: Sig -> Sig -> Sig -> SE Sig +randiDev val dev cps = fmap (+ val) $ randi dev cps + +randhDev :: Sig -> Sig -> Sig -> SE Sig +randhDev val dev cps = fmap (+ val) $ randh dev cps + +------------------------------------------------------------------------ +-- choir + +tenorOsc = voiceOsc 0.9 +sopranoOsc = voiceOsc 0.8 + +linVibr2 (v1, v2) (vtime1, vtime2) = linseg [v1, vtime1, v1, vtime2, v2] + +voiceOsc :: Sig -> (Sig -> Sig) -> Sig -> Sig -> SE Sig +voiceOsc mulHarm formantFilter kvib cps = at formantFilter $ voiceAnimator (RndDev 0.05 0.75) kvib $ asig * kenv + where + iharms = sig getSampleRate * 0.4 / cps + asig = gbuzz 1 cps iharms 1 mulHarm (sines3 [(1, 1, 0.25)]) + kenv = leg 0.1 0 1 0.1 + +data RndDev = RndDev + { rndDevRatio :: Sig + , rndDevSpeed :: Sig + } + +voiceAnimator :: RndDev -> Sig -> Sig -> SE Sig +voiceAnimator rndDev kvib ain = aout + where + ktimes = zipWithM (\amp cps -> mul (amp * osc cps) $ addRnd rndDev kvib) [0.0012, 0.0009, 0.00087, 0.0011] [4, 5, 6.3, 4.4] + -- ktimes = zipWith (\amp cps -> kvib * amp * osc cps) [0.0012, 0.0009, 0.00087, 0.0011, 0.00093, 0.00081, 0.0071] [4, 5, 6.3, 4.4, 5.2, 4.2, 5.5] + aout = fmap (mean . fmap (\t -> vdelay ain t 0.015)) ktimes + +addRnd :: RndDev -> Sig -> SE Sig +addRnd spec ain = do + xDt <- randi (rndDevRatio spec) (rndDevSpeed spec) + return $ ain * (1 + xDt) + + +data Formant = Formant + { formantWeight :: Sig + , formantCenter :: Sig + , formantWidth :: Sig + } + +------------------------------------------------------------------------ +-- + + diff --git a/src/Csound/Catalog/Wave/Thor.hs b/src/Csound/Catalog/Wave/Thor.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Thor.hs @@ -0,0 +1,168 @@ +{-# Language FlexibleContexts #-} +module Csound.Catalog.Wave.Thor( + cathedralOrgan, cathedralOrganFx, hammondOrgan, + + amPiano, + + pwBass, pwHarpsichord, pwEnsemble, + + simpleBass, + + EpianoOsc(..), epiano, + + noisyChoir, thorWind, mildWind, boom, windWall, + + razorPad, razorLead +) where + +import Data.List +import Control.Monad + +import Csound.Base + +-- some instruments from the Thor explained series +-- +-- https://www.propellerheads.se/substance/discovering-reason/index.cfm?article=part19&fuseaction=get_article + +------------------------------ +-- thor oscillators + +------------------------------ +-- 1 oscillators + +cathedralOrganFx :: Sig -> Sig2 +cathedralOrganFx = mixAt 0.25 largeHall . fromMono + +cathedralOrgan cps = mul 0.3 $ sum $ fmap ($ cps) [hammondOrgan 3 , detune (2 * cent 4) (hammondOrgan 10), detune (3 * cent 3) (hammondOrgan 6)] + +-- | hammondOrgan detune +-- +-- detune = [0, 30] (in cents) +hammondOrgan :: Sig -> Sig -> SE Sig +hammondOrgan dt x = mul (fades 0.01 0.05) $ fmap mean $ mapM rndOsc + [ x + , 2 * x * cent dt + , 3 * x * cent (2 * dt) ] + +------------------------------ +-- 2 am & sync + +amPiano :: Sig -> SE Sig +amPiano x = mul env $ at (mlp (env * (3000 + x)) 0.25) $ (rndSaw x * rndSaw (4 * x)) + where env = leg 0.01 4 0 0.02 + +------------------------------ +-- 3 pwm + +pwBass :: Sig -> SE Sig +pwBass cps = mul (fades 0.005 0.05) $ at (mlp 1500 0.1) $ rndPw (0.25 * (1 + 0.07 * osc (1 + (7 * cps / 1000)))) cps + +simpleBass :: (D, D) -> Sig +simpleBass (amp, cps') = aout + where + cps = sig cps' + + all = sum + [ 0.4 * oscBy pulse $ cps * 0.998 - 0.12 + , 0.4 * osc $ cps * 1.002 - 0.12 + , 0.4 * oscBy pulse $ cps * 0.998 - 0.12 + , 0.7 * osc $ cps - 0.24 ] + + aout = mul (kgain * sig amp * linsegr [0, 0.01, 1, (3.5 * amp), 0] 0.35 0) + $ blp (700 + (sig amp * 500)) + $ bhp 65 + $ bhp 65 + $ blp ksweep + $ blp ksweep all + + ksweep = expsegr [3000, 0.03, 9000] 3 1 - 3000 + + pulse = sines [1, 1, 1, 1, 0.7, 0.5, 0.3, 0.1] + + kgain = 2 + +pwHarpsichord :: Sig -> SE Sig +pwHarpsichord x = mul 2.5 $ mul (leg 0.005 1.5 0 0.25) $ at (mlp (env * 8000) 0.15) $ at (hp 2500 0.3) $ rndPw 0.4 x + where env = leg 0.01 4 0 0.01 + +pwEnsemble :: Sig -> SE Sig +pwEnsemble x = mul 0.3 $ at (mlp (3500 + x * 2) 0.1) $ mul (leg 0.5 0 1 1) $ sum + [ f 0.2 0.11 2 (x * cent (-6)) + , f 0.8 (-0.1) 1.8 (x * cent 6) + , f 0.2 0.11 2 (x * 0.5) ] + where f a b c = rndPw (a + b * tri c) + +------------------------------ +-- 4 Multi osc (unision) + +data EpianoOsc = EpianoOsc + { epianoOscChorusNum :: Int + , epianoOscChorusAmt :: Sig + , epianoOscNum :: Sig + , epianoOscWeight :: Sig + } + +epiano :: [EpianoOsc] -> (D, D) -> SE Sig +epiano xs (amp, cps) = mul (sig amp * leg 0.001 sust 0 rel) $ at (mlp (2500 + 4500 * (leg 0.085 3 0 0.1)) 0.25) $ + fmap sum $ mapM (\x -> mul (epianoOscWeight x) $ multiRndSE (epianoOscChorusNum x) (epianoOscChorusAmt x) (detune (epianoOscNum x) rndOsc) (sig cps)) xs + -- (multiRndSE 4 5 rndOsc + multiRndSE 8 10 (detune (2.01) rndOsc)) + where + sust = amp + 2 + (0.7 - 3 * k ** 2) + rel = (amp / 10) + 0.05 - (k / 10) + k = cps / 1000 + +------------------------------ +-- 5 noise + +-- noisyChor numberOfFilters bandWidthRatio cps +noisyChoir :: Int -> Sig -> Sig -> SE Sig +noisyChoir n ratio cps = mul 0.5 $ genGhostChoir white [1, 1] [1, 0.5] n (5 + 300 ** ratio) cps + +genGhostChoir :: (SE Sig) -> [Sig] -> [Sig] -> Int -> Sig -> Sig -> SE Sig +genGhostChoir noiseGen amps hs n bw cps = mul env $ fmap sum $ zipWithM f amps hs + where + f :: Sig -> Sig -> SE Sig + f a h = mul a $ bat (filt n bp (h * cps) bw) noiseGen + env = fades 0.4 0.5 + +------------------------------ +-- 6 noise + +mildWind :: Sig -> SE Sig +mildWind cps = thorWind (cps * 2) 120 (0.2, 0.5) + +thorWind :: Sig -> Sig -> (Sig, Sig) -> SE Sig +thorWind cps bw (speedMin, speedMax) = mul 1.3 $ do + speed <- rspline (-1) 1 speedMin speedMax + at (mlp (cps + bw * speed) 0.8) pink + +boom :: Sig -> SE Sig +boom cps = mul (1.2 * expon 1 2.05 0.001) $ fmap sum $ mapM (\x -> bat (bp (0.5 * cps * x) 10) white) [1, 1.51, 2.1, 3.05] + +windWall :: Sig -> SE Sig +windWall cps = mul amEnv $ at (hp1 400) $ at (mlp (filtEnv * cps) 0.2) (mul 20 white ) + where + amEnv = leg 7 10 0 8 + filtEnv = leg 6 0 1 5 + +------------------------------ +-- 9, 10 fm + +razorPad speed amp cps = f cps + 0.75 * f (cps * 0.5) + where f cps = mul (leg 0.5 0 1 1) $ genRazor (filt 1 mlp) speed amp cps + +razorLead bright speed amp cps = mul (0.5 * leg 0.01 1 0.5 0.5) $ genRazor (filt 2 (lp18 $ 2 * bright)) speed amp cps + +genRazor filter speed amp cps = mul amp $ do + a1 <- ampSpline 0.01 + a2 <- ampSpline 0.02 + + return $ filter (1000 + 2 * cps + 500 * amp) 0.1 $ mean [ + fosc 1 3 (a1 * uosc (speed)) cps + , fosc 3 1 (a2 * uosc (speed + 0.2)) cps + , fosc 1 7 (a1 * uosc (speed - 0.15)) cps ] + where ampSpline c = rspline ( amp) (3.5 + amp) ((speed / 4) * (c - 0.1)) ((speed / 4) * (c + 0.1)) + + + + diff --git a/src/Csound/Catalog/Wave/Woodwind.hs b/src/Csound/Catalog/Wave/Woodwind.hs --- a/src/Csound/Catalog/Wave/Woodwind.hs +++ b/src/Csound/Catalog/Wave/Woodwind.hs @@ -7,6 +7,7 @@ , dizi ) where + import Csound.Base hiding (fromSpec) import Csound.Catalog.Wave.WoodwindAlg @@ -623,7 +624,7 @@ inorm = byRange [ 34991, 32586, 35331, 37480 ] iwt1 = f11 - iwt2 = ifB (ifreq <* 1025) f31 f35 + iwt2 = ifB (ifreq `lessThan` 1025) f31 f35 iwt3 = byRange [f32, f33, f34, f36] f11 = sine diff --git a/src/Csound/Catalog/Wave/WoodwindAlg.hs b/src/Csound/Catalog/Wave/WoodwindAlg.hs --- a/src/Csound/Catalog/Wave/WoodwindAlg.hs +++ b/src/Csound/Catalog/Wave/WoodwindAlg.hs @@ -5,6 +5,7 @@ ) where import Data.List (transpose, intersperse) +import Control.Monad import Control.Monad.Trans.State import Csound.Base hiding (fromSpec) @@ -17,6 +18,10 @@ instance Functor Rnd where fmap f (Rnd a) = Rnd $ fmap f a +instance Applicative Rnd where + pure = return + (<*>) = ap + instance Monad Rnd where return = Rnd . return (Rnd a) >>= f = Rnd $ a >>= unRnd . f @@ -162,7 +167,7 @@ freqs = fmap rangeFreq specs byFreq :: Tuple a => D -> [(D, a)] -> a -byFreq ifreq as = guardedTuple (fmap (\(cps, val) -> (sig ifreq <* sig cps, val)) $ init as) (snd $ last as) +byFreq ifreq as = guardedTuple (fmap (\(cps, val) -> (sig ifreq `lessThan` sig cps, val)) $ init as) (snd $ last as) fromHarmSpec :: (D, D, D) -> HarmSpec -> (Sig, Tab) diff --git a/src/Csound/Patch.hs b/src/Csound/Patch.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Patch.hs @@ -0,0 +1,1158 @@ +-- | Patches +-- +-- Collection of beautiful timbres. To try the instrument with midi device just type in the interpreter: +-- +-- > > dac $ atMidi hammondOrgan +-- If you don't have the real device, you can try the virtual midi: +-- +-- > > vdac $ atMidi vibraphone1 +-- +-- The function @atMidi@ invokes a @Patch@ with midi. +module Csound.Patch( + -- * Electric piano + Epiano1(..), epiano1, epiano1', + MutedPiano(..), mutedPiano, mutedPiano', + amPiano, fmPiano, + epiano2, epianoHeavy, epianoBright, + vibraphonePiano1, vibraphonePiano2, + + -- * Organ + cathedralOrgan, toneWheelOrgan, + HammondOrgan(..), hammondOrgan, hammondOrgan', + sawOrgan, triOrgan, sqrOrgan, pwOrgan, waveOrgan, + + -- * Accordeon + accordeon, accordeonBright1, accordeonBright2, brokenAccordeon, + accordeon', Accordeon(..), + + -- * Choir + choirA, choirO, choirU, choirE, + Choir(..), choirA', choirO', choirU', choirE', + + windSings, noisyChoir, longNoisyChoir, noisyChoir', longNoisyChoir', NoisyChoir(..), + + -- * Pad + pwPad, triPad, nightPad, overtonePad, caveOvertonePad, + chorusel, pwEnsemble, fmDroneSlow, fmDroneMedium, fmDroneFast, vibrophonePad, + RazorPad(..), razorPadSlow, razorPadFast, razorPadTremolo, razorPad, razorPad', + dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, + dreamPad', underwaterPad', lightIsTooBrightPad', whaleSongPad', + + -- * Lead + polySynth, + phasingLead, RazorLead(..), razorLeadSlow, razorLeadFast, razorLeadTremolo, + razorLead, razorLead', + overtoneLead, + + -- * Bass + simpleBass, pwBass, deepBass, withDeepBass, + + -- * Plucked + guitar, harpsichord, + + -- * Strike + + smallDahina, dahina, largeDahina, magicDahina, + smallBanyan,banyan, largeBanyan, magicBanyan, + smallXylophone, xylophone, largeXylophone, magicXylophone, + smallTibetanBowl180, tibetanBowl180, largeTibetanBowl180, magicTibetanBowl180, + smallSpinelSphere, spinelSphere, largeSpinelSphere, magicSpinelSphere, + smallPotLid, potLid, largePotLid, magicPotLid, + smallRedCedarWoodPlate, redCedarWoodPlate, largeRedCedarWoodPlate, magicRedCedarWoodPlate, + smallTubularBell, tubularBell, largeTubularBell, magicTubularBell, + smallRedwoodPlate, redwoodPlate, largeRedwoodPlate, magicRedwoodPlate, smallDouglasFirWoodPlate, + douglasFirWoodPlate, largeDouglasFirWoodPlate, magicDouglasFirWoodPlate, smallUniformWoodenBar, + uniformWoodenBar, largeUniformWoodenBar, magicUniformWoodenBar, smallUniformAluminumBar, + uniformAluminumBar, largeUniformAluminumBar, magicUniformAluminumBar, + smallVibraphone1, vibraphone1, largeVibraphone1, magicVibraphone1, + smallVibraphone2, vibraphone2, largeVibraphone2, magicVibraphone2, + smallChalandiPlates, chalandiPlates, largeChalandiPlates, magicChalandiPlates, + smallTibetanBowl152, tibetanBowl152, largeTibetanBowl152, magicTibetanBowl152, + smallTibetanBowl140, tibetanBowl140, largeTibetanBowl140, magicTibetanBowl140, + smallWineGlass, wineGlass, largeWineGlass, magicWineGlass, + smallHandbell, handbell, largeHandbell, magicHandbell, + smallAlbertClockBellBelfast, albertClockBellBelfast, largeAlbertClockBellBelfast, magicAlbertClockBellBelfast, + smallWoodBlock, woodBlock, largeWoodBlock, magicWoodBlock, + + -- * Scrape + scrapeDahina, scrapeBanyan, scrapeXylophone, scrapeTibetanBowl180, scrapeSpinelSphere, scrapePotLid, scrapeRedCedarWoodPlate, + scrapeTubularBell, scrapeRedwoodPlate, scrapeDouglasFirWoodPlate, scrapeUniformWoodenBar, scrapeUniformAluminumBar, + scrapeVibraphone1, scrapeVibraphone2, scrapeChalandiPlates, scrapeTibetanBowl152, scrapeTibetanBowl140, scrapeWineGlass, + scrapeSmallHandbell, scrapeAlbertClockBellBelfast, scrapeWoodBlock, + + scrapeFastDahina, scrapeFastBanyan, scrapeFastXylophone, scrapeFastTibetanBowl180, scrapeFastSpinelSphere, scrapeFastPotLid, + scrapeFastRedCedarWoodPlate, scrapeFastTubularBell, scrapeFastRedwoodPlate, scrapeFastDouglasFirWoodPlate, scrapeFastUniformWoodenBar, + scrapeFastUniformAluminumBar, scrapeFastVibraphone1, scrapeFastVibraphone2, scrapeFastChalandiPlates, scrapeFastTibetanBowl152, + scrapeFastTibetanBowl140, scrapeFastWineGlass, scrapeFastSmallHandbell, scrapeFastAlbertClockBellBelfast, scrapeFastWoodBlock, + + scrapePadDahina, scrapePadBanyan, scrapePadXylophone, scrapePadTibetanBowl180, scrapePadSpinelSphere, scrapePadPotLid, + scrapePadRedCedarWoodPlate, scrapePadTubularBell, scrapePadRedwoodPlate, scrapePadDouglasFirWoodPlate, scrapePadUniformWoodenBar, + scrapePadUniformAluminumBar, scrapePadVibraphone1, scrapePadVibraphone2, scrapePadChalandiPlates, scrapePadTibetanBowl152, + scrapePadTibetanBowl140, scrapePadWineGlass, scrapePadSmallHandbell, scrapePadAlbertClockBellBelfast, scrapePadWoodBlock, + + -- * Woodwind + + Wind(..), woodWind', + + fluteSpec, shortFluteSpec, + flute, shortFlute, fluteVibrato, mutedFlute, brightFlute, + + bassClarinetSpec, shortBassClarinetSpec, + bassClarinet, shortBassClarinet, bassClarinetVibrato, mutedBassClarinet, brightBassClarinet, + + frenchHornSpec, shortFrenchHornSpec, + frenchHorn, shortFrenchHorn, frenchHornVibrato, mutedFrenchHorn, brightFrenchHorn, + + shengSpec, shortShengSpec, + sheng, shortSheng, shengVibrato, mutedSheng, brightSheng, + + hulusiSpec, shortHulusiSpec, + hulusi, shortHulusi, hulusiVibrato, mutedHulusi, brightHulusi, + + diziSpec, shortDiziSpec, + dizi, shortDizi, diziVibrato, mutedDizi, brightDizi, + + -- * X-rays + pulseWidth, xanadu, alienIsAngry, noiz, blue, black, simpleMarimba, okComputer, noiseBell, + + -- * Robotic vowels + robotVowels, robotLoopVowels, robotVowel, + + -- ** Vowels + maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH, + femaleA, femaleE, femaleIY, femaleO, femaleOO, + + -- * Nature + windWall, mildWind, wind, snowCrackle, + + -- * Misc + limRel, singleFx, singleFx' +) where + +import Control.Monad + +import Csound.Base + +import qualified Csound.Catalog.Wave as C +import qualified Csound.Catalog.Reson as C + +import Csound.Catalog.Wave(maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH, + femaleA, femaleE, femaleIY, femaleO, femaleOO) + +import Csound.Catalog.Wave(Accordeon(..)) + +import Data.Char + +fx1 :: Sig -> (a -> a) -> [FxSpec a] +fx1 dw f = [FxSpec dw (return . f)] + +fx1' :: Sig -> (a -> SE a) -> [FxSpec a] +fx1' dw f = [FxSpec dw f] + +-- | Creates a simple FX-xhain, that contains a single pure effect. +-- The first argument is the dry/wet-value. +singleFx :: Sig -> (a -> a) -> [FxSpec a] +singleFx = fx1 + +-- | Creates a simple FX-xhain, that contains a single effect. +-- The first argument is the dry/wet-value. +singleFx' :: Sig -> (a -> SE a) -> [FxSpec a] +singleFx' = fx1' + +-- | Limits the release section of the note. +limRel :: SigSpace a => D -> Patch a -> Patch a +limRel rel p = p { patchInstr = fmap (mul (fadeOut rel)) . patchInstr p } + +---------------------------------------------- +-- electric pianos + +data Epiano1 = Epiano1 + { epiano1Rel :: D } + +instance Default Epiano1 where + def = Epiano1 5 + +epiano1 = epiano1' def + +epiano1' (Epiano1 rel) = Patch + { patchInstr = \a -> mul 0.4 $ C.simpleFading rel a + , patchFx = fx1 0.25 largeHall2 } + +data MutedPiano = MutedPiano + { mutedPianoMute :: Sig + , mutedPianoRel :: D } + +instance Default MutedPiano where + def = MutedPiano 0.5 7 + +mutedPiano = mutedPiano' def + +mutedPiano' (MutedPiano mute rel) = Patch + { patchInstr = \a -> mul 0.7 $ C.simpleSust rel a + , patchFx = fx1 0.25 (largeHall2 . at (mlp3 (250 + 7000 * mute) 0.2)) } + +amPiano = Patch + { patchInstr = mul 1.4 . onCps C.amPiano + , patchFx = fx1 0.25 id } + +fmPiano = Patch + { patchInstr = at fromMono . mul 0.75 . onCps (C.fmFlavio 6 3) + , patchFx = fx1 0.15 smallHall2 } + +epiano2 = Patch + { patchInstr = mul 1.125 . at fromMono . (onCps $ C.epiano [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 2.01 1]) + , patchFx = fx1 0.25 smallHall2 } + +epianoHeavy = Patch + { patchInstr = mul 1.125 . at fromMono . (onCps $ C.epiano [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 2.01 1, C.EpianoOsc 8 15 0.5 0.5]) + , patchFx = fx1 0.2 smallHall2 } + +epianoBright = Patch + { patchInstr = mul 1.12 . at fromMono . (onCps $ C.epiano [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 3.01 1, C.EpianoOsc 8 15 5 0.5, C.EpianoOsc 8 4 7 0.3]) + , patchFx = fx1 0.2 smallHall2 } + +vibraphonePiano1 = smallVibraphone1 { patchInstr = mul (1.5 * fadeOut 0.25) . at (mlp 6500 0.1). patchInstr smallVibraphone1 } +vibraphonePiano2 = smallVibraphone2 { patchInstr = mul (1.5 * fadeOut 0.25) . at (mlp 6500 0.1). patchInstr smallVibraphone2 } + +---------------------------------------------- +-- organs + +cathedralOrgan = Patch + { patchInstr = at fromMono . mul 0.7 . onCps C.cathedralOrgan + , patchFx = fx1 0.27 largeHall2 } + +-- [0, 30] +data HammondOrgan = HammondOrgan + { hammondOrganDetune :: Sig } + +instance Default HammondOrgan where + def = HammondOrgan 12 + +hammondOrgan = hammondOrgan' def + +hammondOrgan' (HammondOrgan detune) = Patch + { patchInstr = mul 0.4 . at fromMono . onCps (C.hammondOrgan detune) + , patchFx = fx1 0.15 smallRoom2 } + +toneWheelOrgan = Patch + { patchInstr = at fromMono . mul 0.6 . onCps C.toneWheel + , patchFx = fx1 0.3 smallHall2 } + +sawOrgan = mul 0.45 $ waveOrgan rndSaw +triOrgan = mul 0.5 $ waveOrgan rndTri +sqrOrgan = mul 0.45 $ waveOrgan rndSqr +pwOrgan k = mul 0.45 $ waveOrgan (rndPw k) + +waveOrgan :: (Sig -> SE Sig) -> Patch2 +waveOrgan wave = Patch + { patchInstr = onCps $ at fromMono . mul (fades 0.01 0.01) . at (mlp 3500 0.1) . wave + , patchFx = fx1 0.25 smallHall2 + } + +---------------------------------------------- +-- accordeons + +accordeon = accordeon' def + +accordeonBright1 = accordeon' (C.Accordeon 1 5 3 7) +accordeonBright2 = accordeon' (C.Accordeon 1 6 3 13) + +accordeonHeavy = accordeon' (C.Accordeon 1 0.501 2 1.005) +brokenAccordeon = accordeon' (C.Accordeon 1 1.07 2.02 0.5) + +accordeon' spec = Patch + { patchInstr = mul 0.63 . onCps (C.accordeon spec) + , patchFx = fx1' 0.25 C.accordeonFx } + +---------------------------------------------- +-- choir + +data Choir = Choir { choirVibr :: Sig } + +instance Default Choir where + def = Choir 7 + +tenor' filt (Choir vib) = Patch + { patchInstr = at fromMono . mul 0.15 . onCps (C.tenorOsc filt vib) + , patchFx = fx1 0.25 smallHall2 } + +soprano' filt (Choir vib) = Patch + { patchInstr = at fromMono . mul 0.15 . onCps (C.sopranoOsc filt vib) + , patchFx = fx1 0.25 smallHall2 } + +choir' filt vib = Patch + { patchInstr = \(amp, cps) -> do + ref <- newRef (0 :: Sig2) + when1 (sig cps <=* 220) $ writeRef ref =<< (patchInstr (tenor' filt vib) (amp, cps)) + when1 (sig cps >* 220) $ writeRef ref =<< (patchInstr (soprano' filt vib) (amp, cps)) + readRef ref + , patchFx = fx1 0.25 smallHall2 + } + +choirA = choirA' def +choirO = choirO' def +choirE = choirE' def +choirU = choirU' def + +choirA' = choir' singA +choirO' = choir' singO +choirE' = choir' singE +choirU' = choir' singU + +data NoisyChoir = NoisyChoir + { noisyChoirFilterNum :: Int + , noisyChoirBw :: Sig + } + +instance Default NoisyChoir where + def = NoisyChoir 2 25 + +windSings = longNoisyChoir' (NoisyChoir 1 15) + +longNoisyChoir = longNoisyChoir' def +noisyChoir = noisyChoir' def + + +longNoisyChoir' (NoisyChoir n bw) = Patch + { patchInstr = at fromMono . mul 0.45 . onCps (C.noisyChoir n bw) + , patchFx = fx1 0.15 magicCave2 } + +noisyChoir' ch = (longNoisyChoir' ch) { patchFx = fx1 0.15 largeHall2 } + +-- modes (wth delay or not delay) +-- +-- dac $ mixAt 0.15 largeHall2 $ mixAt 0.2 (echo 0.25 0.45) $ at fromMono $ midi $ onMsg $ onCps (mul (fadeOut 2) . C.tibetanBowl152 ) + +---------------------------------------------- +-- pads + +pwPad = Patch + { patchInstr = mul 0.6 . at fromMono . onCps C.pwPad + , patchFx = fx1 0.25 smallHall2 } + +triPad = Patch + { patchInstr = fmap fromMono . mul 0.7 . onCps C.triPad + , patchFx = fx1' 0.25 C.triPadFx } + +nightPad = Patch + { patchInstr = mul 0.48 . at fromMono . onCps (mul (fadeOut 1) . C.nightPad 0.5) + , patchFx = fx1 0.25 largeHall2 } + +overtonePad = Patch + { patchInstr = mul 0.65 . at fromMono . mixAt 0.25 (mlp 1500 0.1) . onCps (\cps -> mul (fades 0.25 1.2) (C.tibetan 11 0.012 cps) + mul (fades 0.25 1) (C.tibetan 13 0.015 (cps * 0.5))) + , patchFx = fx1 0.35 smallHall2 } + +caveOvertonePad = overtonePad { patchFx = fx1 0.2 (magicCave2 . mul 0.8) } + +chorusel = Patch + { patchInstr = mul 0.9 . at (mlp (3500 + 2000 * uosc 0.1) 0.1) . onCps (mul (fades 0.65 1) . C.chorusel 13 0.5 10) + , patchFx = fx1 0.35 smallHall2 } + +pwEnsemble = Patch + { patchInstr = at fromMono . mul 0.55 . onCps C.pwEnsemble + , patchFx = fx1 0.25 smallHall2 } + +fmDroneSlow = Patch + { patchInstr = at fromMono . mul 0.5 . onCps (C.fmDrone 3 (10, 5)) + , patchFx = fx1 0.35 largeHall2 } + +fmDroneMedium = Patch + { patchInstr = at fromMono . mul 0.5 . onCps (C.fmDrone 3 (5, 3)) + , patchFx = fx1 0.25 smallHall2 } + +fmDroneFast = Patch + { patchInstr = at fromMono . mul 0.5 . onCps (C.fmDrone 3 (0.5, 1)) + , patchFx = fx1 0.25 smallHall2 } + +vibrophonePad = largeVibraphone1 { patchInstr = mul (1.5 * fades 0.5 0.25) . at (mlp 2500 0.1). patchInstr largeVibraphone1 } + +data RazorPad = RazorPad { razorPadSpeed :: Sig } + +instance Default RazorPad where + def = RazorPad 0.5 + +razorPadSlow = razorPad' (def { razorPadSpeed = 0.1 }) +razorPadFast = razorPad' (def { razorPadSpeed = 1.7 }) +razorPadTremolo = razorPad' (def { razorPadSpeed = 6.7 }) + +razorPad = razorPad' def + +razorPad' (RazorPad speed) = Patch + { patchInstr = at fromMono . mul 0.6 . onCps (uncurry $ C.razorPad speed) + , patchFx = fx1 0.35 largeHall2 } + + +dreamPadFx = [FxSpec 0.35 (return . largeHall2), FxSpec 0.25 (at $ echo 0.25 0.65), FxSpec 0.25 (at $ chorus 0.07 1.25 1)] + +dreamPad = dreamPad' 0.35 +underwaterPad = underwaterPad' 0.35 +lightIsTooBrightPad = lightIsTooBrightPad' 0.55 +whaleSongPad = whaleSongPad' 0.35 + +-- | The first argument is brightness (0 to 1) +dreamPad' :: Sig -> Patch2 +dreamPad' bright = Patch + { patchInstr = fmap fromMono . onCps (C.dreamPad bright) + , patchFx = dreamPadFx + } + +-- | The first argument is brightness (0 to 1) +underwaterPad' :: Sig -> Patch2 +underwaterPad' bright = Patch + { patchInstr = fmap fromMono . onCps (C.underwaterPad bright) + , patchFx = dreamPadFx + } + +-- | The first argument is brightness (0 to 1) +lightIsTooBrightPad' :: Sig -> Patch2 +lightIsTooBrightPad' bright = Patch + { patchInstr = fmap fromMono . onCps (C.lightIsTooBrightPad bright) + , patchFx = dreamPadFx + } + +-- | The first argument is brightness (0 to 1) +whaleSongPad' :: Sig -> Patch2 +whaleSongPad' bright = Patch + { patchInstr = fmap fromMono . onCps (C.whaleSongPad bright) + , patchFx = dreamPadFx + } + +------------------------------------ +-- leads + +polySynth = Patch + { patchInstr = fmap fromMono . onCps C.polySynth + , patchFx = [FxSpec 0.25 (return . largeHall2), FxSpec 0.25 (at $ echo 0.25 0.65), FxSpec 0.25 (at $ chorus 0.07 1.25 1)] + } + +phasingLead = Patch + { patchInstr = at fromMono . mul (0.7 * fadeOut 0.05) . onCps (uncurry C.phasingSynth) + , patchFx = fx1 0.25 smallHall2 } + +data RazorLead = RazorLead + { razorLeadBright :: Sig + , razorLeadSpeed :: Sig } + +instance Default RazorLead where + def = RazorLead 0.5 0.5 + +razorLeadSlow = razorLead' (def { razorLeadSpeed = 0.1 }) +razorLeadFast = razorLead' (def { razorLeadSpeed = 1.7 }) +razorLeadTremolo = razorLead' (def { razorLeadSpeed = 6.7 }) + +razorLead = razorLead' def + +razorLead' (RazorLead bright speed) = Patch + { patchInstr = at fromMono . (\(amp, cps) -> mul (fadeOut (0.05 + amp * 0.3)) $ C.razorLead (bright * sig amp) (speed * sig amp) (sig amp) (sig cps)) + , patchFx = fx1 0.35 smallHall2 } + +overtoneLeadFx :: Sig2 -> SE Sig2 +overtoneLeadFx x = fmap magicCave2 $ mixAt 0.2 (echo 0.25 0.45) (return x) + +overtoneLead :: Patch2 +overtoneLead = Patch + { patchInstr = mul 0.4 . at fromMono . onCps (mul (fades 0.01 1) . C.tibetan 13 0.012) + , patchFx = fx1' 0.15 overtoneLeadFx } + +------------------------------------ +-- bass + +simpleBass = Patch + { patchInstr = at fromMono . mul 0.32 . onCps C.simpleBass + , patchFx = fx1 0.25 smallRoom2 } + +pwBass = Patch + { patchInstr = at fromMono . mul 0.4 . onCps C.pwBass + , patchFx = fx1 0.25 smallHall2 } + +deepBass = Patch + { patchInstr = at fromMono . mul 0.4 . onCps C.deepBass + , patchFx = fx1 0.25 smallHall2 } + +-- | The first argument is the amount of deepBass to mix into the original patch. +withDeepBass :: Sig -> Patch2 -> Patch2 +withDeepBass k = mixInstr k deepBass + +------------------------------------ +-- plucked + +guitar = Patch + { patchInstr = onCps $ fromMono . mul (0.6 * fades 0.01 0.25) . C.plainString + , patchFx = fx1 0.25 smallHall2 } + +harpsichord = Patch + { patchInstr = onCps $ fromMono . mul (0.65 * fades 0.01 0.13) . C.harpsichord + , patchFx = fx1 0.25 smallHall2 } + +-- guita + +------------------------------------ +-- strike + +strikeFx :: Strike -> Sig2 -> SE Sig2 +strikeFx spec a = at (strikeReverb spec) $ (if (strikeHasDelay spec) then (mixAt 0.35 (echo 0.25 0.55)) else id) (return a :: SE Sig2) + +strikeRelease :: (D, D) -> Strike -> D +strikeRelease (amp, cps) spec = (0.85 * strikeRel spec * amp) * amp + (strikeRel spec) - (cps / 10000) + +-- dac $ mixAt 0.15 largeHall2 $ mixAt 0.2 (echo 0.25 0.45) $ at fromMono $ midi $ onMsg $ onCps (mul (fadeOut 2) . C.tibetanBowl152 ) +data Strike = Strike + { strikeRel :: D + , strikeHasDelay :: Bool + , strikeReverb :: Sig2 -> Sig2 + } + +instance Default Strike where + def = Strike 1.5 True smallHall2 + +strike' :: Strike -> (Sig -> Sig) -> Patch Sig2 +strike' spec instr = Patch + { patchInstr = \x@(amp, cps) -> return $ fromMono $ mul (0.75 * sig amp * fadeOut (rel x)) $ instr (sig cps) + , patchFx = fx1' 0.25 (strikeFx spec) } + where rel a = strikeRelease a spec + + +data Size = Small | Medium | Large | Huge + +nextSize x = case x of + Small -> Medium + Medium -> Large + Large -> Huge + Huge -> Huge + +prevSize x = case x of + Small -> Small + Medium -> Small + Large -> Medium + Huge -> Large + +toStrikeSpec :: Size -> Size -> Strike +toStrikeSpec revSpec restSpec = Strike + { strikeReverb = toReverb revSpec + , strikeRel = toRel restSpec + , strikeHasDelay = toHasDelay restSpec } + +toReverb :: Size -> (Sig2 -> Sig2) +toReverb x = case x of + Small -> smallRoom2 + Medium -> smallHall2 + Large -> largeHall2 + Huge -> magicCave2 + +toRel :: Size -> D +toRel x = case x of + Small -> 0.4 + Medium -> 1.5 + Large -> 2.5 + Huge -> 4.5 + +toGain :: Size -> Sig +toGain x = case x of + Small -> 0.85 + Medium -> 0.75 + Large -> 0.6 + Huge -> 0.45 + +toHasDelay :: Size -> Bool +toHasDelay x = case x of + Small -> False + _ -> True + +dahinaSize = Small +banyanSize = Medium +xylophoneSize = Small +tibetanBowl152Size = Medium +tibetanBowl140Size = Small +tibetanBowl180Size = Medium +spinelSphereSize = Small +potLidSize = Medium +redCedarWoodPlateSize = Small +tubularBellSize = Large +redwoodPlateSize = Small +douglasFirWoodPlateSize = Small +uniformWoodenBarSize = Small +uniformAluminumBarSize = Small +vibraphone1Size = Medium +vibraphone2Size = Medium +chalandiPlatesSize = Medium +wineGlassSize = Medium +smallHandbellSize = Medium +albertClockBellBelfastSize = Large +woodBlockSize = Small + +smallStrike :: Size -> (Sig -> Sig) -> Patch2 +smallStrike size = mediumStrike' (prevSize size) size + +mediumStrike :: Size -> (Sig -> Sig) -> Patch2 +mediumStrike size = mediumStrike' size size + +largeStrike :: Size -> (Sig -> Sig) -> Patch2 +largeStrike size = mediumStrike' (nextSize size) size + +magicStrike :: Size -> (Sig -> Sig) -> Patch2 +magicStrike size = mediumStrike' (nextSize $ nextSize size) size + +mediumStrike' :: Size -> Size -> (Sig -> Sig) -> Patch2 +mediumStrike' revSize size f = p { patchInstr = mul (toGain size) . patchInstr p } + where p = strike' (toStrikeSpec revSize size) f + + +smallDahina = smallStrike dahinaSize C.dahina +dahina = mediumStrike dahinaSize C.dahina +largeDahina = largeStrike dahinaSize C.dahina +magicDahina = magicStrike dahinaSize C.dahina + +smallBanyan = smallStrike banyanSize C.banyan +banyan = mediumStrike banyanSize C.banyan +largeBanyan = largeStrike banyanSize C.banyan +magicBanyan = magicStrike banyanSize C.banyan + +smallXylophone = smallStrike xylophoneSize C.xylophone +xylophone = mediumStrike xylophoneSize C.xylophone +largeXylophone = largeStrike xylophoneSize C.xylophone +magicXylophone = magicStrike xylophoneSize C.xylophone + +smallTibetanBowl180 = smallStrike tibetanBowl180Size C.tibetanBowl180 +tibetanBowl180 = mediumStrike tibetanBowl180Size C.tibetanBowl180 +largeTibetanBowl180 = largeStrike tibetanBowl180Size C.tibetanBowl180 +magicTibetanBowl180 = magicStrike tibetanBowl180Size C.tibetanBowl180 + +smallSpinelSphere = smallStrike spinelSphereSize C.spinelSphere +spinelSphere = mediumStrike spinelSphereSize C.spinelSphere +largeSpinelSphere = largeStrike spinelSphereSize C.spinelSphere +magicSpinelSphere = magicStrike spinelSphereSize C.spinelSphere + +smallPotLid = smallStrike potLidSize C.potLid +potLid = mediumStrike potLidSize C.potLid +largePotLid = largeStrike potLidSize C.potLid +magicPotLid = magicStrike potLidSize C.potLid + +smallRedCedarWoodPlate = smallStrike redCedarWoodPlateSize C.redCedarWoodPlate +redCedarWoodPlate = mediumStrike redCedarWoodPlateSize C.redCedarWoodPlate +largeRedCedarWoodPlate = largeStrike redCedarWoodPlateSize C.redCedarWoodPlate +magicRedCedarWoodPlate = magicStrike redCedarWoodPlateSize C.redCedarWoodPlate + +smallTubularBell = smallStrike tubularBellSize C.tubularBell +tubularBell = mediumStrike tubularBellSize C.tubularBell +largeTubularBell = largeStrike tubularBellSize C.tubularBell +magicTubularBell = magicStrike tubularBellSize C.tubularBell + +smallRedwoodPlate = smallStrike redwoodPlateSize C.redwoodPlate +redwoodPlate = mediumStrike redwoodPlateSize C.redwoodPlate +largeRedwoodPlate = largeStrike redwoodPlateSize C.redwoodPlate +magicRedwoodPlate = magicStrike redwoodPlateSize C.redwoodPlate + +smallDouglasFirWoodPlate = smallStrike douglasFirWoodPlateSize C.douglasFirWoodPlate +douglasFirWoodPlate = mediumStrike douglasFirWoodPlateSize C.douglasFirWoodPlate +largeDouglasFirWoodPlate = largeStrike douglasFirWoodPlateSize C.douglasFirWoodPlate +magicDouglasFirWoodPlate = magicStrike douglasFirWoodPlateSize C.douglasFirWoodPlate + +smallUniformWoodenBar = smallStrike uniformWoodenBarSize C.uniformWoodenBar +uniformWoodenBar = mediumStrike uniformWoodenBarSize C.uniformWoodenBar +largeUniformWoodenBar = largeStrike uniformWoodenBarSize C.uniformWoodenBar +magicUniformWoodenBar = magicStrike uniformWoodenBarSize C.uniformWoodenBar + +smallUniformAluminumBar = smallStrike uniformAluminumBarSize C.uniformAluminumBar +uniformAluminumBar = mediumStrike uniformAluminumBarSize C.uniformAluminumBar +largeUniformAluminumBar = largeStrike uniformAluminumBarSize C.uniformAluminumBar +magicUniformAluminumBar = magicStrike uniformAluminumBarSize C.uniformAluminumBar + +smallVibraphone1 = smallStrike vibraphone1Size C.vibraphone1 +vibraphone1 = mediumStrike vibraphone1Size C.vibraphone1 +largeVibraphone1 = largeStrike vibraphone1Size C.vibraphone1 +magicVibraphone1 = magicStrike vibraphone1Size C.vibraphone1 + +smallVibraphone2 = smallStrike vibraphone2Size C.vibraphone2 +vibraphone2 = mediumStrike vibraphone2Size C.vibraphone2 +largeVibraphone2 = largeStrike vibraphone2Size C.vibraphone2 +magicVibraphone2 = magicStrike vibraphone2Size C.vibraphone2 + +smallChalandiPlates = smallStrike chalandiPlatesSize C.chalandiPlates +chalandiPlates = mediumStrike chalandiPlatesSize C.chalandiPlates +largeChalandiPlates = largeStrike chalandiPlatesSize C.chalandiPlates +magicChalandiPlates = magicStrike chalandiPlatesSize C.chalandiPlates + +smallTibetanBowl152 = smallStrike tibetanBowl152Size C.tibetanBowl152 +tibetanBowl152 = mediumStrike tibetanBowl152Size C.tibetanBowl152 +largeTibetanBowl152 = largeStrike tibetanBowl152Size C.tibetanBowl152 +magicTibetanBowl152 = magicStrike tibetanBowl152Size C.tibetanBowl152 + +smallTibetanBowl140 = smallStrike tibetanBowl140Size C.tibetanBowl140 +tibetanBowl140 = mediumStrike tibetanBowl140Size C.tibetanBowl140 +largeTibetanBowl140 = largeStrike tibetanBowl140Size C.tibetanBowl140 +magicTibetanBowl140 = magicStrike tibetanBowl140Size C.tibetanBowl140 + +smallWineGlass = smallStrike wineGlassSize C.wineGlass +wineGlass = mediumStrike wineGlassSize C.wineGlass +largeWineGlass = largeStrike wineGlassSize C.wineGlass +magicWineGlass = magicStrike wineGlassSize C.wineGlass + +smallHandbell = smallStrike smallHandbellSize C.smallHandbell +handbell = mediumStrike smallHandbellSize C.smallHandbell +largeHandbell = largeStrike smallHandbellSize C.smallHandbell +magicHandbell = magicStrike smallHandbellSize C.smallHandbell + +smallAlbertClockBellBelfast = smallStrike albertClockBellBelfastSize C.albertClockBellBelfast +albertClockBellBelfast = mediumStrike albertClockBellBelfastSize C.albertClockBellBelfast +largeAlbertClockBellBelfast = largeStrike albertClockBellBelfastSize C.albertClockBellBelfast +magicAlbertClockBellBelfast = magicStrike albertClockBellBelfastSize C.albertClockBellBelfast + +smallWoodBlock = smallStrike woodBlockSize C.woodBlock +woodBlock = mediumStrike woodBlockSize C.woodBlock +largeWoodBlock = largeStrike woodBlockSize C.woodBlock +magicWoodBlock = magicStrike woodBlockSize C.woodBlock + +--------------------------------------------------------------- +-- scrape + +-- scrapePatch + +names = ["dahina","banyan","xylophone","tibetanBowl180","spinelSphere","potLid","redCedarWoodPlate","tubularBell","redwoodPlate","douglasFirWoodPlate","uniformWoodenBar","uniformAluminumBar","vibraphone1","vibraphone2","chalandiPlates","tibetanBowl152","tibetanBowl140","wineGlass","smallHandbell","albertClockBellBelfast","woodBlock"] +toUpperName (x:xs) = toUpper x : xs + +-- scrapePatch + +scrapeRelease :: (D, D) -> D -> D +scrapeRelease (amp, cps) rel = (0.85 * rel * amp) * amp + rel - (cps / 10000) + +scrapeFast k m = Patch + { patchInstr = \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.02 (scrapeRelease x 0.25)) . at fromMono . C.scrapeModes m) (sig cps) + , patchFx = fx1 0.15 largeHall2 } + +scrape k m = Patch + { patchInstr = \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.5 (scrapeRelease x 0.97)) . at fromMono . C.scrapeModes m) (sig cps) + , patchFx = fx1 0.15 largeHall2 } + +scrapePad k m = Patch + { patchInstr = \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.5 (scrapeRelease x 2.27 )) . at fromMono . C.scrapeModes m) (sig cps) + , patchFx = fx1 0.15 largeHall2 } + +scaleScrapeDahina = 1.32 +scaleScrapeBanyan = 0.95 +scaleScrapeXylophone = 1 +scaleScrapeTibetanBowl180 = 0.55 +scaleScrapeSpinelSphere = 1.4 +scaleScrapePotLid = 0.65 +scaleScrapeRedCedarWoodPlate = 1 +scaleScrapeTubularBell = 0.75 +scaleScrapeRedwoodPlate = 1 +scaleScrapeDouglasFirWoodPlate = 1 +scaleScrapeUniformWoodenBar = 1 +scaleScrapeUniformAluminumBar = 0.75 +scaleScrapeVibraphone1 = 0.9 +scaleScrapeVibraphone2 = 0.9 +scaleScrapeChalandiPlates = 1 +scaleScrapeTibetanBowl152 = 0.65 +scaleScrapeTibetanBowl140 = 0.75 +scaleScrapeWineGlass = 0.6 +scaleScrapeSmallHandbell = 1 +scaleScrapeAlbertClockBellBelfast = 0.5 +scaleScrapeWoodBlock = 1.32 + +scrapeDahina = scrape scaleScrapeDahina C.dahinaModes +scrapeBanyan = scrape scaleScrapeBanyan C.banyanModes +scrapeXylophone = scrape scaleScrapeXylophone C.xylophoneModes +scrapeTibetanBowl180 = scrape scaleScrapeTibetanBowl180 C.tibetanBowlModes180 +scrapeSpinelSphere = scrape scaleScrapeSpinelSphere C.spinelSphereModes +scrapePotLid = scrape scaleScrapePotLid C.potLidModes +scrapeRedCedarWoodPlate = scrape scaleScrapeRedCedarWoodPlate C.redCedarWoodPlateModes +scrapeTubularBell = scrape scaleScrapeTubularBell C.tubularBellModes +scrapeRedwoodPlate = scrape scaleScrapeRedwoodPlate C.redwoodPlateModes +scrapeDouglasFirWoodPlate = scrape scaleScrapeDouglasFirWoodPlate C.douglasFirWoodPlateModes +scrapeUniformWoodenBar = scrape scaleScrapeUniformWoodenBar C.uniformWoodenBarModes +scrapeUniformAluminumBar = scrape scaleScrapeUniformAluminumBar C.uniformAluminumBarModes +scrapeVibraphone1 = scrape scaleScrapeVibraphone1 C.vibraphoneModes1 +scrapeVibraphone2 = scrape scaleScrapeVibraphone2 C.vibraphoneModes2 +scrapeChalandiPlates = scrape scaleScrapeChalandiPlates C.chalandiPlatesModes +scrapeTibetanBowl152 = scrape scaleScrapeTibetanBowl152 C.tibetanBowlModes152 +scrapeTibetanBowl140 = scrape scaleScrapeTibetanBowl140 C.tibetanBowlModes140 +scrapeWineGlass = scrape scaleScrapeWineGlass C.wineGlassModes +scrapeSmallHandbell = scrape scaleScrapeSmallHandbell C.smallHandbellModes +scrapeAlbertClockBellBelfast = scrape scaleScrapeAlbertClockBellBelfast C.albertClockBellBelfastModes +scrapeWoodBlock = scrape scaleScrapeWoodBlock C.woodBlockModes + +scrapeFastDahina = scrapeFast scaleScrapeDahina C.dahinaModes +scrapeFastBanyan = scrapeFast scaleScrapeBanyan C.banyanModes +scrapeFastXylophone = scrapeFast scaleScrapeXylophone C.xylophoneModes +scrapeFastTibetanBowl180 = scrapeFast scaleScrapeTibetanBowl180 C.tibetanBowlModes180 +scrapeFastSpinelSphere = scrapeFast scaleScrapeSpinelSphere C.spinelSphereModes +scrapeFastPotLid = scrapeFast scaleScrapePotLid C.potLidModes +scrapeFastRedCedarWoodPlate = scrapeFast scaleScrapeRedCedarWoodPlate C.redCedarWoodPlateModes +scrapeFastTubularBell = scrapeFast scaleScrapeTubularBell C.tubularBellModes +scrapeFastRedwoodPlate = scrapeFast scaleScrapeRedwoodPlate C.redwoodPlateModes +scrapeFastDouglasFirWoodPlate = scrapeFast scaleScrapeDouglasFirWoodPlate C.douglasFirWoodPlateModes +scrapeFastUniformWoodenBar = scrapeFast scaleScrapeUniformWoodenBar C.uniformWoodenBarModes +scrapeFastUniformAluminumBar = scrapeFast scaleScrapeUniformAluminumBar C.uniformAluminumBarModes +scrapeFastVibraphone1 = scrapeFast scaleScrapeVibraphone1 C.vibraphoneModes1 +scrapeFastVibraphone2 = scrapeFast scaleScrapeVibraphone2 C.vibraphoneModes2 +scrapeFastChalandiPlates = scrapeFast scaleScrapeChalandiPlates C.chalandiPlatesModes +scrapeFastTibetanBowl152 = scrapeFast scaleScrapeTibetanBowl152 C.tibetanBowlModes152 +scrapeFastTibetanBowl140 = scrapeFast scaleScrapeTibetanBowl140 C.tibetanBowlModes140 +scrapeFastWineGlass = scrapeFast scaleScrapeWineGlass C.wineGlassModes +scrapeFastSmallHandbell = scrapeFast scaleScrapeSmallHandbell C.smallHandbellModes +scrapeFastAlbertClockBellBelfast = scrapeFast scaleScrapeAlbertClockBellBelfast C.albertClockBellBelfastModes +scrapeFastWoodBlock = scrapeFast scaleScrapeWoodBlock C.woodBlockModes + +scrapePadDahina = scrapePad scaleScrapeDahina C.dahinaModes +scrapePadBanyan = scrapePad scaleScrapeBanyan C.banyanModes +scrapePadXylophone = scrapePad scaleScrapeXylophone C.xylophoneModes +scrapePadTibetanBowl180 = scrapePad scaleScrapeTibetanBowl180 C.tibetanBowlModes180 +scrapePadSpinelSphere = scrapePad scaleScrapeSpinelSphere C.spinelSphereModes +scrapePadPotLid = scrapePad scaleScrapePotLid C.potLidModes +scrapePadRedCedarWoodPlate = scrapePad scaleScrapeRedCedarWoodPlate C.redCedarWoodPlateModes +scrapePadTubularBell = scrapePad scaleScrapeTubularBell C.tubularBellModes +scrapePadRedwoodPlate = scrapePad scaleScrapeRedwoodPlate C.redwoodPlateModes +scrapePadDouglasFirWoodPlate = scrapePad scaleScrapeDouglasFirWoodPlate C.douglasFirWoodPlateModes +scrapePadUniformWoodenBar = scrapePad scaleScrapeUniformWoodenBar C.uniformWoodenBarModes +scrapePadUniformAluminumBar = scrapePad scaleScrapeUniformAluminumBar C.uniformAluminumBarModes +scrapePadVibraphone1 = scrapePad scaleScrapeVibraphone1 C.vibraphoneModes1 +scrapePadVibraphone2 = scrapePad scaleScrapeVibraphone2 C.vibraphoneModes2 +scrapePadChalandiPlates = scrapePad scaleScrapeChalandiPlates C.chalandiPlatesModes +scrapePadTibetanBowl152 = scrapePad scaleScrapeTibetanBowl152 C.tibetanBowlModes152 +scrapePadTibetanBowl140 = scrapePad scaleScrapeTibetanBowl140 C.tibetanBowlModes140 +scrapePadWineGlass = scrapePad scaleScrapeWineGlass C.wineGlassModes +scrapePadSmallHandbell = scrapePad scaleScrapeSmallHandbell C.smallHandbellModes +scrapePadAlbertClockBellBelfast = scrapePad scaleScrapeAlbertClockBellBelfast C.albertClockBellBelfastModes +scrapePadWoodBlock = scrapePad scaleScrapeWoodBlock C.woodBlockModes + +------------------------------------ +-- woodwind + +data Wind = Wind + { windAtt :: D + , windDec :: D + , windSus :: D + , windVib :: D + , windBright :: D } + +woodWind' spec instr = Patch + { patchInstr = \(amp, cps) -> mul 1.3 $ do + seed <- rnd 1 + vibDisp <- rnd (0.1 * amp) + let dispVib vib = vib * (0.9 + vibDisp) + return $ fromMono $ mul (0.8 * sig amp * fadeOut (windDec spec)) $ instr seed (dispVib $ windVib spec) (windAtt spec) (windSus spec) (windDec spec) (0.4 + 0.75 * windBright spec * amp) cps + , patchFx = fx1 0.25 smallHall2 } + +-- flute + +fluteSpec bright vib = Wind + { windAtt = 0.08 + , windDec = 0.1 + , windSus = 20 + , windVib = vib + , windBright = bright } + +shortFluteSpec bright vib = Wind + { windAtt = 0.03 + , windDec = 0.05 + , windSus = 20 + , windVib = vib + , windBright = bright } + +flute = woodWind' (fluteSpec br vib) C.flute + where + br = 0.7 + vib = 0.015 + +shortFlute = woodWind' (shortFluteSpec br vib) C.flute + where + br = 0.7 + vib = 0.015 + +fluteVibrato = woodWind' (fluteSpec br vib) C.flute + where + br = 0.7 + vib = 0.04 + +mutedFlute = woodWind' (fluteSpec br vib) C.flute + where + br = 0.25 + vib = 0.015 + +brightFlute = woodWind' (fluteSpec br vib) C.flute + where + br = 1.2 + vib = 0.015 + +-- bass clarinet + +bassClarinetSpec bright vib = Wind + { windAtt = 0.06 + , windDec = 0.15 + , windSus = 20 + , windVib = vib + , windBright = bright } + +shortBassClarinetSpec bright vib = Wind + { windAtt = 0.03 + , windDec = 0.04 + , windSus = 20 + , windVib = vib + , windBright = bright } + +bassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet + where + br = 0.7 + vib = 0.01 + +shortBassClarinet = woodWind' (shortBassClarinetSpec br vib) C.bassClarinet + where + br = 0.7 + vib = 0.01 + +bassClarinetVibrato = woodWind' (bassClarinetSpec br vib) C.bassClarinet + where + br = 0.7 + vib = 0.035 + +mutedBassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet + where + br = 0.25 + vib = 0.01 + +brightBassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet + where + br = 1.2 + vib = 0.01 + +-- french horn + +frenchHornSpec bright vib = Wind + { windAtt = 0.08 + , windDec = 0.25 + , windSus = 20 + , windVib = vib + , windBright = bright } + +shortFrenchHornSpec bright vib = Wind + { windAtt = 0.03 + , windDec = 0.04 + , windSus = 20 + , windVib = vib + , windBright = bright } + +frenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn + where + br = 0.7 + vib = 0.01 + +shortFrenchHorn = woodWind' (shortFrenchHornSpec br vib) C.frenchHorn + where + br = 0.7 + vib = 0.01 + +frenchHornVibrato = woodWind' (frenchHornSpec br vib) C.frenchHorn + where + br = 0.7 + vib = 0.035 + +mutedFrenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn + where + br = 0.25 + vib = 0.01 + +brightFrenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn + where + br = 1.2 + vib = 0.01 + +-- sheng + +shengSpec bright vib = Wind + { windAtt = 0.1 + , windDec = 0.2 + , windSus = 20 + , windVib = vib + , windBright = bright } + +shortShengSpec bright vib = Wind + { windAtt = 0.03 + , windDec = 0.04 + , windSus = 20 + , windVib = vib + , windBright = bright } + +sheng = woodWind' (shengSpec br vib) C.sheng + where + br = 0.7 + vib = 0.01 + +shortSheng = woodWind' (shortShengSpec br vib) C.sheng + where + br = 0.7 + vib = 0.01 + +shengVibrato = woodWind' (shengSpec br vib) C.sheng + where + br = 0.7 + vib = 0.025 + +mutedSheng = woodWind' (shengSpec br vib) C.sheng + where + br = 0.25 + vib = 0.01 + +brightSheng = woodWind' (shortShengSpec br vib) C.sheng + where + br = 1.2 + vib = 0.01 + +-- hulusi + +hulusiSpec bright vib = Wind + { windAtt = 0.12 + , windDec = 0.14 + , windSus = 20 + , windVib = vib + , windBright = bright } + +shortHulusiSpec bright vib = Wind + { windAtt = 0.03 + , windDec = 0.04 + , windSus = 20 + , windVib = vib + , windBright = bright } + +hulusi = woodWind' (hulusiSpec br vib) C.hulusi + where + br = 0.7 + vib = 0.015 + +shortHulusi = woodWind' (shortHulusiSpec br vib) C.hulusi + where + br = 0.7 + vib = 0.015 + +hulusiVibrato = woodWind' (hulusiSpec br vib) C.hulusi + where + br = 0.7 + vib = 0.035 + +mutedHulusi = woodWind' (hulusiSpec br vib) C.hulusi + where + br = 0.25 + vib = 0.015 + +brightHulusi = woodWind' (shortHulusiSpec br vib) C.hulusi + where + br = 1.2 + vib = 0.015 + + +-- dizi + +diziSpec bright vib = Wind + { windAtt = 0.03 + , windDec = 0.2 + , windSus = 20 + , windVib = vib + , windBright = bright } + +shortDiziSpec bright vib = Wind + { windAtt = 0.1 + , windDec = 0.04 + , windSus = 20 + , windVib = vib + , windBright = bright } + +dizi = woodWind' (diziSpec br vib) C.dizi + where + br = 0.7 + vib = 0.01 + +shortDizi = woodWind' (shortDiziSpec br vib) C.dizi + where + br = 0.7 + vib = 0.01 + +diziVibrato = woodWind' (diziSpec br vib) C.dizi + where + br = 0.7 + vib = 0.035 + +mutedDizi = woodWind' (diziSpec br vib) C.dizi + where + br = 0.25 + vib = 0.01 + +brightDizi = woodWind' (shortDiziSpec br vib) C.dizi + where + br = 1.2 + vib = 0.01 + +------------------------------------ +-- x-rays + +pulseWidth = Patch + { patchInstr = mul (0.75 * 0.6) . at fromMono . mul (fades 0.07 0.1). onCps (uncurry C.pulseWidth) + , patchFx = fx1 0.15 smallHall2 } + +xanadu = Patch + { patchInstr = mul (1.2 * 0.6) . at fromMono . mul (fades 0.01 2.2). onCps C.xanadu1 + , patchFx = fx1 0.27 largeHall2 } + +alienIsAngry = Patch + { patchInstr = at fromMono . mul (0.5 * fades 0.01 2.3). onCps (C.fmMod 5) + , patchFx = fx1 0.15 smallRoom2 } + +noiz = Patch + { patchInstr = at fromMono . mul (1.5 * fades 0.01 0.5). onCps C.noiz + , patchFx = fx1 0.15 smallHall2 } + +blue = Patch + { patchInstr = at fromMono . mul (1.5 * fades 0.01 0.5). onCps (C.blue 5 7 0.24 12) + , patchFx = fx1 0.25 smallHall2 } + +black = Patch + { patchInstr = at fromMono . mul (2 * fades 0.01 0.5). onCps (\cps -> C.black 3 (cps / 2) (cps * 2) 12 (sig cps)) + , patchFx = fx1 0.25 smallHall2 } + +simpleMarimba = Patch + { patchInstr = at fromMono . mul (0.8 * fades 0.01 0.5). onCps (C.simpleMarimba 5) + , patchFx = fx1 0.25 smallHall2 } + +okComputer = Patch + { patchInstr = \(amp, cps) -> (at fromMono . mul (0.75 * sig amp * fades 0.01 0.01) . at (mlp (1500 + sig amp * 8500) 0.1) . (C.okComputer . (/ 25))) (sig cps) + , patchFx = fx1 0.25 id } + +snowCrackle = Patch + { patchInstr = \(amp, cps) -> (return . fromMono . mul (0.8 * sig amp * fades 0.001 0.001) . (C.snowCrackle . (/ 25))) (sig cps) + , patchFx = fx1 0.25 id } + +noiseBell = Patch + { patchInstr = at fromMono . mul 0.75 . onCps (C.noiseBell (31, 125) 2.3 0.2 . ( * 8)) + , patchFx = fx1 0.25 smallHall2 } + +------------------------------------ +-- vowels + +robotVowels vows latVow = Patch + { patchInstr = at fromMono . mul (1.1 * fades 0.1 0.1). onCps (C.vowels 25 vows latVow) + , patchFx = fx1 0.15 smallHall2 } + +robotLoopVowels loopDur vows = Patch + { patchInstr = at fromMono . mul (1.1 * fades 0.1 0.1). onCps (C.loopVowels 25 loopDur vows) + , patchFx = fx1 0.15 smallHall2 } + +robotVowel vow = Patch + { patchInstr = at fromMono . mul (1.1 * fades 0.1 0.1). onCps (C.oneVowel 25 vow) + , patchFx = fx1 0.15 smallHall2 } + +------------------------------------ +-- nature / effects + +windWall = Patch + { patchInstr = at fromMono . mul (1.25 * fades 0.1 5). onCps C.windWall + , patchFx = fx1 0.25 largeHall2 } + +mildWind = Patch + { patchInstr = at fromMono . mul (1.25 * fades 0.1 1.5). onCps C.mildWind + , patchFx = fx1 0.25 largeHall2 } + +wind = Patch + { patchInstr = at fromMono . mul (0.8 * fades 0.1 1.5). onCps (\cps -> C.thorWind (cps * 2) 150 (0.3, 1)) + , patchFx = fx1 0.25 largeHall2 } + +------------------------------------ +-- drums +