packages feed

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 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)