csound-catalog 0.7.3 → 0.7.4
raw patch · 21 files changed
+1604/−1490 lines, 21 filesdep ~csound-expressiondep ~csound-samplerPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: csound-expression, csound-sampler
API changes (from Hackage documentation)
+ Csound.Catalog.Drum.Tr808: cbell :: Sam
+ Csound.Catalog.Drum.Tr808: cbell' :: TrSpec -> Sam
+ Csound.Catalog.Drum.Tr808: cowSpec :: TrSpec
+ Csound.Catalog.Drum.Tr808: cowbell :: SE Sig
+ Csound.Catalog.Drum.Tr808: cowbell' :: TrSpec -> SE Sig
+ Csound.Patch: accordeonHeavy :: Patch Sig2
+ Csound.Patch: limRel :: SigSpace a => D -> Patch a -> Patch a
- Csound.Catalog.Wave: amFlavio :: () => p -> Sig -> Sig
+ Csound.Catalog.Wave: amFlavio :: D -> Sig -> Sig
- Csound.Catalog.Wave: fmDrone :: Sig -> (D, D) -> Sig -> (Sig, Sig)
+ Csound.Catalog.Wave: fmDrone :: Sig -> (D, D) -> Sig -> Sig2
- Csound.Catalog.Wave: fmDrones :: Sig -> [Sig] -> [Sig] -> (D, D) -> Sig -> SE (Sig, Sig)
+ Csound.Catalog.Wave: fmDrones :: Sig -> [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2
- Csound.Catalog.Wave: simpleFading :: D -> (D, D) -> SE (Sig, Sig)
+ Csound.Catalog.Wave: simpleFading :: D -> (D, D) -> SE Sig2
- Csound.Catalog.Wave: simpleSust :: D -> (D, D) -> SE (Sig, Sig)
+ Csound.Catalog.Wave: simpleSust :: D -> (D, D) -> SE Sig2
Files
- csound-catalog.cabal +8/−3
- src/Csound/Catalog/Drum.hs +13/−3
- src/Csound/Catalog/Drum/Hm.hs +10/−1
- src/Csound/Catalog/Drum/MiniPops.hs +209/−143
- src/Csound/Catalog/Drum/Tr808.hs +264/−221
- src/Csound/Catalog/Effect.hs +18/−18
- src/Csound/Catalog/Reson.hs +43/−43
- src/Csound/Catalog/Wave/Ac.hs +31/−31
- src/Csound/Catalog/Wave/Bitwig.hs +26/−20
- src/Csound/Catalog/Wave/Deserted.hs +20/−20
- src/Csound/Catalog/Wave/Flavio.hs +41/−39
- src/Csound/Catalog/Wave/Fm.hs +2/−2
- src/Csound/Catalog/Wave/Misc.hs +31/−25
- src/Csound/Catalog/Wave/Sean.hs +107/−125
- src/Csound/Catalog/Wave/Sharc.hs +10/−16
- src/Csound/Catalog/Wave/Thor.hs +73/−72
- src/Csound/Catalog/Wave/VestigeOfTime.hs +16/−16
- src/Csound/Catalog/Wave/Vowel.hs +67/−67
- src/Csound/Catalog/Wave/Woodwind.hs +157/−157
- src/Csound/Catalog/Wave/WoodwindAlg.hs +24/−24
- src/Csound/Patch.hs +434/−444
csound-catalog.cabal view
@@ -1,6 +1,6 @@ Name: csound-catalog-Version: 0.7.3-Cabal-Version: >= 1.6+Version: 0.7.4+Cabal-Version: >= 1.22 License: BSD3 License-file: LICENSE Author: Anton Kholomiov@@ -27,8 +27,13 @@ Library Ghc-Options: -Wall Build-Depends:- base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.3.2, csound-sampler >=0.0.9.0, sharc-timbre+ base >= 4, base < 5,+ transformers >= 0.3,+ csound-expression >= 5.3.4,+ csound-sampler >=0.0.10.0,+ sharc-timbre Hs-Source-Dirs: src/+ Default-language: Haskell2010 Exposed-Modules: Csound.Catalog Csound.Catalog.Drum
src/Csound/Catalog/Drum.hs view
@@ -9,8 +9,8 @@ -- * Korg MiniPops Drum kit mpBd, mpSn1, mpSn2, mpRim, mpCym1, mpCym2, mpBon1, mpBon2, mpBon3, mpCl, mpCow, mpGro, mpMar, mpQj, mpTam, - -- * Csound percussive models kit - boo, gro, sbells, tam, cab, crun, shake, spaper, + -- * Csound percussive models kit+ boo, gro, sbells, tam, cab, crun, shake, spaper, ) where import Csound.Base@@ -21,6 +21,8 @@ import qualified Csound.Catalog.Drum.MiniPops as M +hmBd1,hmBd2,hmBd3,hmSn1,hmSn2,hmSweeo,hmBoink,hmOhh,hmChh,hmCr,hmClap :: Sam+ hmBd1 = H.bd1 hmBd2 = H.bd2 hmBd3 = H.bd3@@ -33,6 +35,8 @@ hmCr = H.cr hmClap = H.clap +trBd, trSn, trOhh, trChh, trHtom, trMtom, trLtom, trCym, trCl, trRim, trMar, trHcon, trMcon, trLcon :: Sam+ trBd = T.bd trSn = T.sn trOhh = T.ohh@@ -48,6 +52,8 @@ trMcon = T.mcon trLcon = T.lcon +mpBd, mpSn1, mpSn2, mpRim, mpCym1, mpCym2,mpBon1, mpBon2, mpBon3, mpCl, mpCow, mpGro, mpMar, mpQj, mpTam :: Sam+ mpBd = M.bd mpSn1 = M.sn1 mpSn2 = M.sn2@@ -64,7 +70,11 @@ mpQj = M.qj mpTam = M.tam -mkSam = limSam 1 +mkSam :: Sig -> Sam+mkSam = limSam 1++boo, gro, sbells, tam, cab, crun, spaper :: Sam+shake :: Sig -> Sam boo = mkSam $ bamboo 1 0.01 gro = mkSam $ guiro 1 0.01
src/Csound/Catalog/Drum/Hm.hs view
@@ -31,7 +31,10 @@ k <- birnd 0.09 return $ a * (1 + sig k) +addDur' :: D -> a -> SE a addDur' dt x = xtratim dt >> return x++addDur :: a -> SE a addDur = addDur' 0.1 toDrum :: Sig -> SE Sig@@ -63,7 +66,7 @@ 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]+ 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@@ -73,6 +76,7 @@ -- fullkit +bassDrum :: SE Sig bassDrum = bassDrum' 64 bassDrum' :: D -> SE Sig@@ -104,6 +108,7 @@ 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 :: SE Sig crash = crash' $ cpspch 13.05 -- | Recommended values cpspch(13.03) - cpspch(13.10)@@ -149,6 +154,7 @@ , (0.0209, 3.979) ] +handClap :: SE Sig handClap = handClap' 400 handClap' :: D -> SE Sig@@ -179,7 +185,10 @@ -------------------------------------------------- -- sampler +mkSam :: SE Sig -> Sam mkSam = limSam 4++bd1, bd2, sn1, sweep, boink, sn2, ohh, chh, bd3, cr, clap :: Sam bd1 = mkSam dumb bd2 = mkSam dumbBass
src/Csound/Catalog/Drum/MiniPops.hs view
@@ -1,339 +1,404 @@--- | Drums of the Korg Mini Pops 7 drum machine (recoded from Iain McCurdy).+-- | Drums of the Korg Mini Pops 7 drum machine (recoded from Iain McCurdy). module Csound.Catalog.Drum.MiniPops(- MpSpec(..),+ MpSpec(..), - bass, snare1, snare2, rimShot, cymbal1, cymbal2, bongo1, bongo2, bongo3,- claves, cowbell, guiro, maracas, quijada, tamb,+ 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,+ -- * 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,+ -- * 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'+ -- ** Generic+ bd', sn1', sn2', rim', cym1', cym2', bon1', bon2', bon3', cl', cow', gro', mar', qj', tam' ) where -import Csound.Base hiding (guiro)+import Csound.Base hiding (guiro, dur) import Csound.Sam data MpSpec = MpSpec {- mpDur :: D- , mpCps :: D- , mpRnd :: Maybe D }+ mpDur :: D+ , mpCps :: D+ , mpRnd :: Maybe D } rndAmp :: Sig -> SE Sig rndAmp a = do- k <- birnd 0.09- return $ a * (1 + sig k)+ k <- birnd 0.09+ return $ a * (1 + sig k) +addDur' :: D -> a -> SE a addDur' dt x = xtratim dt >> return x++addDur :: a -> SE a addDur = addDur' 0.1 toDrum :: Sig -> SE Sig toDrum a = rndAmp =<< addDur a +defSpec :: D -> D -> MpSpec defSpec dur cps = MpSpec- { mpDur = dur- , mpCps = cps- , mpRnd = Just 0.085 }+ { 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+ k <- birnd amount+ return $ x + k * total +rndDur, rndCps :: D -> D -> SE D+ rndDur amt x = rndVal x amt x rndCps amt x = rndVal x (amt / 10) x rndSpec :: MpSpec -> SE MpSpec rndSpec spec = do- dur <- rndDur'- cps <- rndCps'- return $ spec- { mpDur = dur- , mpCps = cps }- where- rndDur' = (maybe return rndDur $ (mpRnd spec)) $ mpDur spec- rndCps' = (maybe return rndCps $ (mpRnd spec)) $ mpCps spec+ dur <- rndDur'+ cps <- rndCps'+ return $ spec+ { mpDur = dur+ , mpCps = cps }+ where+ rndDur' = (maybe return rndDur $ (mpRnd spec)) $ mpDur spec+ rndCps' = (maybe return rndCps $ (mpRnd spec)) $ mpCps spec +rezz :: Sig -> Sig -> Sig rezz cps bw = reson (mpulse 1 0) cps (cps * bw) `withD` 2 +bass :: SE Sig bass = bass' bdSpec +bdSpec :: MpSpec bdSpec = defSpec 0.43 64 +bass' :: MpSpec -> SE Sig bass' spec = pureBass' =<< rndSpec spec -- dur = 1.7 -- cps = 64+pureBass' :: MpSpec -> SE Sig pureBass' spec = toDrum aout- where- dur = mpDur spec- cps = sig $ mpCps spec+ 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]+ aout = mul (env * 225 * fadeOut dur) $ lp1 500 $ rezz cps 0.001+ env = transeg [1, dur, -14, 0] +snare1 :: SE Sig snare1 = snare1' snSpec1 +snSpec1 :: MpSpec snSpec1 = defSpec 0.38 800 +snare1' :: MpSpec -> SE Sig snare1' spec = pureSnare1' =<< rndSpec spec -- cps = 800+pureSnare1' :: MpSpec -> SE Sig pureSnare1' spec = toDrum =<< (mul (fadeOut dur) $ aout)- where- dur = mpDur spec- cps = mpCps spec+ 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+ 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+ 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+ aout = fmap ((0.7 * astrike1) + ) $ mul 2 $ asig1 +snare2 :: SE Sig snare2 = snare2' snSpec2 +snSpec2 :: MpSpec snSpec2 = defSpec 0.4 800 +snare2' :: MpSpec -> SE Sig snare2' spec = pureSnare2' =<< rndSpec spec +pureSnare2' :: MpSpec -> SE Sig pureSnare2' spec = toDrum =<< (mul (fadeOut dur) $ aout)- where- dur = mpDur spec- cps = mpCps spec+ 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+ 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+ 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+ aout = fmap ((0.5 * astrike1) + ) $ mul 2.3 $ asig1 +rimShot :: SE Sig rimShot = rimShot' rimSpec +rimSpec :: MpSpec rimSpec = defSpec 0.005 1700 +rimShot' :: MpSpec -> SE Sig rimShot' spec = pureRimShot' =<< rndSpec spec -- cps = 1700 -- dur = 0.005+pureRimShot' :: MpSpec -> SE Sig pureRimShot' spec = toDrum $ mul (fadeOut dur) $ asig- where- dur = mpDur spec- cps = sig $ mpCps spec+ 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)+ asig1 = osc' 0.2 cps+ asig2 = reson asig1 cps 1500 `withD` 2+ asig = bhp 500 (asig1 + asig2 * 0.4 * 0.3) +cymbal1 :: SE Sig cymbal1 = cymbal1' cymSpec1 +cymSpec1 :: MpSpec cymSpec1 = defSpec 0.304 6000 +cymbal1' :: MpSpec -> SE Sig cymbal1' spec = pureCymbal1' =<< rndSpec spec -- dur = 0.304 -- cps = 6000+pureCymbal1' :: MpSpec -> SE Sig pureCymbal1' spec = (toDrum =<< ) $ mul (fadeOut dur) $ do- anoise <- white- let asig1 = blp 14000 $ reson (anoise*aenv) icf (icf*0.7) `withD` 1- asig2 = bhp 6000 $ (asig1 + anoise * 0.001)- return $ 0.25 * aenv * asig2- where- dur = mpDur spec- cps = sig $ mpCps spec+ 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+ aenv = transeg [1,dur,-2,0]+ icf = cps +cymbal2 :: SE Sig cymbal2 = cymbal2' cymSpec2 +cymSpec2 :: MpSpec cymSpec2 = defSpec 1.404 1000 +cymbal2' :: MpSpec -> SE Sig cymbal2' spec = pureCymbal2' =<< rndSpec spec +pureCymbal2' :: MpSpec -> SE Sig pureCymbal2' spec = (toDrum =<< ) $ mul (fadeOut dur) $ do- anoise <- white- let asig = mul aenv $ bhp 6000 $ mul aenv $ lp1 12000 $ reson (anoise * aenv) icf (icf * 0.9) `withD` 1- return $ astrike * 0.2 + asig * 1.5- where- dur = mpDur spec- cps = mpCps spec+ 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])+ icf = sig $ cps * 5+ aenv = transeg [1,dur,-2,0]+ xdur = 0.004+ aenv2 = transeg [1,xdur,-2,0]+ astrike = mul aenv2 $ osc (transeg [cps,xdur,-4,0.4*cps]) -- dur = 0.2 -- cps = 630+bongo1 :: SE Sig bongo1 = bongo1' bonSpec1 +bonSpec1 :: MpSpec bonSpec1 = defSpec 0.2 630 +bongo1' :: MpSpec -> SE Sig bongo1' spec = pureBongo1' =<< rndSpec spec +pureBongo1' :: MpSpec -> SE Sig pureBongo1' spec = toDrum $ mul (fadeOut dur) $ asig- where- dur = mpDur spec- cps = sig $ mpCps spec+ 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]+ asig = mul (4 * aenv ) $ blp 8000 $ bhp 300 $ rezz cps 0.03+ aenv = transeg [1,dur,13,0] +bongo2 :: SE Sig bongo2 = bongo2' bonSpec2 +bonSpec2 :: MpSpec bonSpec2 = defSpec 0.2 400 +bongo2' :: MpSpec -> SE Sig bongo2' spec = pureBongo2' =<< rndSpec spec -- dur = 0.2 -- cps = 400+pureBongo2' :: MpSpec -> SE Sig pureBongo2' spec = toDrum $ mul (fadeOut dur) $ asig- where- dur = mpDur spec- cps = mpCps spec+ 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+ kcps = expon cps dur (cps * 0.975)+ aenv = transeg [1,dur-0.005,0,0.1,0.005,0, 0]+ asig = mul (4 * aenv) $ bhp 100 $ lp1 5000 $ rezz kcps 0.03 +bongo3 :: SE Sig bongo3 = bongo3' bonSpec3 +bonSpec3 :: MpSpec bonSpec3 = defSpec 1.229 194 +bongo3' :: MpSpec -> SE Sig bongo3' spec = pureBongo3' =<< rndSpec spec -- dur = 1.229 -- cps = 194+pureBongo3' :: MpSpec -> SE Sig pureBongo3' spec = toDrum $ mul (fadeOut dur) $ asig- where- dur = mpDur spec- cps = sig $ mpCps spec+ 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+ aenv = transeg [0, 0.001, -2, 1, dur-0.001, -2, 0]+ kbw = linseg [0.05,0.01,0.008]+ asig = mul (5 * aenv) $ blp 11000 $ rezz cps kbw +claves :: SE Sig claves = claves' clSpec +clSpec :: MpSpec clSpec = defSpec 0.186 400 +claves' :: MpSpec -> SE Sig claves' spec = pureClaves' =<< rndSpec spec +pureClaves' :: MpSpec -> SE Sig pureClaves' spec = toDrum aout- where- dur = mpDur spec- cps = sig $ mpCps spec+ 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+ aenv = linseg [1, dur, 0]+ asig1 = rezz cps 0.025+ asig2 = rezz (cps * 5.45) 0.03+ aout = mul (3.2 * aenv * fadeOut dur) $ asig1 + 1.3 * asig2 +cowbell :: SE Sig cowbell = cowbell' cowSpec +cowSpec :: MpSpec cowSpec = defSpec 0.3 850 +cowbell' :: MpSpec -> SE Sig cowbell' spec = pureCowbell' =<< rndSpec spec +pureCowbell' :: MpSpec -> SE Sig pureCowbell' spec = toDrum asig- where- dur = mpDur spec- cps = sig $ mpCps spec+ 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]+ asig = mul (aenv * 3 * fadeOut dur) $ bhp 100 $+ rezz cps 0.007+ + 0.8 * rezz (cps * 5.537) 0.03+ aenv = linseg [1, dur, 0] +guiro :: SE Sig guiro = guiro' groSpec +groSpec :: MpSpec groSpec = defSpec 0.256 66 +guiro' :: MpSpec -> SE Sig guiro' spec = pureGuiro' =<< rndSpec spec +pureGuiro' :: MpSpec -> SE Sig pureGuiro' spec = toDrum asig- where- dur = mpDur spec- cps = mpCps spec+ 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)]+ aenv = linseg [0,0.001,1,dur-0.111,0.6,0.1,1,0.01,0]+ asig = mul (3 * aenv * fadeOut dur) $ bhp 1000 $ reson (0.1 * sqr kcps) 4300 3000 `withD` 1+ kcps = transeg [cps,dur,2,(1.1 * cps)] +maracas :: SE Sig maracas = maracas' marSpec +marSpec :: MpSpec marSpec = defSpec 0.05 5000 +maracas' :: MpSpec -> SE Sig maracas' spec = pureMaracas' =<< rndSpec spec +pureMaracas' :: MpSpec -> SE Sig pureMaracas' spec = toDrum =<< do- asig <- noise 1 0.04- return $ mul (0.35 * aenv * fadeOut dur) $ bhp 2000 $ reson asig 9000 4000 `withD` 2- where- dur = mpDur spec- cps = sig $ mpCps spec-- aenv = transeg [1,dur,-4,0]+ asig <- noise 1 0.04+ return $ mul (0.35 * aenv * fadeOut dur) $ bhp 2000 $ reson asig 9000 4000 `withD` 2+ where+ dur = mpDur spec+ aenv = transeg [1,dur,-4,0] +quijada :: SE Sig quijada = quijada' qjSpec +qjSpec :: MpSpec qjSpec = defSpec 0.817 550 +quijada' :: MpSpec -> SE Sig quijada' spec = pureQuijada' =<< rndSpec spec +pureQuijada' :: MpSpec -> SE Sig pureQuijada' spec = toDrum $ bhp cps $ mul (6 * fadeOut dur) $ phi dur (1/22.7272) + phi (dur * 0.39) (1/13.1579)- where- dur = mpDur spec- cps = sig $ mpCps spec+ 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]+ phi dt freq = mul kenv $ reson (mpulse 1 freq) 2727 400 `withD` 1+ where kenv = transeg [0.8,0.05,1, 1,dt-0.05,-6,0] +tamb :: SE Sig tamb = tamb' tamSpec +tamSpec :: MpSpec tamSpec = defSpec 0.271 7000 +tamb', pureTamb' :: MpSpec -> SE Sig+ tamb' spec = pureTamb' =<< rndSpec spec pureTamb' spec = toDrum =<< do- anoise <- noise 1 0- return $ mul (1.5 * aenv * fadeOut dur)- $ reson (bhp cps $ (+ (anoise * 0.1 * aenv)) $ reson (anoise * aenv) 4600 100 `withD` 2) 9000 3000 `withD` 1- where- dur = mpDur spec- cps = sig $ mpCps spec- aenv = transeg [1,dur,-8,0]+ anoise <- noise 1 0+ return $ mul (1.5 * aenv * fadeOut dur)+ $ reson (bhp cps $ (+ (anoise * 0.1 * aenv)) $ reson (anoise * aenv) 4600 100 `withD` 2) 9000 3000 `withD` 1+ where+ dur = mpDur spec+ cps = sig $ mpCps spec+ aenv = transeg [1,dur,-8,0] ------------------------------------------------------- -- Sampler +mkSam :: SE Sig -> Sam mkSam = limSam 4 -- | Bass drum@@ -396,6 +461,7 @@ tam :: Sam tam = mkSam tamb +mkSam' :: (t -> SE Sig) -> t -> Sam mkSam' f spec = mkSam $ f spec bd' :: MpSpec -> Sam
src/Csound/Catalog/Drum/Tr808.hs view
@@ -1,193 +1,216 @@--- | Drums of the Korg TR-808 drum machine (recoded from Iain McCurdy).+-- | Drums of the Korg TR-808 drum machine (recoded from Iain McCurdy). module Csound.Catalog.Drum.Tr808(- TrSpec(..),+ TrSpec(..), - bass, bass2, snare, openHiHat, closedHiHat,- lowTom, midTom, highTom, cymbal, claves, rimShot,- maraca, highConga, midConga, lowConga,+ bass, bass2, snare, openHiHat, closedHiHat,+ lowTom, midTom, highTom, cymbal, claves, rimShot,+ maraca, highConga, midConga, lowConga, cowbell, - -- * 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,+ -- * 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, cowSpec, cowbell', - -- * Sampler- bd, bd2, sn, ohh, chh, htom, mtom, ltom, cym, cl, rim, mar, hcon, mcon, lcon,+ -- * Sampler+ bd, bd2, sn, ohh, chh, htom, mtom, ltom, cym, cl, rim, mar, hcon, mcon, lcon, cbell, - -- ** Generic- 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', cbell' ) where import Control.Monad -import Csound.Base+import Csound.Base hiding (dur) 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)+ k <- birnd 0.09+ return $ a * (1 + sig k) data TrSpec = TrSpec {- trDur :: D- , trTune :: D- , trCps :: D- , trRnd :: Maybe D- }+ trDur :: D+ , trTune :: D+ , trCps :: D+ , trRnd :: Maybe D+ } +cpsSpec :: D -> TrSpec cpsSpec cps = TrSpec- { trDur = 0.8- , trTune = 0- , trCps = cps- , trRnd = Just 0.085 }+ { 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+ k <- birnd amount+ return $ x + k * total +rndDur, rndCps, rndTune :: D -> D -> SE D+ 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+ 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 bdSpec = TrSpec- { trDur = 0.95- , trTune = 1- , trCps = 55- , trRnd = Just 0.05 }+ { trDur = 0.95+ , trTune = 1+ , trCps = 55+ , trRnd = Just 0.05 } +addDur' :: D -> a -> SE a addDur' dt x = xtratim dt >> return x++addDur :: a -> SE a addDur = addDur' 0.1 +bass :: SE Sig bass = bass' bdSpec +bass' :: TrSpec -> SE Sig bass' spec = pureBass' =<< rndSpec spec pureBass' :: TrSpec -> SE Sig pureBass' spec = rndAmp =<< addDur amix- where- dur = trDur spec- cps = trCps spec+ 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+ 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+ 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 bdSpec2 = TrSpec- { trDur = 1.3- , trTune = 1- , trCps = 57- , trRnd = Just 0.05 }+ { trDur = 1.3+ , trTune = 1+ , trCps = 57+ , trRnd = Just 0.05 } +bass2 :: SE Sig bass2 = bass2' bdSpec2 +bass2' :: TrSpec -> SE Sig 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+ compr x = dam x 0.65 2.4 2.3 0.05 0.1+ dur = trDur spec+ cps = sig $ trCps spec +snSpec :: TrSpec snSpec = cpsSpec 342 +snare :: SE Sig snare = snare' snSpec +snare' :: TrSpec -> SE Sig 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+ where+ dur = trDur spec+ tune = trTune spec+ cps = trCps spec - iNseDur = dur * 0.3- iPchDur = dur * 0.1+ 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)+ -- 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+ -- 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, chSpec :: TrSpec+ ohSpec = cpsSpec 296 chSpec = cpsSpec 296 +openHiHat, closedHiHat :: SE Sig+ 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+ where dur = trDur spec closedHiHat' :: TrSpec -> SE Sig closedHiHat' spec = genHiHat (expsega [1, (dur / 2), 0.001]) spec- where dur = trDur 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+ where+ dur = trDur spec+ tune = trTune spec+ cps = trCps spec - halfDur = dur * 0.5+ 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+ -- 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+ -- 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, mtSpec, ltSpec :: TrSpec+ htSpec = cpsSpec 200 mtSpec = cpsSpec 133 ltSpec = cpsSpec 90 +lowTom, midTom, highTom :: SE Sig+ lowTom = lowTom' ltSpec midTom = midTom' mtSpec highTom = highTom' htSpec@@ -206,194 +229,206 @@ 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+ where+ dur = trDur spec+ tune = trTune spec+ cps = trCps spec - ifrq = cps * octave tune- halfDur = durDt * dur+ ifrq = cps * octave tune+ halfDur = durDt * dur - -- sine tone signal- aAmpEnv = fadeIn 0.04 * transeg [1, halfDur, -10, 0.001]- afmod = expsega [5, 0.125/ifrq, 1]- asig = mul (-aAmpEnv) $ rndOsc (sig ifrq * afmod)+ -- sine tone signal+ aAmpEnv = fadeIn 0.04 * 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+ -- 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 :: TrSpec cymSpec = cpsSpec 296 +cymbal :: SE Sig 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+ where+ dur = trDur spec+ tune = trTune spec+ cps = trCps spec - fullDur = dur * 2+ 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+ -- 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+ -- 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 :: TrSpec clSpec = cpsSpec 2500 +claves :: SE Sig claves = claves' clSpec -- cps = 2500 claves' :: TrSpec -> SE Sig claves' spec = rndAmp =<< addDur =<< asig- where- dur = trDur spec- tune = trTune spec- cps = trCps spec+ 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)+ 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 :: TrSpec rimSpec = cpsSpec 1700 +rimShot :: SE Sig rimShot = rimShot' rimSpec +rimShot' :: TrSpec -> SE Sig 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+ where+ dur = trDur spec+ tune = trTune spec+ cps = trCps spec - fullDur = 0.027 * dur+ 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+ -- 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+ -- 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]+ 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 :: TrSpec cowSpec = cpsSpec 562 +cowbell :: SE Sig cowbell = cowbell' cowSpec -- cps = 562 cowbell' :: TrSpec -> SE Sig cowbell' spec = rndAmp =<< addDur =<< ares- where- dur = trDur spec- tune = trTune spec- cps = trCps spec+ 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+ ifrq1 = sig $ cps * octave tune+ ifrq2 = 1.5 * ifrq1+ fullDur = 0.7 * dur+ ishape = -30+ 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+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+ where+ iTimGap = 0.01 -} +marSpec :: TrSpec marSpec = cpsSpec 450 +maraca :: SE Sig maraca = maraca' marSpec maraca' :: TrSpec -> SE Sig maraca' spec = rndAmp =<< addDur =<< anoise- where- dur = trDur spec- tune = trTune spec- cps = trCps spec+ where+ dur = trDur spec+ tune = trTune 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+ 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, mcSpec, lcSpec :: TrSpec+ hcSpec = cpsSpec 420 mcSpec = cpsSpec 310 lcSpec = cpsSpec 227 +highConga, midConga, lowConga :: SE Sig+ highConga = highConga' hcSpec midConga = midConga' mcSpec lowConga = lowConga' lcSpec@@ -413,21 +448,22 @@ genConga :: D -> TrSpec -> SE Sig genConga dt spec = rndAmp =<< addDur =<< asig- where- dur = trDur spec- tune = trTune spec- cps = trCps spec+ 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)+ 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 :: SE Sig -> Sam mkSam = limSam 4 -- | Bass drum@@ -489,8 +525,12 @@ lcon :: Sam lcon = mkSam lowConga +cbell :: Sam+cbell = mkSam cowbell+ -- generic sam +mkSam' :: (t -> SE Sig) -> t -> Sam mkSam' f spec = mkSam $ f spec -- | Bass drum@@ -552,4 +592,7 @@ lcon' :: TrSpec -> Sam lcon' = mkSam' lowConga' +-- | Cowbell+cbell' :: TrSpec -> Sam+cbell' = mkSam' cowbell'
src/Csound/Catalog/Effect.hs view
@@ -1,6 +1,6 @@ -- | A gallery of sound processors (effects). module Csound.Catalog.Effect(- nightChorus, nightReverb, + nightChorus, nightReverb, vibroDelay, delayLine, bassEnhancment, declick, sweepFilter, loopSweepFilter, -- * Presets@@ -9,9 +9,9 @@ import Control.Monad -import Csound.Base+import Csound.Base hiding (dur, filt, del) --- | A signal goes throgh the chain of varible delays. +-- | A signal goes throgh the chain of varible delays. -- Delay time is affected by vibrato. -- -- > aout = vibroDelay n delayBufferSize vibDepth vibRate asig@@ -40,9 +40,9 @@ -- * iscale -- amplitude of the vibrato on delay time (in milliseconds). nightChorus :: D -> D -> Sig -> Sig nightChorus idlym iscale asig = 0.5 * aout- where + where phi cps maxDel = vdelay3 asig (sig (idlym / 5) + sig (idlym / iscale) * osc cps) maxDel- aout = sum $ zipWith phi + aout = sum $ zipWith phi [1, 0.995, 1.05, 1] [900, 700, 700, 900] @@ -50,11 +50,11 @@ -- | Reverb ----- A bunch of delay lines FDN reverb, with feedback matrix based upon +-- A bunch of delay lines FDN reverb, with feedback matrix based upon -- physical modeling scattering junction of 8 lossless waveguides--- of equal characteristic impedance. Based on Julius O. Smith III, +-- of equal characteristic impedance. Based on Julius O. Smith III, -- \"A New Approach to Digital Reverberation using Closed Waveguide--- Networks,\" Proceedings of the International Computer Music +-- Networks,\" Proceedings of the International Computer Music -- Conference 1985, p. 47-53 (also available as a seperate -- publication from CCRMA), as well as some more recent papers by -- Smith and others.@@ -70,13 +70,13 @@ -- a good small \"live\" room sound, 0.8 -- a small hall, 0.9 a large hall, -- 0.99 an enormous stone cavern.--- +-- -- * @ipitchmod@ -- amount of random pitch modulation -- for the delay lines. 1 is the \"normal\" -- amount, but this may be too high for -- held pitches such as piano tones. -- adjust to taste.--- +-- -- * @itone@ -- cutoff frequency of lowpass filters -- in feedback loops of delay lines, -- in hz. lower cutoff frequencies results@@ -86,15 +86,15 @@ nightReverb :: Int -> D -> D -> D -> Sig -> SE (Sig, Sig) nightReverb n igain ipitchmod itone asig = do afiltRefs <- mapM newRef $ replicate n 0- afilts1 <- mapM readRef afiltRefs + afilts1 <- mapM readRef afiltRefs let apj = (2 / fromIntegral n) * sum afilts1 adels <- sequence $ zipWith3 (del apj) idels ks afilts1 zipWithM_ (\ref x -> writeRef ref $ filt x) afiltRefs adels afilts2 <- mapM readRef afiltRefs- return (mean $ odds afilts2, mean $ evens afilts2) + return (mean $ odds afilts2, mean $ evens afilts2) where idels = cycle $ fmap ( / getSampleRate) [2473, 2767, 3217, 3557, 3907, 4127, 2143, 1933]- ks = cycle $ zipWith3 (\a b c -> randi a b `withSeed` c) + ks = cycle $ zipWith3 (\a b c -> randi a b `withSeed` c) [0.001, 0.0011, 0.0017, 0.0006, 0.001, 0.0011, 0.0017, 0.0006] [3.1, 3.5, 1.11, 3.973, 2.341, 1.897, 0.891, 3.221] [0.06, 0.9, 0.7, 0.3, 0.63, 0.7, 0.9, 0.44]@@ -117,8 +117,8 @@ -- | A chain of delay lines. -- -- > delayLine n k dt asig--- --- A signal (@asig@) is passed through the chain of fixed time delays (A @dt@ is the delay time +--+-- A signal (@asig@) is passed through the chain of fixed time delays (A @dt@ is the delay time -- @n@ is a number of filters, k - is scale of the signals that is passed through each delay line). delayLine :: Int -> D -> D -> Sig -> (Sig, Sig) delayLine n k dt asig = (mean $ asig : odds asigs, mean $ asig : evens asigs)@@ -147,14 +147,14 @@ bayAtNight :: Sig -> SE (Sig, Sig) bayAtNight = mapOut (bassEnhancment 100 1.5)- . nightReverb 8 0.98 0.8 20000 + . nightReverb 8 0.98 0.8 20000 . nightChorus 2 30 where mapOut f = fmap (\(a, b) -> (f a, f b)) -- | The effect that was used in the piece \"Vestige of time\". vestigeOfTime :: Sig -> (Sig, Sig)-vestigeOfTime - = mapOut ((* 0.3) . (\x -> reverb2 x 2 0.2)) +vestigeOfTime+ = mapOut ((* 0.3) . (\x -> reverb2 x 2 0.2)) . delayLine 6 1.2 0.9 where mapOut f (a, b) = (f a, f b)
src/Csound/Catalog/Reson.hs view
@@ -7,7 +7,7 @@ anO, anA, anE, anIY, anO2, wow, -- * Modal synthesis- + -- ** Instruments strikeModes, scrapeModes, modesInstr, wetModesInstr, @@ -17,18 +17,18 @@ -- ** Parameters -- | Parameters for the function 'Csound.Air.modes' Modes(..), fromModes,- singleModes, dahinaModes, banyanModes, xylophoneModes, tibetanBowlModes180, - spinelSphereModes, potLidModes, redCedarWoodPlateModes, + singleModes, dahinaModes, banyanModes, xylophoneModes, tibetanBowlModes180,+ spinelSphereModes, potLidModes, redCedarWoodPlateModes, tubularBellModes, redwoodPlateModes, douglasFirWoodPlateModes,- uniformWoodenBarModes, uniformAluminumBarModes, vibraphoneModes1, - vibraphoneModes2, chalandiPlatesModes, tibetanBowlModes152, - tibetanBowlModes140, wineGlassModes, smallHandbellModes, + uniformWoodenBarModes, uniformAluminumBarModes, vibraphoneModes1,+ vibraphoneModes2, chalandiPlatesModes, tibetanBowlModes152,+ tibetanBowlModes140, wineGlassModes, smallHandbellModes, albertClockBellBelfastModes, woodBlockModes ) where import Csound.Base --- | List of pairs of +-- | List of pairs of -- -- > [(centerFrequency, bandWidth)] --@@ -39,7 +39,7 @@ anO, anA, anE, anIY, anO2 :: Reson anO = [(280, 20), (650, 25), (2200, 30), (3450, 40), (4500, 50)]-anA = [(650, 50), (1100, 50), (2860, 50), (3300, 50), (4500, 50)] +anA = [(650, 50), (1100, 50), (2860, 50), (3300, 50), (4500, 50)] anE = [(500, 50), (1750, 50), (2450, 50), (3350, 50), (5000, 50)] anIY = [(330, 50), (2000, 50), (2800, 50), (3650, 50), (5000, 50)] anO2 = [(400, 50), (840, 50), (2800, 50), (3250, 50), (4500, 50)]@@ -54,7 +54,7 @@ -- modes instruments strikeModes :: Modes Sig -> Sig -> Sig-strikeModes ms cps = modesInstr ms (blp cps simpleStrike) cps +strikeModes ms cps = modesInstr ms (blp cps simpleStrike) cps scrapeModes :: Modes Sig -> Sig -> SE Sig scrapeModes ms cps = fmap (\exciter -> modesInstr ms exciter cps) simpleScrape@@ -65,7 +65,7 @@ wetModesInstr :: D -> Modes Sig -> Sig -> Sig -> Sig wetModesInstr dryRatio ms exciter cps = (modesGain ms * )- $ dryWet (sig dryRatio) (modes (fromModes ms) cps) exciter + $ dryWet (sig dryRatio) (modes (fromModes ms) cps) exciter --------------------------------------------------- -- exciters@@ -77,13 +77,13 @@ strike dt' = do onHighDur <- noise 1 0 onNormDur <- noise (osciln 1 (1 / dt) decayShape 1) 0- - return $ guardedTuple ++ return $ guardedTuple [ (sig dt `lessThan` 0.001, onLowDur) , (sig dt >=* 1, onHighDur)- ] onNormDur + ] onNormDur where- onLowDur = mpulse 1 0 + onLowDur = mpulse 1 0 decayShape = estartEnds [1, -0.002, 0] dt = maxB dt' 0.00001@@ -105,32 +105,32 @@ fromModes :: Num a => Modes a -> [(a, a)] fromModes a = zip (modesFrequencies a) (fmap (modesQualityFactor a * ) $ modesQualityRatios a) -singleModes, dahinaModes, banyanModes, xylophoneModes, tibetanBowlModes180, spinelSphereModes, - potLidModes, redCedarWoodPlateModes, tubularBellModes, redwoodPlateModes, douglasFirWoodPlateModes, +singleModes, dahinaModes, banyanModes, xylophoneModes, tibetanBowlModes180, spinelSphereModes,+ potLidModes, redCedarWoodPlateModes, tubularBellModes, redwoodPlateModes, douglasFirWoodPlateModes, uniformWoodenBarModes, uniformAluminumBarModes, vibraphoneModes1, vibraphoneModes2, chalandiPlatesModes,- tibetanBowlModes152, tibetanBowlModes140, wineGlassModes, smallHandbellModes, albertClockBellBelfastModes, + tibetanBowlModes152, tibetanBowlModes140, wineGlassModes, smallHandbellModes, albertClockBellBelfastModes, woodBlockModes :: Fractional a => Modes a -singleModes = Modes +singleModes = Modes { modesFrequencies = [1, 1] , modesQualityFactor = 1000 , modesQualityRatios = repeat 1 , modesGain = 15 } -dahinaModes = Modes +dahinaModes = Modes { modesFrequencies = [1, 2.89, 4.95, 6.99, 8.01, 9.02] , modesQualityFactor = 50 , modesQualityRatios = repeat 1 , modesGain = 15 } -banyanModes = Modes +banyanModes = Modes { modesFrequencies = [1, 2.0, 3.01, 4.01, 4.69, 5.63] , modesQualityFactor = 444 , modesQualityRatios = repeat 1 , modesGain = 15 } xylophoneModes = Modes- { modesFrequencies = [1, 3.932, 9.538, 16.688, 24.566, 31.147]+ { modesFrequencies = [1, 3.932, 9.538, 16.688, 24.566, 31.147] , modesQualityFactor = 200 , modesQualityRatios = repeat 1 , modesGain = 15 }@@ -144,18 +144,18 @@ -- with diameter of 3.6675mm spinelSphereModes = Modes- { modesFrequencies = - [1, 1.026513174725, 1.4224916858532, 1.4478690202098, 1.4661959580455- , 1.499452545408, 1.7891839345101, 1.8768994627782, 1.9645945254541- , 1.9786543873113, 2.0334612432847, 2.1452852391916, 2.1561524686621- , 2.2533435661294, 2.2905090816065, 2.3331798413917, 2.4567715528268- , 2.4925556408289, 2.5661806088514, 2.6055768738808, 2.6692760296751- , 2.7140956766436, 2.7543617293425, 2.7710411870043 + { modesFrequencies =+ [1, 1.026513174725, 1.4224916858532, 1.4478690202098, 1.4661959580455+ , 1.499452545408, 1.7891839345101, 1.8768994627782, 1.9645945254541+ , 1.9786543873113, 2.0334612432847, 2.1452852391916, 2.1561524686621+ , 2.2533435661294, 2.2905090816065, 2.3331798413917, 2.4567715528268+ , 2.4925556408289, 2.5661806088514, 2.6055768738808, 2.6692760296751+ , 2.7140956766436, 2.7543617293425, 2.7710411870043 ] , modesQualityFactor = 80 , modesQualityRatios = repeat 1 , modesGain = 15 }- + potLidModes = Modes { modesFrequencies = [ 1, 3.2, 6.23, 6.27, 9.92, 14.15 ] , modesQualityFactor = 1500@@ -167,7 +167,7 @@ , modesQualityFactor = 100 , modesQualityRatios = repeat 1 , modesGain = 15 }- + tubularBellModes = Modes { modesFrequencies = [ 272/437, 538/437, 874/437, 1281/437, 1755/437, 2264/437, 2813/437, 3389/437, 4822/437, 5255/437 ] , modesQualityFactor = 2000@@ -185,7 +185,7 @@ , modesQualityFactor = 100 , modesQualityRatios = repeat 1 , modesGain = 15 }- + uniformWoodenBarModes = Modes { modesFrequencies = [ 1, 2.572, 4.644, 6.984, 9.723, 12 ] , modesQualityFactor = 300@@ -198,67 +198,67 @@ , modesQualityRatios = repeat 1 , modesGain = 15 } -vibraphoneModes1 = Modes +vibraphoneModes1 = Modes { modesFrequencies = [1, 3.984, 10.668, 17.979, 23.679, 33.642] , modesQualityFactor = 2000 , modesQualityRatios = repeat 1 , modesGain = 15 }- -vibraphoneModes2 = Modes ++vibraphoneModes2 = Modes { modesFrequencies = [1, 3.997, 9.469, 15.566, 20.863, 29.440] , modesQualityFactor = 2000 , modesQualityRatios = repeat 1 , modesGain = 15 } -chalandiPlatesModes = Modes +chalandiPlatesModes = Modes { modesFrequencies = [1, 1.72581, 5.80645, 7.41935, 13.91935] , modesQualityFactor = 500 , modesQualityRatios = repeat 1 , modesGain = 15 } -tibetanBowlModes152 = Modes +tibetanBowlModes152 = Modes { modesFrequencies = [1, 2.66242, 4.83757, 7.51592, 10.64012, 14.21019, 18.14027] , modesQualityFactor = 2200 , modesQualityRatios = repeat 1 , modesGain = 15 } -tibetanBowlModes140 = Modes +tibetanBowlModes140 = Modes { modesFrequencies = [1, 2.76515, 5.12121, 7.80681, 10.78409] , modesQualityFactor = 2200 , modesQualityRatios = repeat 1 , modesGain = 15 } -wineGlassModes = Modes +wineGlassModes = Modes { modesFrequencies = [1, 2.32, 4.25, 6.63, 9.38] , modesQualityFactor = 1500 , modesQualityRatios = repeat 1 , modesGain = 15 } -smallHandbellModes = Modes +smallHandbellModes = Modes { modesFrequencies = [ 1, 1.0019054878049, 1.7936737804878, 1.8009908536585, 2.5201981707317 , 2.5224085365854, 2.9907012195122, 2.9940548780488, 3.7855182926829 , 3.8061737804878, 4.5689024390244, 4.5754573170732, 5.0296493902439 , 5.0455030487805, 6.0759908536585, 5.9094512195122, 6.4124237804878 , 6.4430640243902, 7.0826219512195, 7.0923780487805, 7.3188262195122- , 7.5551829268293 + , 7.5551829268293 ] , modesQualityFactor = 2500 , modesQualityRatios = repeat 1 , modesGain = 15 } -albertClockBellBelfastModes = Modes +albertClockBellBelfastModes = Modes { modesFrequencies = [ 2.043260,1.482916,1.000000,3.328848,4.761811,1.477056,0.612007 ,2.661295,1.002793,4.023776,0.254139,2.043916,4.032463,2.659438- ,4.775560,5.500494,3.331014,0.809697,2.391301, 0.254098,1.901476,2.366563 + ,4.775560,5.500494,3.331014,0.809697,2.391301, 0.254098,1.901476,2.366563 ] -- ,0.614968,2.046543,1.814887,3.130744,2.484426,0.558874,0.801697,0.070870,3.617036,2.782656 , modesQualityFactor = 2400 , modesQualityRatios = repeat 1 , modesGain = 15 } -woodBlockModes = Modes +woodBlockModes = Modes { modesFrequencies = [915/915,1540/915,1863/915,3112/915] , modesQualityFactor = 60 , modesQualityRatios = repeat 1
src/Csound/Catalog/Wave/Ac.hs view
@@ -2,31 +2,31 @@ pulseWidth, xanadu1, xanadu2, stringPad, toneWheel, guitar, harpsichord, xing,- fmMod, filteredChorus, plainString, fmTubularBell, - delayedString, melody, rhodes, + fmMod, filteredChorus, plainString, fmTubularBell,+ delayedString, melody, rhodes, ) where import Data.List -import Csound.Base- --- | +import Csound.Base hiding (filt)++-- | -- -- > aout = pulseWidth amplitude cps pulseWidth :: Sig -> Sig -> Sig pulseWidth amp cps = asignal where- ilforate = 2.3 -- LFO SPEED IN Hz- isawlvl = 0.5 -- LEVEL OF SAWTOOTH WAVEFORM- ipwmlvl = 0.5 -- LEVEL OF PULSE WAVEFORM- ipwm = 0.2 -- DC OFFSET OF PULSE width- ipwmlfo = 0.1 -- DEPTH OF PULSE WIDTH MODULATION- ivcffrq = 800 -- CUTOFF OF GLOBAL LOW PASS FILTER- ienvflt = 200 -- MAX CHANGE IN LPF CUTOFF BY ENVELOPE- ikbdflt = 0.1 -- RELATIVE CHANGE IN LPF CUTOFF TO PITCH+ ilforate = 2.3 -- LFO SPEED IN Hz+ isawlvl = 0.5 -- LEVEL OF SAWTOOTH WAVEFORM+ ipwmlvl = 0.5 -- LEVEL OF PULSE WAVEFORM+ ipwm = 0.2 -- DC OFFSET OF PULSE width+ ipwmlfo = 0.1 -- DEPTH OF PULSE WIDTH MODULATION+ ivcffrq = 800 -- CUTOFF OF GLOBAL LOW PASS FILTER+ ienvflt = 200 -- MAX CHANGE IN LPF CUTOFF BY ENVELOPE+ ikbdflt = 0.1 -- RELATIVE CHANGE IN LPF CUTOFF TO PITCH -- the oscillators klfo = kr $ osc ilforate- asaw = oscBy (elins [-1, 1]) cps + asaw = oscBy (elins [-1, 1]) cps apwm = table (0.5 + asaw / 2 + (klfo * ipwmlfo + ipwm)) (lins [-1, 50, -1, 0, 1, 50, 1]) `withD` 1 awaves = isawlvl * asaw + ipwmlvl * apwm -- the envelope@@ -39,16 +39,16 @@ xanaduPlucks :: D -> D -> D -> (Sig, Sig, Sig) xanaduPlucks cps vibrAmp vibrCps = (phi vib, phi shift, phi (-shift)) where phi asig = pluck 1 (cpsoct $ oct + asig) cps giwave 1- shift = 8/1200 + shift = 8/1200 vib = kr $ poscil (sig vibrAmp) (sig vibrCps) cosine oct = sig $ octcps cps --- | +-- | -- -- > aout <- xanadu1 cps xanadu1 :: D -> SE Sig xanadu1 cps = do- _ <- delayr 2 + _ <- delayr 2 ~ [tap1, tap2, d1, d2] <- mapM deltap3 [f1, f2, 2, 1.1] delayw $ g * damping return $ damping * mean [gleft, tap1, d1, gright, tap2, d2]@@ -57,7 +57,7 @@ f2 = expseg [0.015, 15, 1.055] damping = 1 --- | +-- | -- -- > aout <- xanadu2 cps xanadu2 :: D -> SE Sig@@ -69,7 +69,7 @@ where (g, gleft, gright) = xanaduPlucks cps (1/80) 6.1 damping = 1 --- | +-- | -- -- > stringPad amplitude cps stringPad :: Sig -> Sig -> Sig@@ -83,7 +83,7 @@ toneWheel cps = asignal where ikey = 12 * int' (cps - 6) + 100 * (cps - 6)- wheels = + wheels = [ ifB (ikey - 12 >* 12) gitonewheel1 gitonewheel2 , ifB (ikey + 7 >* 12) gitonewheel1 gitonewheel2 , ifB (ikey >* 12) gitonewheel1 gitonewheel2@@ -133,12 +133,12 @@ f vol freq = poscil vol (sig freq * cps) sine norm = 32310- asignal = (sig $ 1 / norm) * sum + asignal = (sig $ 1 / norm) * sum [ f (amps env1 0.05 0.3 6.7 0.8) 1 , f (amps env2 0.12 0.5 10.5 0 ) 2.7 , f (amps env3 0.02 0.8 70 0 ) 4.95 ]- + env1 = [ 0,0.001,5200,0.001,800,0.001,3000,0.0025,1100,0.002 , 2800,0.0015,1500,0.001,2100,0.011,1600,0.03,1400,0.95 , 700,1,320,1,180,1,90,1,40,1,20,1,12,1,6,1,3,1,0,1,0]@@ -166,36 +166,36 @@ ishift = 4 / 12000 ipch = cps ioct = octcps cps- amodi = ar $ loopseg [0, iattack, 5, sig xdur, 2, irelease, 0] (sig $ 1 / xdur) - amodr = ar $ loopseg [ip6, 1, ip7, 1, ip6] (sig $ 0.5 / xdur) + amodi = ar $ loopseg [0, iattack, 5, sig xdur, 2, irelease, 0] (sig $ 1 / xdur)+ amodr = ar $ loopseg [ip6, 1, ip7, 1, ip6] (sig $ 0.5 / xdur) a1 = amodi * (amodr - 1 / amodr) / 2 a2 = amodi * (amodr + 1 / amodr) / 2 a1ndx = abs $ a1 / 10- a3 = tablei a1ndx (skipNorm $ bessels 20) `withD` 1 + a3 = tablei a1ndx (skipNorm $ bessels 20) `withD` 1 ao1 = poscil a1 ipch cosine a4 = exp $ -0.5 * a3 + ao1 ao2 = poscil (a2 * ipch) cps cosine aleft = poscil a4 (ao2 + cpsoct (ioct + ishift)) sine aright = poscil a4 (ao2 + cpsoct (ioct - ishift)) sine- asignal = 0.5 * (aleft + aright) + asignal = 0.5 * (aleft + aright) -- | Filtered chorus, Michael Bergeman -- -- > filteredChorus cycleDuration cps filteredChorus :: D -> Sig -> Sig filteredChorus xdur cps = asignal- where + where a ~~ b = loopseg [sig a, 1, sig b, 1, sig a] (sig $ 1 / (xdur * 2)) filt cf1 bw1 cf2 bw2 x = balance (bp cf2 bw2 $ bp cf1 bw1 x) x- harm fqc = poscil ((sig $ idb)) fqc $ sines + harm fqc = poscil ((sig $ idb)) fqc $ sines [ 0.28, 1, 0.74, 0.66, 0.78, 0.48, 0.05, 0.33, 0.12 , 0.08, 0.01, 0.54, 0.19, 0.08, 0.05, 0.16, 0.01, 0.11, 0.3, 0.02, 0.2] a1s x = mean $ fmap (harm . (* cpsoct (octcps cps + x))) [1, 0.999, 1.001]- rvb dt dh x = 0.5 * (x + reverb2 x dt dh) + rvb dt dh x = 0.5 * (x + reverb2 x dt dh) idb = 1.5 - asignal = mean + asignal = mean [ rvb 5 0.3 $ filt (40 ~~ 800) 40 (220 ~~ 440) ((440 ~~ 220) * 0.8) $ a1s (-0.01) , rvb 4 0.2 $ filt (800 ~~ 40) 40 (440 ~~ 220) ((220 ~~ 440) * 0.8) $ a1s 0.01 ]@@ -205,7 +205,7 @@ -- > plainString cps plainString :: D -> Sig plainString cps = wgpluck2 0.1 1.0 cps 0.25 0.05- + -- | Rhodes electric piano model, Perry Cook -- -- > rhodes cps
src/Csound/Catalog/Wave/Bitwig.hs view
@@ -1,9 +1,10 @@ module Csound.Catalog.Wave.Bitwig(- pwPad, triPad, triPadFx, triPadBy, pwPadBy,- Accordeon(..), accordeon, accordeonFx+ pwPad, pwPadMidi, triPad, triPadFx, triPadBy, pwPadBy,+ Accordeon(..), accordeon, accordeonFx ) where -import Csound.Base+import Prelude hiding (filter)+import Csound.Base hiding (lfo) --------------------------------------------------- -- wind pads@@ -11,47 +12,52 @@ triPadFx :: Sig2 -> SE Sig2 triPadFx a = mixAt 0.5 smallHall2 $ at (chorus 0.2 0.3 0.25) (return a :: SE Sig2) +triPad :: Sig -> SE Sig triPad = triPadBy mlp triPadBy :: ResonFilter -> Sig -> SE Sig triPadBy filter x = mul (1.5 * fades 0.3 0.5) $ at (filter (x * 5) 0.15) $ do- lfo <- rand 1.2- mul 0.5 $ rndTri (x + 1.5 * lfo) + rndTri (x * cent 8)+ lfo <- rand 1.2+ mul 0.5 $ rndTri (x + 1.5 * lfo) + rndTri (x * cent 8) pwPad :: Sig -> SE Sig pwPad = pwPadBy mlp pwPadBy :: ResonFilter -> Sig -> SE Sig pwPadBy filter x = mul (fades 0.3 0.95) $ at (filter (x * 5) 0.15) $ do- let lfo = uosc 4- return $ mul 0.5 $ pw (0.2 + 0.4 * lfo) x + tri (x * cent 8)+ let lfo = uosc 4+ return $ mul 0.5 $ pw (0.2 + 0.4 * lfo) x + tri (x * cent 8) +pwPadMidi :: SE Sig2 pwPadMidi = mul 0.5 $ mixAt 0.5 smallHall2 $ at (chorus 0.2 0.3 0.25) $ at fromMono $ midi $ onMsg pwPad --------------------------------------------------- -- accordeon +osc4 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig osc4 freq1 freq2 freq3 freq4 a b cps = cfd4 a b (saw (cps * freq1)) (sqr (cps * freq2)) (saw (cps * freq3)) (sqr (cps * freq4))++mlpTrack :: Sig -> Sig -> Sig -> Sig -> Sig mlpTrack cps center q = mlp (cps + 6500 * center) q -data Accordeon = Accordeon - { accordeonFreq1 :: Sig- , accordeonFreq2 :: Sig- , accordeonFreq3 :: Sig- , accordeonFreq4 :: Sig- }+data Accordeon = Accordeon+ { accordeonFreq1 :: Sig+ , accordeonFreq2 :: Sig+ , accordeonFreq3 :: Sig+ , accordeonFreq4 :: Sig+ } instance Default Accordeon where- def = Accordeon 1 0.5 2.01 2+ 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)+ 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 frq (x, y) = fmap (\r -> x + y * linseg [0, 0.01, a, dt, b] * r) (randi 1 frq)+ 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)
src/Csound/Catalog/Wave/Deserted.hs view
@@ -1,8 +1,8 @@ module Csound.Catalog.Wave.Deserted(- simpleMarimba, marimbaWave, phasingSynth, noiz, wind + simpleMarimba, marimbaWave, phasingSynth, noiz, wind ) where -import Csound.Base+import Csound.Base hiding (ramp, osc') -- | Simple marimba (by John Fitch) with percussive envelope. --@@ -18,12 +18,12 @@ marimbaWave :: D -> Sig -> Sig -> Sig marimbaWave xdur amp cps = a6 where- k10 = linseg [2.25, 0.03, 3, xdur - 0.03, 2] + k10 = linseg [2.25, 0.03, 3, xdur - 0.03, 2] a1 = gbuzz amp cps k10 0 35 (sines3 [(1, 1, 90)])- a2 = reson' a1 500 50 - a3 = reson' a2 150 100 - a4 = reson' a3 3500 150 - a5 = reson' a4 3500 150 + a2 = reson' a1 500 50+ a3 = reson' a2 150 100+ a4 = reson' a3 3500 150+ a5 = reson' a4 3500 150 a6 = balance a5 a1 reson' a b c = reson a b c `withD` 1 @@ -35,7 +35,7 @@ -- -- * attackDecayRatio -- (0, 1) wind :: D -> (D, D) -> (D, D) -> D -> SE Sig-wind xdur (bandRise, bandDec) (freqRise, freqDec) winds = +wind xdur (bandRise, bandDec) (freqRise, freqDec) winds = fmap fromRnd $ rand 1 where valu1 = 100@@ -44,45 +44,45 @@ ramp a b = linseg [a, xdur, b] fromRnd a = aout where- a2 = butbp a (ramp freqRise freqDec) (ramp bandRise bandDec) + a2 = butbp a (ramp freqRise freqDec) (ramp bandRise bandDec) a3 = butbp a2 (ramp (freqRise - valu1) (freqDec + valu2)) (ramp (bandRise + valu1) (bandDec - valu2))- + aout = (a2 + a3) * linseg [0, xdur * winds, 1, xdur * winde, 0] --- | +-- | -- > noiz cps noiz :: Sig -> SE Sig noiz cps = fmap a2 k2- where + where k1 = linseg [1, 0.05, 100, 0.2, 100, 2, 1, idur, 1]- k2 = fmap ( `withD` 1) $ rand 500 + k2 = fmap ( `withD` 1) $ rand 500 buzz' kamp kcps = buzz kamp (sig kcps * cps) k1 sine- - a1 = mean $ zipWith buzz' [0.3, 1, 1] [1, 0.5, 0.501] ++ a1 = mean $ zipWith buzz' [0.3, 1, 1] [1, 0.5, 0.501] a2 k = a1 * osc k --- | +-- | -- > phasingSynth amp cps phasingSynth :: Sig -> Sig -> Sig phasingSynth amp cps = aout where osc' ftab k ph = oscBy ftab (cps * k) `withD` ph osc1 = osc' sine- osc2 = osc' $ sines [1, 0, 0.9, 0, 0.8, 0, 0.7, 0, 0.6, 0, 0.5, 0, 0.4, 0, 0.3, 0, 0.2, 0, 0.1] - asum = amp * mean + osc2 = osc' $ sines [1, 0, 0.9, 0, 0.8, 0, 0.7, 0, 0.6, 0, 0.5, 0, 0.4, 0, 0.3, 0, 0.2, 0, 0.1]+ asum = amp * mean [ osc1 1 0 , osc2 1.008 0.02 , osc1 0.992 0.04 , osc2 2 0.06 , osc2 1 0.08 , osc1 1 0.01 ]- kosc1 = 0.5 * once sine + kosc1 = 0.5 * once sine kosc2 = 0.5 * once sine `withD` 0.4 kosc3 = 1.0 * once sine `withD` 0.8 - afilt = sum + afilt = sum [ butbp asum kosc1 1000 , butbp asum kosc2 300 , butbp asum kosc3 20 ]
src/Csound/Catalog/Wave/Flavio.hs view
@@ -1,63 +1,65 @@ module Csound.Catalog.Wave.Flavio(- amFlavio, fmFlavio, simpleSust, simpleFading+ amFlavio, fmFlavio, simpleSust, simpleFading ) where -import Data.List-import Control.Monad+import Csound.Base -import Csound.Base +icero, icasi :: D icero = 0.000001-icasi = 0.0001 +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+amFlavio :: D -> Sig -> Sig+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), +-- irel1 = 6, ifm = (2, 7),+fmFlavio :: D -> Sig -> Sig -> Sig fmFlavio irel1 ifm cps = aout- where - irel2 = irel1 * 0.5 - idec = 1- iatt = 0.01+ where+ irel2 = irel1 * 0.5+ idec = 1+ iatt = 0.01 - (iidx1, iidx2, iidx3, iidx4, iidx5) = (4, 4, 4, 4, 3)+ (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+ 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))+ afrq = kidx * osc (ifm * cps)+ aout = kamp * osc (cps * (1 + afrq)) +simpleSust, simpleFading :: D -> (D, D) -> SE Sig2 simpleSust = genSimple 0.25 0.1 simpleFading = genSimple icasi icero +genSimple :: D -> D -> D -> (D, D) -> SE Sig2 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+ aleft <- fmap pureGen $ random 1 (11 * sig amp)+ aright <- fmap pureGen $ random 1 (10.5 * sig amp)+ return (aleft, aright)+ where+ cps = sig dcps+ pureGen ichr = aout+ where+ irel1 = irel * (0.5 + amp)+ 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+ -- 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+ aout = blp kcf a3
src/Csound/Catalog/Wave/Fm.hs view
@@ -8,10 +8,10 @@ fmBass1 env (amp, cps) = bhp 35 $ env 0.01 3 0.01 0.05 * (port amp 0.01) * (\x -> fosc 2 1 (1.5 * env 0.01 0.5 0.5 0.05) x + 0.4 * osc (x * 0.501)) (cps * (let env1 = env 1.2 0.1 0.85 5 * env 1.2 0.75 0.25 0.05 in 1 + (0.02 * env1 * uosc (3 * env1)))) fmBass2 :: MonoAdsr -> (Sig, Sig) -> Sig-fmBass2 adsrEnv (amp, cps) = env1 * (\freq -> fosc 1 1 (1 + 3.4 * env2) freq) ((cps * (1 + 0.001 * osc (2 * env4) * env4)))+fmBass2 adsrEnv (amp, cps) = env1 * (port amp 0.01) * (\freq -> fosc 1 1 (1 + 3.4 * env2) freq) ((cps * (1 + 0.001 * osc (2 * env4) * env4))) where env1 = adsrEnv 0.015 (5.2 + rel) 0.001 0.5- env2 = adsrEnv 0.015 1.4 0.5 1.2 + env2 = adsrEnv 0.015 1.4 0.5 1.2 env4 = adsrEnv 3.2 0.1 0.85 5 rel = 3 * (1 - (cps - 50) / 150)
src/Csound/Catalog/Wave/Misc.hs view
@@ -1,6 +1,6 @@-module Csound.Catalog.Wave.Misc ( +module Csound.Catalog.Wave.Misc ( okComputer, polySynthFx, polySynth,- dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, + dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, dreamPadBy, lightIsTooBrightPadBy, whaleSongPadBy, deepBass, @@ -9,9 +9,10 @@ celloWave ) where -import Csound.Base +import Prelude hiding (filter)+import Csound.Base --- | Tech sound. Random sinusoids palyed at the very fast rate. +-- | Tech sound. Random sinusoids palyed at the very fast rate. -- -- > okComputer rate --@@ -22,12 +23,13 @@ go anoise = osc (samphold anoise kgate) kgate = kr $ oscil 1 cps (elins [1, 0, 0]) +polySynth :: Sig -> SE Sig polySynth x = mul (fades 0.01 0.15) $ uni rndSaw x + uni rndSaw (x * cent 14) + (mul 0.2 $ at (lp 400 0.1) white)- where uni = multiHz 2 (cent 50) polySynthFx :: ResonFilter -> SE Sig -> SE Sig2 polySynthFx filter = mixAt 0.25 largeHall2 . mixAt 0.25 (echo 0.25 0.65) . at (chorus 0.07 1.25 0.25) . at (fromMono . filter 5500 0.12 . filt 2 br 18000 0.3) +uni :: (Sig -> SE Sig) -> Sig -> SE Sig uni = multiHz 2 (cent 50) lightIsTooBrightPad :: ResonFilter -> Sig -> Sig -> SE Sig@@ -43,7 +45,7 @@ whaleSongPadBy :: ResonFilter -> Wave -> Sig -> Sig -> SE Sig whaleSongPadBy filter wave brightness = genDreamPadInstr filter mkOsc brightness where mkOsc vibLfo1 vibLfo2 x = uni wave (vibLfo1 x) + uni wave (vibLfo2 $ x * cent 14) + uni wave (vibLfo2 $ 3 * x * cent 14) + mul 0.15 (uni wave (vibLfo2 $ 7 * x * cent 14)) + mul 0.15 (uni wave ((vibLfo2 $ 11 * x * cent 14) + 400 * uosc 0.2))- + underwaterPad :: ResonFilter -> Sig -> Sig -> SE Sig underwaterPad filter = dreamPadBy filter rndTri @@ -52,27 +54,30 @@ dreamPadBy :: ResonFilter -> Wave -> Sig -> Sig -> SE Sig dreamPadBy filter wave brightness = genDreamPadInstr filter mkOsc brightness- where mkOsc vibLfo1 vibLfo2 x = uni wave (vibLfo1 x) + uni wave (vibLfo2 $ x * cent 14) - -genDreamPadInstr filter mkOsc brightness x = do+ where mkOsc vibLfo1 vibLfo2 x = uni wave (vibLfo1 x) + uni wave (vibLfo2 $ x * cent 14)++genDreamPadInstr :: (Sig -> Sig -> Sig -> Sig)+ -> ((Sig -> Sig) -> (Sig -> Sig) -> p -> SE Sig)+ -> Sig -> p -> SE Sig+genDreamPadInstr filter mkOsc brightness frq = do a1 <- oscs a2 <- nois- return $ mul (fades 0.85 0.95) $ fx1 (a2 + a1) + fx2 a1 - where + return $ mul (fades 0.85 0.95) $ fx1 (a2 + a1) + fx2 a1+ where fx1 = filt 2 filter (filtLfo1 (700 + brightness * 2500)) 0.26 fx2 = filter (filtLfo2 (1200 + brightness * 2500)) 0.32 -- saw- oscs = mkOsc vibLfo1 vibLfo2 x+ oscs = mkOsc vibLfo1 vibLfo2 frq -- 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))+ -- uni = multiHz 2 (cent 50) 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)) @@ -82,7 +87,8 @@ 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)]+deepBass :: Sig -> Sig+deepBass q = 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 $ q * 0.5), osc (q * 0.5)] impulseMarimba1 :: Sig -> Sig impulseMarimba1 cps = mul 4 $ at (mlp cps 0.95) $ impulse 0@@ -92,18 +98,18 @@ celloWave :: (D, Sig) -> SE Sig-celloWave = go p t x y z+celloWave = go where- go p t x y z = (\(amp, cps) -> ($ cps) ((mul $ sig amp) . at (- mlp (800) 0.45 . - hp 50 10 . - bat (\x -> sum [- bp (300 + 200 * (p - 0.5)) 60 x, - bp (700 + 300 * (t - 0.5)) 40 x, - bp (1500 + 600 * (x - 0.5)) 30 x]) . - mul (leg (0.1 + 0.5 * (1 - amp)) 0.5 0.8 0.1)) . - rndSaw . - (\x -> x * (1 + y * 0.07 * linsegr [0, 0.2, 0.3, 0.2, 0.85, 5, 1] 0.2 1 * osc (12 * z)))))+ go = (\(amp, cps) -> ($ cps) ((mul $ sig amp) . at (+ mlp (800) 0.45 .+ hp 50 10 .+ bat (\q -> sum [+ bp (300 + 200 * (p - 0.5)) 60 x,+ bp (700 + 300 * (t - 0.5)) 40 x,+ bp (1500 + 600 * (q - 0.5)) 30 x]) .+ mul (leg (0.1 + 0.5 * (1 - amp)) 0.5 0.8 0.1)) .+ rndSaw .+ (\q -> q * (1 + y * 0.07 * linsegr [0, 0.2, 0.3, 0.2, 0.85, 5, 1] 0.2 1 * osc (12 * z))))) p = 0.25 t = 0.3 x = 0.45
src/Csound/Catalog/Wave/Sean.hs view
@@ -1,67 +1,66 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# Language FlexibleContexts #-} module Csound.Catalog.Wave.Sean(- RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec,- snowCrackle,- fmDrone, fmDrones,- tenorOsc, sopranoOsc+ RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec,+ snowCrackle,+ fmDrone, fmDrones, fmPulse, fmPulses, scDrone, scDrones,+ tenorOsc, sopranoOsc ) where -import Data.List import Control.Monad -import Csound.Base hiding (formant)+import Csound.Base hiding (formant, dur, idur) data RissetBellSpec = RissetBellSpec- { rissetBellRands :: [D]- , rissetBellRandShifts :: [D]- , rissetBellDurs :: [D]- , rissetBellAmps :: [Sig]- , rissetBellFreqs :: [Sig]- , rissetBellFreqShifts :: [Sig]- }+ { 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)+ 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)+ 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)+ 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] }+ { 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+ 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] }+ { 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+ where env = expsegr [1, dur, 0.001] dur 0.001 ------------------------------------------------------------------------ @@ -70,133 +69,116 @@ -- > 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 (sig 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))+ where+ mouseDrum :: Sig -> Sig -> Sig -> Sig+ mouseDrum freq index cps =+ sched instr $ withDur (sig 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)+ 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]+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 :: (D, D) -> Sig -> Sig2 scDrone = fmDrone 3++scDrones :: [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2 scDrones = fmDrones 3 +pulseIndex :: [Int] -> Sig -> Sig pulseIndex ns speed = 1 + 7 * seqSqr [seqDesc ns] speed +fmPulse :: [Int] -> Sig -> Sig -> Sig2 fmPulse ns speed = fmDrone (pulseIndex ns speed) (0.05, 0.5)++fmPulses :: [Sig] -> [Sig] -> [Int] -> Sig -> Sig -> SE Sig2 fmPulses amps harms ns speed = fmDrones (pulseIndex ns speed) amps harms (0.05, 0.5) -- | > dac $ fmDrone 3 (20, 5) 110+fmDrone :: Sig -> (D, D) -> Sig -> Sig2 fmDrone index (iatt, irel) cps = (aout1, aout2)- where- ifreq1 = cps- iamp = 0.39- idev = index * ifreq1- kamp1 = leg iatt 0 1 irel+ 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)+ 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+ aout1 = f 1 0.998 1.5007 0.1+ aout2 = f 0.99 0.987 1.498 0.13 +fmDrones :: Sig -> [Sig] -> [Sig] -> (D, D) -> Sig -> SE Sig2 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+ where+ kamp1 = leg iatt 0 1 irel - 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)+ f amp h = do+ let ifreq1 = h * cps+ idev = index * ifreq1 - ares = fmap sum $ zipWithM f amps harms- aout = liftA2 (,) ares ares+ 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) -randomD :: D -> D -> SE D-randomD val dev = fmap ir $ random (sig $ val - dev) (sig $ val + dev)+ ares = fmap sum $ zipWithM f amps harms+ aout = liftA2 (,) ares ares 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 +sopranoOsc, tenorOsc :: (Sig -> Sig) -> Sig -> Sig -> SE Sig+ 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+ 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- }+ { 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+ 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- }-----------------------------------------------------------------------------+ xDt <- randi (rndDevRatio spec) (rndDevSpeed spec)+ return $ ain * (1 + xDt)
src/Csound/Catalog/Wave/Sharc.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Csound.Catalog.Wave.Sharc( -- * Oscillators sharcOsc, sigSharcOsc, rndSharcOsc, rndSigSharcOsc,@@ -25,7 +26,6 @@ import qualified Sharc.Types as Sh import qualified Sharc.Data as Sh import Csound.Base-import Sharc.Types note2sig :: Sh.Note -> Sig note2sig n = oscBy (harmonics2tab $ Sh.noteHarmonics n) (sig $ double $ Sh.pitchFund $ Sh.notePitch n)@@ -58,7 +58,7 @@ -- The second argument picks upth table by frequency -- and the third supplies the frequency. sigSharcOsc :: SharcInstr -> D -> Sig -> Sig-sigSharcOsc = genSharcOsc' oscBy +sigSharcOsc = genSharcOsc' oscBy -- | Sharc oscillator with randomized phase. rndSharcOsc :: SharcInstr -> D -> SE Sig@@ -66,18 +66,18 @@ -- | Sharc oscillator with continuous pitch and randomized phase. rndSigSharcOsc :: SharcInstr -> D -> Sig -> SE Sig-rndSigSharcOsc = genSharcOsc' rndOscBy +rndSigSharcOsc = genSharcOsc' rndOscBy genSharcOsc' :: (Tab -> Sig -> a) -> SharcInstr -> D -> Sig -> a genSharcOsc' wave (SharcInstr instr) cps cpsSig = wave t cpsSig where- t = fromTabListD tabs (cps2pitch cps - int keyMin) + t = fromTabListD tabs (cps2pitch cps - int keyMin) tabs = tabList $ fmap note2tab ns ns = Sh.instrNotes instr keys = fmap (Sh.pitchKeyNum . Sh.notePitch) ns- keyMin = minimum keys + keyMin = minimum keys cps2pitch :: Floating a => a -> a cps2pitch x = 69 + 12 * logBase 2 (x / 440)@@ -139,7 +139,7 @@ quadMorphsynthSharcOsc' spec morphSpec instr (x, y) freq = quadMorphsynthOscMultiCps morphSpec (fmap (getSpecIntervals spec) instr) (x, y) freq getSpecIntervals spec (SharcInstr instr) = zip borderFreqs specs- where + where groups = splitTo (padSharcSize spec) (Sh.instrNotes instr) medians = fmap getMedian groups borders = fmap getBorder groups@@ -149,9 +149,9 @@ splitTo :: Int -> [a] -> [[a]]-splitTo n as = go size as- where - size = max 1 (length as `div` n)+splitTo m as = go size as+ where+ size = max 1 (length as `div` m) go :: Int -> [a] -> [[a]] go n bs@@ -172,17 +172,11 @@ note2padsynth :: Double -> Sh.Note -> PadsynthSpec note2padsynth bandwidth note = (defPadsynthSpec bandwidth normAmps) { padsynthFundamental = Sh.pitchFund (Sh.notePitch note) }- where + where normAmps = fmap ( / maxAmp) amps amps = fmap Sh.harmonicAmplitude $ Sh.noteHarmonics note maxAmp = maximum amps --toStereoOsc :: (a -> SE Sig) -> (a -> SE Sig2)-toStereoOsc f x = do- left <- f x- right <- f x- return (left, right) --------------------------------------------------------------------------- -- sharc instr
src/Csound/Catalog/Wave/Thor.hs view
@@ -1,27 +1,28 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# Language FlexibleContexts #-} module Csound.Catalog.Wave.Thor(- cathedralOrgan, cathedralOrganFx, hammondOrgan,+ cathedralOrgan, cathedralOrganFx, hammondOrgan, - amPiano, amPianoBy,+ amPiano, amPianoBy, - pwBass, pwHarpsichord, pwEnsemble,- pwBassBy, pwHarpsichordBy, pwEnsembleBy,+ pwBass, pwHarpsichord, pwEnsemble,+ pwBassBy, pwHarpsichordBy, pwEnsembleBy, - simpleBass, + simpleBass, - ReleaseTime,- EpianoOsc(..), epiano, epianoBy, pianoEnv, xpianoEnv,+ ReleaseTime,+ EpianoOsc(..), epiano, epianoBy, pianoEnv, xpianoEnv, - noisyChoir, thorWind, mildWind, boom, windWall, + noisyChoir, thorWind, mildWind, boom, windWall, - razorPad, razorLead+ razorPad, razorLead ) where -import Data.List+import Prelude hiding (filter, all) import Control.Monad -import Csound.Base +import Csound.Base hiding (pulse) -- some instruments from the Thor explained series --@@ -42,17 +43,17 @@ -- -- 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) ]+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 amPianoBy :: ResonFilter -> Sig -> SE Sig amPianoBy filter x = mul env $ at (filter (env * (3000 + x)) 0.25) $ (rndSaw x * rndSaw (4 * x))- where env = leg 0.01 4 0 0.02+ where env = leg 0.01 4 0 0.02 amPiano :: Sig -> SE Sig amPiano = amPianoBy mlp@@ -68,41 +69,41 @@ simpleBass :: (D, D) -> Sig simpleBass (amp, cps') = aout- where- cps = sig cps'+ 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 ]+ 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+ 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+ ksweep = expsegr [3000, 0.03, 9000] 3 1 - 3000 - pulse = sines [1, 1, 1, 1, 0.7, 0.5, 0.3, 0.1]+ pulse = sines [1, 1, 1, 1, 0.7, 0.5, 0.3, 0.1] - kgain = 2+ kgain = 2 pwHarpsichordBy :: ResonFilter -> Sig -> SE Sig pwHarpsichordBy filter x = mul 2.5 $ mul (leg 0.005 1.5 0 0.25) $ at (filter (env * 8000) 0.15) $ at (hp 2500 0.3) $ rndPw 0.4 x- where env = leg 0.01 4 0 0.01+ where env = leg 0.01 4 0 0.01 pwHarpsichord :: Sig -> SE Sig pwHarpsichord = pwHarpsichordBy mlp pwEnsembleBy :: ResonFilter -> Sig -> SE Sig pwEnsembleBy filter x = mul 0.3 $ at (filter (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)+ [ 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) pwEnsemble :: Sig -> SE Sig pwEnsemble = pwEnsembleBy mlp@@ -112,30 +113,30 @@ type ReleaseTime = D -data EpianoOsc = EpianoOsc - { epianoOscChorusNum :: Int- , epianoOscChorusAmt :: Sig- , epianoOscNum :: Sig - , epianoOscWeight :: Sig- }+data EpianoOsc = EpianoOsc+ { epianoOscChorusNum :: Int+ , epianoOscChorusAmt :: Sig+ , epianoOscNum :: Sig+ , epianoOscWeight :: Sig+ } xpianoEnv :: ReleaseTime -> (D, D) -> Sig xpianoEnv userRelease (amp, cps) = sig amp * xeg 0.01 sust 0.25 rel- where- sust = maxB (amp + 2 + (0.7 - 3 * k ** 2)) 0.1- rel = userRelease + maxB ((amp / 5) + 0.05 - (k / 10)) 0.02- k = cps / 3500+ where+ sust = maxB (amp + 2 + (0.7 - 3 * k ** 2)) 0.1+ rel = userRelease + maxB ((amp / 5) + 0.05 - (k / 10)) 0.02+ k = cps / 3500 pianoEnv :: ReleaseTime -> (D, D) -> Sig pianoEnv userRelease (amp, cps) = sig amp * leg 0.001 sust 0.25 rel- where- sust = maxB (amp + 2 + (0.7 - 3 * k ** 2)) 0.1- rel = userRelease + maxB ((amp / 5) + 0.05 - (k / 10)) 0.02- k = cps / 3500+ where+ sust = maxB (amp + 2 + (0.7 - 3 * k ** 2)) 0.1+ rel = userRelease + maxB ((amp / 5) + 0.05 - (k / 10)) 0.02+ k = cps / 3500 epianoBy :: ResonFilter -> ReleaseTime -> [EpianoOsc] -> (D, D) -> SE Sig epianoBy filter releaseTime xs (amp, cps) = mul (pianoEnv releaseTime (amp, cps)) $ at (filter (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 + fmap sum $ mapM (\x -> mul (epianoOscWeight x) $ multiRndSE (epianoOscChorusNum x) (epianoOscChorusAmt x) (detune (epianoOscNum x) rndOsc) (sig cps)) xs epiano :: ReleaseTime -> [EpianoOsc] -> (D, D) -> SE Sig epiano = epianoBy mlp@@ -148,10 +149,10 @@ 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+ 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@@ -159,34 +160,34 @@ 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 +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+ where+ amEnv = leg 7 10 0 8+ filtEnv = leg 6 0 1 5 ------------------------------ -- 9, 10 fm -razorPad filter speed amp cps = f cps + 0.75 * f (cps * 0.5)- where f cps = mul (leg 0.5 0 1 1) $ genRazor filter speed amp cps+razorPad filter speed amp frq = f frq + 0.75 * f (frq * 0.5)+ where f cps = mul (leg 0.5 0 1 1) $ genRazor filter 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 + 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))+ 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))
src/Csound/Catalog/Wave/VestigeOfTime.hs view
@@ -1,13 +1,13 @@ {-# Language FlexibleInstances #-} module Csound.Catalog.Wave.VestigeOfTime ( filteredSaw, filteredSawRising, filteredSawFalling,- filteredNoise, - resonInstr, simpleResonInstr, resonVibrato, + filteredNoise,+ resonInstr, simpleResonInstr, resonVibrato, delaySaw, femaleVowel, amBell ) where -import Csound.Base- +import Csound.Base hiding (filt)+ import Csound.Catalog.Effect(vibroDelay) import Csound.Catalog.Reson(Reson) @@ -27,17 +27,17 @@ filteredSawFalling :: D -> Sig -> Sig filteredSawFalling fallDur = filteredSaw (linseg [5000, fallDur, 500]) --- | The saw is filtered with band pass filter. Centere frequency of the filter +-- | The saw is filtered with band pass filter. Centere frequency of the filter -- can vary. -- -- > filteredSaw centerFrequency sawCps filteredSaw :: Sig -> Sig -> Sig filteredSaw kcf cps = aout- where + where a1 = chorusPitch 3 0.003 saw cps aout = reson a1 kcf 100 `withD` 2 --- | The white noise is filtered with band pass filter. Centere frequency of the filter +-- | The white noise is filtered with band pass filter. Centere frequency of the filter -- can vary. -- -- > filteredNoise centerFrequency sawCps@@ -46,7 +46,7 @@ anoise <- rand 1 return $ balance (reson anoise cfq bw `withD` 2) anoise --- | +-- | -- > simpleResonInstr cycleLength cps simpleResonInstr :: D -> Sig -> Sig simpleResonInstr dt = resonInstr (f f21) (f f22) (f f23) 1@@ -61,7 +61,7 @@ --- | Signal is passed through three band-pass filters. +-- | Signal is passed through three band-pass filters. -- We can alter the relative center frequencies of the filters. -- -- > resonInstr filt1 filt2 filt3 amp cps = aout@@ -72,14 +72,14 @@ asig2 = amp * 0.7 * osc cps phi cf bw filt = reson asig (cf * filt) bw `withD` 2- aout = balance (sum + aout = balance (sum [ 0.6 * phi 110 20 filt1 , phi 220 30 filt2- , 0.6 * phi 440 40 filt3 - , 0.4 * asig + , 0.6 * phi 440 40 filt3+ , 0.4 * asig , 2 * asig2 ]) asig2- + f19 = sines [1, 0.1, 0.1, 0.278, 0.245, 0.3, 0.352, 0.846, 0.669, 0, 0, 0, 0.1, 0.1, 0.1] -- | Vibrato and resonant filter with varying center frequency.@@ -93,13 +93,13 @@ waveTab = sines [1, 0.832, 0.5, 0.215, 0.6, 0.133, 0.785, 0.326, 0.018, 0.028, 0.0647, 0.0143, 0.0213] --- | Singing a reson's vowels (see "Csound.Catalog.Reson"). +-- | Singing a reson's vowels (see "Csound.Catalog.Reson"). femaleVowel :: Reson -> Sig -> Sig femaleVowel vowel cps = aout- where + where afilt1 = chorusPitch 3 0.003 (\x -> buzz 1 x 15 sine) cps aout = blp 2000 $ resonsBy (\cf bw x -> reson x cf bw `withD` 2) vowel afilt1- + -- | Delayed saw wave. delaySaw :: Sig -> Sig delaySaw cps = vibroDelay 6 3 2 0.25 $ saw cps
src/Csound/Catalog/Wave/Vowel.hs view
@@ -6,17 +6,17 @@ -- > vibrato 0.12 5 $ oneVowel maleA 330 vowels, loopVowels, oneVowel, Vowel,- + -- * Vowels maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH,- femaleA, femaleE, femaleIY, femaleO, femaleOO + femaleA, femaleE, femaleIY, femaleO, femaleOO ) where import Data.List(transpose) -import Csound.Base+import Csound.Base hiding (dur) --- | Sings a sequence of vowels with the given frequency. +-- | Sings a sequence of vowels with the given frequency. -- -- > vowels maxDur [(vowel1, dur1), (vowel2, dur2), (vowel3, dur3), ...] lastVowel cps --@@ -31,7 +31,7 @@ vowels = vowelsBy mkEnv where mkEnv xs x = linseg ( ( ++ [x, 1, x]) $ (\(a, b) -> [a, b]) =<< xs) --- | Sings a loop of vowels with the given frequency. +-- | Sings a loop of vowels with the given frequency. -- -- > loopVowels maxDur xdur [(vowel1, dur1), (vowel2, dur2), (vowel3, dur3), ...] cps --@@ -46,20 +46,20 @@ -- * cps - frequency of the note. loopVowels :: D -> Sig -> [(Vowel, D)] -> Sig -> Sig loopVowels maxDur xdur params = vowelsBy mkEnv maxDur params lastVowel- where + where mkEnv xs x = loopseg ((++ [sig x]) $ (\(a, b) -> [sig a, sig b]) =<< xs) (1 / xdur) lastVowel = fst $ head params -- | Generic construcotr for the signals that interpolate between vowel sounds. -- It takes a function that constructs an envelope to proceed from one vowel to another. -- The envelope function takes two parameters. It's list of vowels with durations--- and the value of the final vowel. +-- and the value of the final vowel. -- -- > vowelsBy makeEnvelope vowelSquence lastVowel cps vowelsBy :: ([(D, D)] -> D -> Sig) -> D -> [(Vowel, D)] -> Vowel -> Sig -> Sig vowelsBy mkEnv maxDur params lastVowel cps = case params of [(vow, _)] -> oneVowel maxDur vow cps- _ -> (/100) $ sum $ zipWith3 harm + _ -> (/100) $ sum $ zipWith3 harm [fmt1, fmt2, fmt3, fmt4, fmt5] [amp1, amp2, amp3, amp4, amp5] [bw1, bw2, bw3, bw4, bw5]@@ -71,7 +71,7 @@ harm fmt amp bw = fof amp cps fmt ioct bw ris dur dec iolaps sine sigmoid maxDur `withDs` [0, 1] ioct = 0- iolaps = 20 + iolaps = 20 -- | Sings a single vowel with the given frequency.@@ -86,19 +86,19 @@ [bw1, bw2, bw3, bw4, bw5] where [ fmt1, amp1, bw1, fmt2, amp2, bw2, fmt3, amp3, bw3- , fmt4, amp4, bw4, fmt5, amp5, bw5, ris, dur, dec + , fmt4, amp4, bw4, fmt5, amp5, bw5, ris, dur, dec ] = vowelParams v harm fmt amp bw = fof (sig amp) cps (sig fmt) ioct (sig bw) (sig ris) (sig dur) (sig dec) iolaps sine sigmoid maxDur `withDs` [0, 1] ioct = 0- iolaps = 20 - + iolaps = 20 + vowelParams :: Vowel -> [D]-vowelParams v = fmap (flip table vowelTab . (+ index)) $ fmap int [0 .. 17] +vowelParams v = fmap (flip table vowelTab . (+ index)) $ fmap int [0 .. 17] where index = vowelIndex v- --- | Abstract type that represents a vowel. ++-- | Abstract type that represents a vowel. newtype Vowel = Vowel { unVowel :: D } instance Tuple Vowel where@@ -121,69 +121,69 @@ vowelTab :: Tab vowelTab = skipNorm $ doubles -- 1 - male voice singing A--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- [ 609, 0, 100, 1000, -6, 100, 2450, -12, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 2700, -11, 100, 3240, -24, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ [ 609, 0, 100, 1000, -6, 100, 2450, -12, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 2700, -11, 100, 3240, -24, 100, 0.003, 0.02, 0.007 -- 2 - male voice singing E--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 400, 0, 100, 1700, -9, 100, 2300, -8, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 2900, -11, 100, 3400, -19, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 400, 0, 100, 1700, -9, 100, 2300, -8, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 2900, -11, 100, 3400, -19, 100, 0.003, 0.02, 0.007 -- 3 - male voice singing IY--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 238, 0, 100, 1741, -20, 100, 2450, -16, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 2900, -20, 100, 4000, -32, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 238, 0, 100, 1741, -20, 100, 2450, -16, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 2900, -20, 100, 4000, -32, 100, 0.003, 0.02, 0.007 -- 4 - male voice singing O--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 325, 0, 100, 700, -12, 100, 2550, -26, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 2850, -22, 100, 3100, -28, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 325, 0, 100, 700, -12, 100, 2550, -26, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 2850, -22, 100, 3100, -28, 100, 0.003, 0.02, 0.007 -- 5 - male voice singing OO--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 360, 0, 100, 750, -12, 100, 2400, -29, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 2675, -26, 100, 2950, -35, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 360, 0, 100, 750, -12, 100, 2400, -29, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 2675, -26, 100, 2950, -35, 100, 0.003, 0.02, 0.007 -- 6 - male voice singing U--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 415, 0, 100, 1400, -12, 100, 2200, -16, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 2800, -18, 100, 3300, -27, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 415, 0, 100, 1400, -12, 100, 2200, -16, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 2800, -18, 100, 3300, -27, 100, 0.003, 0.02, 0.007 -- 7 - male voice singing ER--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 300, 0, 100, 1600, -14, 100, 2150, -12, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 2700, -15, 100, 3100, -23, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 300, 0, 100, 1600, -14, 100, 2150, -12, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 2700, -15, 100, 3100, -23, 100, 0.003, 0.02, 0.007 -- 8 - male voice singing UH--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 400, 0, 100, 1050, -12, 100, 2200, -19, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 2650, -20, 100, 3100, -29, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 400, 0, 100, 1050, -12, 100, 2200, -19, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 2650, -20, 100, 3100, -29, 100, 0.003, 0.02, 0.007 -- 9 - female voice singing A--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 650, 0, 100, 1100, -8, 100, 2860, -13, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 3300, -12, 100, 4500, -19, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 650, 0, 100, 1100, -8, 100, 2860, -13, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 3300, -12, 100, 4500, -19, 100, 0.003, 0.02, 0.007 -- 10 - female voice singing E--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 500, 0, 100, 1750, -9, 100, 2450, -10, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 3350, -14, 100, 5000, -23, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 500, 0, 100, 1750, -9, 100, 2450, -10, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 3350, -14, 100, 5000, -23, 100, 0.003, 0.02, 0.007 -- 11 - female voice singing IY--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 330, 0, 100, 2000, -14, 100, 2800, -11, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 3450, -50, 100, 4500, -52, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 330, 0, 100, 2000, -14, 100, 2800, -11, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 3450, -50, 100, 4500, -52, 100, 0.003, 0.02, 0.007 -- 12 - female voice singing O--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 400, 0, 100, 840, -12, 100, 2800, -26, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 3250, -24, 100, 4500, -31, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 400, 0, 100, 840, -12, 100, 2800, -26, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 3250, -24, 100, 4500, -31, 100, 0.003, 0.02, 0.007 -- 13 - female voice singing OO--- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3- , 280, 0, 100, 650, -18, 100, 2200, -48, 100--- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec- , 3450, -50, 100, 4500, -52, 100, 0.003, 0.02, 0.007+-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3+ , 280, 0, 100, 650, -18, 100, 2200, -48, 100+-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec+ , 3450, -50, 100, 4500, -52, 100, 0.003, 0.02, 0.007 ]
src/Csound/Catalog/Wave/Woodwind.hs view
@@ -20,16 +20,16 @@ -- | An emulation of the flute. Parameters ----- > flute seed vibDepth attack sustain decay brightnessLevel cps = +-- > flute seed vibDepth attack sustain decay brightnessLevel cps = -- -- * seed - a seed for the random signals/numbers. It's in (0, 1) -- -- * vibDepth - Amount of the vibrato. It's in [-1, 1] ----- * attack - duration of the attack. +-- * attack - duration of the attack. -- Recommended value: 0.12 for slurred notes,--- 0.06 for tongued notes, --- 0.03 for short notes. +-- 0.06 for tongued notes,+-- 0.03 for short notes. -- -- * sustain - duration of the sustain --@@ -40,27 +40,27 @@ -- -- * cps - frequency of the note flute :: D -> D -> D -> D -> D -> D -> D -> Sig-flute = woodwind $ WoodwindSpec +flute = woodwind $ WoodwindSpec { woodwindRange = fromSpec fluteRangeSpec , woodwindVibratoDur = totalDur- , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012)) + , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012)) } fluteRangeSpec :: [RangeSpec]-fluteRangeSpec = - [ RangeSpec +fluteRangeSpec =+ [ RangeSpec { rangeFreq = 427.28 , rangeNorm = 3949- , rangeHarms = - [ HarmSpec - { harmAmp = AmpSpec + , rangeHarms =+ [ HarmSpec+ { harmAmp = AmpSpec { ampAttack = [0, 0.002, 0.045, 0.146, 0.272, 0.072, 0.043] , ampSustain = [0.043, 0.230, 0.000, 0.118, 0.923] , ampDecay = [0.923, 1.191, 0.794, 0.418, 0.172, 0.053, 0] } , harmWave = [2000, 489, 74, 219, 125, 9, 33, 5, 5] }- , HarmSpec + , HarmSpec { harmAmp = AmpSpec { ampAttack = [0, 0.009, 0.022, -0.049, -0.120, 0.297, 1.890] , ampSustain = [1.890, 1.543, 0.000, 0.546, 0.690]@@ -81,8 +81,8 @@ , RangeSpec { rangeFreq = 608.22 , rangeNorm = 27668.2- , rangeHarms = - [ HarmSpec + , rangeHarms =+ [ HarmSpec { harmAmp = AmpSpec { ampAttack = [0.000, 0.000, -0.005, 0.000, 0.030, 0.198, 0.664] , ampSustain = [0.664, 1.451, 1.782, 1.316, 0.817]@@ -90,7 +90,7 @@ } , harmWave = [12318, 8844, 1841, 1636, 256, 150, 60, 46, 11] }- , HarmSpec + , HarmSpec { harmAmp = AmpSpec { ampAttack = [0,0.000,0.320,0.882,1.863,4.175,4.355] , ampSustain = [4.355,-5.329,-8.303,-1.480,-0.472]@@ -98,7 +98,7 @@ } , harmWave = [1229, 16, 34, 57, 32] }- , HarmSpec + , HarmSpec { harmAmp = AmpSpec { ampAttack = [0,1.000,0.520,-0.303,0.059,-4.103,-6.784] , ampSustain = [-6.784,7.006,11,12.495,-0.562]@@ -108,11 +108,11 @@ } ] }- , RangeSpec + , RangeSpec { rangeFreq = 1013.7 , rangeNorm = 3775- , rangeHarms = - [ HarmSpec + , rangeHarms =+ [ HarmSpec { harmAmp = AmpSpec { ampAttack = [0,0.005,0.000,-0.082,0.36,0.581,0.416] , ampSustain = [0.416,1.073,0.000,0.356,0.86]@@ -120,12 +120,12 @@ } , harmWave = [4128, 883, 354, 79, 59, 23] }- , HarmSpec + , HarmSpec { harmAmp = AmpSpec { ampAttack = [0,-0.005,0.000,0.205,-0.284,-0.208,0.326] , ampSustain = [0.326,-0.401,1.540,0.589,-0.486] , ampDecay = [-0.486,-0.016,0.141,0.105,-0.003,-0.023,0]- } + } , harmWave = [1924, 930, 251, 50, 25, 14] } , HarmSpec@@ -138,10 +138,10 @@ } ] }- , RangeSpec + , RangeSpec { rangeFreq = 22000 , rangeNorm = 4909.05- , rangeHarms = + , rangeHarms = [ HarmSpec { harmAmp = AmpSpec { ampAttack = [0,0.000,0.000,0.211,0.526,0.989,1.216]@@ -155,7 +155,7 @@ { ampAttack = [0,0.500,0.000,0.181,0.859,-0.205,-0.430] , ampSustain = [-0.430,-0.725,-0.544,-0.436,-0.109] , ampDecay = [-0.109,-0.03,-0.022,-0.046,-0.071,-0.019,0]- } + } , harmWave = [174, 12] } , HarmSpec@@ -163,7 +163,7 @@ { ampAttack = [0,0.000,1.000,0.426,0.222,0.175,-0.153] , ampSustain = [-0.153,0.355,0.175,0.16,-0.246] , ampDecay = [-0.246,-0.045,-0.072,0.057,-0.024,0.002,0]- } + } , harmWave = [314, 13] } ]@@ -175,15 +175,15 @@ -- | An emulation of the bass clarinet. Parameters ----- > bassClarinet seed vibDepth attack sustain decay brightnessLevel cps = +-- > bassClarinet seed vibDepth attack sustain decay brightnessLevel cps = -- -- * seed - a seed for the random signals/numbers. It's in (0, 1) -- -- * vibDepth - Amount of the vibrato. It's in [-1, 1] ----- * attack - duration of the attack. --- Recommended value: 0.06 for tongued notes, --- 0.03 for short notes. +-- * attack - duration of the attack.+-- Recommended value: 0.06 for tongued notes,+-- 0.03 for short notes. -- -- * sustain - duration of the sustain --@@ -194,15 +194,15 @@ -- -- * cps - frequency of the note bassClarinet :: D -> D -> D -> D -> D -> D -> D -> Sig-bassClarinet = woodwind $ WoodwindSpec +bassClarinet = woodwind $ WoodwindSpec { woodwindRange = fromSpec bassClarinetRangeSpec , woodwindVibratoDur = totalDur- , woodwindFreqDeviation = ((0, 0.015), (-0.005, 0), (0, 0.003), (0, 0.017)) + , woodwindFreqDeviation = ((0, 0.015), (-0.005, 0), (0, 0.003), (0, 0.017)) } bassClarinetRangeSpec :: [RangeSpec]-bassClarinetRangeSpec = +bassClarinetRangeSpec = [RangeSpec { rangeFreq = 67.13 , rangeNorm = 29786.7@@ -350,15 +350,15 @@ -- | An emulation of the french horn. Parameters ----- > frenchHorn seed vibDepth attack sustain decay brightnessLevel cps = +-- > frenchHorn seed vibDepth attack sustain decay brightnessLevel cps = -- -- * seed - a seed for the random signals/numbers. It's in (0, 1) -- -- * vibDepth - Amount of the vibrato. It's in [-1, 1] ----- * attack - duration of the attack. --- Recommended value: 0.06 for tongued notes (up to 0.12 for lower notes, up to G2), --- 0.03 for short notes. +-- * attack - duration of the attack.+-- Recommended value: 0.06 for tongued notes (up to 0.12 for lower notes, up to G2),+-- 0.03 for short notes. -- -- * sustain - duration of the sustain --@@ -369,14 +369,14 @@ -- -- * cps - frequency of the note frenchHorn :: D -> D -> D -> D -> D -> D -> D -> Sig-frenchHorn = woodwind $ WoodwindSpec +frenchHorn = woodwind $ WoodwindSpec { woodwindRange = fromSpec frenchHornRangeSpec , woodwindVibratoDur = totalDur- , woodwindFreqDeviation = ((-0.012, 0), (0, 0.005), (-0.005, 0), (0, 0.009)) + , woodwindFreqDeviation = ((-0.012, 0), (0, 0.005), (-0.005, 0), (0, 0.009)) } frenchHornRangeSpec :: [RangeSpec]-frenchHornRangeSpec = +frenchHornRangeSpec = [RangeSpec { rangeFreq = 113.26 , rangeNorm = 5137@@ -580,15 +580,15 @@ -- | An emulation of the sheng. Parameters ----- > sheng seed vibDepth attack sustain decay brightnessLevel cps = +-- > sheng seed vibDepth attack sustain decay brightnessLevel cps = -- -- * seed - a seed for the random signals/numbers. It's in (0, 1) -- -- * vibDepth - Amount of the vibrato. It's in [-1, 1] ----- * attack - duration of the attack. --- Recommended value: 0.1, --- 0.03 for short notes. +-- * attack - duration of the attack.+-- Recommended value: 0.1,+-- 0.03 for short notes. -- -- * sustain - duration of the sustain --@@ -599,7 +599,7 @@ -- -- * cps - frequency of the note sheng :: D -> D -> D -> D -> D -> D -> D -> Sig-sheng = woodwind $ WoodwindSpec +sheng = woodwind $ WoodwindSpec { woodwindRange = shengRange , woodwindVibratoDur = const 0.625 , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012))@@ -608,16 +608,16 @@ shengRange :: (D, D, D) -> D -> ([(Sig, Tab)], D) shengRange (iattack, isustain, idecay) ifreq = ([(amp1, iwt1), (amp2, iwt2), (amp3, iwt3)], inorm) where- amp1 = ar $ linseg + amp1 = ar $ linseg [ 0, 0.20*iattack, 2000, 0.40*iattack, 2050, 0.4*iattack, 2250, 0.18*isustain, 2500 , 0.78*isustain, 2300, 0.04*isustain, 2000, 1.0*idecay, 0, 1, 0]- amp2 = ar $ linseg + amp2 = ar $ linseg [ 0, 0.11*iattack, 100, 0.12*iattack, 5000, 0.12*iattack, 7500, 0.3*iattack, 9500 , 0.35*iattack, 10500, 0.18*isustain, 12000, 0.3*isustain, 11000, 0.48*isustain, 10000 , 0.04*isustain, 9000, 0.23*idecay, 7000, 0.67*idecay, 0, 1, 0]- amp3 = ar $ linseg - [ 0, 0.18*iattack, 10, 0.15*iattack, 1250, 0.2*iattack, 1800, 0.24*iattack, 1900 - , 0.23*iattack, 2200, 0.03*isustain, 2600, 0.2*isustain, 2900, 0.35*isustain, 2700 + amp3 = ar $ linseg+ [ 0, 0.18*iattack, 10, 0.15*iattack, 1250, 0.2*iattack, 1800, 0.24*iattack, 1900+ , 0.23*iattack, 2200, 0.03*isustain, 2600, 0.2*isustain, 2900, 0.35*isustain, 2700 , 0.23*isustain, 2400, 0.15*isustain, 2000, 0.04*isustain, 1800, 0.23*idecay, 1200 , 0.42*idecay, 20, 0.15*idecay, 0, 1, 0] @@ -626,33 +626,33 @@ iwt1 = f11 iwt2 = ifB (ifreq `lessThan` 1025) f31 f35 iwt3 = byRange [f32, f33, f34, f36]- + f11 = sine f31 = skipNorm $ sines2 [(2, 1), (3, 0.16), (4, 1.16), (5, 0.45), (6, 0.33)]- f32 = skipNorm $ sines2 + f32 = skipNorm $ sines2 [ (7, 1), (8, 0.83), (9, 0.85), (10, 0.16), (11, 0.5), (12, 0.38) , (13, 0.05), (14, 0.26), (15, 0.16), (16, 0.13), (17, 0.12), (18, 0.05), (19, 0.11)] f33 = skipNorm $ sines2 [ (7, 0.21), (8, 0.33), (9, 0.36), (10, 0.3), (11, 0.76), (12, 0.38), (13, 0.5), (14, 0.07)] f34 = skipNorm $ sines2 [ (7, 0.43), (8, 1.2), (9, 0.4), (10, 0.3), (11, 0.1) ] f35 = skipNorm $ sines2 [ (2, 0.58), (3, 0.83), (4, 0.83) ]- f36 = skipNorm $ sines2 [ (5, 2.1), (6, 1.2), (7, 0.4) ] - + f36 = skipNorm $ sines2 [ (5, 2.1), (6, 1.2), (7, 0.4) ]+ byRange :: Tuple a => [a] -> a byRange = byFreq ifreq . zip freqs freqs = [538, 760, 1025, 22000] ------------------------------------------------------------------- Hulusi +-- Hulusi -- | An emulation of the hulusi. Parameters ----- > hulusi seed vibDepth attack sustain decay brightnessLevel cps = +-- > hulusi seed vibDepth attack sustain decay brightnessLevel cps = -- -- * seed - a seed for the random signals/numbers. It's in (0, 1) -- -- * vibDepth - Amount of the vibrato. It's in [-1, 1] ----- * attack - duration of the attack. +-- * attack - duration of the attack. -- Recommended value: 0.03 -- -- * sustain - duration of the sustain@@ -664,7 +664,7 @@ -- -- * cps - frequency of the note hulusi :: D -> D -> D -> D -> D -> D -> D -> Sig-hulusi = woodwind $ WoodwindSpec +hulusi = woodwind $ WoodwindSpec { woodwindRange = hulusiRange , woodwindVibratoDur = const 20 , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012))@@ -672,18 +672,18 @@ hulusiRange :: (D, D, D) -> D -> ([(Sig, Tab)], D)-hulusiRange (iattack, isustain, idecay) ifreq = - ( [ (amp1, iwt1), (amp2, iwt2), (amp3, iwt3) ] - , inorm +hulusiRange (iattack, isustain, idecay) ifreq =+ ( [ (amp1, iwt1), (amp2, iwt2), (amp3, iwt3) ]+ , inorm )- where + where byRange :: Tuple a => [a] -> a byRange = byFreq ifreq . zip [320, 427, 680, 22000]- + amp1 = byRange [amp1_0, amp1_1, amp1_2, amp1_3] amp2 = byRange [amp2_0, amp2_1, amp2_2, amp2_3] amp3 = byRange [amp3_0, amp3_1, amp3_2, amp3_3]- + iwt1 = byRange [iwt1_0, iwt1_1, iwt1_2, iwt1_3] iwt2 = byRange [iwt2_0, iwt2_1, iwt2_2, iwt2_3] iwt3 = byRange [iwt3_0, iwt3_1, iwt3_2, iwt3_3]@@ -691,19 +691,19 @@ inorm = byRange [ inorm_0, inorm_1, inorm_2, inorm_3 ] -- range 0- amp1_0 = ar $ linseg + amp1_0 = ar $ linseg [ 0, 0.33*iattack, 750, 0.17*iattack, 2000, 0.17*iattack , 5000, 0.16*iattack, 13000, 0.17*iattack, 15000, 0.03*isustain , 16000, 0.47*isustain, 15000, 0.5*isustain, 13500, 0.2*idecay , 13000, 0.2*idecay, 11000, 0.2*idecay, 6000, 0.2*idecay, 150, 0.2*idecay, 0 ]- amp2_0 = ar $ linseg + amp2_0 = ar $ linseg [ 0, 0.67*iattack, 30, 0.33*iattack, 9000, 0.05*isustain , 11000, 0.05*isustain, 12000, 0.4*isustain, 9500, 0.5*isustain , 7200, 0.2*idecay, 5600, 0.2*idecay, 3200, 0.2*idecay- , 1000, 0.2*idecay, 50, 0.1*idecay, 0, 0.1*idecay, 0 + , 1000, 0.2*idecay, 50, 0.1*idecay, 0, 0.1*idecay, 0 ]- amp3_0 = ar $ linseg + amp3_0 = ar $ linseg [ 0, 0.33*iattack, 0, 0.4*iattack, 30, 0.27*iattack , 3600, 0.07*isustain, 2000, 0.43*isustain, 2800, 0.5*isustain , 3000, 0.2*idecay, 2700, 0.2*idecay, 1500, 0.2*idecay, 150@@ -716,20 +716,20 @@ inorm_0 = 26985 -- range 1- amp1_1 = ar $ linseg + amp1_1 = ar $ linseg [ 0, 0.43*iattack, 1600, 0.27*iattack, 9000, 0.3*iattack , 5400, 0.5*isustain, 5500, 0.5*isustain, 5300, 0.2*idecay , 4200, 0.2*idecay, 3000, 0.2*idecay, 1000, 0.2*idecay- , 100, 0.2*idecay, 0 + , 100, 0.2*idecay, 0 ]- amp2_1 = ar $ linseg + amp2_1 = ar $ linseg [ 0, 0.43*iattack, 20, 0.13*iattack, 700, 0.30*iattack , 6300, 0.14*iattack, 7500, 0.03*isustain, 9000, 0.14*isustain , 9200, 0.65*isustain, 7000, 0.14*isustain, 6000, 0.04*isustain , 5000, 0.2*idecay, 4600, 0.2*idecay, 3600, 0.2*idecay, 2400, 0.2*idecay , 600, 0.15*idecay, 0, 0.05*idecay, 0 ]- amp3_1 = ar $ linseg + amp3_1 = ar $ linseg [ 0, 0.52*iattack, 10, 0.26*iattack, 1500, 0.22*iattack , 7000, 0.03*isustain, 9000, 0.02*isustain, 10500, 0.15*isustain , 9700, 0.65*isustain, 8000, 0.15*isustain, 6400, 0.2*idecay@@ -739,21 +739,21 @@ iwt2_1 = f33 iwt3_1 = f34 inorm_1 = 36133- - -- range2: ; for high middle range tones- amp1_2 = ar $ linseg ++ -- range2: ; for high middle range tones+ amp1_2 = ar $ linseg [ 0, 0.27*iattack, 1500, 0.22*iattack, 8000, 0.51*iattack , 9000, 0.02*isustain, 11000, 0.04*isustain, 10600, 0.81*isustain , 10000, 0.09*isustain, 9000, 0.04*isustain, 7000, 0.2*idecay- , 6000, 0.2*idecay, 4000, 0.2*idecay, 2000, 0.2*idecay, 600, 0.2*idecay, 0 + , 6000, 0.2*idecay, 4000, 0.2*idecay, 2000, 0.2*idecay, 600, 0.2*idecay, 0 ]- amp2_2 = ar $ linseg + amp2_2 = ar $ linseg [ 0, 0.38*iattack, 20, 0.17*iattack, 3800, 0.45*iattack, 5500, 0.02*isustain , 6000, 0.5*isustain, 3800, 0.35*isustain, 3300, 0.09*isustain , 1000, 0.04*isustain, 750, 0.2*idecay, 600, 0.2*idecay, 350, 0.2*idecay- , 150, 0.2*idecay, 40, 0.2*idecay, 0 + , 150, 0.2*idecay, 40, 0.2*idecay, 0 ]- amp3_2 = ar $ linseg + amp3_2 = ar $ linseg [ 0, 0.44*iattack, 20, 0.1*iattack, 1300, 0.08*iattack, 750, 0.38*iattack , 600, 0.5*isustain, 800, 0.35*isustain, 750, 0.1*isustain, 550, 0.05*isustain , 50, 0.2*idecay, 30, 0.2*idecay, 15, 0.2*idecay, 7, 0.2*idecay, 0, 0.2*idecay, 0@@ -763,31 +763,31 @@ iwt3_2 = f37 inorm_2 = 27905 - -- range3: ; for high range tones- amp1_3 = ar $ linseg + -- range3: ; for high range tones+ amp1_3 = ar $ linseg [ 0, 0.15*iattack, 300, 0.15*iattack, 1100, 0.15*iattack , 4000, 0.15*iattack, 9000, 0.15*iattack, 20000, 0.15*iattack , 27000, 0.10*iattack, 29000, 0.12*isustain, 26000, 0.56*isustain , 27000, 0.32*isustain, 24000, 0.33*idecay, 23000, 0.33*idecay , 6000, 0.17*idecay, 1000, 0.16*idecay, 0 ]- amp2_3 = ar $ linseg + amp2_3 = ar $ linseg [ 0, 0.45*iattack, 15, 0.15*iattack, 250, 0.15*iattack, 850, 0.15*iattack , 1800, 0.1*iattack, 2100, 0.03*isustain, 2250, 0.07*isustain, 2000 , 0.25*isustain, 2100, 0.4*isustain, 2000, 0.15*isustain, 1400, 0.1*isustain , 800, 0.45*idecay, 170, 0.22*idecay, 120, 0.11*idecay, 40, 0.11*idecay , 15, 0.11*idecay, 0 ]- amp3_3 = ar $ linseg + amp3_3 = ar $ linseg [ 0, 0.52*iattack, 15, 0.15*iattack, 400, 0.22*iattack , 2050, 0.11*iattack, 2200, 0.06*isustain, 1000, 0.15*isustain , 1500, 0.13*isustain, 1250, 0.5*isustain, 2500, 0.04*isustain , 2300, 0.12*isustain, 2000, 0.2*idecay, 1600, 0.2*idecay , 900, 0.2*idecay, 150, 0.2*idecay, 20, 0.1*idecay, 0, 0.1*idecay, 0 ]- iwt1_3 = f11- iwt2_3 = f12- iwt3_3 = f13- inorm_3 = 27507 + iwt1_3 = f11+ iwt2_3 = f12+ iwt3_3 = f13+ inorm_3 = 27507 f11 = sine f12 = skipNorm $ sines2 [(2, 1)]@@ -805,13 +805,13 @@ -- | An emulation of the dizi. Parameters ----- > dizi seed vibDepth attack sustain decay brightnessLevel cps = +-- > dizi seed vibDepth attack sustain decay brightnessLevel cps = -- -- * seed - a seed for the random signals/numbers. It's in (0, 1) -- -- * vibDepth - Amount of the vibrato. It's in [-1, 1] ----- * attack - duration of the attack. +-- * attack - duration of the attack. -- Recommended value: 0.12 for slurred notes, 0.07 for tongued notes, 0.03 for short notes. -- -- * sustain - duration of the sustain@@ -823,7 +823,7 @@ -- -- * cps - frequency of the note dizi :: D -> D -> D -> D -> D -> D -> D -> Sig-dizi = woodwind $ WoodwindSpec +dizi = woodwind $ WoodwindSpec { woodwindRange = diziRange , woodwindVibratoDur = const 0.625 , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012))@@ -831,18 +831,18 @@ diziRange :: (D, D, D) -> D -> ([(Sig, Tab)], D)-diziRange (iattack, isustain, idecay) ifreq = - ( [ (amp1, iwt1), (amp2, iwt2), (amp3, iwt3) ] - , inorm +diziRange (iattack, isustain, idecay) ifreq =+ ( [ (amp1, iwt1), (amp2, iwt2), (amp3, iwt3) ]+ , inorm )- where + where byRange :: Tuple a => [a] -> a byRange = byFreq ifreq . zip [320, 480, 680, 905, 1280, 1710, 22000]- + amp1 = byRange [amp1_1, amp1_2, amp1_3, amp1_4, amp1_5, amp1_6, amp1_7] amp2 = byRange [amp2_1, amp2_2, amp2_3, amp2_4, amp2_5, amp2_6, amp2_7] amp3 = byRange [amp3_1, amp3_2, amp3_3, amp3_4, amp3_5, amp3_6, amp3_7]- + iwt1 = byRange [iwt1_1, iwt1_2, iwt1_3, iwt1_4, iwt1_5, iwt1_6, iwt1_7] iwt2 = byRange [iwt2_1, iwt2_2, iwt2_3, iwt2_4, iwt2_5, iwt2_6, iwt2_7] iwt3 = byRange [iwt3_1, iwt3_2, iwt3_3, iwt3_4, iwt3_5, iwt3_6, iwt3_7]@@ -853,27 +853,27 @@ isus = isustain / 4 idec = iattack / 6 - - -- range1: ; for very low range tones- amp1_1 = ar $ linseg ++ -- range1: ; for very low range tones+ amp1_1 = ar $ linseg [ 0, 0.4*iattack, 1500, 0.6*iattack, 10000, 0.5*isustain, 11000 , 0.5*isustain, 9000, 0.4*idecay, 8000, 0.3*idecay, 1500, 0.3*idecay, 0 ]- amp2_1 = ar $ linseg + amp2_1 = ar $ linseg [ 0, 0.4*iattack, 200, 0.1*iattack, 1000, 0.5*iattack, 6000 , 0.1*isustain, 11000, 0.3*isustain, 13000, 0.6*isustain, 12000 , 0.6*idecay, 1500, 0.4*idecay, 0 ]- amp3_1 = ar $ linseg + amp3_1 = ar $ linseg [ 0, 0.5*iattack, 30, 0.5*iattack, 500, 0.1*isustain, 1200 , 0.7*isustain, 2200, 0.2*isustain, 1750, 0.5*idecay, 250 , 0.2*idecay, 0, 1, 0 ]- iwt1_1 = f11- iwt2_1 = f20- iwt3_1 = f21- inorm_1 = 32875+ iwt1_1 = f11+ iwt2_1 = f20+ iwt3_1 = f21+ inorm_1 = 32875 - -- range2: ; for very low range tones- amp1_2 = ar $ linseg + -- range2: ; for very low range tones+ amp1_2 = ar $ linseg [ 0, 0.4*iattack, 2000, 0.3*iattack, 6000, 0.3*iattack, 25000 , 0.5*isustain, 24000, 0.5*isustain, 20000, 0.4*idecay, 5000 , 0.3*idecay, 1500, 0.3*idecay, 0 ]@@ -884,123 +884,123 @@ amp3_2 = ar $ linseg [ 0, 0.5*iattack, 30, 0.5*iattack, 500, 0.1*isustain, 1200 , 0.7*isustain, 2200, 0.2*isustain, 1750, 0.5*idecay, 250, 0.2*idecay, 0, 1, 0 ]- iwt1_2 = f11- iwt2_2 = f22- iwt3_2 = f23- inorm_2 = 26080+ iwt1_2 = f11+ iwt2_2 = f22+ iwt3_2 = f23+ inorm_2 = 26080 - -- range3: ; for low range tones- amp1_3 = ar $ linseg + -- range3: ; for low range tones+ amp1_3 = ar $ linseg [ 0, iatt, 0.000, iatt, 0.219, iatt, 0.500, iatt, 0.889, iatt, 1.035 , iatt, 0.963, isus, 0.424, isus, 0.135, isus, 0.108, isus, 0.204- , idec, 0.445, idec, 0.531, idec, 0.513, idec, 0.365, idec, 0.053, idec, 0 + , idec, 0.445, idec, 0.531, idec, 0.513, idec, 0.365, idec, 0.053, idec, 0 ] amp2_3 = ar $ linseg [ 0, iatt, 0.000, iatt, -0.106, iatt, -0.112, iatt, -0.187, iatt , -0.091, iatt, 0.056, isus, 0.558, isus, 0.901, isus, 0.904, isus- , 0.729, idec, 0.303, idec, 0.057, idec, 0.016, idec, -0.076, idec, -0.016, idec, 0 + , 0.729, idec, 0.303, idec, 0.057, idec, 0.016, idec, -0.076, idec, -0.016, idec, 0 ]- amp3_3 = ar $ linseg + amp3_3 = ar $ linseg [ 0, iatt, 1.000, iatt, 0.607, iatt, -0.116, iatt, -0.205, iatt, -0.530, iatt , -0.195, isus, 0.601, isus, 0.478, isus, -0.371, isus, -0.916, idec , -0.782, idec, -0.107, idec, -0.811, idec, -0.189, idec, -0.036, idec, 0 ]- iwt1_3 = f24- iwt2_3 = f25- iwt3_3 = f26- inorm_3 = 24364- - -- range4: ; for low mid-range tones - amp1_4 = ar $ linseg + iwt1_3 = f24+ iwt2_3 = f25+ iwt3_3 = f26+ inorm_3 = 24364++ -- range4: ; for low mid-range tones+ amp1_4 = ar $ linseg [ 0, iatt, 0.000, iatt, 0.049, iatt, 0.027, iatt, 0.005, iatt , -0.020, iatt, 0.378, isus, 0.925, isus, 1.032, isus, 1.106, isus , 0.915, idec, 0.858, idec, 0.722, idec, 0.250, idec, -0.002, idec , 0.004, idec, 0 ]- amp2_4 = ar $ linseg + amp2_4 = ar $ linseg [ 0, iatt, 0.000, iatt, -0.182, iatt, -0.029, iatt, 0.397, iatt , 2.065, iatt, 3.136, isus, 0.250, isus, -0.685, isus, -1.369, isus , -1.176, idec, -1.023, idec, -0.212, idec, 0.810, idec, 0.469, idec , 0.018, idec, 0 ]- amp3_4 = ar $ linseg+ amp3_4 = ar $ linseg [ 0, iatt, 1.000, iatt, 0.007, iatt, 1.039, iatt, 0.466, iatt , 0.627, iatt, 4.181, isus, -2.481, isus, -2.529, isus , -4.838, isus, 0.137, idec, -2.823, idec, -1.899, idec , 4.910, idec, 0.319, idec, 0.039, idec, 0 ]- iwt1_4 = f27- iwt2_4 = f28- iwt3_4 = f29+ iwt1_4 = f27+ iwt2_4 = f28+ iwt3_4 = f29 inorm_4 = 27832- - -- range5: ; for high mid-range tones - amp1_5 = ar $ linseg ++ -- range5: ; for high mid-range tones+ amp1_5 = ar $ linseg [ 0, iatt, 0.000, iatt, 0.000, iatt, 0.018, iatt, 0.000, iatt , 0.450, iatt, 1.130, isus, 1.475, isus, 1.682, isus, 1.533, isus , 1.243, idec, 0.945, idec, 0.681, idec, 0.210, idec, 0.046, idec , 0.004, idec, 0 ]- amp2_5 = ar $ linseg + amp2_5 = ar $ linseg [ 0, iatt, 0.000, iatt, 0.102, iatt, 0.196, iatt, 1.000, iatt , 1.108, iatt, -0.024, isus, -1.557, isus, -2.443, isus , -1.553, isus, -0.979, idec, -0.268, idec, -0.271, idec- , -0.015, idec, 0.017, idec, 0.108, idec, 0 + , -0.015, idec, 0.017, idec, 0.108, idec, 0 ]- amp3_5 = ar $ linseg + amp3_5 = ar $ linseg [ 0, iatt, 1.000, iatt, 0.423, iatt, 0.287, iatt, 0.000, iatt , -0.987, iatt, -0.621, isus, 3.030, isus, 2.349, isus, 3.075, isus , 0.331, idec, 0.994, idec, -1.319, idec, -0.378, idec, 0.000, idec , -0.023, idec, 0 ]- iwt1_5 = f30- iwt2_5 = f31- iwt3_5 = f32- inorm_5 = 27918+ iwt1_5 = f30+ iwt2_5 = f31+ iwt3_5 = f32+ inorm_5 = 27918 - -- range6: ; for high range tones- amp1_6 = ar $ linseg + -- range6: ; for high range tones+ amp1_6 = ar $ linseg [ 0, iatt, 0.000, iatt, 0.322, iatt, 0.115, iatt, 0.090, iatt , -0.148, iatt, 1.743, isus, 2.079, isus, 0.844, isus , 0.889, isus, 1.914, idec, 0.718, idec, 0.206, idec , 0.361, idec, -0.278, idec, -0.272, idec, 0 ]- amp2_6 = ar $ linseg + amp2_6 = ar $ linseg [ 0, iatt, 1.000, iatt, 2.675, iatt, 1.579, iatt, -0.879, iatt , -4.025, iatt, -9.342, isus, 4.570, isus, -3.372, isus , -2.904, isus, 0.755, idec, 5.796, idec, -3.764, idec , 2.193, idec, 0.718, idec, 1.029, idec, 0 ]- amp3_6 = ar $ linseg + amp3_6 = ar $ linseg [ 0, iatt, 0.000, iatt, -0.334, iatt, -0.108, iatt, 0.028, iatt , 0.765, iatt, -0.874, isus, -1.222, isus, 0.236, isus , 0.187, isus, -1.036, idec, 0.276, idec, 0.532, idec , -0.204, idec, 0.311, idec, 0.283, idec, 0 ]- iwt1_6 = f33- iwt2_6 = f34- iwt3_6 = f35- inorm_6 = 23538+ iwt1_6 = f33+ iwt2_6 = f34+ iwt3_6 = f35+ inorm_6 = 23538 - -- range7: ; for very high range tones - amp1_7 = ar $ linseg + -- range7: ; for very high range tones+ amp1_7 = ar $ linseg [ 0, iatt, 0.000, iatt, -0.071, iatt, 0.017, iatt, 0.134, iatt , -0.068, iatt, 0.192, isus, 1.375, isus, 1.875, isus, 1.463, isus , 1.446, idec, 0.932, idec, 0.561, idec, 0.100, idec, 0.036, idec- , 0.000, idec, 0 + , 0.000, idec, 0 ]- amp2_7 = ar $ linseg + amp2_7 = ar $ linseg [ 0, iatt, 1.000, iatt, 3.541, iatt, 3.665, iatt, -0.651, iatt , 1.017, iatt, 1.331, isus, -4.611, isus, -2.534, isus, -4.241, isus , -2.738, idec, -0.609, idec, -1.065, idec, 1.122, idec, 0.605, idec , 0.093, idec, 0 ]- amp3_7 = ar $ linseg + amp3_7 = ar $ linseg [ 0, iatt, 0.000, iatt, 0.061, iatt, 0.093, iatt, 0.323, iatt , 1.011, iatt, 0.819, isus, 0.162, isus, -0.152, isus, 0.080, isus , -0.139, idec, 0.051, idec, -0.054, idec, -0.019, idec, -0.013, idec , 0.003, idec, 0 ]- iwt1_7 = f36- iwt2_7 = f37- iwt3_7 = f38- inorm_7 = 30675+ iwt1_7 = f36+ iwt2_7 = f37+ iwt3_7 = f38+ inorm_7 = 30675 f11 = sine @@ -1008,11 +1008,11 @@ f21 = skipNorm $ sines [ 0, 0, 0, 1, 1.3, 0.66, 0.9, 0.5, 0.8, 0.6, 1.2, 0.5, 0.8, 0.6, 0.75, 0.6, 0.9, 1.2, 0.9, 1.1, 0.85, 0.9, 0.4, 0.3, 0.45, 0.3, 0.25, 0.15 ] f22 = skipNorm $ sines [ 0, 1, 0, 0.33 ] f23 = skipNorm $ sines [ 0, 0, 0.75, 0, 0.28, 0.45, 0.36, 1, 0.54, 0.5, 0.81, 1, 0.95, 0.9, 0.08, 0.24, 0.45, 0.41, 0.25, 0.07 ]- f24 = skipNorm $ sines [ 20742, 2870, 929, 899, 1567, 958, 318, 1168, 838, 781, 192 ] + f24 = skipNorm $ sines [ 20742, 2870, 929, 899, 1567, 958, 318, 1168, 838, 781, 192 ] f25 = skipNorm $ sines [ 18419, 4615, 1255, 689, 3851, 1889, 498, 3127, 3041, 2262, 422, 136 ]- f26 = skipNorm $ sines [ 1700, 331, 615, 259, 188, 164, 79, 393, 191, 108 ] + f26 = skipNorm $ sines [ 1700, 331, 615, 259, 188, 164, 79, 393, 191, 108 ] f27 = skipNorm $ sines [ 17040, 1836, 3609, 4228, 3600, 1910, 9599, 3722, 925, 862, 1292, 227 ]- f28 = skipNorm $ sines [ 4206, 283, 125, 465, 341, 168, 201, 196, 199, 140 ] + f28 = skipNorm $ sines [ 4206, 283, 125, 465, 341, 168, 201, 196, 199, 140 ] f29 = skipNorm $ sines [ 24, 22, 129, 209, 54, 127 ] f30 = skipNorm $ sines [ 13283, 1588, 2948, 337, 9009, 1040, 2175, 222 ] f31 = skipNorm $ sines [ 3831, 572, 332, 252, 209, 243, 91 ]
src/Csound/Catalog/Wave/WoodwindAlg.hs view
@@ -1,14 +1,14 @@ module Csound.Catalog.Wave.WoodwindAlg( WoodwindSpec(..), RangeSpec(..), HarmSpec(..), AmpSpec(..), WaveSpec, fromSpec, byFreq,- woodwind + woodwind ) where import Data.List (transpose, intersperse) import Control.Monad import Control.Monad.Trans.State -import Csound.Base hiding (fromSpec)+import Csound.Base hiding (fromSpec, sustain, select) ---------------------------------------------------------------- -- Deterministic random numbers@@ -24,13 +24,13 @@ instance Monad Rnd where return = Rnd . return- (Rnd a) >>= f = Rnd $ a >>= unRnd . f + (Rnd a) >>= f = Rnd $ a >>= unRnd . f evalRnd :: Rnd a -> D -> a-evalRnd = evalState . unRnd +evalRnd = evalState . unRnd rndNext :: Rnd ()-rndNext = Rnd $ modify $ frac' . (* 105.947) +rndNext = Rnd $ modify $ frac' . (* 105.947) rndGet :: Rnd D rndGet = Rnd $ get@@ -49,7 +49,7 @@ iseed <- rndWithin (0, 1) return $ asig * (1 + (randi (sig pct) (sig cps) `withSeed` iseed)) -minDt :: D -> D -> D +minDt :: D -> D -> D minDt n x = maxB x (n / getControlRate) ----------------------------------------------------------------@@ -62,19 +62,19 @@ , woodwindFreqDeviation :: ((D, D), (D, D), (D, D), (D, D)) } -- | Harmonics per pitch range.-data RangeSpec = RangeSpec +data RangeSpec = RangeSpec { rangeFreq :: D , rangeNorm :: D , rangeHarms :: [HarmSpec] } -- | The harmonics.-data HarmSpec = HarmSpec +data HarmSpec = HarmSpec { harmAmp :: AmpSpec , harmWave :: WaveSpec } -- | Envelopes for linseg-data AmpSpec = AmpSpec - { ampAttack :: [D] +data AmpSpec = AmpSpec+ { ampAttack :: [D] , ampSustain :: [D] , ampDecay :: [D] } @@ -86,7 +86,7 @@ -- | An emulation of the woodwindinstruments. Parameters ----- > woodwind spec seed vibDepth attack sustain decay brightnessLevel cps = +-- > woodwind spec seed vibDepth attack sustain decay brightnessLevel cps = -- -- -- * spec - a specification of the algorithm@@ -103,16 +103,16 @@ -- -- * brightnessLevel - Controls the frequency of the low-pass filter. It's in (0, 1) woodwind :: WoodwindSpec -> D -> D -> D -> D -> D -> D -> D -> Sig-woodwind spec seedVal vibPercent attack sustain decay brightnessLevel cps = +woodwind spec seedVal vibPercent attack sustain decay brightnessLevel cps = evalRnd (rndWoodwind spec vibPercent attack sustain decay brightnessLevel cps) seedVal rndWoodwind :: WoodwindSpec -> D -> D -> D -> D -> D -> D -> Rnd Sig rndWoodwind spec vibCoeff attack sustain decay brightnessLevel cps = do- iphase <- rndWithin (0, 1) - durs <- initDurations + iphase <- rndWithin (0, 1)+ durs <- initDurations kfreq <- woodwindVibrato (woodwindVibratoDur spec durs) =<< (freqDeviation (woodwindFreqDeviation spec) durs $ sig cps) - let (harms1, inorm) = woodwindRange spec durs cps + let (harms1, inorm) = woodwindRange spec durs cps harms2 <- mapM (ampVarOnHarm 0.02) harms1 return $ brightness durs brightnessLevel $ sumHarms harms2 inorm iphase kfreq where@@ -123,12 +123,12 @@ return (minDt 6 iattack, minDt 5 sustain, minDt 6 idecay) woodwindVibrato :: D -> Sig -> Rnd Sig- woodwindVibrato xdur asig = do + woodwindVibrato xdur asig = do let ivibdepth = abs (vibCoeff * cps) kvibdepth <- randiPct 0.1 5 $ sig ivibdepth * linseg [0.1, 0.8 * xdur, 1, 0.2 * xdur, 0.7] ~ [ivibr1, ivibr2, ivibr3] <- mapM rndWithin $ replicate 3 (0, 1)- kvibrate <- randiPct 0.1 5 $ - ifB (sig vibCoeff >* 0) + kvibrate <- randiPct 0.1 5 $+ ifB (sig vibCoeff >* 0) -- if vibrato is positive it gets faster (linseg [2.5 + ivibr1, xdur, 4.5 + ivibr2]) -- if vibrato is negative it gets slower@@ -147,20 +147,20 @@ ampVarOnHarm perct (amp, wt) = fmap (\x -> (x, wt)) $ ampVar perct amp sumHarms :: [(Sig, Tab)] -> D -> D -> Sig -> Sig- sumHarms hs norm iphase kfreq = ( / sig norm) $ mean $ - fmap (\(amp, wt) -> oscili amp kfreq wt `withD` iphase) hs + sumHarms hs norm iphase kfreq = ( / sig norm) $ mean $+ fmap (\(amp, wt) -> oscili amp kfreq wt `withD` iphase) hs brightness :: (D, D, D) -> D -> Sig -> Sig- brightness (iattack, isustain, idecay) level asig = balance (tone asig env) asig + brightness (iattack, isustain, idecay) level asig = balance (tone asig env) asig where ifiltcut = tablei (9 * level) (skipNorm $ doubles [40, 40, 80, 160, 320, 640, 1280, 2560, 5120, 10240, 10240])- env = linseg [0, iattack, ifiltcut, isustain, ifiltcut, idecay, 0] + env = linseg [0, iattack, ifiltcut, isustain, ifiltcut, idecay, 0] ---------------------------------------------------------------- -- Converting specification to signals fromSpec :: [RangeSpec] -> (D, D, D) -> D -> ([(Sig, Tab)], D) fromSpec specs durs ifreq = (hs, inorm)- where + where inorm = byFreq ifreq $ fmap (\x -> (rangeFreq x, rangeNorm x)) specs hs = fmap (byFreq ifreq . zip freqs . fmap (fromHarmSpec durs)) $ transpose $ fmap rangeHarms specs @@ -176,7 +176,7 @@ fromAmpSpec :: (D, D, D) -> AmpSpec -> Sig fromAmpSpec (attack, sustain, decay) spec = linseg $ att ++ (tail sus) ++ (tail dec) where phi dt select = intersperse (dt / fromIntegral (pred $ length $ select spec)) (select spec)- att = phi attack ampAttack + att = phi attack ampAttack sus = phi sustain ampSustain dec = phi decay ampDecay
src/Csound/Patch.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -- | Patches -- -- Collection of beautiful timbres. To try the instrument with midi device just type in the interpreter:@@ -10,224 +11,225 @@ -- 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,- addHammer,+ -- * Electric piano+ Epiano1(..), epiano1, epiano1',+ MutedPiano(..), mutedPiano, mutedPiano',+ amPiano, fmPiano,+ epiano2, epianoHeavy, epianoBright,+ vibraphonePiano1, vibraphonePiano2,+ addHammer, - -- * Organ- cathedralOrgan, toneWheelOrgan,- HammondOrgan(..), hammondOrgan, hammondOrgan',- sawOrgan, triOrgan, sqrOrgan, pwOrgan, waveOrgan,+ -- * Organ+ cathedralOrgan, toneWheelOrgan,+ HammondOrgan(..), hammondOrgan, hammondOrgan',+ sawOrgan, triOrgan, sqrOrgan, pwOrgan, waveOrgan, - hammondOrganm, hammondOrganm', sawOrganm, triOrganm, sqrOrganm, pwOrganm, waveOrganm,+ hammondOrganm, hammondOrganm', sawOrganm, triOrganm, sqrOrganm, pwOrganm, waveOrganm, - -- * Accordeon- accordeon, accordeonBright1, accordeonBright2, brokenAccordeon,- accordeon', Accordeon(..),+ -- * Accordeon+ accordeon, accordeonBright1, accordeonBright2, brokenAccordeon, accordeonHeavy,+ accordeon', Accordeon(..), - -- * Choir- choirA, choirO, choirU, choirE,- Choir(..), choirA', choirO', choirU', choirE',+ -- * Choir+ choirA, choirO, choirU, choirE,+ Choir(..), choirA', choirO', choirU', choirE', - windSings, noisyChoir, longNoisyChoir, noisyChoir', longNoisyChoir', NoisyChoir(..),- noisyRise, noisySpiral, noisySpiral',+ windSings, noisyChoir, longNoisyChoir, noisyChoir', longNoisyChoir', NoisyChoir(..),+ noisyRise, noisySpiral, noisySpiral', - -- * Pad- pwPad, triPad, nightPad, overtonePad, caveOvertonePad,- chorusel, pwEnsemble, fmDroneSlow, fmDroneMedium, fmDroneFast, vibrophonePad,- RazorPad(..), razorPadSlow, razorPadFast, razorPadTremolo, razorPad, razorPad',- dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, dreamPadBy,- dreamPad', underwaterPad', lightIsTooBrightPad', whaleSongPad', dreamPad',+ -- * Pad+ pwPad, triPad, nightPad, overtonePad, caveOvertonePad,+ chorusel, pwEnsemble, fmDroneSlow, fmDroneMedium, fmDroneFast, vibrophonePad,+ RazorPad(..), razorPadSlow, razorPadFast, razorPadTremolo, razorPad, razorPad',+ dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, dreamPadBy,+ dreamPad', underwaterPad', lightIsTooBrightPad', whaleSongPad', - -- ** Pad Monosynth- pwPadm, triPadm, nightPadm, overtonePadm, caveOvertonePadm, choruselm,- pwEnsemblem, fmDroneSlowm, fmDroneMediumm, fmDroneFastm,- razorPadSlowm, razorPadFastm, razorPadTremolom, razorPadm, razorPadm',- dreamPadm, dreamPadBym, underwaterPadm, lightIsTooBrightPadm, whaleSongPadm, dreamPadm', underwaterPadm', dreamPadBym',- lightIsTooBrightPadm', whaleSongPadm',+ -- ** Pad Monosynth+ pwPadm, triPadm, nightPadm, overtonePadm, caveOvertonePadm, choruselm,+ pwEnsemblem, fmDroneSlowm, fmDroneMediumm, fmDroneFastm,+ razorPadSlowm, razorPadFastm, razorPadTremolom, razorPadm, razorPadm',+ dreamPadm, dreamPadBym, underwaterPadm, lightIsTooBrightPadm, whaleSongPadm, dreamPadm', underwaterPadm', dreamPadBym',+ lightIsTooBrightPadm', whaleSongPadm', - -- * Lead- polySynth,- phasingLead, RazorLead(..), razorLeadSlow, razorLeadFast, razorLeadTremolo,- razorLead, razorLead',- overtoneLead,+ -- * Lead+ polySynth,+ phasingLead, RazorLead(..), razorLeadSlow, razorLeadFast, razorLeadTremolo,+ razorLead, razorLead',+ overtoneLead, - -- ** Lead Monosynth- polySynthm, dafunkLead,+ -- ** Lead Monosynth+ polySynthm, dafunkLead, - -- * Bass- simpleBass, pwBass, deepBass, withDeepBass,- fmBass1, fmBass2,+ -- * Bass+ simpleBass, pwBass, deepBass, withDeepBass,+ fmBass1, fmBass2, - -- * Bowed- celloSynt,+ -- * Bowed+ celloSynt, - -- * Plucked- guitar, harpsichord,+ -- * Plucked+ guitar, harpsichord, - -- * Strikeh+ -- * Strikeh - 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,+ 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,+ -- * 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,+ 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,+ scrapePadDahina, scrapePadBanyan, scrapePadXylophone, scrapePadTibetanBowl180, scrapePadSpinelSphere, scrapePadPotLid,+ scrapePadRedCedarWoodPlate, scrapePadTubularBell, scrapePadRedwoodPlate, scrapePadDouglasFirWoodPlate, scrapePadUniformWoodenBar,+ scrapePadUniformAluminumBar, scrapePadVibraphone1, scrapePadVibraphone2, scrapePadChalandiPlates, scrapePadTibetanBowl152,+ scrapePadTibetanBowl140, scrapePadWineGlass, scrapePadSmallHandbell, scrapePadAlbertClockBellBelfast, scrapePadWoodBlock, - -- ** Scrape monosynth- -- | Unfortunately they don't work with @atMonoMidi@. Though @atNote@ works fine.- scrapeDahinam, scrapeBanyanm, scrapeXylophonem, scrapeTibetanBowl180m, scrapeSpinelSpherem, scrapePotLidm, scrapeRedCedarWoodPlatem,- scrapeTubularBellm, scrapeRedwoodPlatem, scrapeDouglasFirWoodPlatem, scrapeUniformWoodenBarm, scrapeUniformAluminumBarm,- scrapeVibraphone1m, scrapeVibraphone2m, scrapeChalandiPlatesm, scrapeTibetanBowl152m, scrapeTibetanBowl140m, scrapeWineGlassm,- scrapeSmallHandbellm, scrapeAlbertClockBellBelfastm, scrapeWoodBlockm,+ -- ** Scrape monosynth+ -- | Unfortunately they don't work with @atMonoMidi@. Though @atNote@ works fine.+ scrapeDahinam, scrapeBanyanm, scrapeXylophonem, scrapeTibetanBowl180m, scrapeSpinelSpherem, scrapePotLidm, scrapeRedCedarWoodPlatem,+ scrapeTubularBellm, scrapeRedwoodPlatem, scrapeDouglasFirWoodPlatem, scrapeUniformWoodenBarm, scrapeUniformAluminumBarm,+ scrapeVibraphone1m, scrapeVibraphone2m, scrapeChalandiPlatesm, scrapeTibetanBowl152m, scrapeTibetanBowl140m, scrapeWineGlassm,+ scrapeSmallHandbellm, scrapeAlbertClockBellBelfastm, scrapeWoodBlockm, - scrapePadDahinam, scrapePadBanyanm, scrapePadXylophonem, scrapePadTibetanBowl180m, scrapePadSpinelSpherem, scrapePadPotLidm,- scrapePadRedCedarWoodPlatem, scrapePadTubularBellm, scrapePadRedwoodPlatem, scrapePadDouglasFirWoodPlatem, scrapePadUniformWoodenBarm,- scrapePadUniformAluminumBarm, scrapePadVibraphone1m, scrapePadVibraphone2m, scrapePadChalandiPlatesm, scrapePadTibetanBowl152m,- scrapePadTibetanBowl140m, scrapePadWineGlassm, scrapePadSmallHandbellm, scrapePadAlbertClockBellBelfastm, scrapePadWoodBlockm,+ scrapePadDahinam, scrapePadBanyanm, scrapePadXylophonem, scrapePadTibetanBowl180m, scrapePadSpinelSpherem, scrapePadPotLidm,+ scrapePadRedCedarWoodPlatem, scrapePadTubularBellm, scrapePadRedwoodPlatem, scrapePadDouglasFirWoodPlatem, scrapePadUniformWoodenBarm,+ scrapePadUniformAluminumBarm, scrapePadVibraphone1m, scrapePadVibraphone2m, scrapePadChalandiPlatesm, scrapePadTibetanBowl152m,+ scrapePadTibetanBowl140m, scrapePadWineGlassm, scrapePadSmallHandbellm, scrapePadAlbertClockBellBelfastm, scrapePadWoodBlockm, - -- * Woodwind+ -- * Woodwind - Wind(..), woodWind',+ Wind(..), woodWind', - fluteSpec, shortFluteSpec,- flute, shortFlute, fluteVibrato, mutedFlute, brightFlute,+ fluteSpec, shortFluteSpec,+ flute, shortFlute, fluteVibrato, mutedFlute, brightFlute, - bassClarinetSpec, shortBassClarinetSpec,- bassClarinet, shortBassClarinet, bassClarinetVibrato, mutedBassClarinet, brightBassClarinet,+ bassClarinetSpec, shortBassClarinetSpec,+ bassClarinet, shortBassClarinet, bassClarinetVibrato, mutedBassClarinet, brightBassClarinet, - frenchHornSpec, shortFrenchHornSpec,- frenchHorn, shortFrenchHorn, frenchHornVibrato, mutedFrenchHorn, brightFrenchHorn,+ frenchHornSpec, shortFrenchHornSpec,+ frenchHorn, shortFrenchHorn, frenchHornVibrato, mutedFrenchHorn, brightFrenchHorn, - shengSpec, shortShengSpec,- sheng, shortSheng, shengVibrato, mutedSheng, brightSheng,+ shengSpec, shortShengSpec,+ sheng, shortSheng, shengVibrato, mutedSheng, brightSheng, - hulusiSpec, shortHulusiSpec,- hulusi, shortHulusi, hulusiVibrato, mutedHulusi, brightHulusi,+ hulusiSpec, shortHulusiSpec,+ hulusi, shortHulusi, hulusiVibrato, mutedHulusi, brightHulusi, - diziSpec, shortDiziSpec,- dizi, shortDizi, diziVibrato, mutedDizi, brightDizi,+ diziSpec, shortDiziSpec,+ dizi, shortDizi, diziVibrato, mutedDizi, brightDizi, - -- * SHARC instruments- SharcInstr,- soloSharc, orcSharc, padSharc, purePadSharc,- dreamSharc, lightIsTooBrightSharc, whaleSongSharc,- sharcOrgan,+ -- * SHARC instruments+ SharcInstr,+ soloSharc, orcSharc, padSharc, purePadSharc,+ dreamSharc, lightIsTooBrightSharc, whaleSongSharc,+ sharcOrgan, - -- ** Padsynth instruments- PadSharcSpec(..),+ -- ** Padsynth instruments+ PadSharcSpec(..), - psOrganSharc, psOrganSharc', psLargeOrganSharc, psLargeOrganSharc', psPianoSharc, psPianoSharc',- xpsPianoSharc, xpsPianoSharc',- psPadSharc, psPadSharc', psSoftPadSharc, psSoftPadSharc',- psMagicPadSharc, psMagicPadSharc', psMagicSoftPadSharc, psMagicSoftPadSharc',- psLargePianoSharc, psLargePianoSharc',- xpsLargePianoSharc,- xpsLargePianoSharc',+ psOrganSharc, psOrganSharc', psLargeOrganSharc, psLargeOrganSharc', psPianoSharc, psPianoSharc',+ xpsPianoSharc, xpsPianoSharc',+ psPadSharc, psPadSharc', psSoftPadSharc, psSoftPadSharc',+ psMagicPadSharc, psMagicPadSharc', psMagicSoftPadSharc, psMagicSoftPadSharc',+ psLargePianoSharc, psLargePianoSharc',+ xpsLargePianoSharc,+ xpsLargePianoSharc', - -- *** Deep pads- psDeepPadSharc, psDeepPadSharc', psDeepSoftPadSharc, psDeepSoftPadSharc',- psDeepMagicPadSharc, psDeepMagicPadSharc', psDeepMagicSoftPadSharc, psDeepMagicSoftPadSharc',+ -- *** Deep pads+ psDeepPadSharc, psDeepPadSharc', psDeepSoftPadSharc, psDeepSoftPadSharc',+ psDeepMagicPadSharc, psDeepMagicPadSharc', psDeepMagicSoftPadSharc, psDeepMagicSoftPadSharc', - --- *** Crossfades- psPadSharcCfd, psPadSharcCfd', psPadSharcCfd4, psPadSharcCfd4', psDeepPadSharcCfd, psDeepPadSharcCfd',- psDeepPadSharcCfd4, psDeepPadSharcCfd4', psSoftPadSharcCfd, psSoftPadSharcCfd', psSoftPadSharcCfd4, psSoftPadSharcCfd4',- psDeepSoftPadSharcCfd, psDeepSoftPadSharcCfd', psDeepSoftPadSharcCfd4, psDeepSoftPadSharcCfd4',+ --- *** Crossfades+ psPadSharcCfd, psPadSharcCfd', psPadSharcCfd4, psPadSharcCfd4', psDeepPadSharcCfd, psDeepPadSharcCfd',+ psDeepPadSharcCfd4, psDeepPadSharcCfd4', psSoftPadSharcCfd, psSoftPadSharcCfd', psSoftPadSharcCfd4, psSoftPadSharcCfd4',+ psDeepSoftPadSharcCfd, psDeepSoftPadSharcCfd', psDeepSoftPadSharcCfd4, psDeepSoftPadSharcCfd4', - -- *** High resolution Padsynth instruments- psOrganSharcHifi,- psLargeOrganSharcHifi,- psPianoSharcHifi,- xpsPianoSharcHifi,- psPadSharcHifi,- psSoftPadSharcHifi,- psMagicPadSharcHifi,- psMagicSoftPadSharcHifi,- psLargePianoSharcHifi,- xpsLargePianoSharcHifi,+ -- *** High resolution Padsynth instruments+ psOrganSharcHifi,+ psLargeOrganSharcHifi,+ psPianoSharcHifi,+ xpsPianoSharcHifi,+ psPadSharcHifi,+ psSoftPadSharcHifi,+ psMagicPadSharcHifi,+ psMagicSoftPadSharcHifi,+ psLargePianoSharcHifi,+ xpsLargePianoSharcHifi, - -- *** Vedic pads- -- | Deep spiritual pads.- vedicPad, vedicPadCfd, vedicPadCfd4, vibhu, rishi, agni, prakriti, rajas, avatara, bhumi,+ -- *** Vedic pads+ -- | Deep spiritual pads.+ vedicPad, vedicPadCfd, vedicPadCfd4, vibhu, rishi, agni, prakriti, rajas, avatara, bhumi, - --- *** High resolution vedic pads- -- | Deep spiritual pads.- vedicPadHifi, vibhuHifi, rishiHifi, agniHifi, prakritiHifi, rajasHifi, avataraHifi, bhumiHifi,+ --- *** High resolution vedic pads+ -- | Deep spiritual pads.+ vedicPadHifi, vibhuHifi, rishiHifi, agniHifi, prakritiHifi, rajasHifi, avataraHifi, bhumiHifi, - --- *** Low resolution vedic pads- -- | Deep spiritual pads.- vedicPadLofi, vibhuLofi, rishiLofi, agniLofi, prakritiLofi, rajasLofi, avataraLofi, bhumiLofi,+ --- *** Low resolution vedic pads+ -- | Deep spiritual pads.+ vedicPadLofi, vibhuLofi, rishiLofi, agniLofi, prakritiLofi, rajasLofi, avataraLofi, bhumiLofi, - --- *** Crossfade vedic pads- -- | Crossfade between deep spiritual pads. All pads take in padsynthBandwidth and crossfade level as parameters.- vibhuRishi, vibhuAgni, vibhuPrakriti, vibhuRajas, vibhuAvatara, vibhuBhumi, rishiAgni, rishiPrakriti,- rishiRajas, rishiAvatara, rishiBhumi, agniPrakriti, agniRajas, agniAvatara, agniBhumi, prakritiRajas,- prakritiAvatara, prakritiBhumi, rajasAvatara, rajasBhumi, avataraBhumi,+ --- *** Crossfade vedic pads+ -- | Crossfade between deep spiritual pads. All pads take in padsynthBandwidth and crossfade level as parameters.+ vibhuRishi, vibhuAgni, vibhuPrakriti, vibhuRajas, vibhuAvatara, vibhuBhumi, rishiAgni, rishiPrakriti,+ rishiRajas, rishiAvatara, rishiBhumi, agniPrakriti, agniRajas, agniAvatara, agniBhumi, prakritiRajas,+ prakritiAvatara, prakritiBhumi, rajasAvatara, rajasBhumi, avataraBhumi, - -- ** concrete instruments- shViolin, shViolinPizzicato, shViolinMuted, shViolinMarteleBowing, shViolinsEnsemble, shViola, shViolaPizzicato, shViolaMuted,+ -- ** concrete instruments+ shViolin, shViolinPizzicato, shViolinMuted, shViolinMarteleBowing, shViolinsEnsemble, shViola, shViolaPizzicato, shViolaMuted, shViolaMarteleBowing, shTuba, shTromboneMuted, shTrombone, shPiccolo, shOboe, shFrenchHornMuted, shFrenchHorn, shFlute, shEnglishHorn, shClarinetEflat, shTrumpetMutedC, shTrumpetC, shContrabassClarinet, shContrabassoon, shCello, shCelloPizzicato, shCelloMuted, shCelloMarteleBowing, shContrabassPizzicato, shContrabassMuted, shContrabassMarteleBowing, shContrabass, shClarinet, shBassTrombone, shBassClarinet, shBassoon, shBassFlute, shTrumpetBach, shAltoTrombone, shAltoFlute, - -- * X-rays- pulseWidth, xanadu, alienIsAngry, noiz, blue, black, simpleMarimba, impulseMarimba1, impulseMarimba2, okComputer, noiseBell,+ -- * X-rays+ pulseWidth, xanadu, alienIsAngry, noiz, blue, black, simpleMarimba, impulseMarimba1, impulseMarimba2, okComputer, noiseBell, - -- * Robotic vowels- robotVowels, robotLoopVowels, robotVowel,+ -- * Robotic vowels+ robotVowels, robotLoopVowels, robotVowel, - -- ** Vowels+ -- ** Vowels maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH, femaleA, femaleE, femaleIY, femaleO, femaleOO, - -- * Nature- windWall, mildWind, wind, snowCrackle,+ -- * Nature+ windWall, mildWind, wind, snowCrackle, - -- * Misc- -- limRel,- singleFx, singleFx'+ -- * Misc+ limRel,+ singleFx, singleFx' ) where -import Control.Monad+import Prelude hiding (filter) -import Csound.Base+import Csound.Base hiding (ampCps, br, seed, filt, detune, mute)+import qualified Csound.Base as C(br, filt) import qualified Csound.Catalog.Wave as C import qualified Csound.Catalog.Reson as C@@ -236,30 +238,26 @@ femaleA, femaleE, femaleIY, femaleO, femaleOO) import Csound.Catalog.Wave(Accordeon(..),- ReleaseTime,- SharcInstr,- PadSharcSpec(..),- shViolin, shViolinPizzicato, shViolinMuted, shViolinMarteleBowing, shViolinsEnsemble, shViola, shViolaPizzicato, shViolaMuted,+ ReleaseTime,+ SharcInstr,+ PadSharcSpec(..),+ shViolin, shViolinPizzicato, shViolinMuted, shViolinMarteleBowing, shViolinsEnsemble, shViola, shViolaPizzicato, shViolaMuted, shViolaMarteleBowing, shTuba, shTromboneMuted, shTrombone, shPiccolo, shOboe, shFrenchHornMuted, shFrenchHorn, shFlute, shEnglishHorn, shClarinetEflat, shTrumpetMutedC, shTrumpetC, shContrabassClarinet, shContrabassoon, shCello, shCelloPizzicato, shCelloMuted, shCelloMarteleBowing, shContrabassPizzicato, shContrabassMuted, shContrabassMarteleBowing, shContrabass, shClarinet, shBassTrombone, shBassClarinet, shBassoon, shBassFlute, shTrumpetBach, shAltoTrombone, shAltoFlute) -import Data.Char monoArgToNote :: MonoArg -> (Sig, Sig) monoArgToNote arg = (monoAmp arg * monoGate arg, monoCps arg) monoSig1 :: SigSpace a => (Sig -> a) -> (MonoArg -> a) monoSig1 f arg = mul env $ f cps- where- env = amp * monoAdsr arg 0.35 0.5 1 0.5- amp = port (monoAmp arg) 0.01- cps = portk (monoCps arg) (delay1 gate * 0.01)- gate = monoGate arg--onSig1 :: SigSpace a => (Sig -> a) -> Sig2 -> a-onSig1 f (amp, cps) = mul amp $ f cps+ where+ env = amp * monoAdsr arg 0.35 0.5 1 0.5+ amp = port (monoAmp arg) 0.01+ cps = portk (monoCps arg) (delay1 gate * 0.01)+ gate = monoGate arg fx1 :: Sig -> (a -> a) -> Patch a -> Patch a fx1 dw f = FxChain [fxSpec dw (return . f)]@@ -288,26 +286,26 @@ -- electric pianos data Epiano1 = Epiano1- { epiano1Rel :: D }+ { epiano1Rel :: D } instance Default Epiano1 where- def = Epiano1 5+ def = Epiano1 5 epiano1 = epiano1' def epiano1' (Epiano1 rel) = withLargeHall $ polySynt $ \a -> mul 0.4 $ C.simpleFading rel a data MutedPiano = MutedPiano- { mutedPianoMute :: Sig- , mutedPianoRel :: D }+ { mutedPianoMute :: Sig+ , mutedPianoRel :: D } instance Default MutedPiano where- def = MutedPiano 0.5 7+ def = MutedPiano 0.5 7 mutedPiano = mutedPiano' def mutedPiano' (MutedPiano mute rel) = fx1 0.25 (largeHall2 . at (mlp3 (250 + 7000 * mute) 0.2)) $- polySynt $ \a -> mul 0.7 $ C.simpleSust rel a+ polySynt $ \a -> mul 0.7 $ C.simpleSust rel a amPiano = fx1 0.25 id $ polySyntFilter $ \filter -> mul 1.4 . onCps (C.amPianoBy filter) @@ -317,13 +315,13 @@ epianoReleaseTime = 0.25 epiano2 = addHammer 0.15 $ fx1 0.25 smallHall2 $- polySyntFilter $ \filter -> mul 1.125 . at fromMono . (onCps $ C.epianoBy filter epianoReleaseTime [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 2.01 1])+ polySyntFilter $ \filter -> mul 1.125 . at fromMono . (onCps $ C.epianoBy filter epianoReleaseTime [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 2.01 1]) epianoHeavy = addHammer 0.15 $ fx1 0.2 smallHall2 $- polySyntFilter $ \filter -> mul 1.125 . at fromMono . (onCps $ C.epianoBy filter epianoReleaseTime [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 2.01 1, C.EpianoOsc 8 15 0.5 0.5])+ polySyntFilter $ \filter -> mul 1.125 . at fromMono . (onCps $ C.epianoBy filter epianoReleaseTime [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 2.01 1, C.EpianoOsc 8 15 0.5 0.5]) epianoBright = addHammer 0.15 $ fx1 0.2 smallHall2 $- polySyntFilter $ \filter -> mul 1.12 . at fromMono . (onCps $ C.epianoBy filter epianoReleaseTime [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])+ polySyntFilter $ \filter -> mul 1.12 . at fromMono . (onCps $ C.epianoBy filter epianoReleaseTime [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]) vibraphonePiano1 = vibraphoneToPiano smallVibraphone1 vibraphonePiano2 = vibraphoneToPiano smallVibraphone2@@ -341,10 +339,10 @@ -- [0, 30] data HammondOrgan = HammondOrgan- { hammondOrganDetune :: Sig }+ { hammondOrganDetune :: Sig } instance Default HammondOrgan where- def = HammondOrgan 12+ def = HammondOrgan 12 hammondOrgan = hammondOrgan' def @@ -397,7 +395,7 @@ data Choir = Choir { choirVibr :: Sig } instance Default Choir where- def = Choir 7+ def = Choir 7 tenor' filt (Choir vib) = withSmallHall $ polySynt $ at fromMono . mul 0.15 . onCps (C.tenorOsc filt vib) soprano' filt (Choir vib) = withSmallHall $ polySynt $ at fromMono . mul 0.15 . onCps (C.sopranoOsc filt vib)@@ -415,12 +413,12 @@ choirU' = choir' singU data NoisyChoir = NoisyChoir- { noisyChoirFilterNum :: Int- , noisyChoirBw :: Sig- }+ { noisyChoirFilterNum :: Int+ , noisyChoirBw :: Sig+ } instance Default NoisyChoir where- def = NoisyChoir 2 25+ def = NoisyChoir 2 25 windSings = longNoisyChoir' (NoisyChoir 1 15) @@ -479,7 +477,7 @@ data RazorPad = RazorPad { razorPadSpeed :: Sig } instance Default RazorPad where- def = RazorPad 0.5+ def = RazorPad 0.5 razorPadSlow = razorPad' (def { razorPadSpeed = 0.1 }) razorPadFast = razorPad' (def { razorPadSpeed = 1.7 })@@ -566,7 +564,7 @@ ------------------------------------ -- leads -polySynthFxChain = FxChain [fxSpec 0.25 (return . largeHall2), fxSpec 0.25 (return . (at $ echo 0.25 0.65)), fxSpec 0.25 (at $ chorus 0.07 1.25 1), fxSpecFilter 1 $ \filter -> return . at (filter 5500 0.12 . filt 2 br 18000 0.3)]+polySynthFxChain = FxChain [fxSpec 0.25 (return . largeHall2), fxSpec 0.25 (return . (at $ echo 0.25 0.65)), fxSpec 0.25 (at $ chorus 0.07 1.25 1), fxSpecFilter 1 $ \filter -> return . at (filter 5500 0.12 . C.filt 2 C.br 18000 0.3)] polySynth = polySynthFxChain $ polySynt $ fmap fromMono . onCps C.polySynth polySynthm = polySynthFxChain $ monoSynt $ fmap fromMono . monoSig1 C.polySynth@@ -574,11 +572,11 @@ phasingLead = withSmallHall $ polySynt $ at fromMono . mul (0.7 * fadeOut 0.05) . onCps (uncurry C.phasingSynth) data RazorLead = RazorLead- { razorLeadBright :: Sig- , razorLeadSpeed :: Sig }+ { razorLeadBright :: Sig+ , razorLeadSpeed :: Sig } instance Default RazorLead where- def = RazorLead 0.5 0.5+ def = RazorLead 0.5 0.5 razorLeadSlow = razorLead' (def { razorLeadSpeed = 0.1 }) razorLeadFast = razorLead' (def { razorLeadSpeed = 1.7 })@@ -606,7 +604,7 @@ fmBass1 = adsrMono (\env (amp, cps) -> return $ fromMono $ C.fmBass1 env (amp, cps)) fmBass2 = fxs $ adsrMono (\env (amp, cps) -> return $ fromMono $ C.fmBass2 env (amp, cps))- where fxs = FxChain [fxSpec 1 (at (chorus 0.2 0.15 0.17)), fxSpec 1 (return . at (bhp 35 . blp 1200))]+ where fxs = FxChain [fxSpec 1 (at (chorus 0.2 0.15 0.17)), fxSpec 1 (return . at (bhp 35 . blp 1200))] -- | The first argument is the amount of deepBass to mix into the original patch. withDeepBass :: Sig -> Patch2 -> Patch2@@ -630,75 +628,75 @@ -- 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- }+ { strikeRel :: D+ , strikeHasDelay :: Bool+ , strikeReverb :: Sig2 -> Sig2+ } instance Default Strike where- def = Strike 1.5 True smallHall2+ def = Strike 1.5 True smallHall2 strike' :: Strike -> (Sig -> Sig) -> Patch2 strike' spec instr = fx1' 0.25 (strikeFx spec) $ polySynt $ \x@(amp, cps) -> return $ fromMono $ mul (0.75 * sig amp * fadeOut (rel x)) $ instr (sig cps)- where rel a = strikeRelease a 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+ Small -> Medium+ Medium -> Large+ Large -> Huge+ Huge -> Huge prevSize x = case x of- Small -> Small- Medium -> Small- Large -> Medium- Huge -> Large+ 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 }+ { 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+ 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+ 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+ Small -> 0.85+ Medium -> 0.75+ Large -> 0.6+ Huge -> 0.45 toHasDelay :: Size -> Bool toHasDelay x = case x of- Small -> False- _ -> True+ Small -> False+ _ -> True -dahinaSize = Small-banyanSize = Medium-xylophoneSize = Small-tibetanBowl152Size = Medium-tibetanBowl140Size = Small-tibetanBowl180Size = Medium-spinelSphereSize = Small-potLidSize = Medium+dahinaSize = Small+banyanSize = Medium+xylophoneSize = Small+tibetanBowl152Size = Medium+tibetanBowl140Size = Small+tibetanBowl180Size = Medium+spinelSphereSize = Small+potLidSize = Medium redCedarWoodPlateSize = Small-tubularBellSize = Large-redwoodPlateSize = Small+tubularBellSize = Large+redwoodPlateSize = Small douglasFirWoodPlateSize = Small uniformWoodenBarSize = Small uniformAluminumBarSize = Small@@ -724,7 +722,7 @@ mediumStrike' :: Size -> Size -> (Sig -> Sig) -> Patch2 mediumStrike' revSize size f = mapPatchInstr (\instr -> mul (toGain size) . instr) p- where p = strike' (toStrikeSpec revSize size) f+ where p = strike' (toStrikeSpec revSize size) f smallDahina = smallStrike dahinaSize C.dahina@@ -837,11 +835,6 @@ -- 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) @@ -851,7 +844,7 @@ scrapem k m = fx1 0.15 largeHall2 $ monoSynt $ (\(amp, cps) -> (mul (0.75 * amp * k * fades 0.5 1.97) . at fromMono . C.scrapeModes m) cps) . monoArgToNote -scrapePad k m = fx1 0.15 largeHall2 $ polySynt $ \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.5 (scrapeRelease x 2.27 )) . at fromMono . C.scrapeModes m) (sig cps)+scrapePad k m = fx1 0.15 largeHall2 $ polySynt $ \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.5 (scrapeRelease x 2.27 )) . at fromMono . C.scrapeModes m) (sig cps) scrapePadm k m = fx1 0.15 largeHall2 $ monoSynt $ (\(amp, cps) -> (mul (0.75 * amp * k * fades 0.5 2.27) . at fromMono . C.scrapeModes m) cps) . monoArgToNote @@ -992,264 +985,264 @@ -- woodwind data Wind = Wind- { windAtt :: D- , windDec :: D- , windSus :: D- , windVib :: D- , windBright :: D }+ { windAtt :: D+ , windDec :: D+ , windSus :: D+ , windVib :: D+ , windBright :: D } woodWind' spec instr = withSmallHall $ polySynt $ \(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+ 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 -- flute fluteSpec bright vib = Wind- { windAtt = 0.08- , windDec = 0.1- , windSus = 20- , windVib = vib- , windBright = bright }+ { 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 }+ { 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+ where+ br = 0.7+ vib = 0.015 shortFlute = woodWind' (shortFluteSpec br vib) C.flute- where- br = 0.7- vib = 0.015+ where+ br = 0.7+ vib = 0.015 fluteVibrato = woodWind' (fluteSpec br vib) C.flute- where- br = 0.7- vib = 0.04+ where+ br = 0.7+ vib = 0.04 mutedFlute = woodWind' (fluteSpec br vib) C.flute- where- br = 0.25- vib = 0.015+ where+ br = 0.25+ vib = 0.015 brightFlute = woodWind' (fluteSpec br vib) C.flute- where- br = 1.2- vib = 0.015+ 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 }+ { 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 }+ { 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+ where+ br = 0.7+ vib = 0.01 shortBassClarinet = woodWind' (shortBassClarinetSpec br vib) C.bassClarinet- where- br = 0.7- vib = 0.01+ where+ br = 0.7+ vib = 0.01 bassClarinetVibrato = woodWind' (bassClarinetSpec br vib) C.bassClarinet- where- br = 0.7- vib = 0.035+ where+ br = 0.7+ vib = 0.035 mutedBassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet- where- br = 0.25- vib = 0.01+ where+ br = 0.25+ vib = 0.01 brightBassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet- where- br = 1.2- vib = 0.01+ 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 }+ { 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 }+ { 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+ where+ br = 0.7+ vib = 0.01 shortFrenchHorn = woodWind' (shortFrenchHornSpec br vib) C.frenchHorn- where- br = 0.7- vib = 0.01+ where+ br = 0.7+ vib = 0.01 frenchHornVibrato = woodWind' (frenchHornSpec br vib) C.frenchHorn- where- br = 0.7- vib = 0.035+ where+ br = 0.7+ vib = 0.035 mutedFrenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn- where- br = 0.25- vib = 0.01+ where+ br = 0.25+ vib = 0.01 brightFrenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn- where- br = 1.2- vib = 0.01+ where+ br = 1.2+ vib = 0.01 -- sheng shengSpec bright vib = Wind- { windAtt = 0.1- , windDec = 0.2- , windSus = 20- , windVib = vib- , windBright = bright }+ { 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 }+ { 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+ where+ br = 0.7+ vib = 0.01 shortSheng = woodWind' (shortShengSpec br vib) C.sheng- where- br = 0.7- vib = 0.01+ where+ br = 0.7+ vib = 0.01 shengVibrato = woodWind' (shengSpec br vib) C.sheng- where- br = 0.7- vib = 0.025+ where+ br = 0.7+ vib = 0.025 mutedSheng = woodWind' (shengSpec br vib) C.sheng- where- br = 0.25- vib = 0.01+ where+ br = 0.25+ vib = 0.01 brightSheng = woodWind' (shortShengSpec br vib) C.sheng- where- br = 1.2- vib = 0.01+ where+ br = 1.2+ vib = 0.01 -- hulusi hulusiSpec bright vib = Wind- { windAtt = 0.12- , windDec = 0.14- , windSus = 20- , windVib = vib- , windBright = bright }+ { 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 }+ { 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+ where+ br = 0.7+ vib = 0.015 shortHulusi = woodWind' (shortHulusiSpec br vib) C.hulusi- where- br = 0.7- vib = 0.015+ where+ br = 0.7+ vib = 0.015 hulusiVibrato = woodWind' (hulusiSpec br vib) C.hulusi- where- br = 0.7- vib = 0.035+ where+ br = 0.7+ vib = 0.035 mutedHulusi = woodWind' (hulusiSpec br vib) C.hulusi- where- br = 0.25- vib = 0.015+ where+ br = 0.25+ vib = 0.015 brightHulusi = woodWind' (shortHulusiSpec br vib) C.hulusi- where- br = 1.2- vib = 0.015+ where+ br = 1.2+ vib = 0.015 -- dizi diziSpec bright vib = Wind- { windAtt = 0.03- , windDec = 0.2- , windSus = 20- , windVib = vib- , windBright = bright }+ { 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 }+ { 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+ where+ br = 0.7+ vib = 0.01 shortDizi = woodWind' (shortDiziSpec br vib) C.dizi- where- br = 0.7- vib = 0.01+ where+ br = 0.7+ vib = 0.01 diziVibrato = woodWind' (diziSpec br vib) C.dizi- where- br = 0.7- vib = 0.035+ where+ br = 0.7+ vib = 0.035 mutedDizi = woodWind' (diziSpec br vib) C.dizi- where- br = 0.25- vib = 0.01+ where+ br = 0.25+ vib = 0.01 brightDizi = woodWind' (shortDiziSpec br vib) C.dizi- where- br = 1.2- vib = 0.01+ where+ br = 1.2+ vib = 0.01 ------------------------------------ -- x-rays@@ -1417,7 +1410,7 @@ psPadFilterBy :: Sig -> Sig -> (Sig -> Sig -> Sig -> Sig) -> (D, D) -> Sig -> Sig psPadFilterBy rippleLevel q resonFilter ampCps = resonFilter (0.3 * (sig $ snd ampCps) + 2500 + 2000 * fades 0.15 (0.6 + rel ampCps) + rippleLevel * slope 0.75 0.5 * osc 8) q- where rel (amp, cps) = amp - cps / 3500+ where rel (amp, cps) = amp - cps / 3500 psPadFilter filter = psPadFilterBy 75 15 filter psSoftPadFilter filter = psPadFilterBy 350 0.15 filter@@ -1435,8 +1428,9 @@ psDeepOscCfd4 koeffX koeffY (spec1, sh1) (spec2, sh2) (spec3, sh3) (spec4, sh4) = deepOsc (psOscCfd4 koeffX koeffY (spec1, sh1) (spec2, sh2) (spec3, sh3) (spec4, sh4)) genPsPad :: (Sig2 -> Sig2) -> (ResonFilter -> (D, D) -> Sig -> Sig) -> (D -> SE Sig2) -> Patch2-genPsPad effect mkFilter wave = fxs $ polySyntFilter $ \filter ampCps -> mul (1.2 * fades 0.5 (0.6 + rel ampCps)) $ onCps (at (mkFilter filter ampCps) . wave) ampCps- where+genPsPad effect mkFilter wave =+ fxs $ polySyntFilter $ \filter ampCps -> mul (1.2 * fades 0.5 (0.6 + rel ampCps)) $ onCps (at (mkFilter filter ampCps) . wave) ampCps+ where fxs = FxChain [fxSpec 0.25 (return . effect), fxSpec 0.5 (return . (at $ mul 2.1 . saturator 0.75)), fxSpec 0.3 (return . (at $ echo 0.125 0.65))] rel (amp, cps) = amp - cps / 3500 @@ -1581,10 +1575,6 @@ psDeepMagicSoftPadSharc' :: PadSharcSpec -> SharcInstr -> Patch2 psDeepMagicSoftPadSharc' spec sh = genPsPad magicCave2 psSoftPadFilter (psDeepOsc spec sh) -vedicSize = 15-vedicSizeHifi = 32-vedicSizeLofi = 4- -- | Deep spiritual drones. -- -- > vedicPad sharcInstrument bandwidth@@ -1592,8 +1582,8 @@ -- Good values for bandwidth lies in the interval [0, 120] vedicPad :: SharcInstr -> PadsynthBandwidth -> Patch2 vedicPad instr bandwidth = mul 0.8 $- addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $- psDeepSoftPadSharc' (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }) instr+ addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $+ psDeepSoftPadSharc' (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }) instr -- | Deep spiritual drones. Crossfade between two instruments. --@@ -1602,8 +1592,8 @@ -- Good values for bandwidth lies in the interval [0, 120] vedicPadCfd :: Sig -> SharcInstr -> SharcInstr -> PadsynthBandwidth -> Patch2 vedicPadCfd k instr1 instr2 bandwidth = mul 0.8 $- addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $- psDeepSoftPadSharcCfd' k (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr1) (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr2)+ addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $+ psDeepSoftPadSharcCfd' k (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr1) (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr2) -- | Deep spiritual drones. Crossfade between four instruments. --@@ -1612,10 +1602,10 @@ -- Good values for bandwidth lies in the interval [0, 120] vedicPadCfd4 :: Sig -> Sig -> SharcInstr -> SharcInstr -> SharcInstr -> SharcInstr -> PadsynthBandwidth -> Patch2 vedicPadCfd4 kX kY instr1 instr2 instr3 instr4 bandwidth = mul 0.8 $- addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $- psDeepSoftPadSharcCfd4' kX kY- (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr1) (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr2)- (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr3) (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr4)+ addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $+ psDeepSoftPadSharcCfd4' kX kY+ (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr1) (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr2)+ (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr3) (def { padSharcBandwidth = bandwidth, padSharcSize = 15 }, instr4) -- | Deep spiritual drones. Contains twice as many ftables as for simple @vedicPad@.@@ -1625,9 +1615,9 @@ -- Good values for bandwidth lies in the interval [0, 120] vedicPadHifi :: SharcInstr -> PadsynthBandwidth -> Patch2 vedicPadHifi instr bandwidth = mul 0.8 $- addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $- deepPad $- psSoftPadSharc' (def { padSharcBandwidth = bandwidth, padSharcSize = 32 }) instr+ addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $+ deepPad $+ psSoftPadSharc' (def { padSharcBandwidth = bandwidth, padSharcSize = 32 }) instr -- | Deep spiritual drones. Contains only quater of ftables as for simple @vedicPad@. --@@ -1636,9 +1626,9 @@ -- Good values for bandwidth lies in the interval [0, 120] vedicPadLofi :: SharcInstr -> PadsynthBandwidth -> Patch2 vedicPadLofi instr bandwidth = mul 0.8 $- addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $- deepPad $- psSoftPadSharc' (def { padSharcBandwidth = bandwidth, padSharcSize = 4 }) instr+ addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $+ deepPad $+ psSoftPadSharc' (def { padSharcBandwidth = bandwidth, padSharcSize = 4 }) instr -- | Eminent vibhu :: PadsynthBandwidth -> Patch2@@ -1813,16 +1803,16 @@ noisyRise :: Patch2 noisyRise = fxs $ polySynt $ onCps $ \cps -> mul 0.24 $ wave cps- where- fxs = FxChain [fxSpec 0.35 (return . largeHall2), fxSpec 0.5 (return . (at $ echo 0.25 0.85))]- wave x = noisy x + pad x- noisy x = at (mul 0.3 . fromMono . bat (bp (x * 5) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3]) 14) white- pad x = envelope $ filter x $ padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2))+ where+ fxs = FxChain [fxSpec 0.35 (return . largeHall2), fxSpec 0.5 (return . (at $ echo 0.25 0.85))]+ wave x = noisy x + pad x+ noisy x = at (mul 0.3 . fromMono . bat (bp (x * 5) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3]) 14) white+ pad x = envelope $ filter x $ padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2)) - envelope asig = mul (fades 0.5 0.7) asig- filter cps asig = at (bhp 30) $ bat (lp (200 + (cps + 3000)) 45) $ asig+ envelope asig = mul (fades 0.5 0.7) asig+ filter cps asig = at (bhp 30) $ bat (lp (200 + (cps + 3000)) 45) $ asig - spec = noisySpec+ spec = noisySpec noisySpiral :: Patch2 noisySpiral = noisySpiral' 8@@ -1832,16 +1822,16 @@ -- > noisySpiral' finalSpeedOfOscillation noisySpiral' :: D -> Patch2 noisySpiral' spiralSpeed = fxs $ polySynt $ onCps $ \cps -> mul 0.24 $ wave cps- where- fxs = FxChain [fxSpec 0.15 (return . magicCave2), fxSpec 0.43 (return . (at $ echo 0.35 0.85))]+ where+ fxs = FxChain [fxSpec 0.15 (return . magicCave2), fxSpec 0.43 (return . (at $ echo 0.35 0.85))] - wave x = noisy x + pad x- noisy x = at (mul 0.3 . fromMono . bat (bp (x * 5) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3] * uosc (expseg [0.25, 5, spiralSpeed])) 14) white- pad x = envelope $ filter x $ padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2))- envelope asig = mul (fades 0.5 0.7) asig- filter cps asig = at (bhp 30) $ bat (lp (200 + (cps + 3000)) 45) $ asig+ wave x = noisy x + pad x+ noisy x = at (mul 0.3 . fromMono . bat (bp (x * 5) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3] * uosc (expseg [0.25, 5, spiralSpeed])) 14) white+ pad x = envelope $ filter x $ padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2))+ envelope asig = mul (fades 0.5 0.7) asig+ filter cps asig = at (bhp 30) $ bat (lp (200 + (cps + 3000)) 45) $ asig - spec = noisySpec+ spec = noisySpec noisyHarms = [ 1, 1, 0.7600046992, 0.6199994683, 0.9399998784, 0.4400023818, 0.0600003302, 0.8499968648, 0.0899999291, 0.8199964762, 0.3199984133, 0.9400014281, 0.3000001907, 0.120003365, 0.1799997687, 0.5200006366] noisySpec = defPadsynthSpec 82.2 noisyHarms