summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAntonKholomiov <>2017-03-22 18:22:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-03-22 18:22:00 (GMT)
commit9c1e597377e34a67e29061b8ed8171092a0d25c3 (patch)
tree5b3dc97c879aede5ffd4de881bab47d1823f3d14
parentd05a8c4980cf0ad2cc89d8f2ec4ebcb6feefec72 (diff)
version 0.7.00.7.0
-rw-r--r--csound-catalog.cabal5
-rw-r--r--src/Csound/Catalog/Wave.hs18
-rw-r--r--src/Csound/Catalog/Wave/Bitwig.hs12
-rw-r--r--src/Csound/Catalog/Wave/Fm.hs17
-rw-r--r--src/Csound/Catalog/Wave/Misc.hs73
-rw-r--r--src/Csound/Catalog/Wave/Thor.hs47
-rw-r--r--src/Csound/Patch.hs226
7 files changed, 266 insertions, 132 deletions
diff --git a/csound-catalog.cabal b/csound-catalog.cabal
index 5d9c8af..ce02176 100644
--- a/csound-catalog.cabal
+++ b/csound-catalog.cabal
@@ -1,5 +1,5 @@
Name: csound-catalog
-Version: 0.6.1
+Version: 0.7.0
Cabal-Version: >= 1.6
License: BSD3
License-file: LICENSE
@@ -27,7 +27,7 @@ Source-repository head
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 @@ Library
Csound.Catalog.Wave.WoodwindAlg
Csound.Catalog.Wave.Vowel
Csound.Catalog.Wave.Ac
+ Csound.Catalog.Wave.Fm
Csound.Catalog.Wave.VestigeOfTime
Csound.Catalog.Wave.Deserted
Csound.Catalog.Wave.TheHeartbeat
diff --git a/src/Csound/Catalog/Wave.hs b/src/Csound/Catalog/Wave.hs
index 60b3ade..247ca94 100644
--- a/src/Csound/Catalog/Wave.hs
+++ b/src/Csound/Catalog/Wave.hs
@@ -1,5 +1,5 @@
-- | Timbres
-module Csound.Catalog.Wave(
+module Csound.Catalog.Wave(
-- * Woodwind instruments
flute, bassClarinet, frenchHorn, sheng, hulusi, dizi,
@@ -71,28 +71,32 @@ 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,
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 @@ module Csound.Catalog.Wave(
-- * Other instruments
okComputer, deepBass,
- impulseMarimba1, impulseMarimba2
+ impulseMarimba1, impulseMarimba2,
+ celloWave
) where
@@ -138,6 +143,7 @@ import Csound.Catalog.Wave.Sean
import Csound.Catalog.Wave.Flavio
import Csound.Catalog.Wave.Thor
import Csound.Catalog.Wave.Bitwig
+import Csound.Catalog.Wave.Fm
import Csound.Catalog.Wave.Misc
diff --git a/src/Csound/Catalog/Wave/Bitwig.hs b/src/Csound/Catalog/Wave/Bitwig.hs
index 7aecec3..ca80762 100644
--- a/src/Csound/Catalog/Wave/Bitwig.hs
+++ b/src/Csound/Catalog/Wave/Bitwig.hs
@@ -1,5 +1,5 @@
module Csound.Catalog.Wave.Bitwig(
- pwPad, triPad, triPadFx,
+ pwPad, triPad, triPadFx, triPadBy, pwPadBy,
Accordeon(..), accordeon, accordeonFx
) where
@@ -11,12 +11,18 @@ import Csound.Base
triPadFx :: Sig2 -> SE Sig2
triPadFx a = mixAt 0.5 smallHall2 $ at (chorus 0.2 0.3 0.25) (return a :: SE Sig2)
-triPad x = mul (1.5 * fades 0.3 0.5) $ at (mlp (x * 5) 0.15) $ do
+triPad = triPadBy mlp
+
+triPadBy :: ResonFilter -> Sig -> SE Sig
+triPadBy filter x = mul (1.5 * fades 0.3 0.5) $ at (filter (x * 5) 0.15) $ do
lfo <- rand 1.2
mul 0.5 $ rndTri (x + 1.5 * lfo) + rndTri (x * cent 8)
pwPad :: Sig -> SE Sig
-pwPad x = mul (fades 0.3 0.95) $ at (mlp (x * 5) 0.15) $ do
+pwPad = pwPadBy mlp
+
+pwPadBy :: ResonFilter -> Sig -> SE Sig
+pwPadBy filter x = mul (fades 0.3 0.95) $ at (filter (x * 5) 0.15) $ do
let lfo = uosc 4
return $ mul 0.5 $ pw (0.2 + 0.4 * lfo) x + tri (x * cent 8)
diff --git a/src/Csound/Catalog/Wave/Fm.hs b/src/Csound/Catalog/Wave/Fm.hs
new file mode 100644
index 0000000..99f3759
--- /dev/null
+++ b/src/Csound/Catalog/Wave/Fm.hs
@@ -0,0 +1,17 @@
+module Csound.Catalog.Wave.Fm(
+ fmBass1, fmBass2
+) where
+
+import Csound.Base
+
+fmBass1 :: MonoAdsr -> (Sig, Sig) -> Sig
+fmBass1 env (amp, cps) = bhp 35 $ env 0.01 3 0.01 0.05 * (port amp 0.01) * (\x -> fosc 2 1 (1.5 * env 0.01 0.5 0.5 0.05) x + 0.4 * osc (x * 0.501)) (cps * (let env1 = env 1.2 0.1 0.85 5 * env 1.2 0.75 0.25 0.05 in 1 + (0.02 * env1 * uosc (3 * env1))))
+
+fmBass2 :: MonoAdsr -> (Sig, Sig) -> Sig
+fmBass2 adsrEnv (amp, cps) = env1 * (\freq -> fosc 1 1 (1 + 3.4 * env2) freq) ((cps * (1 + 0.001 * osc (2 * env4) * env4)))
+ where
+ env1 = adsrEnv 0.015 (5.2 + rel) 0.001 0.5
+ env2 = adsrEnv 0.015 1.4 0.5 1.2
+ env4 = adsrEnv 3.2 0.1 0.85 5
+
+ rel = 3 * (1 - (cps - 50) / 150) \ No newline at end of file
diff --git a/src/Csound/Catalog/Wave/Misc.hs b/src/Csound/Catalog/Wave/Misc.hs
index f875e25..71d2c08 100644
--- a/src/Csound/Catalog/Wave/Misc.hs
+++ b/src/Csound/Catalog/Wave/Misc.hs
@@ -1,10 +1,12 @@
-module Csound.Catalog.Wave.Misc (
+module Csound.Catalog.Wave.Misc (
okComputer, polySynthFx, polySynth,
- dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad,
- dreamPadBy,
+ dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad,
+ dreamPadBy, lightIsTooBrightPadBy, whaleSongPadBy,
deepBass,
- impulseMarimba1, impulseMarimba2
+ impulseMarimba1, impulseMarimba2,
+
+ celloWave
) where
import Csound.Base
@@ -20,35 +22,45 @@ okComputer cps = fmap go $ noise 11000 0.99
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
+
+dreamPad :: ResonFilter -> Sig -> Sig -> SE Sig
+dreamPad filter = dreamPadBy filter rndSaw
-genDreamPadInstr mkOsc brightness x = do
+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 :: Sig -> Sig
impulseMarimba2 cps = bat (bp cps 120) $ impulse 0
-
+celloWave :: (D, Sig) -> SE Sig
+celloWave = go p t x y z
+ where
+ go p t x y z = (\(amp, cps) -> ($ cps) ((mul $ sig amp) . at (
+ mlp (800) 0.45 .
+ hp 50 10 .
+ bat (\x -> sum [
+ bp (300 + 200 * (p - 0.5)) 60 x,
+ bp (700 + 300 * (t - 0.5)) 40 x,
+ bp (1500 + 600 * (x - 0.5)) 30 x]) .
+ mul (leg (0.1 + 0.5 * (1 - amp)) 0.5 0.8 0.1)) .
+ rndSaw .
+ (\x -> x * (1 + y * 0.07 * linsegr [0, 0.2, 0.3, 0.2, 0.85, 5, 1] 0.2 1 * osc (12 * z)))))
+ p = 0.25
+ t = 0.3
+ x = 0.45
+ y = 0.15
+ z = 0.45
diff --git a/src/Csound/Catalog/Wave/Thor.hs b/src/Csound/Catalog/Wave/Thor.hs
index af55a83..0afaad4 100644
--- a/src/Csound/Catalog/Wave/Thor.hs
+++ b/src/Csound/Catalog/Wave/Thor.hs
@@ -2,14 +2,16 @@
module Csound.Catalog.Wave.Thor(
cathedralOrgan, cathedralOrganFx, hammondOrgan,
- amPiano,
+ amPiano, amPianoBy,
pwBass, pwHarpsichord, pwEnsemble,
+ pwBassBy, pwHarpsichordBy, pwEnsembleBy,
+
simpleBass,
ReleaseTime,
- EpianoOsc(..), epiano, pianoEnv, xpianoEnv,
+ EpianoOsc(..), epiano, epianoBy, pianoEnv, xpianoEnv,
noisyChoir, thorWind, mildWind, boom, windWall,
@@ -48,15 +50,21 @@ hammondOrgan dt x = mul (fades 0.01 0.05) $ fmap mean $ mapM rndOsc
------------------------------
-- 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 @@ simpleBass (amp, cps') = aout
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 @@ pianoEnv userRelease (amp, cps) = sig amp * leg 0.001 sust 0.25 rel
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 @@ windWall cps = mul amEnv $ at (hp1 400) $ at (mlp (filtEnv * cps) 0.2) (mul 20 w
------------------------------
-- 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 @@ genRazor filter speed amp cps = mul amp $ do
, fosc 3 1 (a2 * uosc (speed + 0.2)) cps
, fosc 1 7 (a1 * uosc (speed - 0.15)) cps ]
where ampSpline c = rspline ( amp) (3.5 + amp) ((speed / 4) * (c - 0.1)) ((speed / 4) * (c + 0.1))
-
-
-
-
diff --git a/src/Csound/Patch.hs b/src/Csound/Patch.hs
index ff1f6e9..52a66fe 100644
--- a/src/Csound/Patch.hs
+++ b/src/Csound/Patch.hs
@@ -9,6 +9,7 @@
--
-- The function @atMidi@ invokes a @Patch@ with midi.
module Csound.Patch(
+
-- * Electric piano
Epiano1(..), epiano1, epiano1',
MutedPiano(..), mutedPiano, mutedPiano',
@@ -40,7 +41,7 @@ module Csound.Patch(
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 @@ module Csound.Patch(
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 @@ module Csound.Patch(
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 Csound.Catalog.Wave(Accordeon(..),
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' def
mutedPiano' (MutedPiano mute rel) = fx1 0.25 (largeHall2 . at (mlp3 (250 + 7000 * mute) 0.2)) $
polySynt $ \a -> mul 0.7 $ C.simpleSust rel a
-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 :: ReleaseTime
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 @@ hammondOrganm = hammondOrganm' def
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,11 +366,17 @@ triOrganm = mul 0.5 $ waveOrganm rndTri
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 @@ noisyChoir' ch = fx1 0.15 largeHall2 $ dryNoisyChoir ch
----------------------------------------------
-- 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 @@ razorPad = razorPad' def
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 @@ dreamPadBym = dreamPadBym' 0.35
-- | 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' def
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 @@ overtoneLead = fx1' 0.15 overtoneLeadFx $ polySynt $ mul 0.4 . at fromMono . onC
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 @@ scrapeFast k m = fx1 0.15 largeHall2 $ polySynt $ \x@(amp, cps) -> (mul (0.75 *
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 @@ impulseMarimba1 = fx1 0.3 smallHall2 $ polySynt $ at fromMono . mul (0.8 * fadeO
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,11 +1320,18 @@ purePadSharc instr = fx1 0.35 largeHall2 $ polySynt $ fmap fromMono . onCps (C.p
-- | 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
@@ -1300,7 +1348,7 @@ psOrganSharcHifi = psOrganSharc' hiDef
-- | 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 @@ psLargeOrganSharcHifi = psLargeOrganSharc' hiDef
-- | 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 @@ psPianoSharcHifi = psPianoSharc' hiDef
-- | Padsynth instrument with piano-like amplitude envelope. We can specify aux parameters.
psPianoSharc' :: PadSharcSpec -> ReleaseTime -> SharcInstr -> Patch2
psPianoSharc' spec releaseTime sh = fxs $ polySynt $ \ampCps -> mul (0.75 * C.pianoEnv releaseTime ampCps) $ onCps (C.padsynthSharcOsc2' spec sh) ampCps
- 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 @@ xpsPianoSharcHifi = xpsPianoSharc' hiDef
-- | 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 @@ psLargePianoSharcHifi = psLargePianoSharc' hiDef
-- | 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 @@ xpsLargePianoSharcHifi = xpsLargePianoSharc' hiDef
-- | 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 @@ psOscCfd4 koeffX koeffY (spec1, sh1) (spec2, sh2) (spec3, sh3) (spec4, sh4) x =
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 @@ vedicSizeLofi = 4
-- 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 @@ vedicPad instr bandwidth = mul 0.8 $
-- Good values for bandwidth lies in the interval [0, 120]
vedicPadCfd :: Sig -> SharcInstr -> SharcInstr -> PadsynthBandwidth -> Patch2
vedicPadCfd k instr1 instr2 bandwidth = mul 0.8 $
- addPreFx 0.45 (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 @@ vedicPadCfd k instr1 instr2 bandwidth = mul 0.8 $
-- 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 @@ vedicPadCfd4 kX kY instr1 instr2 instr3 instr4 bandwidth = mul 0.8 $
-- 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 @@ vedicPadHifi instr bandwidth = mul 0.8 $
-- 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 @@ avataraBhumi = vedicCfd shAvatara shBhumi
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 = noisySpiral' 8
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 @@ noisySpec = defPadsynthSpec 82.2 noisyHarms
-- 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)