diff --git a/csound-catalog.cabal b/csound-catalog.cabal --- a/csound-catalog.cabal +++ b/csound-catalog.cabal @@ -1,5 +1,5 @@ Name: csound-catalog -Version: 0.7.1 +Version: 0.7.2 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE @@ -27,7 +27,7 @@ Library Ghc-Options: -Wall Build-Depends: - base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.2.2, csound-sampler >=0.0.8.1, sharc-timbre + base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.3.2, csound-sampler >=0.0.9.0, sharc-timbre Hs-Source-Dirs: src/ Exposed-Modules: Csound.Catalog 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 @@ -3,15 +3,15 @@ -- * Subtractive dumb, dumbBass, pluckSnare, sortaKnockSweep, metalBoink, - -- * Fullkit + -- * Fullkit -- ** Non-pitched drums - snare, openHihat, closedHihat, + snare, openHihat, closedHihat, -- ** Pitched drums -- -- The instrument turns a pitch (in Hz) to the signal. - bassDrum, crash, handClap, + bassDrum, crash, handClap, bassDrum', crash', handClap', -- * Sampler @@ -21,7 +21,7 @@ import Csound.Base import Csound.Sam --- subtractive +-- subtractive bpb :: Sig -> Sig -> Sig -> Sig bpb cfq q asig = balance (bp cfq q asig) asig @@ -44,9 +44,9 @@ dumbBass :: SE Sig dumbBass = (toDrum =<<) $ fmap (bpb kfreqenv (kfreqenv / 8)) $ rand $ expseg [0.0001, 0.01, 1, 0.08, 0.01] where kfreqenv = expseg [50, 0.01, 200, 0.08, 50] - -pluckSnare :: SE Sig -pluckSnare = toDrum $ pluck kampenv4 kptchenv 50 (elins [1, 1]) 4 `withDs` [0.8, 3] + +pluckSnare :: SE Sig +pluckSnare = toDrum $ pluck kampenv4 kptchenv 50 (elins [1, 1]) 4 `withDs` [0.8, 3] where kampenv4 = linseg [0, 0.001, 1, xdur - 0.21, 1, 0.02, 0] kptchenv = linseg [100, 0.01, 300, 0.2, 200, 0.01, 200] @@ -57,16 +57,16 @@ sortaKnockSweep = (toDrum =<<) $ fmap (resonsBy bpb [ (kfreqenv41, kfreqenv41 / 8) - , (kfreqenv42, kfreqenv42 / 4) + , (kfreqenv42, kfreqenv42 / 4) ] ) $ rand kampenv4 where kfreqenv41 = expseg [ 50, 0.01, 200, 0.08, 50] - kfreqenv42 = linseg [ 150, 0.01, 1000, 0.08, 250] - kampenv4 = linseg [ 0, 0.01, 1, 0.08, 0, 0.01, 0] + kfreqenv42 = linseg [ 150, 0.01, 1000, 0.08, 250] + kampenv4 = linseg [ 0, 0.01, 1, 0.08, 0, 0.01, 0] metalBoink :: SE Sig -metalBoink = toDrum $ foscil kampenv61 30 1 6.726 kampenv62 sine +metalBoink = toDrum $ foscil kampenv61 30 1 6.726 kampenv62 sine where kampenv61 = expseg [ 0.01, 0.01, 1, 0.2, 0.1, 0.1, 0.001 ] kampenv62 = linseg [ 1, 0.1, 10, 0.1, 0.5, 0.01, 1 ] @@ -78,7 +78,7 @@ bassDrum' :: D -> SE Sig bassDrum' cps = toDrum $ env * osc (sig cps * kgliss * 0.5) where env = linseg [0, 0.00245, 1, 0.1225, 0] - kgliss = expseg [10, 0.625, 1, 0.25, 1] + kgliss = expseg [10, 0.625, 1, 0.25, 1] openHihat :: SE Sig @@ -100,9 +100,9 @@ asound <- rand 1 let as1 = butbp asound 210 55 return $ kenv2 * (as1 * 0.9 + asound * 0.8 * kenv1) - where + where kenv1 = linseg [0, 0.00176, 1, 0.1232, 0] - kenv2 = expseg [0.01, 0.0002, 1, 0.0297, 0.01, 0.09, 0.01] + kenv2 = expseg [0.01, 0.0002, 1, 0.0297, 0.01, 0.09, 0.01] crash = crash' $ cpspch 13.05 @@ -115,7 +115,7 @@ kenv2 = expseg [0.001, 0.0466, 1, 3.95, 0.001] resonator asig = 0.7 * a1 + 0.6 * kenv18 * a2 - where + where flt a = butbp asig (sig $ a * cps) (sig $ 0.5 * cps) a1 = sum $ fmap flt [1, 2.1, 2.8] a2 = comb a1 0.5 (0.5 / cps) @@ -125,7 +125,7 @@ aall = sum $ zipWith3 harm weights envelopes harmonics - harmonics = + harmonics = [ [1, 0.89, 1.12341] , [2.24, 2.4 * 0.98, 2.14 * 1.02] , [3.312, 3.513312*0.89, 3.123312*1.11] @@ -138,7 +138,7 @@ weights = replicate 7 0.2 ++ [0.1] - envelopes = fmap (\(a, b) -> expseg [0.01, a, 1, b, 0.01]) + envelopes = fmap (\(a, b) -> expseg [0.01, a, 1, b, 0.01]) [ (0.0274, 3.972) , (0.0264, 3.973) , (0.0209, 3.979) @@ -158,15 +158,15 @@ kenv2 = expseg [0.001, 0.005, 1, 0.35, 0.001] onNoise asig = aout - where + where anoise1 = kenv1 * asig anoise2 = kenv2 * asig adel1 = anoise1 - adel2 = delaySig 0.01 anoise1 - adel3 = delaySig 0.02 anoise1 - adel4 = delaySig 0.03 anoise2 - + adel2 = delaySig 0.01 anoise1 + adel3 = delaySig 0.02 anoise1 + adel4 = delaySig 0.03 anoise2 + aout = mean [ rz adel1 2 , rz adel2 3 @@ -179,7 +179,7 @@ -------------------------------------------------- -- sampler -mkSam = limSam 1 +mkSam = limSam 4 bd1 = mkSam dumb bd2 = mkSam dumbBass @@ -194,4 +194,4 @@ bd3 = mkSam bassDrum cr = mkSam crash -clap = mkSam handClap +clap = mkSam handClap 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 @@ -2,26 +2,26 @@ module Csound.Catalog.Drum.MiniPops( MpSpec(..), - bass, snare1, snare2, rimShot, cymbal1, cymbal2, bongo1, bongo2, bongo3, + 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, + 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, + 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) import Csound.Sam data MpSpec = MpSpec { - mpDur :: D + mpDur :: D , mpCps :: D , mpRnd :: Maybe D } @@ -37,14 +37,14 @@ toDrum :: Sig -> SE Sig toDrum a = rndAmp =<< addDur a -defSpec dur cps = MpSpec +defSpec dur cps = MpSpec { mpDur = dur - , mpCps = cps + , mpCps = cps , mpRnd = Just 0.085 } rndVal :: D -> D -> D -> SE D rndVal total amount x = do - k <- birnd amount + k <- birnd amount return $ x + k * total rndDur amt x = rndVal x amt x @@ -52,13 +52,13 @@ rndSpec :: MpSpec -> SE MpSpec rndSpec spec = do - dur <- rndDur' + dur <- rndDur' cps <- rndCps' - return $ spec - { mpDur = dur + return $ spec + { mpDur = dur , mpCps = cps } - where - rndDur' = (maybe return rndDur $ (mpRnd spec)) $ mpDur spec + where + rndDur' = (maybe return rndDur $ (mpRnd spec)) $ mpDur spec rndCps' = (maybe return rndCps $ (mpRnd spec)) $ mpCps spec rezz cps bw = reson (mpulse 1 0) cps (cps * bw) `withD` 2 @@ -97,7 +97,7 @@ aenv = transeg [1, dur ,-5 , 0] asig1 = at (bhp 3000) $ mul aenv asig - xdur = 0.006 + xdur = 0.006 astrike = osc (transeg [cps,xdur,-4,60]) aenv2 = transeg [1,xdur,-2,0] astrike1 = aenv2 * astrike @@ -118,9 +118,9 @@ 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 + asig1 = at (bhp 3000) $ mul aenv asig - xdur = 0.005 + xdur = 0.005 astrike = osc (transeg [cps,xdur,-4,cps / 4]) aenv2 = transeg [1,xdur,-2,0] astrike1 = aenv2 * astrike @@ -141,7 +141,7 @@ dur = mpDur spec cps = sig $ mpCps spec - aenv = expon 1 dur 0.0001 + 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) @@ -159,7 +159,7 @@ 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 + where dur = mpDur spec cps = sig $ mpCps spec @@ -242,7 +242,7 @@ clSpec = defSpec 0.186 400 -claves' spec = pureClaves' =<< rndSpec spec +claves' spec = pureClaves' =<< rndSpec spec pureClaves' spec = toDrum aout where @@ -251,14 +251,14 @@ aenv = linseg [1, dur, 0] asig1 = rezz cps 0.025 - asig2 = rezz (cps * 5.45) 0.03 + asig2 = rezz (cps * 5.45) 0.03 aout = mul (3.2 * aenv * fadeOut dur) $ asig1 + 1.3 * asig2 cowbell = cowbell' cowSpec cowSpec = defSpec 0.3 850 -cowbell' spec = pureCowbell' =<< rndSpec spec +cowbell' spec = pureCowbell' =<< rndSpec spec pureCowbell' spec = toDrum asig where @@ -274,7 +274,7 @@ groSpec = defSpec 0.256 66 -guiro' spec = pureGuiro' =<< rndSpec spec +guiro' spec = pureGuiro' =<< rndSpec spec pureGuiro' spec = toDrum asig where @@ -289,7 +289,7 @@ marSpec = defSpec 0.05 5000 -maracas' spec = pureMaracas' =<< rndSpec spec +maracas' spec = pureMaracas' =<< rndSpec spec pureMaracas' spec = toDrum =<< do asig <- noise 1 0.04 @@ -299,20 +299,20 @@ cps = sig $ mpCps spec aenv = transeg [1,dur,-4,0] - + quijada = quijada' qjSpec qjSpec = defSpec 0.817 550 -quijada' spec = pureQuijada' =<< rndSpec spec +quijada' spec = pureQuijada' =<< rndSpec spec pureQuijada' spec = toDrum $ bhp cps $ mul (6 * fadeOut dur) $ phi dur (1/22.7272) + phi (dur * 0.39) (1/13.1579) where dur = mpDur spec cps = sig $ mpCps spec - phi dt freq = mul kenv $ reson (mpulse 1 freq) 2727 400 `withD` 1 + 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] @@ -320,13 +320,13 @@ tamSpec = defSpec 0.271 7000 -tamb' spec = pureTamb' =<< rndSpec spec +tamb' spec = pureTamb' =<< rndSpec spec pureTamb' spec = toDrum =<< do anoise <- noise 1 0 - return $ mul (1.5 * aenv * fadeOut dur) + 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 + where dur = mpDur spec cps = sig $ mpCps spec aenv = transeg [1,dur,-8,0] @@ -334,7 +334,7 @@ ------------------------------------------------------- -- Sampler -mkSam = limSam 1 +mkSam = limSam 4 -- | Bass drum bd :: Sam @@ -346,11 +346,11 @@ -- | Snare 2 sn2 :: Sam -sn2 = mkSam snare2 +sn2 = limSam 2 snare2 -- | Rim shot rim :: Sam -rim = mkSam rimShot +rim = limSam 1 rimShot -- | Cymbal 1 cym1 :: 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 @@ -2,7 +2,7 @@ module Csound.Catalog.Drum.Tr808( TrSpec(..), - bass, bass2, snare, openHiHat, closedHiHat, + bass, bass2, snare, openHiHat, closedHiHat, lowTom, midTom, highTom, cymbal, claves, rimShot, maraca, highConga, midConga, lowConga, @@ -38,16 +38,16 @@ , trRnd :: Maybe D } -cpsSpec cps = TrSpec +cpsSpec cps = TrSpec { trDur = 0.8 , trTune = 0 - , trCps = cps + , trCps = cps , trRnd = Just 0.085 } rndVal :: D -> D -> D -> SE D rndVal total amount x = do - k <- birnd amount + k <- birnd amount return $ x + k * total rndDur amt x = rndVal x amt x @@ -59,19 +59,19 @@ dur <- rndDur' tune <- rndTune' cps <- rndCps' - return $ spec - { trDur = dur + return $ spec + { trDur = dur , trTune = tune , trCps = cps } - where + 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 + , trCps = 55 , trRnd = Just 0.05 } addDur' dt x = xtratim dt >> return x @@ -99,7 +99,7 @@ aimp = oscili aenv1 acps sine amix = asig1 * 0.7 + aimp * 0.25 -bdSpec2 = TrSpec +bdSpec2 = TrSpec { trDur = 1.3 , trTune = 1 , trCps = 57 @@ -110,24 +110,24 @@ 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) $ +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 + where compr x = dam x 0.65 2.4 2.3 0.05 0.1 dur = trDur spec - cps = sig $ trCps spec + cps = sig $ trCps spec snSpec = cpsSpec 342 - + snare = snare' snSpec snare' spec = pureSnare' =<< rndSpec spec --- sound consists of two sine tones, an octave apart and a noise signal +-- sound consists of two sine tones, an octave apart and a noise signal pureSnare' :: TrSpec -> SE Sig pureSnare' spec = rndAmp =<< addDur =<< (apitch + anoise) - where + where dur = trDur spec tune = trTune spec cps = trCps spec @@ -141,7 +141,7 @@ apitch2 = rndOsc (0.5 * sig cps) apitch = mul (0.75 * aenv1) (apitch1 + apitch2) - -- noise component + -- noise component aenv2 = expon 1 iNseDur 0.0005 kcf = expsegr [5000, 0.1, 3000] iNseDur 0.0001 anoise = mul aenv2 $ do @@ -166,20 +166,20 @@ -- cps = 296 genHiHat :: Sig -> TrSpec -> SE Sig genHiHat pitchedEnv spec = rndAmp =<< addDur =<< (amix1 + anoise) - where + 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] + 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] + 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 @@ -190,7 +190,7 @@ lowTom = lowTom' ltSpec midTom = midTom' mtSpec -highTom = highTom' htSpec +highTom = highTom' htSpec -- cps = 200 highTom' :: TrSpec -> SE Sig @@ -206,7 +206,7 @@ genTom :: D -> (Sig, Sig, Sig) -> TrSpec -> SE Sig genTom durDt (resonCf, hpCf, lpCf) spec = rndAmp =<< addDur =<< (asig + anoise) - where + where dur = trDur spec tune = trTune spec cps = trCps spec @@ -215,14 +215,14 @@ halfDur = durDt * dur -- sine tone signal - aAmpEnv = transeg [1, halfDur, -10, 0.001] + 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 + anoise = mul aEnvNse $ do x <- noise 1 0.4 return $ blp (lpCf * otune) $ bhp (hpCf * otune) $ reson x (resonCf * otune) 800 `withD` 1 @@ -234,7 +234,7 @@ -- cps = 296 cymbal' :: TrSpec -> SE Sig cymbal' spec = rndAmp =<< addDur =<< (fmap (amix1 + ) anoise) - where + where dur = trDur spec tune = trTune spec cps = trCps spec @@ -249,7 +249,7 @@ -- noise element aenv2 = expsega [1,0.3,0.07,fullDur-0.1,0.00001] - kcf = expseg [14000, 0.7, 7000, fullDur-0.1, 5000] + 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 @@ -290,7 +290,7 @@ -- ring aenv1 = expsega [1,fullDur,0.001] - ifrq1 = sig $ cps * octave tune + ifrq1 = sig $ cps * octave tune aring = mul (0.5 * (aenv1 - 0.001)) $ at (bbp ifrq1 (ifrq1 * 8)) $ rndOscBy tabTR808RimShot ifrq1 -- noise @@ -325,13 +325,13 @@ 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 + 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) + 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' @@ -347,7 +347,7 @@ 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 + 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 @@ -396,7 +396,7 @@ highConga = highConga' hcSpec midConga = midConga' mcSpec -lowConga = lowConga' lcSpec +lowConga = lowConga' lcSpec -- high conga -- cps = 420 @@ -428,7 +428,7 @@ ----------------------------------------------------- -- sampler -mkSam = limSam 1 +mkSam = limSam 4 -- | Bass drum bd :: Sam @@ -443,11 +443,11 @@ -- | Open hi-hat ohh :: Sam -ohh = mkSam openHiHat +ohh = limSam 8 openHiHat -- | Closed hi-hat chh :: Sam -chh = mkSam closedHiHat +chh = mkSam closedHiHat -- | High tom htom :: Sam @@ -463,7 +463,7 @@ -- | Cymbal cym :: Sam -cym = mkSam cymbal +cym = limSam 8 cymbal -- | Claves cl :: Sam 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,7 +1,7 @@ {-# Language FlexibleContexts #-} module Csound.Catalog.Wave.Sean( RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec, - snowCrackle, + snowCrackle, fmDrone, fmDrones, tenorOsc, sopranoOsc ) where @@ -15,7 +15,7 @@ { rissetBellRands :: [D] , rissetBellRandShifts :: [D] , rissetBellDurs :: [D] - , rissetBellAmps :: [Sig] + , rissetBellAmps :: [Sig] , rissetBellFreqs :: [Sig] , rissetBellFreqShifts :: [Sig] } @@ -37,10 +37,10 @@ env = expsegr [1, dur, 0.001] dur 0.001 ares = mul 0.75 $ fmap sum $ zipWithM (\(iamp, ifreq, ifreqDt) (idur, irand, irandDt) -> partial iamp ifreq ifreqDt idur irand irandDt) (zip3 iamps ifreqs ifreqDt) (zip3 idurs irands irandDt) -timpaniSpec = RissetBellSpec +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] + , 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] } @@ -50,7 +50,7 @@ where env = expsegr [1, dur, 0.001] dur 0.001 -noiseBellSpec = RissetBellSpec +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] @@ -72,13 +72,13 @@ snowCrackle speed = mlp 1200 0.1 $ mouseDrum speed (3 + 2 * uosc 0.1) (160 + 100 * uosc 0.13) where mouseDrum :: Sig -> Sig -> Sig -> Sig - mouseDrum freq index cps = - sched instr $ withDur dur $ fmap (\[a, b] -> (a, b)) $ randList 2 $ dust freq - where + 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)) + mouseDrumGrain dur + (cps + 10 * sig (2 * rndCps - 1)) (index + 0.01 * sig (2 * rndIndex - 1)) mouseDrumGrain dur icarfreq index = aosc @@ -100,8 +100,8 @@ aosc4 = osc (a4 + aosc1 + amod') ares = 0.5 * kamp1 * sum [aosc2, aosc3, aosc4] -scDrone = fmDrone 3 -scDrones = fmDrones 3 +scDrone = fmDrone 3 +scDrones = fmDrones 3 pulseIndex ns speed = 1 + 7 * seqSqr [seqDesc ns] speed @@ -112,9 +112,9 @@ fmDrone index (iatt, irel) cps = (aout1, aout2) where ifreq1 = cps - iamp = 0.39 + iamp = 0.39 idev = index * ifreq1 - kamp1 = leg iatt 0 1 irel + kamp1 = leg iatt 0 1 irel f a1 a2 a3 a4 = iamp * fmDronePartial 0 index idev kamp1 ifreq1 (a1, a2, a3, a4) @@ -123,12 +123,12 @@ fmDrones index amps harms (iatt, irel) cps = aout where - iamp = 0.39 - kamp1 = leg iatt 0 1 irel + iamp = 0.39 + kamp1 = leg iatt 0 1 irel f amp h = do let ifreq1 = h * cps - idev = index * ifreq1 + idev = index * ifreq1 a1 <- randomSig 1 0.03 a2 <- randomSig 0.998 0.025 @@ -152,24 +152,24 @@ gaussSig val dev = fmap ((+ val)) $ gauss val randiDev :: Sig -> Sig -> Sig -> SE Sig -randiDev val dev cps = fmap (+ val) $ randi dev cps +randiDev val dev cps = fmap (+ val) $ randi dev cps randhDev :: Sig -> Sig -> Sig -> SE Sig -randhDev val dev cps = fmap (+ val) $ randh dev cps +randhDev val dev cps = fmap (+ val) $ randh dev cps ------------------------------------------------------------------------ -- choir -tenorOsc = voiceOsc 0.9 -sopranoOsc = voiceOsc 0.8 +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 + where iharms = sig getSampleRate * 0.4 / cps - asig = gbuzz 1 cps iharms 1 mulHarm (sines3 [(1, 1, 0.25)]) + asig = gbuzz 1 cps iharms 1 mulHarm (sines3 [(1, 1, 0.25)]) kenv = leg 0.1 0 1 0.1 data RndDev = RndDev @@ -190,13 +190,13 @@ return $ ain * (1 + xDt) -data Formant = Formant +data Formant = Formant { formantWeight :: Sig , formantCenter :: Sig - , formantWidth :: Sig + , formantWidth :: Sig } ------------------------------------------------------------------------ --- +-- diff --git a/src/Csound/Patch.hs b/src/Csound/Patch.hs --- a/src/Csound/Patch.hs +++ b/src/Csound/Patch.hs @@ -11,15 +11,15 @@ module Csound.Patch( -- * Electric piano - Epiano1(..), epiano1, epiano1', + Epiano1(..), epiano1, epiano1', MutedPiano(..), mutedPiano, mutedPiano', - amPiano, fmPiano, + amPiano, fmPiano, epiano2, epianoHeavy, epianoBright, vibraphonePiano1, vibraphonePiano2, addHammer, -- * Organ - cathedralOrgan, toneWheelOrgan, + cathedralOrgan, toneWheelOrgan, HammondOrgan(..), hammondOrgan, hammondOrgan', sawOrgan, triOrgan, sqrOrgan, pwOrgan, waveOrgan, @@ -45,13 +45,13 @@ -- ** Pad Monosynth pwPadm, triPadm, nightPadm, overtonePadm, caveOvertonePadm, choruselm, - pwEnsemblem, fmDroneSlowm, fmDroneMediumm, fmDroneFastm, + pwEnsemblem, fmDroneSlowm, fmDroneMediumm, fmDroneFastm, razorPadSlowm, razorPadFastm, razorPadTremolom, razorPadm, razorPadm', dreamPadm, dreamPadBym, underwaterPadm, lightIsTooBrightPadm, whaleSongPadm, dreamPadm', underwaterPadm', dreamPadBym', lightIsTooBrightPadm', whaleSongPadm', -- * Lead - polySynth, + polySynth, phasingLead, RazorLead(..), razorLeadSlow, razorLeadFast, razorLeadTremolo, razorLead, razorLead', overtoneLead, @@ -67,7 +67,7 @@ celloSynt, -- * Plucked - guitar, harpsichord, + guitar, harpsichord, -- * Strikeh @@ -75,20 +75,20 @@ smallBanyan,banyan, largeBanyan, magicBanyan, smallXylophone, xylophone, largeXylophone, magicXylophone, smallTibetanBowl180, tibetanBowl180, largeTibetanBowl180, magicTibetanBowl180, - smallSpinelSphere, spinelSphere, largeSpinelSphere, magicSpinelSphere, + 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, + 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, + smallWineGlass, wineGlass, largeWineGlass, magicWineGlass, smallHandbell, handbell, largeHandbell, magicHandbell, smallAlbertClockBellBelfast, albertClockBellBelfast, largeAlbertClockBellBelfast, magicAlbertClockBellBelfast, smallWoodBlock, woodBlock, largeWoodBlock, magicWoodBlock, @@ -97,7 +97,7 @@ scrapeDahina, scrapeBanyan, scrapeXylophone, scrapeTibetanBowl180, scrapeSpinelSphere, scrapePotLid, scrapeRedCedarWoodPlate, scrapeTubularBell, scrapeRedwoodPlate, scrapeDouglasFirWoodPlate, scrapeUniformWoodenBar, scrapeUniformAluminumBar, scrapeVibraphone1, scrapeVibraphone2, scrapeChalandiPlates, scrapeTibetanBowl152, scrapeTibetanBowl140, scrapeWineGlass, - scrapeSmallHandbell, scrapeAlbertClockBellBelfast, scrapeWoodBlock, + scrapeSmallHandbell, scrapeAlbertClockBellBelfast, scrapeWoodBlock, scrapeFastDahina, scrapeFastBanyan, scrapeFastXylophone, scrapeFastTibetanBowl180, scrapeFastSpinelSphere, scrapeFastPotLid, scrapeFastRedCedarWoodPlate, scrapeFastTubularBell, scrapeFastRedwoodPlate, scrapeFastDouglasFirWoodPlate, scrapeFastUniformWoodenBar, @@ -111,11 +111,11 @@ -- ** Scrape monosynth - -- | Unfortunately they don't work with @atMonoMidi@. Though @atNote@ works fine. + -- | 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, + scrapeSmallHandbellm, scrapeAlbertClockBellBelfastm, scrapeWoodBlockm, scrapePadDahinam, scrapePadBanyanm, scrapePadXylophonem, scrapePadTibetanBowl180m, scrapePadSpinelSpherem, scrapePadPotLidm, scrapePadRedCedarWoodPlatem, scrapePadTubularBellm, scrapePadRedwoodPlatem, scrapePadDouglasFirWoodPlatem, scrapePadUniformWoodenBarm, @@ -126,28 +126,28 @@ Wind(..), woodWind', - fluteSpec, shortFluteSpec, - flute, shortFlute, fluteVibrato, mutedFlute, brightFlute, + fluteSpec, shortFluteSpec, + flute, shortFlute, fluteVibrato, mutedFlute, brightFlute, 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, - hulusiSpec, shortHulusiSpec, + hulusiSpec, shortHulusiSpec, hulusi, shortHulusi, hulusiVibrato, mutedHulusi, brightHulusi, - diziSpec, shortDiziSpec, + diziSpec, shortDiziSpec, dizi, shortDizi, diziVibrato, mutedDizi, brightDizi, -- * SHARC instruments - SharcInstr, - soloSharc, orcSharc, padSharc, purePadSharc, - dreamSharc, lightIsTooBrightSharc, whaleSongSharc, + SharcInstr, + soloSharc, orcSharc, padSharc, purePadSharc, + dreamSharc, lightIsTooBrightSharc, whaleSongSharc, sharcOrgan, -- ** Padsynth instruments @@ -166,7 +166,7 @@ psDeepMagicPadSharc, psDeepMagicPadSharc', psDeepMagicSoftPadSharc, psDeepMagicSoftPadSharc', --- *** Crossfades - psPadSharcCfd, psPadSharcCfd', psPadSharcCfd4, psPadSharcCfd4', psDeepPadSharcCfd, psDeepPadSharcCfd', + psPadSharcCfd, psPadSharcCfd', psPadSharcCfd4, psPadSharcCfd4', psDeepPadSharcCfd, psDeepPadSharcCfd', psDeepPadSharcCfd4, psDeepPadSharcCfd4', psSoftPadSharcCfd, psSoftPadSharcCfd', psSoftPadSharcCfd4, psSoftPadSharcCfd4', psDeepSoftPadSharcCfd, psDeepSoftPadSharcCfd', psDeepSoftPadSharcCfd4, psDeepSoftPadSharcCfd4', @@ -179,7 +179,7 @@ psSoftPadSharcHifi, psMagicPadSharcHifi, psMagicSoftPadSharcHifi, - psLargePianoSharcHifi, + psLargePianoSharcHifi, xpsLargePianoSharcHifi, -- *** Vedic pads @@ -220,14 +220,14 @@ -- * Nature windWall, mildWind, wind, snowCrackle, - -- * Misc - -- limRel, + -- * Misc + -- limRel, singleFx, singleFx' ) where import Control.Monad -import Csound.Base +import Csound.Base import qualified Csound.Catalog.Wave as C import qualified Csound.Catalog.Reson as C @@ -252,7 +252,7 @@ monoSig1 :: SigSpace a => (Sig -> a) -> (MonoArg -> a) monoSig1 f arg = mul env $ f cps - where + 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) @@ -273,7 +273,7 @@ singleFx = fx1 singleFxFilter :: Sig -> (ResonFilter -> a -> a) -> Patch a -> Patch a -singleFxFilter dw f = FxChain [fxSpecFilter dw (\filter x -> return $ f filter x)] +singleFxFilter dw f = FxChain [fxSpecFilter dw (\filter x -> return $ f filter x)] -- | Creates a simple FX-xhain, that contains a single effect. -- The first argument is the dry/wet-value. @@ -287,17 +287,17 @@ ---------------------------------------------- -- electric pianos -data Epiano1 = Epiano1 +data Epiano1 = Epiano1 { 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 +data MutedPiano = MutedPiano { mutedPianoMute :: Sig , mutedPianoRel :: D } @@ -306,23 +306,23 @@ 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 +mutedPiano' (MutedPiano mute rel) = fx1 0.25 (largeHall2 . at (mlp3 (250 + 7000 * mute) 0.2)) $ + polySynt $ \a -> mul 0.7 $ C.simpleSust rel a amPiano = fx1 0.25 id $ polySyntFilter $ \filter -> mul 1.4 . onCps (C.amPianoBy filter) -fmPiano = withSmallHall $ polySynt $ at fromMono . mul 0.75 . onCps (C.fmFlavio 6 3) +fmPiano = withSmallHall $ polySynt $ at fromMono . mul 0.75 . onCps (C.fmFlavio 6 3) epianoReleaseTime :: ReleaseTime 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]) +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]) -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]) +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]) -epianoBright = addHammer 0.15 $ fx1 0.2 smallHall2 $ +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]) vibraphonePiano1 = vibraphoneToPiano smallVibraphone1 @@ -337,10 +337,10 @@ ---------------------------------------------- -- organs -cathedralOrgan = withLargeHall $ polySynt $ at fromMono . mul 0.7 . onCps C.cathedralOrgan +cathedralOrgan = withLargeHall $ polySynt $ at fromMono . mul 0.7 . onCps C.cathedralOrgan -- [0, 30] -data HammondOrgan = HammondOrgan +data HammondOrgan = HammondOrgan { hammondOrganDetune :: Sig } instance Default HammondOrgan where @@ -354,7 +354,7 @@ hammondOrganm' (HammondOrgan detune) = fx1 0.15 smallRoom2 $ monoSynt $ mul 0.4 . at fromMono . monoSig1 (C.hammondOrgan detune) -toneWheelOrgan = withSmallHall $ polySynt $ at fromMono . mul (0.6 * fadeOut 0.05) . onCps C.toneWheel +toneWheelOrgan = withSmallHall $ polySynt $ at fromMono . mul (0.6 * fadeOut 0.05) . onCps C.toneWheel sawOrgan = mul 0.45 $ waveOrgan rndSaw triOrgan = mul 0.5 $ waveOrgan rndTri @@ -369,13 +369,13 @@ organFx :: Patch2 -> Patch2 organFx = withSmallHall . singleFxFilter 1 (\filter -> at $ filter 3500 0.1) -waveOrgan :: (Sig -> SE Sig) -> Patch2 +waveOrgan :: (Sig -> SE Sig) -> Patch2 waveOrgan wave = organFx $ polySynt $ onCps $ at fromMono . mul (fades 0.01 0.01) . wave -waveOrganm :: (Sig -> SE Sig) -> Patch2 +waveOrganm :: (Sig -> SE Sig) -> Patch2 waveOrganm wave = organFx $ monoSynt $ monoSig1 $ at fromMono . mul (fades 0.01 0.01) . wave -waveOrganWithKey :: (D -> Sig -> SE Sig) -> Patch2 +waveOrganWithKey :: (D -> Sig -> SE Sig) -> Patch2 waveOrganWithKey wave = organFx $ polySynt $ onCps $ \cps -> (at fromMono . mul (fades 0.01 0.01) . wave cps) (sig cps) ---------------------------------------------- @@ -414,7 +414,7 @@ choirE' = choir' singE choirU' = choir' singU -data NoisyChoir = NoisyChoir +data NoisyChoir = NoisyChoir { noisyChoirFilterNum :: Int , noisyChoirBw :: Sig } @@ -431,7 +431,7 @@ dryNoisyChoir (NoisyChoir n bw) = polySynt $ at fromMono . mul 0.45 . onCps (C.noisyChoir n bw) longNoisyChoir' ch = fx1 0.15 magicCave2 $ dryNoisyChoir ch - + noisyChoir' ch = fx1 0.15 largeHall2 $ dryNoisyChoir ch -- modes (wth delay or not delay) @@ -529,7 +529,7 @@ -- | The first argument is brightness (0 to 1) dreamPadm' :: Sig -> Patch2 -dreamPadm' bright = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.dreamPad filter bright) +dreamPadm' bright = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.dreamPad filter bright) -- | The first argument is brightness (0 to 1). The second argument is a wave function. dreamPadBym' :: Sig -> (Sig -> SE Sig) -> Patch2 @@ -537,28 +537,28 @@ -- | The first argument is brightness (0 to 1) underwaterPad' :: Sig -> Patch2 -underwaterPad' bright = dreamPadFx $ polySyntFilter $ \filter -> fmap fromMono . onCps (C.underwaterPad filter bright) +underwaterPad' bright = dreamPadFx $ polySyntFilter $ \filter -> fmap fromMono . onCps (C.underwaterPad filter bright) -- | The first argument is brightness (0 to 1) underwaterPadm' :: Sig -> Patch2 -underwaterPadm' bright = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.underwaterPad filter bright) +underwaterPadm' bright = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.underwaterPad filter bright) -- | The first argument is brightness (0 to 1) lightIsTooBrightPad' :: Sig -> Patch2 -lightIsTooBrightPad' bright = dreamPadFx $ polySyntFilter $ \filter -> fmap fromMono . onCps (C.lightIsTooBrightPad filter bright) +lightIsTooBrightPad' bright = dreamPadFx $ polySyntFilter $ \filter -> fmap fromMono . onCps (C.lightIsTooBrightPad filter bright) lightIsTooBrightPadm' :: Sig -> Patch2 -lightIsTooBrightPadm' bright = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.lightIsTooBrightPad filter bright) +lightIsTooBrightPadm' bright = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.lightIsTooBrightPad filter bright) lightIsTooBrightPadWithKey :: Sig -> (D -> Sig -> SE Sig) -> Patch2 lightIsTooBrightPadWithKey brightness wave = dreamPadFx $ polySyntFilter $ genDreamPadNote C.lightIsTooBrightPadBy wave brightness -- | The first argument is brightness (0 to 1) whaleSongPad' :: Sig -> Patch2 -whaleSongPad' bright = dreamPadFx $ polySyntFilter $ \filter -> fmap fromMono . onCps (C.whaleSongPad filter bright) +whaleSongPad' bright = dreamPadFx $ polySyntFilter $ \filter -> fmap fromMono . onCps (C.whaleSongPad filter bright) whaleSongPadm' :: Sig -> Patch2 -whaleSongPadm' bright = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.whaleSongPad filter bright) +whaleSongPadm' bright = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.whaleSongPad filter bright) whaleSongPadWithKey :: Sig -> (D -> Sig -> SE Sig) -> Patch2 whaleSongPadWithKey brightness wave = dreamPadFx $ polySyntFilter $ genDreamPadNote C.whaleSongPadBy wave brightness @@ -568,13 +568,13 @@ 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)] -polySynth = polySynthFxChain $ polySynt $ fmap fromMono . onCps C.polySynth -polySynthm = polySynthFxChain $ monoSynt $ fmap fromMono . monoSig1 C.polySynth - +polySynth = polySynthFxChain $ polySynt $ fmap fromMono . onCps C.polySynth +polySynthm = polySynthFxChain $ monoSynt $ fmap fromMono . monoSig1 C.polySynth + phasingLead = withSmallHall $ polySynt $ at fromMono . mul (0.7 * fadeOut 0.05) . onCps (uncurry C.phasingSynth) -data RazorLead = RazorLead - { razorLeadBright :: Sig +data RazorLead = RazorLead + { razorLeadBright :: Sig , razorLeadSpeed :: Sig } instance Default RazorLead where @@ -629,10 +629,10 @@ strikeRelease (amp, cps) spec = (0.85 * strikeRel spec * amp) * amp + (strikeRel spec) - (cps / 10000) -- dac $ mixAt 0.15 largeHall2 $ mixAt 0.2 (echo 0.25 0.45) $ at fromMono $ midi $ onMsg $ onCps (mul (fadeOut 2) . C.tibetanBowl152 ) -data Strike = Strike +data Strike = Strike { strikeRel :: D , strikeHasDelay :: Bool - , strikeReverb :: Sig2 -> Sig2 + , strikeReverb :: Sig2 -> Sig2 } instance Default Strike where @@ -657,10 +657,10 @@ Huge -> Large toStrikeSpec :: Size -> Size -> Strike -toStrikeSpec revSpec restSpec = Strike +toStrikeSpec revSpec restSpec = Strike { strikeReverb = toReverb revSpec , strikeRel = toRel restSpec - , strikeHasDelay = toHasDelay restSpec } + , strikeHasDelay = toHasDelay restSpec } toReverb :: Size -> (Sig2 -> Sig2) toReverb x = case x of @@ -835,12 +835,12 @@ --------------------------------------------------------------- -- scrape --- scrapePatch +-- 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 +-- scrapePatch scrapeRelease :: (D, D) -> D -> D scrapeRelease (amp, cps) rel = (0.85 * rel * amp) * amp + rel - (cps / 10000) @@ -991,29 +991,29 @@ ------------------------------------ -- woodwind -data Wind = Wind +data Wind = Wind { windAtt :: D , windDec :: D - , windSus :: D - , windVib :: D + , windSus :: D + , windVib :: D , windBright :: D } -woodWind' spec instr = withSmallHall $ polySynt $ \(amp, cps) -> mul 1.3 $ do +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) + 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 +fluteSpec bright vib = Wind { windAtt = 0.08 , windDec = 0.1 , windSus = 20 , windVib = vib , windBright = bright } -shortFluteSpec bright vib = Wind +shortFluteSpec bright vib = Wind { windAtt = 0.03 , windDec = 0.05 , windSus = 20 @@ -1021,40 +1021,40 @@ , windBright = bright } flute = woodWind' (fluteSpec br vib) C.flute - where + where br = 0.7 vib = 0.015 shortFlute = woodWind' (shortFluteSpec br vib) C.flute - where + where br = 0.7 vib = 0.015 fluteVibrato = woodWind' (fluteSpec br vib) C.flute - where + where br = 0.7 vib = 0.04 mutedFlute = woodWind' (fluteSpec br vib) C.flute - where + where br = 0.25 vib = 0.015 brightFlute = woodWind' (fluteSpec br vib) C.flute - where + where br = 1.2 vib = 0.015 -- bass clarinet -bassClarinetSpec bright vib = Wind +bassClarinetSpec bright vib = Wind { windAtt = 0.06 , windDec = 0.15 , windSus = 20 , windVib = vib , windBright = bright } -shortBassClarinetSpec bright vib = Wind +shortBassClarinetSpec bright vib = Wind { windAtt = 0.03 , windDec = 0.04 , windSus = 20 @@ -1062,40 +1062,40 @@ , windBright = bright } bassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet - where + where br = 0.7 vib = 0.01 shortBassClarinet = woodWind' (shortBassClarinetSpec br vib) C.bassClarinet - where + where br = 0.7 vib = 0.01 bassClarinetVibrato = woodWind' (bassClarinetSpec br vib) C.bassClarinet - where + where br = 0.7 vib = 0.035 mutedBassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet - where + where br = 0.25 vib = 0.01 brightBassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet - where + where br = 1.2 vib = 0.01 -- french horn -frenchHornSpec bright vib = Wind +frenchHornSpec bright vib = Wind { windAtt = 0.08 , windDec = 0.25 , windSus = 20 , windVib = vib , windBright = bright } -shortFrenchHornSpec bright vib = Wind +shortFrenchHornSpec bright vib = Wind { windAtt = 0.03 , windDec = 0.04 , windSus = 20 @@ -1103,40 +1103,40 @@ , windBright = bright } frenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn - where + where br = 0.7 vib = 0.01 shortFrenchHorn = woodWind' (shortFrenchHornSpec br vib) C.frenchHorn - where + where br = 0.7 vib = 0.01 frenchHornVibrato = woodWind' (frenchHornSpec br vib) C.frenchHorn - where + where br = 0.7 vib = 0.035 mutedFrenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn - where + where br = 0.25 vib = 0.01 brightFrenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn - where + where br = 1.2 vib = 0.01 -- sheng -shengSpec bright vib = Wind +shengSpec bright vib = Wind { windAtt = 0.1 , windDec = 0.2 , windSus = 20 , windVib = vib , windBright = bright } -shortShengSpec bright vib = Wind +shortShengSpec bright vib = Wind { windAtt = 0.03 , windDec = 0.04 , windSus = 20 @@ -1144,40 +1144,40 @@ , windBright = bright } sheng = woodWind' (shengSpec br vib) C.sheng - where + where br = 0.7 vib = 0.01 shortSheng = woodWind' (shortShengSpec br vib) C.sheng - where + where br = 0.7 vib = 0.01 shengVibrato = woodWind' (shengSpec br vib) C.sheng - where + where br = 0.7 vib = 0.025 mutedSheng = woodWind' (shengSpec br vib) C.sheng - where + where br = 0.25 vib = 0.01 brightSheng = woodWind' (shortShengSpec br vib) C.sheng - where + where br = 1.2 vib = 0.01 -- hulusi -hulusiSpec bright vib = Wind +hulusiSpec bright vib = Wind { windAtt = 0.12 , windDec = 0.14 , windSus = 20 , windVib = vib , windBright = bright } -shortHulusiSpec bright vib = Wind +shortHulusiSpec bright vib = Wind { windAtt = 0.03 , windDec = 0.04 , windSus = 20 @@ -1185,41 +1185,41 @@ , windBright = bright } hulusi = woodWind' (hulusiSpec br vib) C.hulusi - where + where br = 0.7 vib = 0.015 shortHulusi = woodWind' (shortHulusiSpec br vib) C.hulusi - where + where br = 0.7 vib = 0.015 hulusiVibrato = woodWind' (hulusiSpec br vib) C.hulusi - where + where br = 0.7 vib = 0.035 mutedHulusi = woodWind' (hulusiSpec br vib) C.hulusi - where + where br = 0.25 vib = 0.015 brightHulusi = woodWind' (shortHulusiSpec br vib) C.hulusi - where + where br = 1.2 vib = 0.015 -- dizi -diziSpec bright vib = Wind +diziSpec bright vib = Wind { windAtt = 0.03 , windDec = 0.2 , windSus = 20 , windVib = vib , windBright = bright } -shortDiziSpec bright vib = Wind +shortDiziSpec bright vib = Wind { windAtt = 0.1 , windDec = 0.04 , windSus = 20 @@ -1227,27 +1227,27 @@ , windBright = bright } dizi = woodWind' (diziSpec br vib) C.dizi - where + where br = 0.7 vib = 0.01 shortDizi = woodWind' (shortDiziSpec br vib) C.dizi - where + where br = 0.7 vib = 0.01 diziVibrato = woodWind' (diziSpec br vib) C.dizi - where + where br = 0.7 vib = 0.035 mutedDizi = woodWind' (diziSpec br vib) C.dizi - where + where br = 0.25 vib = 0.01 brightDizi = woodWind' (shortDiziSpec br vib) C.dizi - where + where br = 1.2 vib = 0.01 @@ -1267,7 +1267,7 @@ black = fx1 0.25 smallHall2 $ polySynt $ at fromMono . mul (2 * fades 0.01 0.5). onCps (\cps -> C.black 3 (cps / 2) (cps * 2) 12 (sig cps)) simpleMarimba = fx1 0.25 smallHall2 $ polySynt $ at fromMono . mul (0.8 * fades 0.01 0.5). onCps (C.simpleMarimba 5) - + impulseMarimba1 = fx1 0.3 smallHall2 $ polySynt $ at fromMono . mul (0.8 * fadeOut 0.75). onCps C.impulseMarimba1 impulseMarimba2 = fx1 0.3 smallHall2 $ polySynt $ at fromMono . mul (0.8 * fadeOut 0.75). onCps C.impulseMarimba2 @@ -1277,7 +1277,7 @@ snowCrackle = polySynt $ \(amp, cps) -> (return . fromMono . mul (0.8 * sig amp * fades 0.001 0.001) . (C.snowCrackle . (/ 25))) (sig cps) noiseBell = fx1 0.25 smallHall2 $ polySynt $ at fromMono . mul 0.75 . onCps (C.noiseBell (31, 125) 2.3 0.2 . ( * 8)) - + ------------------------------------ -- vowels @@ -1370,7 +1370,7 @@ -- | High resolution Padsynth instrument with piano-like amplitude envelope. psPianoSharcHifi :: ReleaseTime -> SharcInstr -> Patch2 psPianoSharcHifi = psPianoSharc' hiDef - + -- | Padsynth instrument with piano-like amplitude envelope. We can specify aux parameters. psPianoSharc' :: PadSharcSpec -> ReleaseTime -> SharcInstr -> Patch2 psPianoSharc' spec releaseTime sh = fxs $ polySynt $ \ampCps -> mul (0.75 * C.pianoEnv releaseTime ampCps) $ onCps (C.padsynthSharcOsc2' spec sh) ampCps @@ -1420,7 +1420,7 @@ where rel (amp, cps) = amp - cps / 3500 psPadFilter filter = psPadFilterBy 75 15 filter -psSoftPadFilter filter = psPadFilterBy 350 0.15 filter +psSoftPadFilter filter = psPadFilterBy 350 0.15 filter deepOsc :: (Num a, SigSpace a) => (D -> a) -> (D -> a) deepOsc f x = mul 0.5 (f x + f (x / 2)) @@ -1436,7 +1436,7 @@ 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 + 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 @@ -1591,8 +1591,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) $ +vedicPad instr bandwidth = mul 0.8 $ + 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. @@ -1601,8 +1601,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) $ +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) -- | Deep spiritual drones. Crossfade between four instruments. @@ -1611,9 +1611,9 @@ -- -- 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 +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) @@ -1624,9 +1624,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 $ +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 -- | Deep spiritual drones. Contains only quater of ftables as for simple @vedicPad@. @@ -1635,9 +1635,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 $ +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 -- | Eminent @@ -1814,7 +1814,7 @@ 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))] + 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)) @@ -1833,7 +1833,7 @@ 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))] + 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 @@ -1854,8 +1854,8 @@ ---------------------------------- -dafunkWave cfq adsrFun (amp, cps) = at (bhp 30) $ diode (0.95 + 0.2 * cfq) (550 + 4500 * cfq) (0.52 + 0.4 * cfq) $ amp * env * (\x -> saw x + 0.5 * saw (x * 0.503) + 0.25 * (sqr (x * 0.253))) (port cps 0.001) - where +dafunkWave cfq adsrFun (amp, cps) = at (bhp 30) $ diode 1.2 (550 + 4500 * cfq) (0.52 + 0.4 * cfq) $ amp * env * (\x -> saw x + 0.5 * saw (x * 0.503) + 0.25 * (sqr (x * 0.253))) (port cps 0.001) + where env = adsrFun 0.019 8.5 0.2 0.07 dafunkLead = adsrMono (\env (amp, cps) -> return $ fromMono $ dafunkWave cfq env (amp, cps))