diff --git a/csound-catalog.cabal b/csound-catalog.cabal --- a/csound-catalog.cabal +++ b/csound-catalog.cabal @@ -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 diff --git a/src/Csound/Catalog/Drum.hs b/src/Csound/Catalog/Drum.hs --- a/src/Csound/Catalog/Drum.hs +++ b/src/Csound/Catalog/Drum.hs @@ -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 diff --git a/src/Csound/Catalog/Drum/Hm.hs b/src/Csound/Catalog/Drum/Hm.hs --- a/src/Csound/Catalog/Drum/Hm.hs +++ b/src/Csound/Catalog/Drum/Hm.hs @@ -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 diff --git a/src/Csound/Catalog/Drum/MiniPops.hs b/src/Csound/Catalog/Drum/MiniPops.hs --- a/src/Csound/Catalog/Drum/MiniPops.hs +++ b/src/Csound/Catalog/Drum/MiniPops.hs @@ -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 diff --git a/src/Csound/Catalog/Drum/Tr808.hs b/src/Csound/Catalog/Drum/Tr808.hs --- a/src/Csound/Catalog/Drum/Tr808.hs +++ b/src/Csound/Catalog/Drum/Tr808.hs @@ -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' diff --git a/src/Csound/Catalog/Effect.hs b/src/Csound/Catalog/Effect.hs --- a/src/Csound/Catalog/Effect.hs +++ b/src/Csound/Catalog/Effect.hs @@ -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) diff --git a/src/Csound/Catalog/Reson.hs b/src/Csound/Catalog/Reson.hs --- a/src/Csound/Catalog/Reson.hs +++ b/src/Csound/Catalog/Reson.hs @@ -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 diff --git a/src/Csound/Catalog/Wave/Ac.hs b/src/Csound/Catalog/Wave/Ac.hs --- a/src/Csound/Catalog/Wave/Ac.hs +++ b/src/Csound/Catalog/Wave/Ac.hs @@ -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 diff --git a/src/Csound/Catalog/Wave/Bitwig.hs b/src/Csound/Catalog/Wave/Bitwig.hs --- a/src/Csound/Catalog/Wave/Bitwig.hs +++ b/src/Csound/Catalog/Wave/Bitwig.hs @@ -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) diff --git a/src/Csound/Catalog/Wave/Deserted.hs b/src/Csound/Catalog/Wave/Deserted.hs --- a/src/Csound/Catalog/Wave/Deserted.hs +++ b/src/Csound/Catalog/Wave/Deserted.hs @@ -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 ] diff --git a/src/Csound/Catalog/Wave/Flavio.hs b/src/Csound/Catalog/Wave/Flavio.hs --- a/src/Csound/Catalog/Wave/Flavio.hs +++ b/src/Csound/Catalog/Wave/Flavio.hs @@ -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 diff --git a/src/Csound/Catalog/Wave/Fm.hs b/src/Csound/Catalog/Wave/Fm.hs --- a/src/Csound/Catalog/Wave/Fm.hs +++ b/src/Csound/Catalog/Wave/Fm.hs @@ -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) diff --git a/src/Csound/Catalog/Wave/Misc.hs b/src/Csound/Catalog/Wave/Misc.hs --- a/src/Csound/Catalog/Wave/Misc.hs +++ b/src/Csound/Catalog/Wave/Misc.hs @@ -1,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 diff --git a/src/Csound/Catalog/Wave/Sean.hs b/src/Csound/Catalog/Wave/Sean.hs --- a/src/Csound/Catalog/Wave/Sean.hs +++ b/src/Csound/Catalog/Wave/Sean.hs @@ -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) diff --git a/src/Csound/Catalog/Wave/Sharc.hs b/src/Csound/Catalog/Wave/Sharc.hs --- a/src/Csound/Catalog/Wave/Sharc.hs +++ b/src/Csound/Catalog/Wave/Sharc.hs @@ -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 diff --git a/src/Csound/Catalog/Wave/Thor.hs b/src/Csound/Catalog/Wave/Thor.hs --- a/src/Csound/Catalog/Wave/Thor.hs +++ b/src/Csound/Catalog/Wave/Thor.hs @@ -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)) diff --git a/src/Csound/Catalog/Wave/VestigeOfTime.hs b/src/Csound/Catalog/Wave/VestigeOfTime.hs --- a/src/Csound/Catalog/Wave/VestigeOfTime.hs +++ b/src/Csound/Catalog/Wave/VestigeOfTime.hs @@ -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 diff --git a/src/Csound/Catalog/Wave/Vowel.hs b/src/Csound/Catalog/Wave/Vowel.hs --- a/src/Csound/Catalog/Wave/Vowel.hs +++ b/src/Csound/Catalog/Wave/Vowel.hs @@ -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 ] diff --git a/src/Csound/Catalog/Wave/Woodwind.hs b/src/Csound/Catalog/Wave/Woodwind.hs --- a/src/Csound/Catalog/Wave/Woodwind.hs +++ b/src/Csound/Catalog/Wave/Woodwind.hs @@ -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 ] diff --git a/src/Csound/Catalog/Wave/WoodwindAlg.hs b/src/Csound/Catalog/Wave/WoodwindAlg.hs --- a/src/Csound/Catalog/Wave/WoodwindAlg.hs +++ b/src/Csound/Catalog/Wave/WoodwindAlg.hs @@ -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 diff --git a/src/Csound/Patch.hs b/src/Csound/Patch.hs --- a/src/Csound/Patch.hs +++ b/src/Csound/Patch.hs @@ -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