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.6.1 +Version: 0.7.0 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.1.0, csound-sampler >=0.0.7.0, sharc-timbre + base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.2.0, csound-sampler >=0.0.8.0, sharc-timbre Hs-Source-Dirs: src/ Exposed-Modules: Csound.Catalog @@ -45,6 +45,7 @@ Csound.Catalog.Wave.WoodwindAlg Csound.Catalog.Wave.Vowel Csound.Catalog.Wave.Ac + Csound.Catalog.Wave.Fm Csound.Catalog.Wave.VestigeOfTime Csound.Catalog.Wave.Deserted Csound.Catalog.Wave.TheHeartbeat diff --git a/src/Csound/Catalog/Wave.hs b/src/Csound/Catalog/Wave.hs --- a/src/Csound/Catalog/Wave.hs +++ b/src/Csound/Catalog/Wave.hs @@ -1,5 +1,5 @@ -- | Timbres -module Csound.Catalog.Wave( +module Csound.Catalog.Wave( -- * Woodwind instruments flute, bassClarinet, frenchHorn, sheng, hulusi, dizi, @@ -71,28 +71,32 @@ -- * Thor cathedralOrgan, cathedralOrganFx, hammondOrgan, - amPiano, + amPiano, amPianoBy, pwBass, pwHarpsichord, pwEnsemble, + pwBassBy, pwHarpsichordBy, pwEnsembleBy, simpleBass, ReleaseTime, - EpianoOsc(..), epiano, pianoEnv, xpianoEnv, + EpianoOsc(..), epiano, epianoBy, pianoEnv, xpianoEnv, noisyChoir, thorWind, mildWind, boom, windWall, razorPad, razorLead, + -- * FM + fmBass1, fmBass2, + -- * Bitwig - pwPad, triPad, triPadFx, + pwPad, triPad, triPadFx, triPadBy, pwPadBy, Accordeon(..), accordeon, accordeonFx, -- * Pads polySynthFx, polySynth, dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, - dreamPadBy, + dreamPadBy, lightIsTooBrightPadBy, whaleSongPadBy, -- * SHARC instruments -- | SHARC ported to Csound. SHARC is a database of musical timbre information by Gregory Sandell. @@ -119,7 +123,8 @@ -- * Other instruments okComputer, deepBass, - impulseMarimba1, impulseMarimba2 + impulseMarimba1, impulseMarimba2, + celloWave ) where @@ -138,6 +143,7 @@ import Csound.Catalog.Wave.Flavio import Csound.Catalog.Wave.Thor import Csound.Catalog.Wave.Bitwig +import Csound.Catalog.Wave.Fm import Csound.Catalog.Wave.Misc 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,5 +1,5 @@ module Csound.Catalog.Wave.Bitwig( - pwPad, triPad, triPadFx, + pwPad, triPad, triPadFx, triPadBy, pwPadBy, Accordeon(..), accordeon, accordeonFx ) where @@ -11,12 +11,18 @@ triPadFx :: Sig2 -> SE Sig2 triPadFx a = mixAt 0.5 smallHall2 $ at (chorus 0.2 0.3 0.25) (return a :: SE Sig2) -triPad x = mul (1.5 * fades 0.3 0.5) $ at (mlp (x * 5) 0.15) $ do +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) pwPad :: Sig -> SE Sig -pwPad x = mul (fades 0.3 0.95) $ at (mlp (x * 5) 0.15) $ do +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) diff --git a/src/Csound/Catalog/Wave/Fm.hs b/src/Csound/Catalog/Wave/Fm.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Fm.hs @@ -0,0 +1,17 @@ +module Csound.Catalog.Wave.Fm( + fmBass1, fmBass2 +) where + +import Csound.Base + +fmBass1 :: MonoAdsr -> (Sig, Sig) -> Sig +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))) + where + env1 = adsrEnv 0.015 (5.2 + rel) 0.001 0.5 + 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,10 +1,12 @@ -module Csound.Catalog.Wave.Misc ( +module Csound.Catalog.Wave.Misc ( okComputer, polySynthFx, polySynth, - dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, - dreamPadBy, + dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, + dreamPadBy, lightIsTooBrightPadBy, whaleSongPadBy, deepBass, - impulseMarimba1, impulseMarimba2 + impulseMarimba1, impulseMarimba2, + + celloWave ) where import Csound.Base @@ -20,35 +22,45 @@ go anoise = osc (samphold anoise kgate) kgate = kr $ oscil 1 cps (elins [1, 0, 0]) - -polySynth x = mul (fades 0.01 0.15) $ at (mlp 5500 0.12) $ at (filt 2 br 18000 0.3) $ uni rndSaw x + uni rndSaw (x * cent 14) + (mul 0.2 $ at (lp 400 0.1) white) +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 :: SE Sig -> SE Sig2 -polySynthFx = mixAt 0.25 largeHall2 . mixAt 0.25 (echo 0.25 0.65) . at (chorus 0.07 1.25 0.25) . at fromMono +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 = multiHz 2 (cent 50) -dreamPad = dreamPadBy rndSaw -underwaterPad = dreamPadBy rndTri +lightIsTooBrightPad :: ResonFilter -> Sig -> Sig -> SE Sig +lightIsTooBrightPad filter = lightIsTooBrightPadBy filter rndSaw -lightIsTooBrightPad = genDreamPadInstr mkOsc - where mkOsc vibLfo1 vibLfo2 x = uni rndSaw (vibLfo1 x) + uni rndSaw (vibLfo2 $ x * cent 14) + mul 0.3 (mul (uosc 0.25) (rndTri (vibLfo2 $ x * 7 * cent 4)) + mul (isawSeq [1, 0.5, 0.25] 6 * uosc 0.17) (rndTri (vibLfo2 $ x * 13)) + mul (sqrSeq [1, 0.5, 0.25, 0.1] 8 * uosc 0.28) (rndOsc (vibLfo2 $ x * 9 * cent 3))) +lightIsTooBrightPadBy :: ResonFilter -> Wave -> Sig -> Sig -> SE Sig +lightIsTooBrightPadBy filter wave brightness = genDreamPadInstr filter mkOsc brightness + where mkOsc vibLfo1 vibLfo2 x = uni wave (vibLfo1 x) + uni wave (vibLfo2 $ x * cent 14) + mul 0.3 (mul (uosc 0.25) (rndTri (vibLfo2 $ x * 7 * cent 4)) + mul (isawSeq [1, 0.5, 0.25] 6 * uosc 0.17) (rndTri (vibLfo2 $ x * 13)) + mul (sqrSeq [1, 0.5, 0.25, 0.1] 8 * uosc 0.28) (rndOsc (vibLfo2 $ x * 9 * cent 3))) -whaleSongPad = genDreamPadInstr mkOsc - where mkOsc vibLfo1 vibLfo2 x = uni rndTri (vibLfo1 x) + uni rndTri (vibLfo2 $ x * cent 14) + uni rndTri (vibLfo2 $ 3 * x * cent 14) + mul 0.15 (uni rndTri (vibLfo2 $ 7 * x * cent 14)) + mul 0.15 (uni rndTri ((vibLfo2 $ 11 * x * cent 14) + 400 * uosc 0.2)) +whaleSongPad :: ResonFilter -> Sig -> Sig -> SE Sig +whaleSongPad filter = whaleSongPadBy filter rndTri -dreamPadBy :: (Sig -> SE Sig) -> Sig -> Sig -> SE Sig -dreamPadBy wave = genDreamPadInstr mkOsc - where mkOsc vibLfo1 vibLfo2 x = uni wave (vibLfo1 x) + uni wave (vibLfo2 $ x * cent 14) +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 -genDreamPadInstr mkOsc brightness x = do +dreamPad :: ResonFilter -> Sig -> Sig -> SE Sig +dreamPad filter = dreamPadBy filter rndSaw + +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 a1 <- oscs a2 <- nois return $ mul (fades 0.85 0.95) $ fx1 (a2 + a1) + fx2 a1 - where - fx1 = filt 2 mlp (filtLfo1 (700 + brightness * 2500)) 0.26 - fx2 = mlp (filtLfo2 (1200 + brightness * 2500)) 0.32 + 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 @@ -79,4 +91,21 @@ impulseMarimba2 cps = bat (bp cps 120) $ impulse 0 - +celloWave :: (D, Sig) -> SE Sig +celloWave = go p t x y z + 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))))) + p = 0.25 + t = 0.3 + x = 0.45 + y = 0.15 + z = 0.45 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 @@ -2,14 +2,16 @@ module Csound.Catalog.Wave.Thor( cathedralOrgan, cathedralOrganFx, hammondOrgan, - amPiano, + amPiano, amPianoBy, pwBass, pwHarpsichord, pwEnsemble, + pwBassBy, pwHarpsichordBy, pwEnsembleBy, + simpleBass, ReleaseTime, - EpianoOsc(..), epiano, pianoEnv, xpianoEnv, + EpianoOsc(..), epiano, epianoBy, pianoEnv, xpianoEnv, noisyChoir, thorWind, mildWind, boom, windWall, @@ -48,15 +50,21 @@ ------------------------------ -- 2 am & sync -amPiano :: Sig -> SE Sig -amPiano x = mul env $ at (mlp (env * (3000 + x)) 0.25) $ (rndSaw x * rndSaw (4 * x)) +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 +amPiano :: Sig -> SE Sig +amPiano = amPianoBy mlp + ------------------------------ -- 3 pwm +pwBassBy :: ResonFilter -> Sig -> SE Sig +pwBassBy filter cps = mul (fades 0.005 0.05) $ at (filter 1500 0.1) $ rndPw (0.25 * (1 + 0.07 * osc (1 + (7 * cps / 1000)))) cps + pwBass :: Sig -> SE Sig -pwBass cps = mul (fades 0.005 0.05) $ at (mlp 1500 0.1) $ rndPw (0.25 * (1 + 0.07 * osc (1 + (7 * cps / 1000)))) cps +pwBass = pwBassBy mlp simpleBass :: (D, D) -> Sig simpleBass (amp, cps') = aout @@ -82,17 +90,23 @@ kgain = 2 -pwHarpsichord :: Sig -> SE Sig -pwHarpsichord x = mul 2.5 $ mul (leg 0.005 1.5 0 0.25) $ at (mlp (env * 8000) 0.15) $ at (hp 2500 0.3) $ rndPw 0.4 x +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 -pwEnsemble :: Sig -> SE Sig -pwEnsemble x = mul 0.3 $ at (mlp (3500 + x * 2) 0.1) $ mul (leg 0.5 0 1 1) $ sum +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) +pwEnsemble :: Sig -> SE Sig +pwEnsemble = pwEnsembleBy mlp + ------------------------------ -- 4 Multi osc (unision) @@ -119,10 +133,13 @@ rel = userRelease + maxB ((amp / 5) + 0.05 - (k / 10)) 0.02 k = cps / 3500 -epiano :: ReleaseTime -> [EpianoOsc] -> (D, D) -> SE Sig -epiano releaseTime xs (amp, cps) = mul (pianoEnv releaseTime (amp, cps)) $ at (mlp (2500 + 4500 * (leg 0.085 3 0 0.1)) 0.25) $ +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 +epiano :: ReleaseTime -> [EpianoOsc] -> (D, D) -> SE Sig +epiano = epianoBy mlp + ------------------------------ -- 5 noise @@ -159,8 +176,8 @@ ------------------------------ -- 9, 10 fm -razorPad speed amp cps = f cps + 0.75 * f (cps * 0.5) - where f cps = mul (leg 0.5 0 1 1) $ genRazor (filt 1 mlp) speed amp cps +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 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 @@ -173,7 +190,3 @@ , 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/Patch.hs b/src/Csound/Patch.hs --- a/src/Csound/Patch.hs +++ b/src/Csound/Patch.hs @@ -9,6 +9,7 @@ -- -- The function @atMidi@ invokes a @Patch@ with midi. module Csound.Patch( + -- * Electric piano Epiano1(..), epiano1, epiano1', MutedPiano(..), mutedPiano, mutedPiano', @@ -40,7 +41,7 @@ chorusel, pwEnsemble, fmDroneSlow, fmDroneMedium, fmDroneFast, vibrophonePad, RazorPad(..), razorPadSlow, razorPadFast, razorPadTremolo, razorPad, razorPad', dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad, dreamPadBy, - dreamPad', underwaterPad', lightIsTooBrightPad', whaleSongPad', dreamPad', dreamPadBy', + dreamPad', underwaterPad', lightIsTooBrightPad', whaleSongPad', dreamPad', -- ** Pad Monosynth pwPadm, triPadm, nightPadm, overtonePadm, caveOvertonePadm, choruselm, @@ -56,15 +57,19 @@ overtoneLead, -- ** Lead Monosynth - polySynthm, + polySynthm, dafunkLead, -- * Bass simpleBass, pwBass, deepBass, withDeepBass, + fmBass1, fmBass2, + -- * Bowed + celloSynt, + -- * Plucked guitar, harpsichord, - -- * Strike + -- * Strikeh smallDahina, dahina, largeDahina, magicDahina, smallBanyan,banyan, largeBanyan, magicBanyan, @@ -140,8 +145,10 @@ dizi, shortDizi, diziVibrato, mutedDizi, brightDizi, -- * SHARC instruments - SharcInstr, - soloSharc, orcSharc, padSharc, purePadSharc, dreamSharc, dreamSharc', + SharcInstr, + soloSharc, orcSharc, padSharc, purePadSharc, + dreamSharc, lightIsTooBrightSharc, whaleSongSharc, + sharcOrgan, -- ** Padsynth instruments PadSharcSpec(..), @@ -240,20 +247,34 @@ 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 fx1 :: Sig -> (a -> a) -> Patch a -> Patch a -fx1 dw f = FxChain [FxSpec dw (return . f)] +fx1 dw f = FxChain [fxSpec dw (return . f)] fx1' :: Sig -> (a -> SE a) -> Patch a -> Patch a -fx1' dw f = FxChain [FxSpec dw f] +fx1' dw f = FxChain [fxSpec dw f] -- | Creates a simple FX-xhain, that contains a single pure effect. -- The first argument is the dry/wet-value. singleFx :: Sig -> (a -> a) -> Patch a -> Patch a singleFx = fx1 +singleFxFilter :: Sig -> (ResonFilter -> a -> a) -> Patch a -> Patch a +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. singleFx' :: Sig -> (a -> SE a) -> Patch a -> Patch a @@ -288,7 +309,7 @@ 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 $ polySynt $ mul 1.4 . onCps C.amPiano +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) @@ -296,13 +317,13 @@ epianoReleaseTime = 0.25 epiano2 = addHammer 0.15 $ fx1 0.25 smallHall2 $ - polySynt $ mul 1.125 . at fromMono . (onCps $ C.epiano 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 $ - polySynt $ mul 1.125 . at fromMono . (onCps $ C.epiano 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 $ - polySynt $ mul 1.12 . at fromMono . (onCps $ C.epiano 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 @@ -331,7 +352,7 @@ hammondOrgan' (HammondOrgan detune) = fx1 0.15 smallRoom2 $ polySynt $ mul 0.4 . at fromMono . onCps (C.hammondOrgan detune) -hammondOrganm' (HammondOrgan detune) = fx1 0.15 smallRoom2 $ MonoSynt def $ mul 0.4 . at fromMono . onSig1 (C.hammondOrgan detune) +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 @@ -345,12 +366,18 @@ sqrOrganm = mul 0.45 $ waveOrganm rndSqr pwOrganm k = mul 0.45 $ waveOrganm (rndPw k) +organFx :: Patch2 -> Patch2 +organFx = withSmallHall . singleFxFilter 1 (\filter -> at $ filter 3500 0.1) + waveOrgan :: (Sig -> SE Sig) -> Patch2 -waveOrgan wave = withSmallHall $ polySynt $ onCps $ at fromMono . mul (fades 0.01 0.01) . at (mlp 3500 0.1) . wave +waveOrgan wave = organFx $ polySynt $ onCps $ at fromMono . mul (fades 0.01 0.01) . wave waveOrganm :: (Sig -> SE Sig) -> Patch2 -waveOrganm wave = withSmallHall $ MonoSynt def $ onSig1 $ at fromMono . mul (fades 0.01 0.01) . at (mlp 3500 0.1) . wave +waveOrganm wave = organFx $ monoSynt $ monoSig1 $ at fromMono . mul (fades 0.01 0.01) . wave +waveOrganWithKey :: (D -> Sig -> SE Sig) -> Patch2 +waveOrganWithKey wave = organFx $ polySynt $ onCps $ \cps -> (at fromMono . mul (fades 0.01 0.01) . wave cps) (sig cps) + ---------------------------------------------- -- accordeons @@ -414,37 +441,40 @@ ---------------------------------------------- -- pads -pwPad = withSmallHall $ polySynt $ mul 0.6 . at fromMono . onCps C.pwPad -pwPadm = withSmallHall $ MonoSynt def $ mul 0.6 . at fromMono . onSig1 C.pwPad +pwPad = withSmallHall $ polySyntFilter $ \filter -> mul 0.6 . at fromMono . onCps (C.pwPadBy filter) +pwPadm = withSmallHall $ monoSyntFilter $ \filter -> mul 0.6 . at fromMono . monoSig1 (C.pwPadBy filter) -triPad = fx1' 0.25 C.triPadFx $ polySynt $ fmap fromMono . mul 0.7 . onCps C.triPad -triPadm = fx1' 0.25 C.triPadFx $ MonoSynt def $ fmap fromMono . mul 0.7 . onSig1 C.triPad +triPad = fx1' 0.25 C.triPadFx $ polySyntFilter $ \filter -> fmap fromMono . mul 0.7 . onCps (C.triPadBy filter) +triPadm = fx1' 0.25 C.triPadFx $ monoSyntFilter $ \filter -> fmap fromMono . mul 0.7 . monoSig1 (C.triPadBy filter) nightPad = withLargeHall $ polySynt $ mul 0.48 . at fromMono . onCps (mul (fadeOut 1) . C.nightPad 0.5) -nightPadm = withLargeHall $ MonoSynt def $ mul 0.48 . return . fromMono . onSig1 ((fadeOut 1 * ) . C.nightPad 0.5) +nightPadm = withLargeHall $ monoSynt $ mul 0.48 . return . fromMono . monoSig1 ((fadeOut 1 * ) . C.nightPad 0.5) -overtonePad = fx1 0.35 smallHall2 $ polySynt $ mul 0.65 . at fromMono . mixAt 0.25 (mlp 1500 0.1) . onCps (\cps -> mul (fades 0.25 1.2) (C.tibetan 11 0.012 cps) + mul (fades 0.25 1) (C.tibetan 13 0.015 (cps * 0.5))) -overtonePadm = fx1 0.35 smallHall2 $ MonoSynt def $ mul 0.65 . return . fromMono . mixAt 0.25 (mlp 1500 0.1) . onSig1 (\cps -> mul (fades 0.25 1.2) (C.tibetan 11 0.012 cps) + mul (fades 0.25 1) (C.tibetan 13 0.015 (cps * 0.5))) +overtoneFx p = fx1 0.35 smallHall2 $ singleFxFilter 0.25 (\filter -> at (filter 1500 0.1)) p +caveOvertoneFx p = fx1 0.2 magicCave2 $ singleFxFilter 0.25 (\filter -> at (filter 1500 0.1)) $ mul 0.8 p -caveOvertonePad = fx1 0.2 (magicCave2 . mul 0.8) $ dryPatch overtonePad -caveOvertonePadm = fx1 0.2 (magicCave2 . mul 0.8) $ dryPatch overtonePadm +overtonePad = overtoneFx $ polySynt $ mul 0.65 . at fromMono . onCps (\cps -> mul (fades 0.25 1.2) (C.tibetan 11 0.012 cps) + mul (fades 0.25 1) (C.tibetan 13 0.015 (cps * 0.5))) +overtonePadm = overtoneFx $ monoSynt $ mul 0.65 . return . fromMono . monoSig1 (\cps -> mul (fades 0.25 1.2) (C.tibetan 11 0.012 cps) + mul (fades 0.25 1) (C.tibetan 13 0.015 (cps * 0.5))) -chorusel = fx1 0.35 smallHall2 $ polySynt $ mul 0.9 . at (mlp (3500 + 2000 * uosc 0.1) 0.1) . onCps (mul (fades 0.65 1) . C.chorusel 13 0.5 10) -choruselm = fx1 0.35 smallHall2 $ MonoSynt def $ mul 0.9 . return . at (mlp (3500 + 2000 * uosc 0.1) 0.1) . onSig1 (mul (fades 0.65 1) . C.chorusel 13 0.5 10) +caveOvertonePad = caveOvertoneFx $ dryPatch overtonePad +caveOvertonePadm = caveOvertoneFx $ dryPatch overtonePadm -pwEnsemble = withSmallHall $ polySynt $ at fromMono . mul 0.55 . onCps C.pwEnsemble -pwEnsemblem = withSmallHall $ MonoSynt def $ at fromMono . mul 0.55 . onSig1 C.pwEnsemble +chorusel = fx1 0.35 smallHall2 $ polySyntFilter $ \filter note -> (mul 0.9 . at (filter (3500 + 2000 * uosc 0.1) 0.1) . onCps (mul (fades 0.65 1) . C.chorusel 13 0.5 10)) note +choruselm = fx1 0.35 smallHall2 $ monoSyntFilter $ \filter note -> (mul 0.9 . return . at (filter (3500 + 2000 * uosc 0.1) 0.1) . monoSig1 (mul (fades 0.65 1) . C.chorusel 13 0.5 10)) note +pwEnsemble = withSmallHall $ polySyntFilter $ \filter -> at fromMono . mul 0.55 . onCps (C.pwEnsembleBy filter) +pwEnsemblem = withSmallHall $ monoSyntFilter $ \filter -> at fromMono . mul 0.55 . monoSig1 (C.pwEnsembleBy filter) + fmDroneSlow = fx1 0.35 largeHall2 $ polySynt $ at fromMono . mul 0.5 . onCps (C.fmDrone 3 (10, 5)) -fmDroneSlowm = fx1 0.35 largeHall2 $ MonoSynt def $ return . at fromMono . mul 0.5 . onSig1 (C.fmDrone 3 (10, 5)) +fmDroneSlowm = fx1 0.35 largeHall2 $ monoSynt $ return . at fromMono . mul 0.5 . monoSig1 (C.fmDrone 3 (10, 5)) fmDroneMedium = fx1 0.35 largeHall2 $ polySynt $ at fromMono . mul 0.5 . onCps (C.fmDrone 3 (5, 3)) -fmDroneMediumm = fx1 0.35 largeHall2 $ MonoSynt def $ return . at fromMono . mul 0.5 . onSig1 (C.fmDrone 3 (5, 3)) +fmDroneMediumm = fx1 0.35 largeHall2 $ monoSynt $ return . at fromMono . mul 0.5 . monoSig1 (C.fmDrone 3 (5, 3)) fmDroneFast = fx1 0.25 smallHall2 $ polySynt $ at fromMono . mul 0.5 . onCps (C.fmDrone 3 (0.5, 1)) -fmDroneFastm = fx1 0.25 smallHall2 $ MonoSynt def $ return . at fromMono . mul 0.5 . onSig1 (C.fmDrone 3 (0.5, 1)) +fmDroneFastm = fx1 0.25 smallHall2 $ monoSynt $ return . at fromMono . mul 0.5 . monoSig1 (C.fmDrone 3 (0.5, 1)) -vibrophonePad = mapPatchInstr (\instr -> mul (1.5 * fades 0.5 0.25) . at (mlp 2500 0.1). instr) largeVibraphone1 +vibrophonePad = addPreFx 1 (return . (at $ mlp 2500 0.1)) $ mapPatchInstr (\instr -> mul (1.5 * fades 0.5 0.25) . instr) largeVibraphone1 data RazorPad = RazorPad { razorPadSpeed :: Sig } @@ -463,18 +493,16 @@ razorPadm = razorPadm' def -razorPad' (RazorPad speed) = fx1 0.35 largeHall2 $ polySynt $ at fromMono . mul 0.6 . onCps (uncurry $ C.razorPad speed) -razorPadm' (RazorPad speed) = fx1 0.35 largeHall2 $ MonoSynt def $ at fromMono . mul 0.6 . (uncurry $ C.razorPad speed) +razorPad' (RazorPad speed) = fx1 0.35 largeHall2 $ polySyntFilter $ \filter -> at fromMono . mul 0.6 . onCps (uncurry $ C.razorPad filter speed) +razorPadm' (RazorPad speed) = fx1 0.35 largeHall2 $ monoSyntFilter $ \filter arg -> (at fromMono . mul 0.6 . (uncurry $ C.razorPad filter speed)) (monoArgToNote arg) -dreamPadFx = FxChain [FxSpec 0.35 (return . largeHall2), FxSpec 0.25 (at $ echo 0.25 0.65), FxSpec 0.25 (at $ chorus 0.07 1.25 1)] +dreamPadFx = FxChain [fxSpec 0.35 (return . largeHall2), fxSpec 0.25 (return . (at $ echo 0.25 0.65)), fxSpec 0.25 (at $ chorus 0.07 1.25 1)] dreamPad = dreamPad' 0.35 underwaterPad = underwaterPad' 0.35 lightIsTooBrightPad = lightIsTooBrightPad' 0.55 whaleSongPad = whaleSongPad' 0.35 -dreamPadBy = dreamPadBy' 0.35 - dreamPadm = dreamPadm' 0.35 underwaterPadm = underwaterPadm' 0.35 lightIsTooBrightPadm = lightIsTooBrightPadm' 0.55 @@ -484,57 +512,65 @@ -- | The first argument is brightness (0 to 1) dreamPad' :: Sig -> Patch2 -dreamPad' bright = dreamPadFx $ polySynt $ fmap fromMono . onCps (C.dreamPad bright) +dreamPad' bright = dreamPadFx $ polySyntFilter $ \filter note -> (fmap fromMono . onCps (C.dreamPad filter bright)) note -- | The first argument is brightness. The second argument is a wave shape function. -dreamPadBy' :: Sig -> (Sig -> SE Sig) -> Patch2 -dreamPadBy' bright wave = dreamPadFx $ polySynt $ fmap fromMono . onCps (C.dreamPadBy wave bright) +dreamPadBy :: Sig -> Wave -> Patch2 +dreamPadBy brightness wave = dreamPadFx $ polySyntFilter $ \filter note -> (fmap fromMono . onCps (C.dreamPadBy filter wave brightness)) note -dreamPadWithKey :: (D -> Sig -> SE Sig) -> Patch2 -dreamPadWithKey = dreamPadWithKey' 0.35 +genDreamPadNote :: (ResonFilter -> Wave -> Sig -> Sig -> SE Sig) -> (D -> Wave) -> Sig -> ResonFilter -> Instr D Sig2 +genDreamPadNote f wave brightness filter = fmap fromMono . onCps (\cps -> f filter (wave cps) brightness (sig cps)) -dreamPadWithKey' :: Sig -> (D -> Sig -> SE Sig) -> Patch2 -dreamPadWithKey' bright wave = dreamPadFx $ polySynt $ fmap fromMono . onCps (\cps -> (C.dreamPadBy (wave cps) bright) (sig cps)) +-- genDreamPadNoteWithKey :: (ResonFilter -> (D -> Wave) -> Sig -> Sig -> SE Sig) -> Wave -> Sig -> ResonFilter -> Instr D Sig2 +-- genDreamPadNoteWithKey f wave brightness filter = fmap fromMono . onCps (\cps -> f filter (wave cps) brightness (sig cps)) +dreamPadWithKey :: Sig -> (D -> Sig -> SE Sig) -> Patch2 +dreamPadWithKey brightness wave = dreamPadFx $ polySyntFilter $ genDreamPadNote C.dreamPadBy wave brightness + -- | The first argument is brightness (0 to 1) dreamPadm' :: Sig -> Patch2 -dreamPadm' bright = dreamPadFx $ MonoSynt def $ fmap fromMono . onSig1 (C.dreamPad 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 -dreamPadBym' bright wave = dreamPadFx $ MonoSynt def $ fmap fromMono . onSig1 (C.dreamPadBy wave bright) +dreamPadBym' bright wave = dreamPadFx $ monoSyntFilter $ \filter -> fmap fromMono . monoSig1 (C.dreamPadBy filter wave bright) -- | The first argument is brightness (0 to 1) underwaterPad' :: Sig -> Patch2 -underwaterPad' bright = dreamPadFx $ polySynt $ fmap fromMono . onCps (C.underwaterPad 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 $ MonoSynt def $ fmap fromMono . onSig1 (C.underwaterPad 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 $ polySynt $ fmap fromMono . onCps (C.lightIsTooBrightPad bright) +lightIsTooBrightPad' bright = dreamPadFx $ polySyntFilter $ \filter -> fmap fromMono . onCps (C.lightIsTooBrightPad filter bright) lightIsTooBrightPadm' :: Sig -> Patch2 -lightIsTooBrightPadm' bright = dreamPadFx $ MonoSynt def $ fmap fromMono . onSig1 (C.lightIsTooBrightPad 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 $ polySynt $ fmap fromMono . onCps (C.whaleSongPad bright) +whaleSongPad' bright = dreamPadFx $ polySyntFilter $ \filter -> fmap fromMono . onCps (C.whaleSongPad filter bright) whaleSongPadm' :: Sig -> Patch2 -whaleSongPadm' bright = dreamPadFx $ MonoSynt def $ fmap fromMono . onSig1 (C.whaleSongPad 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 + ------------------------------------ -- leads -polySynth = fxs $ polySynt $ fmap fromMono . onCps C.polySynth - where fxs = FxChain [FxSpec 0.25 (return . largeHall2), FxSpec 0.25 (at $ echo 0.25 0.65), FxSpec 0.25 (at $ chorus 0.07 1.25 1)] - -polySynthm = fxs $ MonoSynt def $ fmap fromMono . onSig1 C.polySynth - where fxs = FxChain [FxSpec 0.25 (return . largeHall2), FxSpec 0.25 (at $ echo 0.25 0.65), FxSpec 0.25 (at $ chorus 0.07 1.25 1)] +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 + phasingLead = withSmallHall $ polySynt $ at fromMono . mul (0.7 * fadeOut 0.05) . onCps (uncurry C.phasingSynth) data RazorLead = RazorLead @@ -553,7 +589,7 @@ razorLead' (RazorLead bright speed) = fx1 0.35 smallHall2 $ polySynt $ at fromMono . (\(amp, cps) -> mul (fadeOut (0.05 + amp * 0.3)) $ C.razorLead (bright * sig amp) (speed * sig amp) (sig amp) (sig cps)) overtoneLeadFx :: Sig2 -> SE Sig2 -overtoneLeadFx x = fmap magicCave2 $ mixAt 0.2 (echo 0.25 0.45) x +overtoneLeadFx x = return $ magicCave2 $ mixAt 0.2 (echo 0.25 0.45) x overtoneLead :: Patch2 overtoneLead = fx1' 0.15 overtoneLeadFx $ polySynt $ mul 0.4 . at fromMono . onCps (mul (fades 0.01 1) . C.tibetan 13 0.012) @@ -563,10 +599,15 @@ simpleBass = withSmallRoom $ polySynt $ at fromMono . mul 0.32 . onCps C.simpleBass -pwBass = withSmallHall $ polySynt $ at fromMono . mul 0.4 . onCps C.pwBass +pwBass = withSmallHall $ polySyntFilter $ \filter -> at fromMono . mul 0.4 . onCps (C.pwBassBy filter) deepBass = withSmallHall $ polySynt $ at fromMono . mul 0.4 . onCps C.deepBass +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))] + -- | The first argument is the amount of deepBass to mix into the original patch. withDeepBass :: Sig -> Patch2 -> Patch2 withDeepBass k = mixInstr k deepBass @@ -808,11 +849,11 @@ scrape k m = fx1 0.15 largeHall2 $ polySynt $ \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.5 (scrapeRelease x 0.97)) . at fromMono . C.scrapeModes m) (sig cps) -scrapem k m = fx1 0.15 largeHall2 $ MonoSynt def $ \(amp, cps) -> (mul (0.75 * amp * k * fades 0.5 1.97) . at fromMono . C.scrapeModes m) cps +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) -scrapePadm k m = fx1 0.15 largeHall2 $ MonoSynt def $ \(amp, cps) -> (mul (0.75 * amp * k * fades 0.5 2.27) . at fromMono . C.scrapeModes m) 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 scaleScrapeDahina = 1.32 scaleScrapeBanyan = 0.95 @@ -1231,7 +1272,7 @@ impulseMarimba2 = fx1 0.3 smallHall2 $ polySynt $ at fromMono . mul (0.8 * fadeOut 0.75). onCps C.impulseMarimba2 -okComputer = polySynt $ \(amp, cps) -> (at fromMono . mul (0.75 * sig amp * fades 0.01 0.01) . at (mlp (1500 + sig amp * 8500) 0.1) . (C.okComputer . (/ 25))) (sig cps) +okComputer = polySyntFilter $ \filter (amp, cps) -> (at fromMono . mul (0.75 * sig amp * fades 0.01 0.01) . at (filter (1500 + sig amp * 8500) 0.1) . (C.okComputer . (/ 25))) (sig cps) snowCrackle = polySynt $ \(amp, cps) -> (return . fromMono . mul (0.8 * sig amp * fades 0.001 0.001) . (C.snowCrackle . (/ 25))) (sig cps) @@ -1279,12 +1320,19 @@ -- | Dream Pad patch made with SHARC oscillators. dreamSharc :: SharcInstr -> Patch2 -dreamSharc instr = dreamPadWithKey (C.rndSigSharcOsc instr) +dreamSharc instr = dreamPadWithKey 0.35 (C.rndSigSharcOsc instr) -- | Dream Pad patch made with SHARC oscillators. -dreamSharc' :: SharcInstr -> Sig -> Patch2 -dreamSharc' instr brightness = dreamPadWithKey' brightness (C.rndSigSharcOsc instr) +lightIsTooBrightSharc :: SharcInstr -> Patch2 +lightIsTooBrightSharc instr = lightIsTooBrightPadWithKey 0.6 (C.rndSigSharcOsc instr) +-- | Dream Pad patch made with SHARC oscillators. +whaleSongSharc :: SharcInstr -> Patch2 +whaleSongSharc instr = whaleSongPadWithKey 0.4 (C.rndSigSharcOsc instr) + +sharcOrgan :: SharcInstr -> Patch2 +sharcOrgan instr = waveOrganWithKey (C.rndSigSharcOsc instr) + type PadsynthBandwidth = Double -- | Padsynth instrument with organ-like amplitude envelope. @@ -1300,7 +1348,7 @@ -- | Padsynth instrument with organ-like amplitude envelope. We can specify aux parameters. psOrganSharc' :: PadSharcSpec -> SharcInstr -> Patch2 psOrganSharc' spec sh = fxs $ polySynt $ mul (0.5 * fades 0.01 0.1) . onCps (C.padsynthSharcOsc2' spec sh) - where fxs = FxChain [FxSpec 0.25 (return . smallHall2), FxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] + where fxs = FxChain [fxSpec 0.25 (return . smallHall2), fxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] -- | Padsynth instrument with organ-like amplitude envelope and huge reverb. psLargeOrganSharc :: SharcInstr -> Patch2 @@ -1313,7 +1361,7 @@ -- | Padsynth instrument with organ-like amplitude envelope and huge reverb. psLargeOrganSharc' :: PadSharcSpec -> SharcInstr -> Patch2 psLargeOrganSharc' spec sh = fxs $ polySynt $ mul (0.65 * fades 0.01 0.1) . onCps (C.padsynthSharcOsc2' spec sh) - where fxs = FxChain [FxSpec 0.35 (return . largeHall2), FxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] + where fxs = FxChain [fxSpec 0.35 (return . largeHall2), fxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] -- | Padsynth instrument with piano-like amplitude envelope. psPianoSharc :: ReleaseTime -> SharcInstr -> Patch2 @@ -1326,7 +1374,7 @@ -- | 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 - where fxs = FxChain [FxSpec 0.15 (return . smallHall2), FxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] + where fxs = FxChain [fxSpec 0.15 (return . smallHall2), fxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] -- | Padsynth instrument with piano-like amplitude envelope. xpsPianoSharc :: ReleaseTime -> SharcInstr -> Patch2 @@ -1339,7 +1387,7 @@ -- | Padsynth instrument with piano-like amplitude envelope. We can specify aux parameters. xpsPianoSharc' :: PadSharcSpec -> ReleaseTime -> SharcInstr -> Patch2 xpsPianoSharc' spec releaseTime sh = addHammer 0.12 $ fxs $ polySynt $ \ampCps -> mul (0.75 * C.xpianoEnv releaseTime ampCps) $ onCps (C.padsynthSharcOsc2' spec sh) ampCps - where fxs = FxChain [FxSpec 0.15 (return . smallHall2), FxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] + where fxs = FxChain [fxSpec 0.15 (return . smallHall2), fxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] -- | Padsynth instrument with piano-like amplitude envelope. psLargePianoSharc :: ReleaseTime -> SharcInstr -> Patch2 @@ -1352,7 +1400,7 @@ -- | Padsynth instrument with piano-like amplitude envelope. We can specify aux parameters. psLargePianoSharc' :: PadSharcSpec -> ReleaseTime -> SharcInstr -> Patch2 psLargePianoSharc' spec releaseTime sh = fxs $ polySynt $ \ampCps -> mul (0.75 * C.pianoEnv releaseTime ampCps) $ onCps (C.padsynthSharcOsc2' spec sh) ampCps - where fxs = FxChain [FxSpec 0.15 (return . largeHall2), FxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] + where fxs = FxChain [fxSpec 0.15 (return . largeHall2), fxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] -- | Padsynth instrument with piano-like amplitude envelope. xpsLargePianoSharc :: ReleaseTime -> SharcInstr -> Patch2 @@ -1365,14 +1413,14 @@ -- | Padsynth instrument with piano-like amplitude envelope. We can specify aux parameters. xpsLargePianoSharc' :: PadSharcSpec -> ReleaseTime -> SharcInstr -> Patch2 xpsLargePianoSharc' spec releaseTime sh = fxs $ polySynt $ \ampCps -> mul (0.75 * C.xpianoEnv releaseTime ampCps) $ onCps (C.padsynthSharcOsc2' spec sh) ampCps - where fxs = FxChain [FxSpec 0.15 (return . largeHall2), FxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] + where fxs = FxChain [fxSpec 0.15 (return . largeHall2), fxSpec 1 (return . (at $ mul 1.4 . saturator 0.75))] 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 -psPadFilter = psPadFilterBy 75 15 (\cfq q x -> lowpass2 x cfq q) -psSoftPadFilter = psPadFilterBy 350 0.15 mlp +psPadFilter filter = psPadFilterBy 75 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)) @@ -1386,10 +1434,10 @@ psDeepOscCfd koeff (spec1, sh1) (spec2, sh2) = deepOsc (psOscCfd koeff (spec1, sh1) (spec2, sh2)) 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) -> ((D, D) -> Sig -> Sig) -> (D -> SE Sig2) -> Patch2 -genPsPad effect filter wave = fxs $ polySynt $ \ampCps -> mul (1.2 * fades 0.5 (0.6 + rel ampCps)) $ onCps (at (filter ampCps) . wave) ampCps +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 - fxs = FxChain [FxSpec 0.25 (return . effect), FxSpec 0.5 (return . (at $ mul 2.1 . saturator 0.75)), FxSpec 0.3 (at $ echo 0.125 0.65)] + 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 -- | Padsynth instrument with pad-like amplitude envelope. @@ -1544,7 +1592,7 @@ -- Good values for bandwidth lies in the interval [0, 120] vedicPad :: SharcInstr -> PadsynthBandwidth -> Patch2 vedicPad instr bandwidth = mul 0.8 $ - addPreFx 0.45 (pingPong 0.25 0.65 0.5) $ + 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. @@ -1554,7 +1602,7 @@ -- 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 (pingPong 0.25 0.65 0.5) $ + 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. @@ -1564,7 +1612,7 @@ -- 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 (pingPong 0.25 0.65 0.5) $ + 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) @@ -1577,7 +1625,7 @@ -- Good values for bandwidth lies in the interval [0, 120] vedicPadHifi :: SharcInstr -> PadsynthBandwidth -> Patch2 vedicPadHifi instr bandwidth = mul 0.8 $ - addPreFx 0.45 (pingPong 0.25 0.65 0.5) $ + addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $ deepPad $ psSoftPadSharc' (def { padSharcBandwidth = bandwidth, padSharcSize = 32 }) instr @@ -1588,7 +1636,7 @@ -- Good values for bandwidth lies in the interval [0, 120] vedicPadLofi :: SharcInstr -> PadsynthBandwidth -> Patch2 vedicPadLofi instr bandwidth = mul 0.8 $ - addPreFx 0.45 (pingPong 0.25 0.65 0.5) $ + addPreFx 0.45 (return . pingPong 0.25 0.65 0.5) $ deepPad $ psSoftPadSharc' (def { padSharcBandwidth = bandwidth, padSharcSize = 4 }) instr @@ -1766,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 (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)) @@ -1785,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 (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 @@ -1802,3 +1850,17 @@ -- dac $ mul 0.24 $ at (bhp 30) $ mixAt 0.15 magicCave2 $ mixAt 0.43 (echo 0.35 0.85) $ midi $ onMsg $ (\cps -> (bat (lp (200 + (cps + 3000)) 45) . mul (fades 0.5 0.7) . (\x -> (at (mul 0.3 . fromMono . bat (bp (x * 11) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3] * uosc (expseg [0.25, 5, 8])) 14) white) + padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2)))) cps) -- dac $ mul 0.24 $ at (bhp 30) $ mixAt 0.35 largeHall2 $ mixAt 0.5 (echo 0.25 0.85) $ midi $ onMsg $ (\cps -> (bat (lp (200 + (cps + 3000)) 45) . mul (fades 0.5 0.7) . (\x -> (at (mul 0.3 . fromMono . bat (bp (x * 5) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3]) 14) white) + padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2)))) cps) + + +---------------------------------- + +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 + env = adsrFun 0.019 8.5 0.2 0.07 + +dafunkLead = adsrMono (\env (amp, cps) -> return $ fromMono $ dafunkWave cfq env (amp, cps)) + where cfq = uoscBy (sines [1, 0, 0, 0, 0.05]) 0.5 + + +celloSynt :: Patch2 +celloSynt = withSmallHall' 0.25 $ polySynt $ \(amp, cps) -> at fromMono $ C.celloWave (amp, sig cps)