csound-catalog 0.6.1 → 0.7.0
raw patch · 7 files changed
+266/−132 lines, 7 filesdep ~csound-expressiondep ~csound-samplerPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: csound-expression, csound-sampler
API changes (from Hackage documentation)
- Csound.Patch: dreamPadBy' :: Sig -> (Sig -> SE Sig) -> Patch2
- Csound.Patch: dreamSharc' :: SharcInstr -> Sig -> Patch2
+ Csound.Catalog.Wave: amPianoBy :: ResonFilter -> Sig -> SE Sig
+ Csound.Catalog.Wave: celloWave :: (D, Sig) -> SE Sig
+ Csound.Catalog.Wave: epianoBy :: ResonFilter -> ReleaseTime -> [EpianoOsc] -> (D, D) -> SE Sig
+ Csound.Catalog.Wave: fmBass1 :: MonoAdsr -> (Sig, Sig) -> Sig
+ Csound.Catalog.Wave: fmBass2 :: MonoAdsr -> (Sig, Sig) -> Sig
+ Csound.Catalog.Wave: lightIsTooBrightPadBy :: ResonFilter -> Wave -> Sig -> Sig -> SE Sig
+ Csound.Catalog.Wave: pwBassBy :: ResonFilter -> Sig -> SE Sig
+ Csound.Catalog.Wave: pwEnsembleBy :: ResonFilter -> Sig -> SE Sig
+ Csound.Catalog.Wave: pwHarpsichordBy :: ResonFilter -> Sig -> SE Sig
+ Csound.Catalog.Wave: pwPadBy :: ResonFilter -> Sig -> SE Sig
+ Csound.Catalog.Wave: triPadBy :: ResonFilter -> Sig -> SE Sig
+ Csound.Catalog.Wave: whaleSongPadBy :: ResonFilter -> Wave -> Sig -> Sig -> SE Sig
+ Csound.Patch: celloSynt :: Patch2
+ Csound.Patch: dafunkLead :: Patch (Sig, Sig)
+ Csound.Patch: fmBass1 :: Patch (Sig, Sig)
+ Csound.Patch: fmBass2 :: Patch (Sig, Sig)
+ Csound.Patch: lightIsTooBrightSharc :: SharcInstr -> Patch2
+ Csound.Patch: sharcOrgan :: SharcInstr -> Patch2
+ Csound.Patch: whaleSongSharc :: SharcInstr -> Patch2
- Csound.Catalog.Wave: dreamPad :: Sig -> Sig -> SE Sig
+ Csound.Catalog.Wave: dreamPad :: ResonFilter -> Sig -> Sig -> SE Sig
- Csound.Catalog.Wave: dreamPadBy :: (Sig -> SE Sig) -> Sig -> Sig -> SE Sig
+ Csound.Catalog.Wave: dreamPadBy :: ResonFilter -> Wave -> Sig -> Sig -> SE Sig
- Csound.Catalog.Wave: lightIsTooBrightPad :: Sig -> Sig -> SE Sig
+ Csound.Catalog.Wave: lightIsTooBrightPad :: ResonFilter -> Sig -> Sig -> SE Sig
- Csound.Catalog.Wave: polySynthFx :: SE Sig -> SE Sig2
+ Csound.Catalog.Wave: polySynthFx :: ResonFilter -> SE Sig -> SE Sig2
- Csound.Catalog.Wave: razorPad :: Sig -> Sig -> Sig -> SE Sig
+ Csound.Catalog.Wave: razorPad :: (Fractional (SE b), Fractional t, SigSpace (SE b)) => (Sig -> t -> Sig -> b) -> Sig -> Sig -> Sig -> SE b
- Csound.Catalog.Wave: underwaterPad :: Sig -> Sig -> SE Sig
+ Csound.Catalog.Wave: underwaterPad :: ResonFilter -> Sig -> Sig -> SE Sig
- Csound.Catalog.Wave: whaleSongPad :: Sig -> Sig -> SE Sig
+ Csound.Catalog.Wave: whaleSongPad :: ResonFilter -> Sig -> Sig -> SE Sig
- Csound.Patch: dreamPadBy :: (Sig -> SE Sig) -> Patch2
+ Csound.Patch: dreamPadBy :: Sig -> Wave -> Patch2
Files
- csound-catalog.cabal +3/−2
- src/Csound/Catalog/Wave.hs +12/−6
- src/Csound/Catalog/Wave/Bitwig.hs +9/−3
- src/Csound/Catalog/Wave/Fm.hs +17/−0
- src/Csound/Catalog/Wave/Misc.hs +51/−22
- src/Csound/Catalog/Wave/Thor.hs +30/−17
- src/Csound/Patch.hs +144/−82
csound-catalog.cabal view
@@ -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
src/Csound/Catalog/Wave.hs view
@@ -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
src/Csound/Catalog/Wave/Bitwig.hs view
@@ -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)
+ src/Csound/Catalog/Wave/Fm.hs view
@@ -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)
src/Csound/Catalog/Wave/Misc.hs view
@@ -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
src/Csound/Catalog/Wave/Thor.hs view
@@ -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))----
src/Csound/Patch.hs view
@@ -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)