summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAntonKholomiov <>2015-09-11 15:58:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-09-11 15:58:00 (GMT)
commit20faa284b7f642412c23e68e647124c7472afc2b (patch)
tree3678ba79fa962607ace55f5d4cdc9080f8c37729
parent459bcf79f59615c53c5621d721868e31e259b841 (diff)
version 0.3.00.3.0
-rw-r--r--csound-catalog.cabal12
-rw-r--r--src/Csound/Catalog.hs2
-rw-r--r--src/Csound/Catalog/Drum.hs216
-rw-r--r--src/Csound/Catalog/Drum/Hm.hs197
-rw-r--r--src/Csound/Catalog/Drum/MiniPops.hs444
-rw-r--r--src/Csound/Catalog/Drum/Tr808.hs555
-rw-r--r--src/Csound/Catalog/Effect.hs8
-rw-r--r--src/Csound/Catalog/Reson.hs2
-rw-r--r--src/Csound/Catalog/Wave.hs41
-rw-r--r--src/Csound/Catalog/Wave/Amsterdam.hs2
-rw-r--r--src/Csound/Catalog/Wave/Bitwig.hs51
-rw-r--r--src/Csound/Catalog/Wave/Flavio.hs63
-rw-r--r--src/Csound/Catalog/Wave/Misc.hs55
-rw-r--r--src/Csound/Catalog/Wave/Sean.hs202
-rw-r--r--src/Csound/Catalog/Wave/Thor.hs168
-rw-r--r--src/Csound/Catalog/Wave/Woodwind.hs3
-rw-r--r--src/Csound/Catalog/Wave/WoodwindAlg.hs7
-rw-r--r--src/Csound/Patch.hs1158
18 files changed, 3025 insertions, 161 deletions
diff --git a/csound-catalog.cabal b/csound-catalog.cabal
index 4d8f83b..5dd92c4 100644
--- a/csound-catalog.cabal
+++ b/csound-catalog.cabal
@@ -1,5 +1,5 @@
Name: csound-catalog
-Version: 0.2.2
+Version: 0.3.0
Cabal-Version: >= 1.6
License: BSD3
License-file: LICENSE
@@ -27,15 +27,19 @@ Source-repository head
Library
Ghc-Options: -Wall
Build-Depends:
- base >= 4, base < 5, transformers >= 0.3, csound-expression >= 4.3
+ base >= 4, base < 5, transformers >= 0.3, csound-expression >= 4.8.3, csound-sampler >=0.0.6.3
Hs-Source-Dirs: src/
Exposed-Modules:
Csound.Catalog
Csound.Catalog.Drum
+ Csound.Catalog.Drum.Hm
+ Csound.Catalog.Drum.Tr808
+ Csound.Catalog.Drum.MiniPops
Csound.Catalog.Effect
Csound.Catalog.Envelope
Csound.Catalog.Reson
Csound.Catalog.Wave
+ Csound.Patch
Other-Modules:
Csound.Catalog.Wave.Woodwind
Csound.Catalog.Wave.WoodwindAlg
@@ -47,4 +51,8 @@ Library
Csound.Catalog.Wave.TrappedInConvert
Csound.Catalog.Wave.Amsterdam
Csound.Catalog.Wave.Misc
+ Csound.Catalog.Wave.Sean
+ Csound.Catalog.Wave.Flavio
+ Csound.Catalog.Wave.Thor
+ Csound.Catalog.Wave.Bitwig
diff --git a/src/Csound/Catalog.hs b/src/Csound/Catalog.hs
index a1c9393..e832a77 100644
--- a/src/Csound/Catalog.hs
+++ b/src/Csound/Catalog.hs
@@ -12,7 +12,7 @@ module Csound.Catalog
, module Csound.Catalog.Effect
, module Csound.Catalog.Envelope
, module Csound.Catalog.Reson
- , module Csound.Catalog.Wave
+ , module Csound.Catalog.Wave
) where
import Csound.Catalog.Drum
diff --git a/src/Csound/Catalog/Drum.hs b/src/Csound/Catalog/Drum.hs
index 7405860..bc0642b 100644
--- a/src/Csound/Catalog/Drum.hs
+++ b/src/Csound/Catalog/Drum.hs
@@ -1,156 +1,76 @@
-- | A gallery of the percussive sounds.
module Csound.Catalog.Drum(
- -- * Subtractive
- dumb, dumbBass, pluckSnare, sortaKnockSweep, metalBoink,
+ -- * Hans Mikelson Drum kit
+ hmBd1, hmBd2, hmBd3, hmSn1, hmSn2, hmSweeo, hmBoink, hmOhh, hmChh, hmCr, hmClap,
- -- * Fullkit
+ -- * Tr808 Drum kit
+ trBd, trSn, trOhh, trChh, trHtom, trMtom, trLtom, trCym, trCl, trRim, trMar, trHcon, trMcon, trLcon,
- -- ** Non-pitched drums
- snare, openHihat, closedHihat,
+ -- * Korg MiniPops Drum kit
+ mpBd, mpSn1, mpSn2, mpRim, mpCym1, mpCym2, mpBon1, mpBon2, mpBon3, mpCl, mpCow, mpGro, mpMar, mpQj, mpTam,
- -- ** Pitched drums
- --
- -- The instrument turns a pitch (in Hz) to the signal.
- bassDrum, crash, handClap
+ -- * Csound percussive models kit
+ boo, gro, sbells, tam, cab, crun, shake, spaper,
) where
import Csound.Base
-
--- subtractive
-
-bpb :: Sig -> Sig -> Sig -> Sig
-bpb cfq q asig = balance (bp cfq q asig) asig
-
--- | A \"dumb\" drum.
-dumb :: SE Sig
-dumb = fmap (bpb 1000 100) $ rand $ expseg [0.0001, 0.01, 1, 0.04, 0.01]
-
-dumbBass :: SE Sig
-dumbBass = fmap (bpb kfreqenv (kfreqenv / 8)) $ rand $ expseg [0.0001, 0.01, 1, 0.08, 0.01]
- where kfreqenv = expseg [50, 0.01, 200, 0.08, 50]
-
-pluckSnare :: Sig
-pluckSnare = pluck kampenv4 kptchenv 50 (elins [1, 1]) 4 `withDs` [0.8, 3]
- where
- kampenv4 = linseg [0, 0.001, 1, xdur - 0.21, 1, 0.02, 0]
- kptchenv = linseg [100, 0.01, 300, 0.2, 200, 0.01, 200]
- xdur = 1.25
-
-
-sortaKnockSweep :: SE Sig
-sortaKnockSweep =
- fmap (resonsBy bpb
- [ (kfreqenv41, kfreqenv41 / 8)
- , (kfreqenv42, kfreqenv42 / 4)
- ]
- ) $ rand kampenv4
- where
- kfreqenv41 = expseg [ 50, 0.01, 200, 0.08, 50]
- kfreqenv42 = linseg [ 150, 0.01, 1000, 0.08, 250]
- kampenv4 = linseg [ 0, 0.01, 1, 0.08, 0, 0.01, 0]
-
-metalBoink :: Sig
-metalBoink = foscil kampenv61 30 1 6.726 kampenv62 sine
- where
- kampenv61 = expseg [ 0.01, 0.01, 1, 0.2, 0.1, 0.1, 0.001 ]
- kampenv62 = linseg [ 1, 0.1, 10, 0.1, 0.5, 0.01, 1 ]
-
--- fullkit
-
-bassDrum :: D -> Sig
-bassDrum cps= env * osc (sig cps * kgliss * 0.5)
- where env = linseg [0, 0.00245, 1, 0.1225, 0]
- kgliss = expseg [10, 0.625, 1, 0.25, 1]
-
-
-openHihat :: SE Sig
-openHihat = hihat $ linseg [0, 0.004, 1, 0.121, 0]
-
-closedHihat :: SE Sig
-closedHihat = hihat $ linseg [0, 0.00245, 1, 0.1225, 0]
-
-hihat :: Sig -> SE Sig
-hihat kenv = do
- asig <- rand kenv
- let a1 = moogvcf (butbp asig cf (cf / 2)) cf 0.7
- a2 = comb a1 0.5 (1/cpspch(8))
- return $ a2 * 0.05 + a1 * 0.93
- where cf = cpspch (5.08 + 8)
-
-snare :: SE Sig
-snare = do
- asound <- rand 1
- let as1 = butbp asound 210 55
- return $ kenv2 * (as1 * 0.9 + asound * 0.8 * kenv1)
- where
- kenv1 = linseg [0, 0.00176, 1, 0.1232, 0]
- kenv2 = expseg [0.01, 0.0002, 1, 0.0297, 0.01, 0.09, 0.01]
-
--- | Recommended values cpspch(13.03) - cpspch(13.10)
-crash :: D -> SE Sig
-crash cps = do
- asig <- rand 1
- return $ 0.5 * (0.5 * aall + resonator (aall + asig * kenv2))
- where
- kenv2 = expseg [0.001, 0.0466, 1, 3.95, 0.001]
-
- resonator asig = 0.7 * a1 + 0.6 * kenv18 * a2
- where
- flt a = butbp asig (sig $ a * cps) (sig $ 0.5 * cps)
- a1 = sum $ fmap flt [1, 2.1, 2.8]
- a2 = comb a1 0.5 (0.5 / cps)
- kenv18 = expseg [0.01, 0.02, 1, 3.98, 0.01]
-
- harm k amp hs = k * amp * mean (fmap (osc . sig . ( * cps)) hs)
-
- aall = sum $ zipWith3 harm weights envelopes harmonics
-
- harmonics =
- [ [1, 0.89, 1.12341]
- , [2.24, 2.4 * 0.98, 2.14 * 1.02]
- , [3.312, 3.513312*0.89, 3.123312*1.11]
- , [4.89, 5.89*0.89, 6.89 * 1.03]
- , [5.12, 5.5612*1.02, 7.7312 * 0.998]
- , [6.97, 6.97 * 1.02, 6.97 * 0.98]
- , [7.89, 7.89 * 1.02, 7.89 * 0.98]
- , [1.25, 1.125 * 1.004, 1.134 * 0.996]
- ]
-
- weights = replicate 7 0.2 ++ [0.1]
-
- envelopes = fmap (\(a, b) -> expseg [0.01, a, 1, b, 0.01])
- [ (0.0274, 3.972)
- , (0.0264, 3.973)
- , (0.0209, 3.979)
- , (0.0248, 3.975)
- , (0.0283, 3.971)
- , (0.0330, 3.966)
- , (0.0396, 3.960)
- , (0.0209, 3.979)
- ]
-
-handClap :: D -> SE Sig
-handClap cps = fmap onNoise $ rand 1
- where
- kenv1 = expseg [1.25, 0.03, 0.0001]
- kenv2 = expseg [0.001, 0.005, 1, 0.35, 0.001]
-
- onNoise asig = aout
- where
- anoise1 = kenv1 * asig
- anoise2 = kenv2 * asig
-
- adel1 = anoise1
- adel2 = delaySig 0.01 anoise1
- adel3 = delaySig 0.02 anoise1
- adel4 = delaySig 0.03 anoise2
-
- aout = mean
- [ rz adel1 2
- , rz adel2 3
- , rz adel3 4
- , rz adel4 5.5
- ]
-
- rz x y = resonz x (sig $ cps * y) (sig $ cps * 5.5)
-
+import Csound.Sam
+
+import qualified Csound.Catalog.Drum.Hm as H
+import qualified Csound.Catalog.Drum.Tr808 as T
+import qualified Csound.Catalog.Drum.MiniPops as M
+
+
+hmBd1 = H.bd1
+hmBd2 = H.bd2
+hmBd3 = H.bd3
+hmSn1 = H.sn1
+hmSn2 = H.sn2
+hmSweeo = H.sweep
+hmBoink = H.boink
+hmOhh = H.ohh
+hmChh = H.chh
+hmCr = H.cr
+hmClap = H.clap
+
+trBd = T.bd
+trSn = T.sn
+trOhh = T.ohh
+trChh = T.chh
+trHtom = T.htom
+trMtom = T.mtom
+trLtom = T.ltom
+trCym = T.cym
+trCl = T.cl
+trRim = T.rim
+trMar = T.mar
+trHcon = T.hcon
+trMcon = T.mcon
+trLcon = T.lcon
+
+mpBd = M.bd
+mpSn1 = M.sn1
+mpSn2 = M.sn2
+mpRim = M.rim
+mpCym1 = M.cym1
+mpCym2 = M.cym2
+mpBon1 = M.bon1
+mpBon2 = M.bon2
+mpBon3 = M.bon3
+mpCl = M.cl
+mpCow = M.cow
+mpGro = M.gro
+mpMar = M.mar
+mpQj = M.qj
+mpTam = M.tam
+
+mkSam = limSam 1
+
+boo = mkSam $ bamboo 1 0.01
+gro = mkSam $ guiro 1 0.01
+sbells = mkSam $ sleighbells 1 0.01
+tam = mkSam $ tambourine 1 0.01
+cab = mkSam $ cabasa 1 0.01
+crun = mkSam $ crunch 1 0.1
+shake cps = mkSam $ shaker 1 cps 8 0.999 100 `withD` 0
+spaper = mkSam $ sandpaper 1 0.01
diff --git a/src/Csound/Catalog/Drum/Hm.hs b/src/Csound/Catalog/Drum/Hm.hs
new file mode 100644
index 0000000..bd688f3
--- /dev/null
+++ b/src/Csound/Catalog/Drum/Hm.hs
@@ -0,0 +1,197 @@
+-- | Drums defined by Hans Mikelson.
+module Csound.Catalog.Drum.Hm(
+ -- * Subtractive
+ dumb, dumbBass, pluckSnare, sortaKnockSweep, metalBoink,
+
+ -- * Fullkit
+
+ -- ** Non-pitched drums
+ snare, openHihat, closedHihat,
+
+ -- ** Pitched drums
+ --
+ -- The instrument turns a pitch (in Hz) to the signal.
+ bassDrum, crash, handClap,
+ bassDrum', crash', handClap',
+
+ -- * Sampler
+ bd1, bd2, sn1, sweep, boink, sn2, ohh, chh, bd3, cr, clap
+) where
+
+import Csound.Base
+import Csound.Sam
+
+-- subtractive
+
+bpb :: Sig -> Sig -> Sig -> Sig
+bpb cfq q asig = balance (bp cfq q asig) asig
+
+rndAmp :: Sig -> SE Sig
+rndAmp a = do
+ k <- birnd 0.09
+ return $ a * (1 + sig k)
+
+addDur' dt x = xtratim dt >> return x
+addDur = addDur' 0.1
+
+toDrum :: Sig -> SE Sig
+toDrum a = rndAmp =<< addDur a
+
+-- | A \"dumb\" drum.
+dumb :: SE Sig
+dumb = (toDrum =<<) $ fmap (bpb 1000 100) $ rand $ expseg [0.0001, 0.01, 1, 0.04, 0.01]
+
+dumbBass :: SE Sig
+dumbBass = (toDrum =<<) $ fmap (bpb kfreqenv (kfreqenv / 8)) $ rand $ expseg [0.0001, 0.01, 1, 0.08, 0.01]
+ where kfreqenv = expseg [50, 0.01, 200, 0.08, 50]
+
+pluckSnare :: SE Sig
+pluckSnare = toDrum $ pluck kampenv4 kptchenv 50 (elins [1, 1]) 4 `withDs` [0.8, 3]
+ where
+ kampenv4 = linseg [0, 0.001, 1, xdur - 0.21, 1, 0.02, 0]
+ kptchenv = linseg [100, 0.01, 300, 0.2, 200, 0.01, 200]
+ xdur = 1.25
+
+
+sortaKnockSweep :: SE Sig
+sortaKnockSweep = (toDrum =<<) $
+ fmap (resonsBy bpb
+ [ (kfreqenv41, kfreqenv41 / 8)
+ , (kfreqenv42, kfreqenv42 / 4)
+ ]
+ ) $ rand kampenv4
+ where
+ kfreqenv41 = expseg [ 50, 0.01, 200, 0.08, 50]
+ kfreqenv42 = linseg [ 150, 0.01, 1000, 0.08, 250]
+ kampenv4 = linseg [ 0, 0.01, 1, 0.08, 0, 0.01, 0]
+
+metalBoink :: SE Sig
+metalBoink = toDrum $ foscil kampenv61 30 1 6.726 kampenv62 sine
+ where
+ kampenv61 = expseg [ 0.01, 0.01, 1, 0.2, 0.1, 0.1, 0.001 ]
+ kampenv62 = linseg [ 1, 0.1, 10, 0.1, 0.5, 0.01, 1 ]
+
+-- fullkit
+
+bassDrum = bassDrum' 64
+
+bassDrum' :: D -> SE Sig
+bassDrum' cps = toDrum $ env * osc (sig cps * kgliss * 0.5)
+ where env = linseg [0, 0.00245, 1, 0.1225, 0]
+ kgliss = expseg [10, 0.625, 1, 0.25, 1]
+
+
+openHihat :: SE Sig
+openHihat = hihat $ linseg [0, 0.004, 1, 0.121, 0]
+
+closedHihat :: SE Sig
+closedHihat = hihat $ linseg [0, 0.00245, 1, 0.1225, 0]
+
+hihat :: Sig -> SE Sig
+hihat kenv = toDrum =<< do
+ asig <- rand kenv
+ let a1 = moogvcf (butbp asig cf (cf / 2)) cf 0.7
+ a2 = comb a1 0.5 (1/cpspch(8))
+ return $ a2 * 0.05 + a1 * 0.93
+ where cf = cpspch (5.08 + 8)
+
+snare :: SE Sig
+snare = toDrum =<< do
+ asound <- rand 1
+ let as1 = butbp asound 210 55
+ return $ kenv2 * (as1 * 0.9 + asound * 0.8 * kenv1)
+ where
+ kenv1 = linseg [0, 0.00176, 1, 0.1232, 0]
+ kenv2 = expseg [0.01, 0.0002, 1, 0.0297, 0.01, 0.09, 0.01]
+
+crash = crash' $ cpspch 13.05
+
+-- | Recommended values cpspch(13.03) - cpspch(13.10)
+crash' :: D -> SE Sig
+crash' cps = toDrum =<< do
+ asig <- rand 1
+ return $ 0.5 * (0.5 * aall + resonator (aall + asig * kenv2))
+ where
+ kenv2 = expseg [0.001, 0.0466, 1, 3.95, 0.001]
+
+ resonator asig = 0.7 * a1 + 0.6 * kenv18 * a2
+ where
+ flt a = butbp asig (sig $ a * cps) (sig $ 0.5 * cps)
+ a1 = sum $ fmap flt [1, 2.1, 2.8]
+ a2 = comb a1 0.5 (0.5 / cps)
+ kenv18 = expseg [0.01, 0.02, 1, 3.98, 0.01]
+
+ harm k amp hs = k * amp * mean (fmap (osc . sig . ( * cps)) hs)
+
+ aall = sum $ zipWith3 harm weights envelopes harmonics
+
+ harmonics =
+ [ [1, 0.89, 1.12341]
+ , [2.24, 2.4 * 0.98, 2.14 * 1.02]
+ , [3.312, 3.513312*0.89, 3.123312*1.11]
+ , [4.89, 5.89*0.89, 6.89 * 1.03]
+ , [5.12, 5.5612*1.02, 7.7312 * 0.998]
+ , [6.97, 6.97 * 1.02, 6.97 * 0.98]
+ , [7.89, 7.89 * 1.02, 7.89 * 0.98]
+ , [1.25, 1.125 * 1.004, 1.134 * 0.996]
+ ]
+
+ weights = replicate 7 0.2 ++ [0.1]
+
+ envelopes = fmap (\(a, b) -> expseg [0.01, a, 1, b, 0.01])
+ [ (0.0274, 3.972)
+ , (0.0264, 3.973)
+ , (0.0209, 3.979)
+ , (0.0248, 3.975)
+ , (0.0283, 3.971)
+ , (0.0330, 3.966)
+ , (0.0396, 3.960)
+ , (0.0209, 3.979)
+ ]
+
+handClap = handClap' 400
+
+handClap' :: D -> SE Sig
+handClap' cps = (toDrum =<< ) $ fmap onNoise $ rand 1
+ where
+ kenv1 = expseg [1.25, 0.03, 0.0001]
+ kenv2 = expseg [0.001, 0.005, 1, 0.35, 0.001]
+
+ onNoise asig = aout
+ where
+ anoise1 = kenv1 * asig
+ anoise2 = kenv2 * asig
+
+ adel1 = anoise1
+ adel2 = delaySig 0.01 anoise1
+ adel3 = delaySig 0.02 anoise1
+ adel4 = delaySig 0.03 anoise2
+
+ aout = mean
+ [ rz adel1 2
+ , rz adel2 3
+ , rz adel3 4
+ , rz adel4 5.5
+ ]
+
+ rz x y = resonz x (sig $ cps * y) (sig $ cps * 5.5)
+
+--------------------------------------------------
+-- sampler
+
+mkSam = limSam 1
+
+bd1 = mkSam dumb
+bd2 = mkSam dumbBass
+
+sn1 = mkSam pluckSnare
+sweep = mkSam sortaKnockSweep
+boink = mkSam metalBoink
+
+sn2 = mkSam snare
+ohh = mkSam openHihat
+chh = mkSam closedHihat
+
+bd3 = mkSam bassDrum
+cr = mkSam crash
+clap = mkSam handClap
diff --git a/src/Csound/Catalog/Drum/MiniPops.hs b/src/Csound/Catalog/Drum/MiniPops.hs
new file mode 100644
index 0000000..f2456ec
--- /dev/null
+++ b/src/Csound/Catalog/Drum/MiniPops.hs
@@ -0,0 +1,444 @@
+-- | Drums of the Korg Mini Pops 7 drum machine (recoded from Iain McCurdy).
+module Csound.Catalog.Drum.MiniPops(
+ MpSpec(..),
+
+ bass, snare1, snare2, rimShot, cymbal1, cymbal2, bongo1, bongo2, bongo3,
+ claves, cowbell, guiro, maracas, quijada, tamb,
+
+ -- * Generic
+ bass', bdSpec, snare1', snSpec1, snare2', snSpec2, rimShot', rimSpec,
+ cymbal1', cymSpec1, cymbal2', cymSpec2, bongo1', bonSpec1, bongo2', bonSpec2, bongo3', bonSpec3,
+ claves', clSpec, cowbell', cowSpec, guiro', groSpec, maracas', marSpec, quijada', qjSpec, tamb', tamSpec,
+
+ -- * Sample
+ bd, sn1, sn2, rim, cym1, cym2, bon1, bon2, bon3, cl, cow, gro, mar, qj, tam,
+
+ -- ** Generic
+ bd', sn1', sn2', rim', cym1', cym2', bon1', bon2', bon3', cl', cow', gro', mar', qj', tam'
+) where
+
+import Csound.Base hiding (guiro)
+import Csound.Sam
+
+data MpSpec = MpSpec {
+ mpDur :: D
+ , mpCps :: D
+ , mpRnd :: Maybe D }
+
+
+rndAmp :: Sig -> SE Sig
+rndAmp a = do
+ k <- birnd 0.09
+ return $ a * (1 + sig k)
+
+addDur' dt x = xtratim dt >> return x
+addDur = addDur' 0.1
+
+toDrum :: Sig -> SE Sig
+toDrum a = rndAmp =<< addDur a
+
+defSpec dur cps = MpSpec
+ { mpDur = dur
+ , mpCps = cps
+ , mpRnd = Just 0.085 }
+
+rndVal :: D -> D -> D -> SE D
+rndVal total amount x = do
+ k <- birnd amount
+ return $ x + k * total
+
+rndDur amt x = rndVal x amt x
+rndCps amt x = rndVal x (amt / 10) x
+
+rndSpec :: MpSpec -> SE MpSpec
+rndSpec spec = do
+ dur <- rndDur'
+ cps <- rndCps'
+ return $ spec
+ { mpDur = dur
+ , mpCps = cps }
+ where
+ rndDur' = (maybe return rndDur $ (mpRnd spec)) $ mpDur spec
+ rndCps' = (maybe return rndCps $ (mpRnd spec)) $ mpCps spec
+
+rezz cps bw = reson (mpulse 1 0) cps (cps * bw) `withD` 2
+
+bass = bass' bdSpec
+
+bdSpec = defSpec 0.43 64
+
+bass' spec = pureBass' =<< rndSpec spec
+
+-- dur = 1.7
+-- cps = 64
+pureBass' spec = toDrum aout
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ aout = mul (env * 225 * fadeOut dur) $ lp1 500 $ rezz cps 0.001
+ env = transeg [1, dur, -14, 0]
+
+
+snare1 = snare1' snSpec1
+
+snSpec1 = defSpec 0.38 800
+
+snare1' spec = pureSnare1' =<< rndSpec spec
+
+-- cps = 800
+pureSnare1' spec = toDrum =<< (mul (fadeOut dur) $ aout)
+ where
+ dur = mpDur spec
+ cps = mpCps spec
+
+ anoise = pink
+ asig = fmap (\x -> reson x 6250 9000 `withD` 1) anoise
+ aenv = transeg [1, dur ,-5 , 0]
+ asig1 = at (bhp 3000) $ mul aenv asig
+
+ xdur = 0.006
+ astrike = osc (transeg [cps,xdur,-4,60])
+ aenv2 = transeg [1,xdur,-2,0]
+ astrike1 = aenv2 * astrike
+
+ aout = fmap ((0.7 * astrike1) + ) $ mul 2 $ asig1
+
+snare2 = snare2' snSpec2
+
+snSpec2 = defSpec 0.4 800
+
+snare2' spec = pureSnare2' =<< rndSpec spec
+
+pureSnare2' spec = toDrum =<< (mul (fadeOut dur) $ aout)
+ where
+ dur = mpDur spec
+ cps = mpCps spec
+
+ anoise = pink
+ asig = fmap (\x -> butbp x 5200 5200 `withD` 1) anoise
+ aenv = transeg [1, dur ,-8 , 0]
+ asig1 = at (bhp 3000) $ mul aenv asig
+
+ xdur = 0.005
+ astrike = osc (transeg [cps,xdur,-4,cps / 4])
+ aenv2 = transeg [1,xdur,-2,0]
+ astrike1 = aenv2 * astrike
+
+ aout = fmap ((0.5 * astrike1) + ) $ mul 2.3 $ asig1
+
+
+rimShot = rimShot' rimSpec
+
+rimSpec = defSpec 0.005 1700
+
+rimShot' spec = pureRimShot' =<< rndSpec spec
+
+-- cps = 1700
+-- dur = 0.005
+pureRimShot' spec = toDrum $ mul (fadeOut dur) $ asig
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ aenv = expon 1 dur 0.0001
+ asig1 = osc' 0.2 cps
+ asig2 = reson asig1 cps 1500 `withD` 2
+ asig = bhp 500 (asig1 + asig2 * 0.4 * 0.3)
+
+cymbal1 = cymbal1' cymSpec1
+
+cymSpec1 = defSpec 0.304 6000
+
+cymbal1' spec = pureCymbal1' =<< rndSpec spec
+
+-- dur = 0.304
+-- cps = 6000
+pureCymbal1' spec = (toDrum =<< ) $ mul (fadeOut dur) $ do
+ anoise <- white
+ let asig1 = blp 14000 $ reson (anoise*aenv) icf (icf*0.7) `withD` 1
+ asig2 = bhp 6000 $ (asig1 + anoise * 0.001)
+ return $ 0.25 * aenv * asig2
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ aenv = transeg [1,dur,-2,0]
+ icf = cps
+
+
+cymbal2 = cymbal2' cymSpec2
+
+cymSpec2 = defSpec 1.404 1000
+
+cymbal2' spec = pureCymbal2' =<< rndSpec spec
+
+pureCymbal2' spec = (toDrum =<< ) $ mul (fadeOut dur) $ do
+ anoise <- white
+ let asig = mul aenv $ bhp 6000 $ mul aenv $ lp1 12000 $ reson (anoise * aenv) icf (icf * 0.9) `withD` 1
+ return $ astrike * 0.2 + asig * 1.5
+ where
+ dur = mpDur spec
+ cps = mpCps spec
+
+ icf = sig $ cps * 5
+ aenv = transeg [1,dur,-2,0]
+ xdur = 0.004
+ aenv2 = transeg [1,xdur,-2,0]
+ astrike = mul aenv2 $ osc (transeg [cps,xdur,-4,0.4*cps])
+
+-- dur = 0.2
+-- cps = 630
+bongo1 = bongo1' bonSpec1
+
+bonSpec1 = defSpec 0.2 630
+
+bongo1' spec = pureBongo1' =<< rndSpec spec
+
+pureBongo1' spec = toDrum $ mul (fadeOut dur) $ asig
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ asig = mul (4 * aenv ) $ blp 8000 $ bhp 300 $ rezz cps 0.03
+ aenv = transeg [1,dur,13,0]
+
+bongo2 = bongo2' bonSpec2
+
+bonSpec2 = defSpec 0.2 400
+
+bongo2' spec = pureBongo2' =<< rndSpec spec
+
+-- dur = 0.2
+-- cps = 400
+pureBongo2' spec = toDrum $ mul (fadeOut dur) $ asig
+ where
+ dur = mpDur spec
+ cps = mpCps spec
+
+ kcps = expon cps dur (cps * 0.975)
+ aenv = transeg [1,dur-0.005,0,0.1,0.005,0, 0]
+ asig = mul (4 * aenv) $ bhp 100 $ lp1 5000 $ rezz kcps 0.03
+
+
+bongo3 = bongo3' bonSpec3
+
+bonSpec3 = defSpec 1.229 194
+
+bongo3' spec = pureBongo3' =<< rndSpec spec
+
+-- dur = 1.229
+-- cps = 194
+pureBongo3' spec = toDrum $ mul (fadeOut dur) $ asig
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ aenv = transeg [0, 0.001, -2, 1, dur-0.001, -2, 0]
+ kbw = linseg [0.05,0.01,0.008]
+ asig = mul (5 * aenv) $ blp 11000 $ rezz cps kbw
+
+claves = claves' clSpec
+
+clSpec = defSpec 0.186 400
+
+claves' spec = pureClaves' =<< rndSpec spec
+
+pureClaves' spec = toDrum aout
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ aenv = linseg [1, dur, 0]
+ asig1 = rezz cps 0.025
+ asig2 = rezz (cps * 5.45) 0.03
+ aout = mul (3.2 * aenv * fadeOut dur) $ asig1 + 1.3 * asig2
+
+cowbell = cowbell' cowSpec
+
+cowSpec = defSpec 0.3 850
+
+cowbell' spec = pureCowbell' =<< rndSpec spec
+
+pureCowbell' spec = toDrum asig
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ asig = mul (aenv * 3 * fadeOut dur) $ bhp 100 $
+ rezz cps 0.007
+ + 0.8 * rezz (cps * 5.537) 0.03
+ aenv = linseg [1, dur, 0]
+
+guiro = guiro' groSpec
+
+groSpec = defSpec 0.256 66
+
+guiro' spec = pureGuiro' =<< rndSpec spec
+
+pureGuiro' spec = toDrum asig
+ where
+ dur = mpDur spec
+ cps = mpCps spec
+
+ aenv = linseg [0,0.001,1,dur-0.111,0.6,0.1,1,0.01,0]
+ asig = mul (3 * aenv * fadeOut dur) $ bhp 1000 $ reson (0.1 * sqr kcps) 4300 3000 `withD` 1
+ kcps = transeg [cps,dur,2,(1.1 * cps)]
+
+maracas = maracas' marSpec
+
+marSpec = defSpec 0.05 5000
+
+maracas' spec = pureMaracas' =<< rndSpec spec
+
+pureMaracas' spec = toDrum =<< do
+ asig <- noise 1 0.04
+ return $ mul (0.35 * aenv * fadeOut dur) $ bhp 2000 $ reson asig 9000 4000 `withD` 2
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ aenv = transeg [1,dur,-4,0]
+
+
+quijada = quijada' qjSpec
+
+qjSpec = defSpec 0.817 550
+
+quijada' spec = pureQuijada' =<< rndSpec spec
+
+pureQuijada' spec = toDrum $ bhp cps $ mul (6 * fadeOut dur) $ phi dur (1/22.7272) + phi (dur * 0.39) (1/13.1579)
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+
+ phi dt freq = mul kenv $ reson (mpulse 1 freq) 2727 400 `withD` 1
+ where kenv = transeg [0.8,0.05,1, 1,dt-0.05,-6,0]
+
+
+tamb = tamb' tamSpec
+
+tamSpec = defSpec 0.271 7000
+
+tamb' spec = pureTamb' =<< rndSpec spec
+
+pureTamb' spec = toDrum =<< do
+ anoise <- noise 1 0
+ return $ mul (1.5 * aenv * fadeOut dur)
+ $ reson (bhp cps $ (+ (anoise * 0.1 * aenv)) $ reson (anoise * aenv) 4600 100 `withD` 2) 9000 3000 `withD` 1
+ where
+ dur = mpDur spec
+ cps = sig $ mpCps spec
+ aenv = transeg [1,dur,-8,0]
+
+-------------------------------------------------------
+-- Sampler
+
+mkSam = limSam 1
+
+-- | Bass drum
+bd :: Sam
+bd = mkSam bass
+
+-- | Snare 1
+sn1 :: Sam
+sn1 = mkSam snare1
+
+-- | Snare 2
+sn2 :: Sam
+sn2 = mkSam snare2
+
+-- | Rim shot
+rim :: Sam
+rim = mkSam rimShot
+
+-- | Cymbal 1
+cym1 :: Sam
+cym1 = mkSam cymbal1
+
+-- | Cymbal 2
+cym2 :: Sam
+cym2 = mkSam cymbal2
+
+-- | Bongo 1
+bon1 :: Sam
+bon1 = mkSam bongo1
+
+-- | Bongo 2
+bon2 :: Sam
+bon2 = mkSam bongo2
+
+-- | Bongo 3
+bon3 :: Sam
+bon3 = mkSam bongo3
+
+-- | Claves
+cl :: Sam
+cl = mkSam claves
+
+-- | Cowbell
+cow :: Sam
+cow = mkSam cowbell
+
+-- | Guiro
+gro :: Sam
+gro = mkSam guiro
+
+-- | Maracas
+mar :: Sam
+mar = mkSam maracas
+
+-- | Quijada
+qj :: Sam
+qj = mkSam quijada
+
+-- | Tambourine
+tam :: Sam
+tam = mkSam tamb
+
+mkSam' f spec = mkSam $ f spec
+
+bd' :: MpSpec -> Sam
+bd' = mkSam' bass'
+
+sn1' :: MpSpec -> Sam
+sn1' = mkSam' snare1'
+
+sn2' :: MpSpec -> Sam
+sn2' = mkSam' snare2'
+
+rim' :: MpSpec -> Sam
+rim' = mkSam' rimShot'
+
+cym1' :: MpSpec -> Sam
+cym1' = mkSam' cymbal1'
+
+cym2' :: MpSpec -> Sam
+cym2' = mkSam' cymbal2'
+
+bon1' :: MpSpec -> Sam
+bon1' = mkSam' bongo1'
+
+bon2' :: MpSpec -> Sam
+bon2' = mkSam' bongo2'
+
+bon3' :: MpSpec -> Sam
+bon3' = mkSam' bongo3'
+
+cl' :: MpSpec -> Sam
+cl' = mkSam' claves'
+
+cow' :: MpSpec -> Sam
+cow' = mkSam' cowbell'
+
+gro' :: MpSpec -> Sam
+gro' = mkSam' guiro'
+
+mar' :: MpSpec -> Sam
+mar' = mkSam' maracas'
+
+qj' :: MpSpec -> Sam
+qj' = mkSam' quijada'
+
+tam' :: MpSpec -> Sam
+tam' = mkSam' tamb' \ No newline at end of file
diff --git a/src/Csound/Catalog/Drum/Tr808.hs b/src/Csound/Catalog/Drum/Tr808.hs
new file mode 100644
index 0000000..cfe16ad
--- /dev/null
+++ b/src/Csound/Catalog/Drum/Tr808.hs
@@ -0,0 +1,555 @@
+-- | Drums of the Korg TR-808 drum machine (recoded from Iain McCurdy).
+module Csound.Catalog.Drum.Tr808(
+ TrSpec(..),
+
+ bass, bass2, snare, openHiHat, closedHiHat,
+ lowTom, midTom, highTom, cymbal, claves, rimShot,
+ maraca, highConga, midConga, lowConga,
+
+ -- * Generic
+ bass', bass2', bdSpec, bdSpec2, snare', snSpec, openHiHat', ohSpec, closedHiHat', chSpec,
+ lowTom', ltSpec, midTom', mtSpec, highTom', htSpec, cymbal', cymSpec, claves', clSpec, rimShot', rimSpec,
+ maraca', marSpec, highConga', hcSpec, midConga', mcSpec, lowConga', lcSpec,
+
+ -- * Sampler
+ bd, bd2, sn, ohh, chh, htom, mtom, ltom, cym, cl, rim, mar, hcon, mcon, lcon,
+
+ -- ** Generic
+ bd', bd2', sn', ohh', chh', htom', mtom', ltom', cym', cl', rim', mar', hcon', mcon', lcon'
+
+) where
+
+import Control.Monad
+
+import Csound.Base
+import Csound.Sam
+
+-- don't forget to update the gen-opcodes and the hackage opcodes
+
+rndAmp :: Sig -> SE Sig
+rndAmp a = do
+ k <- birnd 0.09
+ return $ a * (1 + sig k)
+
+data TrSpec = TrSpec {
+ trDur :: D
+ , trTune :: D
+ , trCps :: D
+ , trRnd :: Maybe D
+ }
+
+cpsSpec cps = TrSpec
+ { trDur = 0.8
+ , trTune = 0
+ , trCps = cps
+ , trRnd = Just 0.085 }
+
+
+rndVal :: D -> D -> D -> SE D
+rndVal total amount x = do
+ k <- birnd amount
+ return $ x + k * total
+
+rndDur amt x = rndVal x amt x
+rndCps amt x = rndVal x (amt / 10) x
+rndTune amt x = rndVal 0.7 amt x
+
+rndSpec ::TrSpec -> SE TrSpec
+rndSpec spec = do
+ dur <- rndDur'
+ tune <- rndTune'
+ cps <- rndCps'
+ return $ spec
+ { trDur = dur
+ , trTune = tune
+ , trCps = cps }
+ where
+ rndDur' = (maybe return rndDur $ (trRnd spec)) $ trDur spec
+ rndTune' = (maybe return rndTune $ (trRnd spec)) $ trTune spec
+ rndCps' = (maybe return rndCps $ (trRnd spec)) $ trCps spec
+
+bdSpec = TrSpec
+ { trDur = 0.95
+ , trTune = 1
+ , trCps = 55
+ , trRnd = Just 0.05 }
+
+addDur' dt x = xtratim dt >> return x
+addDur = addDur' 0.1
+
+bass = bass' bdSpec
+
+bass' spec = pureBass' =<< rndSpec spec
+
+pureBass' :: TrSpec -> SE Sig
+pureBass' spec = rndAmp =<< addDur amix
+ where
+ dur = trDur spec
+ cps = trCps spec
+
+ kmul = transegr [0.2, dur * 0.5, -15, 0.01, dur * 0.5, 0, 0] dur 0 0
+ kbend = transegr [0.5, 1.2, -4, 0, 1, 0, 0] dur 0 0
+ asig = gbuzz 0.5 (sig cps * semitone kbend) 20 1 kmul cosine
+ aenv = transeg [1, dur - 0.004, -6, 0]
+ att = linseg [0, 0.004, 1]
+ asig1 = asig * aenv * att
+
+ aenv1 = linseg [1, 0.07, 0]
+ acps = expsega [8 * cps,0.07,0.001]
+ aimp = oscili aenv1 acps sine
+ amix = asig1 * 0.7 + aimp * 0.25
+
+bdSpec2 = TrSpec
+ { trDur = 1.3
+ , trTune = 1
+ , trCps = 57
+ , trRnd = Just 0.05 }
+
+bass2 = bass2' bdSpec2
+
+bass2' spec = pureBass2' =<< rndSpec spec
+
+pureBass2' :: TrSpec -> SE Sig
+pureBass2' spec = (rndAmp <=< addDur) $ compr $ mul (expsegr [1, 0.6 * dur, 0.1, 0.4 * dur, 0.001] (0.4 * dur) 0.001) $
+ fosc 1 2 (0.5 * xeg 0.01 0.1 0.2 0.5) (cps * semitone (expseg [12, 0.01, 27, 0.3, 0.001]))
+ where
+ compr x = dam x 0.65 2.4 2.3 0.05 0.1
+ dur = trDur spec
+ cps = sig $ trCps spec
+
+
+snSpec = cpsSpec 342
+
+snare = snare' snSpec
+
+snare' spec = pureSnare' =<< rndSpec spec
+
+-- sound consists of two sine tones, an octave apart and a noise signal
+pureSnare' :: TrSpec -> SE Sig
+pureSnare' spec = rndAmp =<< addDur =<< (apitch + anoise)
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ iNseDur = dur * 0.3
+ iPchDur = dur * 0.1
+
+ -- sine tones component
+ aenv1 = expsegr [1, iPchDur, 0.0001] iNseDur 0.0001
+ apitch1 = rndOsc (sig cps)
+ apitch2 = rndOsc (0.5 * sig cps)
+ apitch = mul (0.75 * aenv1) (apitch1 + apitch2)
+
+ -- noise component
+ aenv2 = expon 1 iNseDur 0.0005
+ kcf = expsegr [5000, 0.1, 3000] iNseDur 0.0001
+ anoise = mul aenv2 $ do
+ x <- noise 0.75 0
+ return $ blp kcf $ bhp 1000 $ bbp (10000 * octave (sig tune)) 10000 x
+
+ohSpec = cpsSpec 296
+chSpec = cpsSpec 296
+
+openHiHat = openHiHat' ohSpec
+closedHiHat = closedHiHat' chSpec
+
+openHiHat' :: TrSpec -> SE Sig
+openHiHat' spec = genHiHat (linsegr [1, (dur/2) - 0.05, 0.1, 0.05, 0] dur 0) spec
+ where dur = trDur spec
+
+closedHiHat' :: TrSpec -> SE Sig
+closedHiHat' spec = genHiHat (expsega [1, (dur / 2), 0.001]) spec
+ where dur = trDur spec
+
+-- sound consists of 6 pulse oscillators mixed with a noise component
+-- cps = 296
+genHiHat :: Sig -> TrSpec -> SE Sig
+genHiHat pitchedEnv spec = rndAmp =<< addDur =<< (amix1 + anoise)
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ halfDur = dur * 0.5
+
+ -- pitched element
+ harmonics = [1.0, 0.962, 1.233, 1.175,1.419, 2.821]
+ amix = mul 0.5 $ fmap sum $ mapM (rndPw 0.25 . sig . (* (cps * octave tune))) harmonics
+ amix1 = mul pitchedEnv $ at (\asig -> bhp 5000 $ bhp 5000 $ reson asig (5000 * octave (sig tune)) 5000 `withD` 1) amix
+
+ -- noise element
+ kcf = expseg [20000, 0.7, 9000, halfDur-0.1, 9000]
+ anoise = mul pitchedEnv $ do
+ x <- noise 0.8 0
+ return $ bhp 8000 $ blp kcf x
+
+htSpec = cpsSpec 200
+mtSpec = cpsSpec 133
+ltSpec = cpsSpec 90
+
+lowTom = lowTom' ltSpec
+midTom = midTom' mtSpec
+highTom = highTom' htSpec
+
+-- cps = 200
+highTom' :: TrSpec -> SE Sig
+highTom' = genTom 0.5 (400, 100, 1000)
+
+-- cps = 133
+midTom' :: TrSpec -> SE Sig
+midTom' = genTom 0.6 (400, 100, 600)
+
+-- cps = 90
+lowTom' :: TrSpec -> SE Sig
+lowTom' = genTom 0.6 (40, 100, 600)
+
+genTom :: D -> (Sig, Sig, Sig) -> TrSpec -> SE Sig
+genTom durDt (resonCf, hpCf, lpCf) spec = rndAmp =<< addDur =<< (asig + anoise)
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ ifrq = cps * octave tune
+ halfDur = durDt * dur
+
+ -- sine tone signal
+ aAmpEnv = transeg [1, halfDur, -10, 0.001]
+ afmod = expsega [5, 0.125/ifrq, 1]
+ asig = mul (-aAmpEnv) $ rndOsc (sig ifrq * afmod)
+
+ -- noise signal
+ aEnvNse = transeg [1, halfDur, -6 , 0.001]
+ otune = sig $ octave tune
+ anoise = mul aEnvNse $ do
+ x <- noise 1 0.4
+ return $ blp (lpCf * otune) $ bhp (hpCf * otune) $ reson x (resonCf * otune) 800 `withD` 1
+
+cymSpec = cpsSpec 296
+
+cymbal = cymbal' cymSpec
+
+-- sound consists of 6 pulse oscillators mixed with a noise component
+-- cps = 296
+cymbal' :: TrSpec -> SE Sig
+cymbal' spec = rndAmp =<< addDur =<< (fmap (amix1 + ) anoise)
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ fullDur = dur * 2
+
+ -- pitched element
+ harmonics = [1.0, 0.962, 1.233, 1.175,1.419, 2.821]
+ aenv = expon 1 fullDur 0.0001
+ amix = mul 0.5 $ sum $ fmap (pw 0.25 . sig . (* (cps * octave tune))) harmonics
+ amix1 = mul aenv $ blp 12000 $ blp 12000 $ bhp 10000 $ reson amix (5000 * octave (sig tune)) 5000 `withD` 1
+
+ -- noise element
+ aenv2 = expsega [1,0.3,0.07,fullDur-0.1,0.00001]
+ kcf = expseg [14000, 0.7, 7000, fullDur-0.1, 5000]
+ anoise = mul aenv2 $ do
+ x <- noise 0.8 0
+ return $ bhp 8000 $ blp kcf x
+
+clSpec = cpsSpec 2500
+
+claves = claves' clSpec
+
+-- cps = 2500
+claves' :: TrSpec -> SE Sig
+claves' spec = rndAmp =<< addDur =<< asig
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ ifrq = cps * octave tune
+ dt = 0.045 * dur
+ aenv = expsega [1, dt, 0.001]
+ afmod = expsega [3,0.00005,1]
+ asig = mul (- 0.4 * (aenv-0.001)) $ rndOsc (sig ifrq * afmod)
+
+rimSpec = cpsSpec 1700
+
+rimShot = rimShot' rimSpec
+
+rimShot' spec = pureRimShot' =<< rndSpec spec
+
+-- cps = 1700
+pureRimShot' :: TrSpec -> SE Sig
+pureRimShot' spec = rndAmp =<< addDur =<< (mul 0.8 $ aring + anoise)
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ fullDur = 0.027 * dur
+
+ -- ring
+ aenv1 = expsega [1,fullDur,0.001]
+ ifrq1 = sig $ cps * octave tune
+ aring = mul (0.5 * (aenv1 - 0.001)) $ at (bbp ifrq1 (ifrq1 * 8)) $ rndOscBy tabTR808RimShot ifrq1
+
+ -- noise
+ aenv2 = expsega [1, 0.002, 0.8, 0.005, 0.5, fullDur-0.002-0.005, 0.0001]
+ kcf = expsegr [4000, fullDur, 20] fullDur 20
+ anoise = mul (aenv2 - 0.001) $ fmap (blp kcf) $ noise 1 0
+
+ tabTR808RimShot = setSize 1024 $ sines [0.971,0.269,0.041,0.054,0.011,0.013,0.08,0.0065,0.005,0.004,0.003,0.003,0.002,0.002,0.002,0.002,0.002,0.001,0.001,0.001,0.001,0.001,0.002,0.001,0.001]
+
+cowSpec = cpsSpec 562
+
+cowbell = cowbell' cowSpec
+
+-- cps = 562
+cowbell' :: TrSpec -> SE Sig
+cowbell' spec = rndAmp =<< addDur =<< ares
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ ifrq1 = sig $ cps * octave tune
+ ifrq2 = 1.5 * ifrq1
+ fullDur = 0.7 * dur
+ ishape = -30
+ ipw = 0.5
+ kenv1 = transeg [1,fullDur*0.3,ishape,0.2, fullDur*0.7,ishape,0.2]
+ kenv2 = expon 1 fullDur 0.0005
+ kenv = kenv1 * kenv2
+ amix = mul 0.65 $ rndPw 0.5 ifrq1 + rndPw 0.5 ifrq2
+ iLPF2 = 10000
+ kcf = expseg [12000,0.07,iLPF2,1,iLPF2]
+ alpf = at (blp kcf) amix
+ abpf = at (\x -> reson x ifrq2 25) amix
+ ares = mul (0.08 * kenv) $ at dcblock2 $ mul (0.06 * kenv1) abpf + mul 0.5 alpf + mul 0.9 amix
+
+-- TODO clap
+
+{-
+instr 112 ;CLAP
+ krelease release ;SENSE RELEASE OF THIS NOTE ('1' WHEN RELEASED, OTHERWISE ZERO)
+ chnset 1-krelease,"Act12" ;TURN ON ACTIVE LIGHT WHEN NOTE STARTS, TURN IT OFF WHEN NOTE ENDS
+ iTimGap = 0.01 ;GAP BETWEEN EVENTS DURING ATTACK PORTION OF CLAP
+ idur1 = 0.02 ;DURING OF THE THREE INITIAL 'CLAPS'
+ idur2 = 2*i(gkdur12) ;DURATION OF THE FOURTH, MAIN, CLAP
+ idens = 8000 ;DENSITY OF THE NOISE SIGNAL USED TO FORM THE CLAPS
+ iamp1 = 0.5 ;AMPLITUDE OF AUDIO BEFORE BANDPASS FILTER IN OUTPUT
+ iamp2 = 1 ;AMPLITUDE OF AUDIO AFTER BANDPASS FILTER IN OUTPUT
+ if frac(p1)==0 then ;IF THIS IS THE INITIAL NOTE (p1 WILL BE AN INTEGER)
+ ; del. dur env.shape
+ event_i "i", p1+0.1, 0, idur1, p4 ;CALL THIS INSTRUMENT 4 TIMES. ADD A FRACTION ONTO p1 TO BE ABLE TO DIFFERENTIATE THESE SUBSEQUENT NOTES
+ event_i "i", p1+0.1, iTimGap, idur1, p4
+ event_i "i", p1+0.1, iTimGap*2, idur1, p4
+ event_i "i", p1+0.1, iTimGap*3, idur2, p4
+ else
+ kenv transeg 1,p3,-25,0 ;AMPLITUDE ENVELOPE
+ iamp random 0.7,1 ;SLIGHT RANDOMISATION OF AMPLITUDE
+ anoise pinkish kenv*iamp
+ iBPF = 1100*octave(i(gktune12)) ;FREQUENCY OF THE BANDPASS FILTER
+ ibw = 2000*octave(i(gktune12)) ;BANDWIDTH OF THE BANDPASS FILTER
+ iHPF = 1000 ;FREQUENCY OF A HIGHPASS FILTER
+ iLPF = 1 ;SCALER FOR FREQUENCY OF A LOWPASS FILTER
+ kcf expseg 8000,0.07,1700,1,800,2,500,1,500 ;CREATE CUTOFF FREQUENCY ENVELOPE
+ asig butlp anoise,kcf*iLPF ;LOWPASS FILTER THE SOUND
+ asig buthp asig,iHPF ;HIGHPASS FILTER THE SOUND
+ ares reson asig,iBPF,ibw,1 ;BANDPASS FILTER THE SOUND (CREATE A NEW SIGNAL)
+ asig dcblock2 (asig*iamp1)+(ares*iamp2) ;MIX BANDPASS FILTERED AND NON-BANDPASS FILTERED SOUND ELEMENTS
+ asig = asig*p4*i(gklevel12)*1.75*gklevel ;SCALE AMPLITUDE
+ aL,aR pan2 asig,i(gkpan12) ;PAN MONOPHONIC SIGNAL
+ outs aL,aR ;SEND AUDIO TO OUTPUTS
+ endif
+endin
+-}
+
+{-
+clap :: D -> D -> D -> Sig
+clap dur tune cps =
+ where
+ iTimGap = 0.01
+-}
+
+marSpec = cpsSpec 450
+
+maraca = maraca' marSpec
+
+maraca' :: TrSpec -> SE Sig
+maraca' spec = rndAmp =<< addDur =<< anoise
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ fullDur = 0.07* dur
+ otune = sig $ octave tune
+ iHPF = limit (6000 * otune) 20 (sig getSampleRate / 2)
+ iLPF = limit (12000 * otune) 20 (sig getSampleRate / 3)
+ aenv = expsega [0.4,0.014* dur,1,0.01 * dur, 0.05, 0.05 * dur, 0.001]
+ anoise = mul aenv $ fmap (blp iLPF . bhp iHPF) $ noise 0.75 0
+
+hcSpec = cpsSpec 420
+mcSpec = cpsSpec 310
+lcSpec = cpsSpec 227
+
+highConga = highConga' hcSpec
+midConga = midConga' mcSpec
+lowConga = lowConga' lcSpec
+
+-- high conga
+-- cps = 420
+highConga' :: TrSpec -> SE Sig
+highConga' = genConga 0.22
+
+-- cps = 310
+midConga' :: TrSpec -> SE Sig
+midConga' = genConga 0.33
+
+-- cps = 227
+lowConga' :: TrSpec -> SE Sig
+lowConga' = genConga 0.41
+
+genConga :: D -> TrSpec -> SE Sig
+genConga dt spec = rndAmp =<< addDur =<< asig
+ where
+ dur = trDur spec
+ tune = trTune spec
+ cps = trCps spec
+
+ ifrq = cps * octave tune
+ fullDur = dt * dur
+ aenv = transeg [0.7,1/ifrq,1,1,fullDur,-6,0.001]
+ afmod = expsega [3,0.25/ifrq,1]
+ asig = mul (-0.25 * aenv) $ rndOsc (sig ifrq * afmod)
+
+
+-----------------------------------------------------
+-- sampler
+
+mkSam = limSam 1
+
+-- | Bass drum
+bd :: Sam
+bd = mkSam bass
+
+bd2 :: Sam
+bd2 = mkSam bass2
+
+-- | Snare
+sn :: Sam
+sn = mkSam snare
+
+-- | Open hi-hat
+ohh :: Sam
+ohh = mkSam openHiHat
+
+-- | Closed hi-hat
+chh :: Sam
+chh = mkSam closedHiHat
+
+-- | High tom
+htom :: Sam
+htom = mkSam highTom
+
+-- | Middle tom
+mtom :: Sam
+mtom = mkSam midTom
+
+-- | Low tom
+ltom :: Sam
+ltom = mkSam lowTom
+
+-- | Cymbal
+cym :: Sam
+cym = mkSam cymbal
+
+-- | Claves
+cl :: Sam
+cl = mkSam claves
+
+-- | Rim shot
+rim :: Sam
+rim = mkSam rimShot
+
+-- | Maracas
+mar :: Sam
+mar = mkSam maraca
+
+-- | High conga
+hcon :: Sam
+hcon = mkSam highConga
+
+-- | Middle conga
+mcon :: Sam
+mcon = mkSam midConga
+
+-- | Low conga
+lcon :: Sam
+lcon = mkSam lowConga
+
+-- generic sam
+
+mkSam' f spec = mkSam $ f spec
+
+-- | Bass drum
+bd' :: TrSpec -> Sam
+bd' = mkSam' bass'
+
+bd2' :: TrSpec -> Sam
+bd2' = mkSam' bass2'
+
+-- | Snare
+sn' :: TrSpec -> Sam
+sn' = mkSam' snare'
+
+-- | Open hi-hat
+ohh' :: TrSpec -> Sam
+ohh' = mkSam' openHiHat'
+
+-- | Closed hi-hat
+chh' :: TrSpec -> Sam
+chh' = mkSam' closedHiHat'
+
+-- | High tom
+htom' :: TrSpec -> Sam
+htom' = mkSam' highTom'
+
+-- | Middle tom
+mtom' :: TrSpec -> Sam
+mtom' = mkSam' midTom'
+
+-- | Low tom
+ltom' :: TrSpec -> Sam
+ltom' = mkSam' lowTom'
+
+-- | Cymbal
+cym' :: TrSpec -> Sam
+cym' = mkSam' cymbal'
+
+-- | Claves
+cl' :: TrSpec -> Sam
+cl' = mkSam' claves'
+
+-- | Rim shot
+rim' :: TrSpec -> Sam
+rim' = mkSam' rimShot'
+
+-- | Maracas
+mar' :: TrSpec -> Sam
+mar' = mkSam' maraca'
+
+-- | High conga
+hcon' :: TrSpec -> Sam
+hcon' = mkSam' highConga'
+
+-- | Middle conga
+mcon' :: TrSpec -> Sam
+mcon' = mkSam' midConga'
+
+-- | Low conga
+lcon' :: TrSpec -> Sam
+lcon' = mkSam' lowConga'
+
+
diff --git a/src/Csound/Catalog/Effect.hs b/src/Csound/Catalog/Effect.hs
index fb57066..fd0a0de 100644
--- a/src/Csound/Catalog/Effect.hs
+++ b/src/Csound/Catalog/Effect.hs
@@ -85,12 +85,12 @@ nightChorus idlym iscale asig = 0.5 * aout
--
nightReverb :: Int -> D -> D -> D -> Sig -> SE (Sig, Sig)
nightReverb n igain ipitchmod itone asig = do
- afiltRefs <- mapM newSERef $ replicate n 0
- afilts1 <- mapM readSERef afiltRefs
+ afiltRefs <- mapM newRef $ replicate n 0
+ afilts1 <- mapM readRef afiltRefs
let apj = (2 / fromIntegral n) * sum afilts1
adels <- sequence $ zipWith3 (del apj) idels ks afilts1
- zipWithM_ (\ref x -> writeSERef ref $ filt x) afiltRefs adels
- afilts2 <- mapM readSERef afiltRefs
+ zipWithM_ (\ref x -> writeRef ref $ filt x) afiltRefs adels
+ afilts2 <- mapM readRef afiltRefs
return (mean $ odds afilts2, mean $ evens afilts2)
where
idels = cycle $ fmap ( / getSampleRate) [2473, 2767, 3217, 3557, 3907, 4127, 2143, 1933]
diff --git a/src/Csound/Catalog/Reson.hs b/src/Csound/Catalog/Reson.hs
index 6d58914..d8420f1 100644
--- a/src/Csound/Catalog/Reson.hs
+++ b/src/Csound/Catalog/Reson.hs
@@ -79,7 +79,7 @@ strike dt' = do
onNormDur <- noise (osciln 1 (1 / dt) decayShape 1) 0
return $ guardedTuple
- [ (sig dt <* 0.001, onLowDur)
+ [ (sig dt `lessThan` 0.001, onLowDur)
, (sig dt >=* 1, onHighDur)
] onNormDur
where
diff --git a/src/Csound/Catalog/Wave.hs b/src/Csound/Catalog/Wave.hs
index 727b03c..1585432 100644
--- a/src/Csound/Catalog/Wave.hs
+++ b/src/Csound/Catalog/Wave.hs
@@ -59,8 +59,42 @@ module Csound.Catalog.Wave(
maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH,
femaleA, femaleE, femaleIY, femaleO, femaleOO,
+ -- * Sean Costello
+ RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec,
+ snowCrackle,
+ fmDrone, fmDrones,
+ tenorOsc, sopranoOsc,
+
+ -- * Flavio
+ amFlavio, fmFlavio, simpleSust, simpleFading,
+
+ -- * Thor
+ cathedralOrgan, cathedralOrganFx, hammondOrgan,
+
+ amPiano,
+
+ pwBass, pwHarpsichord, pwEnsemble,
+
+ simpleBass,
+
+ EpianoOsc(..), epiano,
+
+ noisyChoir, thorWind, mildWind, boom, windWall,
+
+ razorPad, razorLead,
+
+ -- * Bitwig
+
+ pwPad, triPad, triPadFx,
+ Accordeon(..), accordeon, accordeonFx,
+
+ -- * Pads
+ polySynthFx, polySynth,
+ dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad,
+
-- * Other instruments
- okComputer
+ okComputer, deepBass
+
) where
import Csound.Base
@@ -74,6 +108,11 @@ import Csound.Catalog.Wave.Deserted
import Csound.Catalog.Wave.TheHeartbeat
import Csound.Catalog.Wave.TrappedInConvert
+import Csound.Catalog.Wave.Sean
+import Csound.Catalog.Wave.Flavio
+import Csound.Catalog.Wave.Thor
+import Csound.Catalog.Wave.Bitwig
+
import Csound.Catalog.Wave.Misc
import Csound.Catalog.Reson
diff --git a/src/Csound/Catalog/Wave/Amsterdam.hs b/src/Csound/Catalog/Wave/Amsterdam.hs
index 99212b5..4847e2c 100644
--- a/src/Csound/Catalog/Wave/Amsterdam.hs
+++ b/src/Csound/Catalog/Wave/Amsterdam.hs
@@ -16,6 +16,6 @@ import Csound.Base
-- * cps - the frequency of the note
tibetan :: Int -> Sig -> D -> Sig
tibetan n off cps = chorusPitch n (2 * off * fromIntegral n) (oscBy wave) (sig cps)
- where wave = ifB (cps <* 230) (waveBy 5) (ifB (cps <* 350) (waveBy 3) (waveBy 1))
+ where wave = ifB (cps `lessThan` 230) (waveBy 5) (ifB (cps `lessThan` 350) (waveBy 3) (waveBy 1))
waveBy x = sines $ [0.3, 0, 0, 0] ++ replicate x 0.1
diff --git a/src/Csound/Catalog/Wave/Bitwig.hs b/src/Csound/Catalog/Wave/Bitwig.hs
new file mode 100644
index 0000000..7aecec3
--- /dev/null
+++ b/src/Csound/Catalog/Wave/Bitwig.hs
@@ -0,0 +1,51 @@
+module Csound.Catalog.Wave.Bitwig(
+ pwPad, triPad, triPadFx,
+ Accordeon(..), accordeon, accordeonFx
+) where
+
+import Csound.Base
+
+---------------------------------------------------
+-- wind pads
+
+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
+ 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
+ let lfo = uosc 4
+ return $ mul 0.5 $ pw (0.2 + 0.4 * lfo) x + tri (x * cent 8)
+
+pwPadMidi = mul 0.5 $ mixAt 0.5 smallHall2 $ at (chorus 0.2 0.3 0.25) $ at fromMono $ midi $ onMsg pwPad
+
+---------------------------------------------------
+-- accordeon
+
+osc4 freq1 freq2 freq3 freq4 a b cps = cfd4 a b (saw (cps * freq1)) (sqr (cps * freq2)) (saw (cps * freq3)) (sqr (cps * freq4))
+mlpTrack cps center q = mlp (cps + 6500 * center) q
+
+data Accordeon = Accordeon
+ { accordeonFreq1 :: Sig
+ , accordeonFreq2 :: Sig
+ , accordeonFreq3 :: Sig
+ , accordeonFreq4 :: Sig
+ }
+
+instance Default Accordeon where
+ def = Accordeon 1 0.5 2.01 2
+
+accordeon :: Accordeon -> Sig -> SE Sig2
+accordeon spec cps = fmap fromMono $ liftA2 (\a b -> mul vcaEg $ mlpTrack (cps * 2) (0.5 * vcfEg) 0.1 $ f a b cps) (rndPointer 6 (0.3, 0.2)) (rndPointer 10 (0.4, 0.1))
+ where
+ vcaEg = leg 0.01 0.3 0.5 0.3
+ vcfEg = leg 0.05 0.3 0.2 0.2
+ rndPointer' a dt b cps (x, y) = fmap (\r -> x + y * linseg [0, 0.01, a, dt, b] * r) (randi 1 cps)
+ rndPointer = rndPointer' 1 5 0.35
+ f = osc4 (accordeonFreq1 spec) (accordeonFreq2 spec) (accordeonFreq3 spec) (accordeonFreq4 spec)
+
+accordeonFx :: Sig2 -> SE Sig2
+accordeonFx a = at smallHall2 $ mixAt 0.35 (echo 0.25 0.55) (return a :: SE Sig2)
diff --git a/src/Csound/Catalog/Wave/Flavio.hs b/src/Csound/Catalog/Wave/Flavio.hs
new file mode 100644
index 0000000..ac164b2
--- /dev/null
+++ b/src/Csound/Catalog/Wave/Flavio.hs
@@ -0,0 +1,63 @@
+module Csound.Catalog.Wave.Flavio(
+ amFlavio, fmFlavio, simpleSust, simpleFading
+) where
+
+import Data.List
+import Control.Monad
+
+import Csound.Base
+
+icero = 0.000001
+icasi = 0.0001
+
+-- epiano-s
+
+-- irel1 = 16
+amFlavio irel1 cps = aout
+ where
+ irel1 = 16
+ iamf = 1
+ irel2 = irel1 * 0.7
+ kamp = expsegr [icero, 0.05, 1, 1, 0.7, irel1, icasi, irel2, icero] irel2 icero
+ aam = kamp * osc (iamf * cps)
+ aout = aam * osc cps
+
+-- irel1 = 6, ifm = (2, 7),
+fmFlavio irel1 ifm cps = aout
+ where
+ irel2 = irel1 * 0.5
+ idec = 1
+ iatt = 0.01
+
+ (iidx1, iidx2, iidx3, iidx4, iidx5) = (4, 4, 4, 4, 3)
+
+ kamp = expsegr [icero, iatt, 1, idec, 0.7, irel1, icasi, irel2, icero] irel2 icero
+ kidx = linsegr [iidx1, iatt, iidx2, idec, iidx3, irel1, iidx4, irel2, iidx5] irel2 iidx5
+
+ afrq = kidx * osc (ifm * cps)
+ aout = kamp * osc (cps * (1 + afrq))
+
+
+simpleSust = genSimple 0.25 0.1
+simpleFading = genSimple icasi icero
+
+genSimple isust1 isust2 irel (amp, dcps) = do
+ aleft <- fmap pure $ random 1 (11 * sig amp)
+ aright <- fmap pure $ random 1 (10.5 * sig amp)
+ return (aleft, aright)
+ where
+ cps = sig dcps
+ pure ichr = aout
+ where
+ irel1 = irel * (0.5 + amp)
+ iatt = 0.01
+ idec = 1
+ irel2 = 0.75 * irel1
+
+ -- kamp = expsegr [1, idec, 0.7, irel1, icasi, irel2, icero] irel2 icero
+ kamp = expsegr [1, idec, 0.7, irel1, isust1, irel2, isust2] irel2 icero
+ kcf = 2 * sig amp * linsegr [3000, irel1 + 1, 500] irel2 500
+ a3 = kamp * (osc (cps - ichr) + osc (cps - ichr))* 0.5
+
+ aout = blp kcf a3
+
diff --git a/src/Csound/Catalog/Wave/Misc.hs b/src/Csound/Catalog/Wave/Misc.hs
index 7559c5b..0351149 100644
--- a/src/Csound/Catalog/Wave/Misc.hs
+++ b/src/Csound/Catalog/Wave/Misc.hs
@@ -1,5 +1,7 @@
module Csound.Catalog.Wave.Misc (
- okComputer
+ okComputer, polySynthFx, polySynth,
+ dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad,
+ deepBass
) where
import Csound.Base
@@ -14,3 +16,54 @@ okComputer cps = fmap go $ noise 11000 0.99
where
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)
+ 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
+
+uni = multiHz 2 (cent 50)
+
+dreamPad = genDreamPadInstr mkOsc
+ where mkOsc vibLfo1 vibLfo2 x = uni rndSaw (vibLfo1 x) + uni rndSaw (vibLfo2 $ x * cent 14)
+
+underwaterPad = genDreamPadInstr mkOsc
+ where mkOsc vibLfo1 vibLfo2 x = uni rndTri (vibLfo1 x) + uni rndTri (vibLfo2 $ x * cent 14)
+
+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)))
+
+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))
+
+genDreamPadInstr 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
+
+ -- saw
+ oscs = mkOsc vibLfo1 vibLfo2 x
+
+ -- underwater
+ -- oscs = uni rndTri (vibLfo1 x) + uni rndTri (vibLfo2 $ x * cent 14) -- + uni rndTri (vibLfo2 $ 3 * x * cent 14)
+
+ -- wales howling
+ -- oscs = 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))
+ nois = mul 0.35 $ at (lp 2400 0.1) white
+
+ uni = multiHz 2 (cent 50)
+ lfo1 y x = x * (1 + y * osc (0.35 + 0.05 * osc 0.1))
+ lfo2 y x = x * (1 + y * osc (0.22 + 0.043 * osc 0.14))
+
+ filtLfo1 = lfo1 0.18
+ filtLfo2 = lfo2 0.13
+
+ vibLfo1 = lfo1 0.005
+ vibLfo2 = lfo2 0.007
+
+deepBass x = mul 0.5 $ at (hp1 45) $ at (\x -> dam x 0.45 2 2 0.01 0.01) $ mul (xeg 0.005 0.6 1 0.05) $ sum [(filt 2 lp 275 0.25) (saw $ x * 0.5), osc (x * 0.5)]
diff --git a/src/Csound/Catalog/Wave/Sean.hs b/src/Csound/Catalog/Wave/Sean.hs
new file mode 100644
index 0000000..5f39b03
--- /dev/null
+++ b/src/Csound/Catalog/Wave/Sean.hs
@@ -0,0 +1,202 @@
+{-# Language FlexibleContexts #-}
+module Csound.Catalog.Wave.Sean(
+ RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec,
+ snowCrackle,
+ fmDrone, fmDrones,
+ tenorOsc, sopranoOsc
+) where
+
+import Data.List
+import Control.Monad
+
+import Csound.Base hiding (formant)
+
+data RissetBellSpec = RissetBellSpec
+ { rissetBellRands :: [D]
+ , rissetBellRandShifts :: [D]
+ , rissetBellDurs :: [D]
+ , rissetBellAmps :: [Sig]
+ , rissetBellFreqs :: [Sig]
+ , rissetBellFreqShifts :: [Sig]
+ }
+
+rissetBell :: RissetBellSpec -> (D, D) -> D -> Sig -> Sig -> SE Sig
+rissetBell spec (from, to) dur amp cps = ares
+ where
+ idurs = fmap (dur * ) (rissetBellDurs spec)
+ ifreqs = fmap (cps * ) (rissetBellFreqs spec)
+ ifreqDt = (rissetBellFreqShifts spec)
+ iamps = fmap (amp * ) (rissetBellAmps spec)
+ irands = (rissetBellRands spec)
+ irandDt = (rissetBellRandShifts spec)
+
+ partial iamp ifreq ifreqDt idur irand irandDt = do
+ amod <- randi iamp (linseg [from * irand + irandDt, idur, to * irand + irandDt])
+ return $ mul amod $ osc (ifreq + ifreqDt)
+
+ env = expsegr [1, dur, 0.001] dur 0.001
+ ares = mul 0.75 $ fmap sum $ zipWithM (\(iamp, ifreq, ifreqDt) (idur, irand, irandDt) -> partial iamp ifreq ifreqDt idur irand irandDt) (zip3 iamps ifreqs ifreqDt) (zip3 idurs irands irandDt)
+
+timpaniSpec = RissetBellSpec
+ { rissetBellDurs = [0.087, 0.5, 0.804, 0.065, 0.325, 0.54, 1, 0.195, 0.108, 0.89, 0.075]
+ , rissetBellFreqs = [0.8, 1.00, 1.5, 1.65, 1.97, 2, 2.44, 2.86, 2.71, 2.91, 3.27]
+ , rissetBellFreqShifts = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+ , rissetBellAmps = [1, 2.52, 1.83, 0.55, 1.47, 1.67, 0.62, 0.5, 0.52, 0.55, 0.33]
+ , rissetBellRands = [0.56, 0.56, 0.92, 0.92, 1.19, 1.7, 2, 2.74, 3, 3.75, 4.07]
+ , rissetBellRandShifts = [0, 1, 0, 1.7, 0, 0, 0, 0, 0, 0, 0] }
+
+timpani :: (D, D) -> D -> Sig -> Sig -> SE Sig
+timpani (from, to) dur amp cps = mul env $ rissetBell timpaniSpec (from, to) dur amp cps
+ where env = expsegr [1, dur, 0.001] dur 0.001
+
+
+noiseBellSpec = RissetBellSpec
+ { rissetBellDurs =[1, 0.9, 0.65, 0.55, 0.325, 0.35, 0.25, 0.2, 0.15, 0.1, 0.075]
+ , rissetBellFreqs = [0.56, 0.56, 0.92, 0.92, 1.19, 1.7, 3, 2.74, 3, 3.75, 4.07]
+ , rissetBellFreqShifts = [0, 1, 0, 1.7, 0, 0, 0, 0, 0, 0, 0]
+ , rissetBellAmps = [1, 0.67, 1.35, 1.8, 2.67, 1.67, 1.46, 1.33, 1.33, 0.75, 1.33]
+ , rissetBellRands = [0.56, 0.56, 0.92, 0.92, 1.19, 1.7, 2, 2.74, 3, 3.75, 4.07]
+ , rissetBellRandShifts = [0, 1, 0, 1.7, 0, 0, 0, 0, 0, 0, 0] }
+
+-- | > dac $ noiseBell (31, 125) 2.3 0.2 2900
+noiseBell :: (D, D) -> D -> Sig -> Sig -> SE Sig
+noiseBell (from, to) dur amp cps = mul env $ rissetBell noiseBellSpec (from, to) dur amp cps
+ where env = expsegr [1, dur, 0.001] dur 0.001
+
+------------------------------------------------------------------------
+
+-- | speed ~ 10 - 20
+--
+-- > snowCrackle speed
+snowCrackle :: Sig -> Sig
+snowCrackle speed = mlp 1200 0.1 $ mouseDrum speed (3 + 2 * uosc 0.1) (160 + 100 * uosc 0.13)
+ where
+ mouseDrum :: Sig -> Sig -> Sig -> Sig
+ mouseDrum freq index cps =
+ sched instr $ withDur dur $ fmap (\[a, b] -> (a, b)) $ randList 2 $ dust freq
+ where
+ dur = 0.049
+ instr (rndCps, rndIndex) = return $
+ mouseDrumGrain dur
+ (cps + 10 * sig (2 * rndCps - 1))
+ (index + 0.01 * sig (2 * rndIndex - 1))
+
+ mouseDrumGrain dur icarfreq index = aosc
+ where
+ iratio = 1.416
+ idev = imodfreq * index
+ imodfreq = icarfreq * iratio
+ amod = mul (idev * imodfreq) $ osc imodfreq
+ kenv = expsegr [1, dur, 0.001] dur 0.001
+ aosc = mul kenv $ osc (icarfreq + amod)
+
+------------------------------------------------------------------------
+
+fmDronePartial amod' index idev kamp1 ifreq1 (a1, a2, a3, a4) = ares
+ where
+ aosc1 = mul (idev * kamp1) $ osc (ifreq1 * a1)
+ aosc2 = osc (ifreq1 * a2 + aosc1 + amod')
+ aosc3 = osc (ifreq1 * a3 + aosc1 + amod')
+ aosc4 = osc (a4 + aosc1 + amod')
+ ares = 0.5 * kamp1 * sum [aosc2, aosc3, aosc4]
+
+scDrone = fmDrone 3
+scDrones = fmDrones 3
+
+pulseIndex ns speed = 1 + 7 * seqSqr [seqDesc ns] speed
+
+fmPulse ns speed = fmDrone (pulseIndex ns speed) (0.05, 0.5)
+fmPulses amps harms ns speed = fmDrones (pulseIndex ns speed) amps harms (0.05, 0.5)
+
+-- | > dac $ fmDrone 3 (20, 5) 110
+fmDrone index (iatt, irel) cps = (aout1, aout2)
+ where
+ ifreq1 = cps
+ iamp = 0.39
+ idev = index * ifreq1
+ kamp1 = leg iatt 0 1 irel
+
+ f a1 a2 a3 a4 = iamp * fmDronePartial 0 index idev kamp1 ifreq1 (a1, a2, a3, a4)
+
+ aout1 = f 1 0.998 1.5007 0.1
+ aout2 = f 0.99 0.987 1.498 0.13
+
+fmDrones index amps harms (iatt, irel) cps = aout
+ where
+ iamp = 0.39
+ kamp1 = leg iatt 0 1 irel
+
+ f amp h = do
+ let ifreq1 = h * cps
+ idev = index * ifreq1
+
+ a1 <- randomSig 1 0.03
+ a2 <- randomSig 0.998 0.025
+ a3 <- randomSig 1.5 0.004
+ a4 <- randomSig 0.1 0.03
+ return $ amp * fmDronePartial 0 index idev kamp1 ifreq1 (a1, a2, a3, a4)
+
+ ares = fmap sum $ zipWithM f amps harms
+ aout = liftA2 (,) ares ares
+
+randomD :: D -> D -> SE D
+randomD val dev = fmap ir $ random (sig $ val - dev) (sig $ val + dev)
+
+randomSig :: Sig -> Sig -> SE Sig
+randomSig val dev = random (val - dev) (val + dev)
+
+gaussD :: D -> D -> SE D
+gaussD val dev = fmap ((+ val) . ir) $ gauss (sig val)
+
+gaussSig :: Sig -> Sig -> SE Sig
+gaussSig val dev = fmap ((+ val)) $ gauss val
+
+randiDev :: Sig -> Sig -> Sig -> SE Sig
+randiDev val dev cps = fmap (+ val) $ randi dev cps
+
+randhDev :: Sig -> Sig -> Sig -> SE Sig
+randhDev val dev cps = fmap (+ val) $ randh dev cps
+
+------------------------------------------------------------------------
+-- choir
+
+tenorOsc = voiceOsc 0.9
+sopranoOsc = voiceOsc 0.8
+
+linVibr2 (v1, v2) (vtime1, vtime2) = linseg [v1, vtime1, v1, vtime2, v2]
+
+voiceOsc :: Sig -> (Sig -> Sig) -> Sig -> Sig -> SE Sig
+voiceOsc mulHarm formantFilter kvib cps = at formantFilter $ voiceAnimator (RndDev 0.05 0.75) kvib $ asig * kenv
+ where
+ iharms = sig getSampleRate * 0.4 / cps
+ asig = gbuzz 1 cps iharms 1 mulHarm (sines3 [(1, 1, 0.25)])
+ kenv = leg 0.1 0 1 0.1
+
+data RndDev = RndDev
+ { rndDevRatio :: Sig
+ , rndDevSpeed :: Sig
+ }
+
+voiceAnimator :: RndDev -> Sig -> Sig -> SE Sig
+voiceAnimator rndDev kvib ain = aout
+ where
+ ktimes = zipWithM (\amp cps -> mul (amp * osc cps) $ addRnd rndDev kvib) [0.0012, 0.0009, 0.00087, 0.0011] [4, 5, 6.3, 4.4]
+ -- ktimes = zipWith (\amp cps -> kvib * amp * osc cps) [0.0012, 0.0009, 0.00087, 0.0011, 0.00093, 0.00081, 0.0071] [4, 5, 6.3, 4.4, 5.2, 4.2, 5.5]
+ aout = fmap (mean . fmap (\t -> vdelay ain t 0.015)) ktimes
+
+addRnd :: RndDev -> Sig -> SE Sig
+addRnd spec ain = do
+ xDt <- randi (rndDevRatio spec) (rndDevSpeed spec)
+ return $ ain * (1 + xDt)
+
+
+data Formant = Formant
+ { formantWeight :: Sig
+ , formantCenter :: Sig
+ , formantWidth :: Sig
+ }
+
+------------------------------------------------------------------------
+--
+
+
diff --git a/src/Csound/Catalog/Wave/Thor.hs b/src/Csound/Catalog/Wave/Thor.hs
new file mode 100644
index 0000000..467b0cd
--- /dev/null
+++ b/src/Csound/Catalog/Wave/Thor.hs
@@ -0,0 +1,168 @@
+{-# Language FlexibleContexts #-}
+module Csound.Catalog.Wave.Thor(
+ cathedralOrgan, cathedralOrganFx, hammondOrgan,
+
+ amPiano,
+
+ pwBass, pwHarpsichord, pwEnsemble,
+
+ simpleBass,
+
+ EpianoOsc(..), epiano,
+
+ noisyChoir, thorWind, mildWind, boom, windWall,
+
+ razorPad, razorLead
+) where
+
+import Data.List
+import Control.Monad
+
+import Csound.Base
+
+-- some instruments from the Thor explained series
+--
+-- https://www.propellerheads.se/substance/discovering-reason/index.cfm?article=part19&fuseaction=get_article
+
+------------------------------
+-- thor oscillators
+
+------------------------------
+-- 1 oscillators
+
+cathedralOrganFx :: Sig -> Sig2
+cathedralOrganFx = mixAt 0.25 largeHall . fromMono
+
+cathedralOrgan cps = mul 0.3 $ sum $ fmap ($ cps) [hammondOrgan 3 , detune (2 * cent 4) (hammondOrgan 10), detune (3 * cent 3) (hammondOrgan 6)]
+
+-- | hammondOrgan detune
+--
+-- detune = [0, 30] (in cents)
+hammondOrgan :: Sig -> Sig -> SE Sig
+hammondOrgan dt x = mul (fades 0.01 0.05) $ fmap mean $ mapM rndOsc
+ [ x
+ , 2 * x * cent dt
+ , 3 * x * cent (2 * dt) ]
+
+------------------------------
+-- 2 am & sync
+
+amPiano :: Sig -> SE Sig
+amPiano x = mul env $ at (mlp (env * (3000 + x)) 0.25) $ (rndSaw x * rndSaw (4 * x))
+ where env = leg 0.01 4 0 0.02
+
+------------------------------
+-- 3 pwm
+
+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
+
+simpleBass :: (D, D) -> Sig
+simpleBass (amp, cps') = aout
+ where
+ cps = sig cps'
+
+ all = sum
+ [ 0.4 * oscBy pulse $ cps * 0.998 - 0.12
+ , 0.4 * osc $ cps * 1.002 - 0.12
+ , 0.4 * oscBy pulse $ cps * 0.998 - 0.12
+ , 0.7 * osc $ cps - 0.24 ]
+
+ aout = mul (kgain * sig amp * linsegr [0, 0.01, 1, (3.5 * amp), 0] 0.35 0)
+ $ blp (700 + (sig amp * 500))
+ $ bhp 65
+ $ bhp 65
+ $ blp ksweep
+ $ blp ksweep all
+
+ ksweep = expsegr [3000, 0.03, 9000] 3 1 - 3000
+
+ pulse = sines [1, 1, 1, 1, 0.7, 0.5, 0.3, 0.1]
+
+ 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
+ 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
+ [ 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)
+
+------------------------------
+-- 4 Multi osc (unision)
+
+data EpianoOsc = EpianoOsc
+ { epianoOscChorusNum :: Int
+ , epianoOscChorusAmt :: Sig
+ , epianoOscNum :: Sig
+ , epianoOscWeight :: Sig
+ }
+
+epiano :: [EpianoOsc] -> (D, D) -> SE Sig
+epiano xs (amp, cps) = mul (sig amp * leg 0.001 sust 0 rel) $ at (mlp (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
+ -- (multiRndSE 4 5 rndOsc + multiRndSE 8 10 (detune (2.01) rndOsc))
+ where
+ sust = amp + 2 + (0.7 - 3 * k ** 2)
+ rel = (amp / 10) + 0.05 - (k / 10)
+ k = cps / 1000
+
+------------------------------
+-- 5 noise
+
+-- noisyChor numberOfFilters bandWidthRatio cps
+noisyChoir :: Int -> Sig -> Sig -> SE Sig
+noisyChoir n ratio cps = mul 0.5 $ genGhostChoir white [1, 1] [1, 0.5] n (5 + 300 ** ratio) cps
+
+genGhostChoir :: (SE Sig) -> [Sig] -> [Sig] -> Int -> Sig -> Sig -> SE Sig
+genGhostChoir noiseGen amps hs n bw cps = mul env $ fmap sum $ zipWithM f amps hs
+ where
+ f :: Sig -> Sig -> SE Sig
+ f a h = mul a $ bat (filt n bp (h * cps) bw) noiseGen
+ env = fades 0.4 0.5
+
+------------------------------
+-- 6 noise
+
+mildWind :: Sig -> SE Sig
+mildWind cps = thorWind (cps * 2) 120 (0.2, 0.5)
+
+thorWind :: Sig -> Sig -> (Sig, Sig) -> SE Sig
+thorWind cps bw (speedMin, speedMax) = mul 1.3 $ do
+ speed <- rspline (-1) 1 speedMin speedMax
+ at (mlp (cps + bw * speed) 0.8) pink
+
+boom :: Sig -> SE Sig
+boom cps = mul (1.2 * expon 1 2.05 0.001) $ fmap sum $ mapM (\x -> bat (bp (0.5 * cps * x) 10) white) [1, 1.51, 2.1, 3.05]
+
+windWall :: Sig -> SE Sig
+windWall cps = mul amEnv $ at (hp1 400) $ at (mlp (filtEnv * cps) 0.2) (mul 20 white )
+ where
+ amEnv = leg 7 10 0 8
+ filtEnv = leg 6 0 1 5
+
+------------------------------
+-- 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
+
+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
+
+genRazor filter speed amp cps = mul amp $ do
+ a1 <- ampSpline 0.01
+ a2 <- ampSpline 0.02
+
+ return $ filter (1000 + 2 * cps + 500 * amp) 0.1 $ mean [
+ fosc 1 3 (a1 * uosc (speed)) cps
+ , 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/Catalog/Wave/Woodwind.hs b/src/Csound/Catalog/Wave/Woodwind.hs
index c0e44fc..59a839f 100644
--- a/src/Csound/Catalog/Wave/Woodwind.hs
+++ b/src/Csound/Catalog/Wave/Woodwind.hs
@@ -7,6 +7,7 @@ module Csound.Catalog.Wave.Woodwind
, dizi
) where
+
import Csound.Base hiding (fromSpec)
import Csound.Catalog.Wave.WoodwindAlg
@@ -623,7 +624,7 @@ shengRange (iattack, isustain, idecay) ifreq = ([(amp1, iwt1), (amp2, iwt2), (am
inorm = byRange [ 34991, 32586, 35331, 37480 ]
iwt1 = f11
- iwt2 = ifB (ifreq <* 1025) f31 f35
+ iwt2 = ifB (ifreq `lessThan` 1025) f31 f35
iwt3 = byRange [f32, f33, f34, f36]
f11 = sine
diff --git a/src/Csound/Catalog/Wave/WoodwindAlg.hs b/src/Csound/Catalog/Wave/WoodwindAlg.hs
index 58445d1..82838eb 100644
--- a/src/Csound/Catalog/Wave/WoodwindAlg.hs
+++ b/src/Csound/Catalog/Wave/WoodwindAlg.hs
@@ -5,6 +5,7 @@ module Csound.Catalog.Wave.WoodwindAlg(
) where
import Data.List (transpose, intersperse)
+import Control.Monad
import Control.Monad.Trans.State
import Csound.Base hiding (fromSpec)
@@ -17,6 +18,10 @@ newtype Rnd a = Rnd { unRnd :: State D a }
instance Functor Rnd where
fmap f (Rnd a) = Rnd $ fmap f a
+instance Applicative Rnd where
+ pure = return
+ (<*>) = ap
+
instance Monad Rnd where
return = Rnd . return
(Rnd a) >>= f = Rnd $ a >>= unRnd . f
@@ -162,7 +167,7 @@ fromSpec specs durs ifreq = (hs, inorm)
freqs = fmap rangeFreq specs
byFreq :: Tuple a => D -> [(D, a)] -> a
-byFreq ifreq as = guardedTuple (fmap (\(cps, val) -> (sig ifreq <* sig cps, val)) $ init as) (snd $ last as)
+byFreq ifreq as = guardedTuple (fmap (\(cps, val) -> (sig ifreq `lessThan` sig cps, val)) $ init as) (snd $ last as)
fromHarmSpec :: (D, D, D) -> HarmSpec -> (Sig, Tab)
diff --git a/src/Csound/Patch.hs b/src/Csound/Patch.hs
new file mode 100644
index 0000000..caa50f9
--- /dev/null
+++ b/src/Csound/Patch.hs
@@ -0,0 +1,1158 @@
+-- | Patches
+--
+-- Collection of beautiful timbres. To try the instrument with midi device just type in the interpreter:
+--
+-- > > dac $ atMidi hammondOrgan
+-- If you don't have the real device, you can try the virtual midi:
+--
+-- > > vdac $ atMidi vibraphone1
+--
+-- The function @atMidi@ invokes a @Patch@ with midi.
+module Csound.Patch(
+ -- * Electric piano
+ Epiano1(..), epiano1, epiano1',
+ MutedPiano(..), mutedPiano, mutedPiano',
+ amPiano, fmPiano,
+ epiano2, epianoHeavy, epianoBright,
+ vibraphonePiano1, vibraphonePiano2,
+
+ -- * Organ
+ cathedralOrgan, toneWheelOrgan,
+ HammondOrgan(..), hammondOrgan, hammondOrgan',
+ sawOrgan, triOrgan, sqrOrgan, pwOrgan, waveOrgan,
+
+ -- * Accordeon
+ accordeon, accordeonBright1, accordeonBright2, brokenAccordeon,
+ accordeon', Accordeon(..),
+
+ -- * Choir
+ choirA, choirO, choirU, choirE,
+ Choir(..), choirA', choirO', choirU', choirE',
+
+ windSings, noisyChoir, longNoisyChoir, noisyChoir', longNoisyChoir', NoisyChoir(..),
+
+ -- * Pad
+ pwPad, triPad, nightPad, overtonePad, caveOvertonePad,
+ chorusel, pwEnsemble, fmDroneSlow, fmDroneMedium, fmDroneFast, vibrophonePad,
+ RazorPad(..), razorPadSlow, razorPadFast, razorPadTremolo, razorPad, razorPad',
+ dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad,
+ dreamPad', underwaterPad', lightIsTooBrightPad', whaleSongPad',
+
+ -- * Lead
+ polySynth,
+ phasingLead, RazorLead(..), razorLeadSlow, razorLeadFast, razorLeadTremolo,
+ razorLead, razorLead',
+ overtoneLead,
+
+ -- * Bass
+ simpleBass, pwBass, deepBass, withDeepBass,
+
+ -- * Plucked
+ guitar, harpsichord,
+
+ -- * Strike
+
+ smallDahina, dahina, largeDahina, magicDahina,
+ smallBanyan,banyan, largeBanyan, magicBanyan,
+ smallXylophone, xylophone, largeXylophone, magicXylophone,
+ smallTibetanBowl180, tibetanBowl180, largeTibetanBowl180, magicTibetanBowl180,
+ smallSpinelSphere, spinelSphere, largeSpinelSphere, magicSpinelSphere,
+ smallPotLid, potLid, largePotLid, magicPotLid,
+ smallRedCedarWoodPlate, redCedarWoodPlate, largeRedCedarWoodPlate, magicRedCedarWoodPlate,
+ smallTubularBell, tubularBell, largeTubularBell, magicTubularBell,
+ smallRedwoodPlate, redwoodPlate, largeRedwoodPlate, magicRedwoodPlate, smallDouglasFirWoodPlate,
+ douglasFirWoodPlate, largeDouglasFirWoodPlate, magicDouglasFirWoodPlate, smallUniformWoodenBar,
+ uniformWoodenBar, largeUniformWoodenBar, magicUniformWoodenBar, smallUniformAluminumBar,
+ uniformAluminumBar, largeUniformAluminumBar, magicUniformAluminumBar,
+ smallVibraphone1, vibraphone1, largeVibraphone1, magicVibraphone1,
+ smallVibraphone2, vibraphone2, largeVibraphone2, magicVibraphone2,
+ smallChalandiPlates, chalandiPlates, largeChalandiPlates, magicChalandiPlates,
+ smallTibetanBowl152, tibetanBowl152, largeTibetanBowl152, magicTibetanBowl152,
+ smallTibetanBowl140, tibetanBowl140, largeTibetanBowl140, magicTibetanBowl140,
+ smallWineGlass, wineGlass, largeWineGlass, magicWineGlass,
+ smallHandbell, handbell, largeHandbell, magicHandbell,
+ smallAlbertClockBellBelfast, albertClockBellBelfast, largeAlbertClockBellBelfast, magicAlbertClockBellBelfast,
+ smallWoodBlock, woodBlock, largeWoodBlock, magicWoodBlock,
+
+ -- * Scrape
+ scrapeDahina, scrapeBanyan, scrapeXylophone, scrapeTibetanBowl180, scrapeSpinelSphere, scrapePotLid, scrapeRedCedarWoodPlate,
+ scrapeTubularBell, scrapeRedwoodPlate, scrapeDouglasFirWoodPlate, scrapeUniformWoodenBar, scrapeUniformAluminumBar,
+ scrapeVibraphone1, scrapeVibraphone2, scrapeChalandiPlates, scrapeTibetanBowl152, scrapeTibetanBowl140, scrapeWineGlass,
+ scrapeSmallHandbell, scrapeAlbertClockBellBelfast, scrapeWoodBlock,
+
+ scrapeFastDahina, scrapeFastBanyan, scrapeFastXylophone, scrapeFastTibetanBowl180, scrapeFastSpinelSphere, scrapeFastPotLid,
+ scrapeFastRedCedarWoodPlate, scrapeFastTubularBell, scrapeFastRedwoodPlate, scrapeFastDouglasFirWoodPlate, scrapeFastUniformWoodenBar,
+ scrapeFastUniformAluminumBar, scrapeFastVibraphone1, scrapeFastVibraphone2, scrapeFastChalandiPlates, scrapeFastTibetanBowl152,
+ scrapeFastTibetanBowl140, scrapeFastWineGlass, scrapeFastSmallHandbell, scrapeFastAlbertClockBellBelfast, scrapeFastWoodBlock,
+
+ scrapePadDahina, scrapePadBanyan, scrapePadXylophone, scrapePadTibetanBowl180, scrapePadSpinelSphere, scrapePadPotLid,
+ scrapePadRedCedarWoodPlate, scrapePadTubularBell, scrapePadRedwoodPlate, scrapePadDouglasFirWoodPlate, scrapePadUniformWoodenBar,
+ scrapePadUniformAluminumBar, scrapePadVibraphone1, scrapePadVibraphone2, scrapePadChalandiPlates, scrapePadTibetanBowl152,
+ scrapePadTibetanBowl140, scrapePadWineGlass, scrapePadSmallHandbell, scrapePadAlbertClockBellBelfast, scrapePadWoodBlock,
+
+ -- * Woodwind
+
+ Wind(..), woodWind',
+
+ fluteSpec, shortFluteSpec,
+ flute, shortFlute, fluteVibrato, mutedFlute, brightFlute,
+
+ bassClarinetSpec, shortBassClarinetSpec,
+ bassClarinet, shortBassClarinet, bassClarinetVibrato, mutedBassClarinet, brightBassClarinet,
+
+ frenchHornSpec, shortFrenchHornSpec,
+ frenchHorn, shortFrenchHorn, frenchHornVibrato, mutedFrenchHorn, brightFrenchHorn,
+
+ shengSpec, shortShengSpec,
+ sheng, shortSheng, shengVibrato, mutedSheng, brightSheng,
+
+ hulusiSpec, shortHulusiSpec,
+ hulusi, shortHulusi, hulusiVibrato, mutedHulusi, brightHulusi,
+
+ diziSpec, shortDiziSpec,
+ dizi, shortDizi, diziVibrato, mutedDizi, brightDizi,
+
+ -- * X-rays
+ pulseWidth, xanadu, alienIsAngry, noiz, blue, black, simpleMarimba, okComputer, noiseBell,
+
+ -- * Robotic vowels
+ robotVowels, robotLoopVowels, robotVowel,
+
+ -- ** Vowels
+ maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH,
+ femaleA, femaleE, femaleIY, femaleO, femaleOO,
+
+ -- * Nature
+ windWall, mildWind, wind, snowCrackle,
+
+ -- * Misc
+ limRel, singleFx, singleFx'
+) where
+
+import Control.Monad
+
+import Csound.Base
+
+import qualified Csound.Catalog.Wave as C
+import qualified Csound.Catalog.Reson as C
+
+import Csound.Catalog.Wave(maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH,
+ femaleA, femaleE, femaleIY, femaleO, femaleOO)
+
+import Csound.Catalog.Wave(Accordeon(..))
+
+import Data.Char
+
+fx1 :: Sig -> (a -> a) -> [FxSpec a]
+fx1 dw f = [FxSpec dw (return . f)]
+
+fx1' :: Sig -> (a -> SE a) -> [FxSpec a]
+fx1' dw f = [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) -> [FxSpec a]
+singleFx = fx1
+
+-- | Creates a simple FX-xhain, that contains a single effect.
+-- The first argument is the dry/wet-value.
+singleFx' :: Sig -> (a -> SE a) -> [FxSpec a]
+singleFx' = fx1'
+
+-- | Limits the release section of the note.
+limRel :: SigSpace a => D -> Patch a -> Patch a
+limRel rel p = p { patchInstr = fmap (mul (fadeOut rel)) . patchInstr p }
+
+----------------------------------------------
+-- electric pianos
+
+data Epiano1 = Epiano1
+ { epiano1Rel :: D }
+
+instance Default Epiano1 where
+ def = Epiano1 5
+
+epiano1 = epiano1' def
+
+epiano1' (Epiano1 rel) = Patch
+ { patchInstr = \a -> mul 0.4 $ C.simpleFading rel a
+ , patchFx = fx1 0.25 largeHall2 }
+
+data MutedPiano = MutedPiano
+ { mutedPianoMute :: Sig
+ , mutedPianoRel :: D }
+
+instance Default MutedPiano where
+ def = MutedPiano 0.5 7
+
+mutedPiano = mutedPiano' def
+
+mutedPiano' (MutedPiano mute rel) = Patch
+ { patchInstr = \a -> mul 0.7 $ C.simpleSust rel a
+ , patchFx = fx1 0.25 (largeHall2 . at (mlp3 (250 + 7000 * mute) 0.2)) }
+
+amPiano = Patch
+ { patchInstr = mul 1.4 . onCps C.amPiano
+ , patchFx = fx1 0.25 id }
+
+fmPiano = Patch
+ { patchInstr = at fromMono . mul 0.75 . onCps (C.fmFlavio 6 3)
+ , patchFx = fx1 0.15 smallHall2 }
+
+epiano2 = Patch
+ { patchInstr = mul 1.125 . at fromMono . (onCps $ C.epiano [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 2.01 1])
+ , patchFx = fx1 0.25 smallHall2 }
+
+epianoHeavy = Patch
+ { patchInstr = mul 1.125 . at fromMono . (onCps $ C.epiano [C.EpianoOsc 4 5 1 1, C.EpianoOsc 8 10 2.01 1, C.EpianoOsc 8 15 0.5 0.5])
+ , patchFx = fx1 0.2 smallHall2 }
+
+epianoBright = Patch
+ { patchInstr = mul 1.12 . at fromMono . (onCps $ C.epiano [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])
+ , patchFx = fx1 0.2 smallHall2 }
+
+vibraphonePiano1 = smallVibraphone1 { patchInstr = mul (1.5 * fadeOut 0.25) . at (mlp 6500 0.1). patchInstr smallVibraphone1 }
+vibraphonePiano2 = smallVibraphone2 { patchInstr = mul (1.5 * fadeOut 0.25) . at (mlp 6500 0.1). patchInstr smallVibraphone2 }
+
+----------------------------------------------
+-- organs
+
+cathedralOrgan = Patch
+ { patchInstr = at fromMono . mul 0.7 . onCps C.cathedralOrgan
+ , patchFx = fx1 0.27 largeHall2 }
+
+-- [0, 30]
+data HammondOrgan = HammondOrgan
+ { hammondOrganDetune :: Sig }
+
+instance Default HammondOrgan where
+ def = HammondOrgan 12
+
+hammondOrgan = hammondOrgan' def
+
+hammondOrgan' (HammondOrgan detune) = Patch
+ { patchInstr = mul 0.4 . at fromMono . onCps (C.hammondOrgan detune)
+ , patchFx = fx1 0.15 smallRoom2 }
+
+toneWheelOrgan = Patch
+ { patchInstr = at fromMono . mul 0.6 . onCps C.toneWheel
+ , patchFx = fx1 0.3 smallHall2 }
+
+sawOrgan = mul 0.45 $ waveOrgan rndSaw
+triOrgan = mul 0.5 $ waveOrgan rndTri
+sqrOrgan = mul 0.45 $ waveOrgan rndSqr
+pwOrgan k = mul 0.45 $ waveOrgan (rndPw k)
+
+waveOrgan :: (Sig -> SE Sig) -> Patch2
+waveOrgan wave = Patch
+ { patchInstr = onCps $ at fromMono . mul (fades 0.01 0.01) . at (mlp 3500 0.1) . wave
+ , patchFx = fx1 0.25 smallHall2
+ }
+
+----------------------------------------------
+-- accordeons
+
+accordeon = accordeon' def
+
+accordeonBright1 = accordeon' (C.Accordeon 1 5 3 7)
+accordeonBright2 = accordeon' (C.Accordeon 1 6 3 13)
+
+accordeonHeavy = accordeon' (C.Accordeon 1 0.501 2 1.005)
+brokenAccordeon = accordeon' (C.Accordeon 1 1.07 2.02 0.5)
+
+accordeon' spec = Patch
+ { patchInstr = mul 0.63 . onCps (C.accordeon spec)
+ , patchFx = fx1' 0.25 C.accordeonFx }
+
+----------------------------------------------
+-- choir
+
+data Choir = Choir { choirVibr :: Sig }
+
+instance Default Choir where
+ def = Choir 7
+
+tenor' filt (Choir vib) = Patch
+ { patchInstr = at fromMono . mul 0.15 . onCps (C.tenorOsc filt vib)
+ , patchFx = fx1 0.25 smallHall2 }
+
+soprano' filt (Choir vib) = Patch
+ { patchInstr = at fromMono . mul 0.15 . onCps (C.sopranoOsc filt vib)
+ , patchFx = fx1 0.25 smallHall2 }
+
+choir' filt vib = Patch
+ { patchInstr = \(amp, cps) -> do
+ ref <- newRef (0 :: Sig2)
+ when1 (sig cps <=* 220) $ writeRef ref =<< (patchInstr (tenor' filt vib) (amp, cps))
+ when1 (sig cps >* 220) $ writeRef ref =<< (patchInstr (soprano' filt vib) (amp, cps))
+ readRef ref
+ , patchFx = fx1 0.25 smallHall2
+ }
+
+choirA = choirA' def
+choirO = choirO' def
+choirE = choirE' def
+choirU = choirU' def
+
+choirA' = choir' singA
+choirO' = choir' singO
+choirE' = choir' singE
+choirU' = choir' singU
+
+data NoisyChoir = NoisyChoir
+ { noisyChoirFilterNum :: Int
+ , noisyChoirBw :: Sig
+ }
+
+instance Default NoisyChoir where
+ def = NoisyChoir 2 25
+
+windSings = longNoisyChoir' (NoisyChoir 1 15)
+
+longNoisyChoir = longNoisyChoir' def
+noisyChoir = noisyChoir' def
+
+
+longNoisyChoir' (NoisyChoir n bw) = Patch
+ { patchInstr = at fromMono . mul 0.45 . onCps (C.noisyChoir n bw)
+ , patchFx = fx1 0.15 magicCave2 }
+
+noisyChoir' ch = (longNoisyChoir' ch) { patchFx = fx1 0.15 largeHall2 }
+
+-- modes (wth delay or not delay)
+--
+-- dac $ mixAt 0.15 largeHall2 $ mixAt 0.2 (echo 0.25 0.45) $ at fromMono $ midi $ onMsg $ onCps (mul (fadeOut 2) . C.tibetanBowl152 )
+
+----------------------------------------------
+-- pads
+
+pwPad = Patch
+ { patchInstr = mul 0.6 . at fromMono . onCps C.pwPad
+ , patchFx = fx1 0.25 smallHall2 }
+
+triPad = Patch
+ { patchInstr = fmap fromMono . mul 0.7 . onCps C.triPad
+ , patchFx = fx1' 0.25 C.triPadFx }
+
+nightPad = Patch
+ { patchInstr = mul 0.48 . at fromMono . onCps (mul (fadeOut 1) . C.nightPad 0.5)
+ , patchFx = fx1 0.25 largeHall2 }
+
+overtonePad = Patch
+ { patchInstr = 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)))
+ , patchFx = fx1 0.35 smallHall2 }
+
+caveOvertonePad = overtonePad { patchFx = fx1 0.2 (magicCave2 . mul 0.8) }
+
+chorusel = Patch
+ { patchInstr = mul 0.9 . at (mlp (3500 + 2000 * uosc 0.1) 0.1) . onCps (mul (fades 0.65 1) . C.chorusel 13 0.5 10)
+ , patchFx = fx1 0.35 smallHall2 }
+
+pwEnsemble = Patch
+ { patchInstr = at fromMono . mul 0.55 . onCps C.pwEnsemble
+ , patchFx = fx1 0.25 smallHall2 }
+
+fmDroneSlow = Patch
+ { patchInstr = at fromMono . mul 0.5 . onCps (C.fmDrone 3 (10, 5))
+ , patchFx = fx1 0.35 largeHall2 }
+
+fmDroneMedium = Patch
+ { patchInstr = at fromMono . mul 0.5 . onCps (C.fmDrone 3 (5, 3))
+ , patchFx = fx1 0.25 smallHall2 }
+
+fmDroneFast = Patch
+ { patchInstr = at fromMono . mul 0.5 . onCps (C.fmDrone 3 (0.5, 1))
+ , patchFx = fx1 0.25 smallHall2 }
+
+vibrophonePad = largeVibraphone1 { patchInstr = mul (1.5 * fades 0.5 0.25) . at (mlp 2500 0.1). patchInstr largeVibraphone1 }
+
+data RazorPad = RazorPad { razorPadSpeed :: Sig }
+
+instance Default RazorPad where
+ def = RazorPad 0.5
+
+razorPadSlow = razorPad' (def { razorPadSpeed = 0.1 })
+razorPadFast = razorPad' (def { razorPadSpeed = 1.7 })
+razorPadTremolo = razorPad' (def { razorPadSpeed = 6.7 })
+
+razorPad = razorPad' def
+
+razorPad' (RazorPad speed) = Patch
+ { patchInstr = at fromMono . mul 0.6 . onCps (uncurry $ C.razorPad speed)
+ , patchFx = fx1 0.35 largeHall2 }
+
+
+dreamPadFx = [FxSpec 0.35 (return . largeHall2), FxSpec 0.25 (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
+
+-- | The first argument is brightness (0 to 1)
+dreamPad' :: Sig -> Patch2
+dreamPad' bright = Patch
+ { patchInstr = fmap fromMono . onCps (C.dreamPad bright)
+ , patchFx = dreamPadFx
+ }
+
+-- | The first argument is brightness (0 to 1)
+underwaterPad' :: Sig -> Patch2
+underwaterPad' bright = Patch
+ { patchInstr = fmap fromMono . onCps (C.underwaterPad bright)
+ , patchFx = dreamPadFx
+ }
+
+-- | The first argument is brightness (0 to 1)
+lightIsTooBrightPad' :: Sig -> Patch2
+lightIsTooBrightPad' bright = Patch
+ { patchInstr = fmap fromMono . onCps (C.lightIsTooBrightPad bright)
+ , patchFx = dreamPadFx
+ }
+
+-- | The first argument is brightness (0 to 1)
+whaleSongPad' :: Sig -> Patch2
+whaleSongPad' bright = Patch
+ { patchInstr = fmap fromMono . onCps (C.whaleSongPad bright)
+ , patchFx = dreamPadFx
+ }
+
+------------------------------------
+-- leads
+
+polySynth = Patch
+ { patchInstr = fmap fromMono . onCps C.polySynth
+ , patchFx = [FxSpec 0.25 (return . largeHall2), FxSpec 0.25 (at $ echo 0.25 0.65), FxSpec 0.25 (at $ chorus 0.07 1.25 1)]
+ }
+
+phasingLead = Patch
+ { patchInstr = at fromMono . mul (0.7 * fadeOut 0.05) . onCps (uncurry C.phasingSynth)
+ , patchFx = fx1 0.25 smallHall2 }
+
+data RazorLead = RazorLead
+ { razorLeadBright :: Sig
+ , razorLeadSpeed :: Sig }
+
+instance Default RazorLead where
+ def = RazorLead 0.5 0.5
+
+razorLeadSlow = razorLead' (def { razorLeadSpeed = 0.1 })
+razorLeadFast = razorLead' (def { razorLeadSpeed = 1.7 })
+razorLeadTremolo = razorLead' (def { razorLeadSpeed = 6.7 })
+
+razorLead = razorLead' def
+
+razorLead' (RazorLead bright speed) = Patch
+ { patchInstr = at fromMono . (\(amp, cps) -> mul (fadeOut (0.05 + amp * 0.3)) $ C.razorLead (bright * sig amp) (speed * sig amp) (sig amp) (sig cps))
+ , patchFx = fx1 0.35 smallHall2 }
+
+overtoneLeadFx :: Sig2 -> SE Sig2
+overtoneLeadFx x = fmap magicCave2 $ mixAt 0.2 (echo 0.25 0.45) (return x)
+
+overtoneLead :: Patch2
+overtoneLead = Patch
+ { patchInstr = mul 0.4 . at fromMono . onCps (mul (fades 0.01 1) . C.tibetan 13 0.012)
+ , patchFx = fx1' 0.15 overtoneLeadFx }
+
+------------------------------------
+-- bass
+
+simpleBass = Patch
+ { patchInstr = at fromMono . mul 0.32 . onCps C.simpleBass
+ , patchFx = fx1 0.25 smallRoom2 }
+
+pwBass = Patch
+ { patchInstr = at fromMono . mul 0.4 . onCps C.pwBass
+ , patchFx = fx1 0.25 smallHall2 }
+
+deepBass = Patch
+ { patchInstr = at fromMono . mul 0.4 . onCps C.deepBass
+ , patchFx = fx1 0.25 smallHall2 }
+
+-- | The first argument is the amount of deepBass to mix into the original patch.
+withDeepBass :: Sig -> Patch2 -> Patch2
+withDeepBass k = mixInstr k deepBass
+
+------------------------------------
+-- plucked
+
+guitar = Patch
+ { patchInstr = onCps $ fromMono . mul (0.6 * fades 0.01 0.25) . C.plainString
+ , patchFx = fx1 0.25 smallHall2 }
+
+harpsichord = Patch
+ { patchInstr = onCps $ fromMono . mul (0.65 * fades 0.01 0.13) . C.harpsichord
+ , patchFx = fx1 0.25 smallHall2 }
+
+-- guita
+
+------------------------------------
+-- strike
+
+strikeFx :: Strike -> Sig2 -> SE Sig2
+strikeFx spec a = at (strikeReverb spec) $ (if (strikeHasDelay spec) then (mixAt 0.35 (echo 0.25 0.55)) else id) (return a :: SE Sig2)
+
+strikeRelease :: (D, D) -> Strike -> D
+strikeRelease (amp, cps) spec = (0.85 * strikeRel spec * amp) * amp + (strikeRel spec) - (cps / 10000)
+
+-- dac $ mixAt 0.15 largeHall2 $ mixAt 0.2 (echo 0.25 0.45) $ at fromMono $ midi $ onMsg $ onCps (mul (fadeOut 2) . C.tibetanBowl152 )
+data Strike = Strike
+ { strikeRel :: D
+ , strikeHasDelay :: Bool
+ , strikeReverb :: Sig2 -> Sig2
+ }
+
+instance Default Strike where
+ def = Strike 1.5 True smallHall2
+
+strike' :: Strike -> (Sig -> Sig) -> Patch Sig2
+strike' spec instr = Patch
+ { patchInstr = \x@(amp, cps) -> return $ fromMono $ mul (0.75 * sig amp * fadeOut (rel x)) $ instr (sig cps)
+ , patchFx = fx1' 0.25 (strikeFx spec) }
+ where rel a = strikeRelease a spec
+
+
+data Size = Small | Medium | Large | Huge
+
+nextSize x = case x of
+ Small -> Medium
+ Medium -> Large
+ Large -> Huge
+ Huge -> Huge
+
+prevSize x = case x of
+ Small -> Small
+ Medium -> Small
+ Large -> Medium
+ Huge -> Large
+
+toStrikeSpec :: Size -> Size -> Strike
+toStrikeSpec revSpec restSpec = Strike
+ { strikeReverb = toReverb revSpec
+ , strikeRel = toRel restSpec
+ , strikeHasDelay = toHasDelay restSpec }
+
+toReverb :: Size -> (Sig2 -> Sig2)
+toReverb x = case x of
+ Small -> smallRoom2
+ Medium -> smallHall2
+ Large -> largeHall2
+ Huge -> magicCave2
+
+toRel :: Size -> D
+toRel x = case x of
+ Small -> 0.4
+ Medium -> 1.5
+ Large -> 2.5
+ Huge -> 4.5
+
+toGain :: Size -> Sig
+toGain x = case x of
+ Small -> 0.85
+ Medium -> 0.75
+ Large -> 0.6
+ Huge -> 0.45
+
+toHasDelay :: Size -> Bool
+toHasDelay x = case x of
+ Small -> False
+ _ -> True
+
+dahinaSize = Small
+banyanSize = Medium
+xylophoneSize = Small
+tibetanBowl152Size = Medium
+tibetanBowl140Size = Small
+tibetanBowl180Size = Medium
+spinelSphereSize = Small
+potLidSize = Medium
+redCedarWoodPlateSize = Small
+tubularBellSize = Large
+redwoodPlateSize = Small
+douglasFirWoodPlateSize = Small
+uniformWoodenBarSize = Small
+uniformAluminumBarSize = Small
+vibraphone1Size = Medium
+vibraphone2Size = Medium
+chalandiPlatesSize = Medium
+wineGlassSize = Medium
+smallHandbellSize = Medium
+albertClockBellBelfastSize = Large
+woodBlockSize = Small
+
+smallStrike :: Size -> (Sig -> Sig) -> Patch2
+smallStrike size = mediumStrike' (prevSize size) size
+
+mediumStrike :: Size -> (Sig -> Sig) -> Patch2
+mediumStrike size = mediumStrike' size size
+
+largeStrike :: Size -> (Sig -> Sig) -> Patch2
+largeStrike size = mediumStrike' (nextSize size) size
+
+magicStrike :: Size -> (Sig -> Sig) -> Patch2
+magicStrike size = mediumStrike' (nextSize $ nextSize size) size
+
+mediumStrike' :: Size -> Size -> (Sig -> Sig) -> Patch2
+mediumStrike' revSize size f = p { patchInstr = mul (toGain size) . patchInstr p }
+ where p = strike' (toStrikeSpec revSize size) f
+
+
+smallDahina = smallStrike dahinaSize C.dahina
+dahina = mediumStrike dahinaSize C.dahina
+largeDahina = largeStrike dahinaSize C.dahina
+magicDahina = magicStrike dahinaSize C.dahina
+
+smallBanyan = smallStrike banyanSize C.banyan
+banyan = mediumStrike banyanSize C.banyan
+largeBanyan = largeStrike banyanSize C.banyan
+magicBanyan = magicStrike banyanSize C.banyan
+
+smallXylophone = smallStrike xylophoneSize C.xylophone
+xylophone = mediumStrike xylophoneSize C.xylophone
+largeXylophone = largeStrike xylophoneSize C.xylophone
+magicXylophone = magicStrike xylophoneSize C.xylophone
+
+smallTibetanBowl180 = smallStrike tibetanBowl180Size C.tibetanBowl180
+tibetanBowl180 = mediumStrike tibetanBowl180Size C.tibetanBowl180
+largeTibetanBowl180 = largeStrike tibetanBowl180Size C.tibetanBowl180
+magicTibetanBowl180 = magicStrike tibetanBowl180Size C.tibetanBowl180
+
+smallSpinelSphere = smallStrike spinelSphereSize C.spinelSphere
+spinelSphere = mediumStrike spinelSphereSize C.spinelSphere
+largeSpinelSphere = largeStrike spinelSphereSize C.spinelSphere
+magicSpinelSphere = magicStrike spinelSphereSize C.spinelSphere
+
+smallPotLid = smallStrike potLidSize C.potLid
+potLid = mediumStrike potLidSize C.potLid
+largePotLid = largeStrike potLidSize C.potLid
+magicPotLid = magicStrike potLidSize C.potLid
+
+smallRedCedarWoodPlate = smallStrike redCedarWoodPlateSize C.redCedarWoodPlate
+redCedarWoodPlate = mediumStrike redCedarWoodPlateSize C.redCedarWoodPlate
+largeRedCedarWoodPlate = largeStrike redCedarWoodPlateSize C.redCedarWoodPlate
+magicRedCedarWoodPlate = magicStrike redCedarWoodPlateSize C.redCedarWoodPlate
+
+smallTubularBell = smallStrike tubularBellSize C.tubularBell
+tubularBell = mediumStrike tubularBellSize C.tubularBell
+largeTubularBell = largeStrike tubularBellSize C.tubularBell
+magicTubularBell = magicStrike tubularBellSize C.tubularBell
+
+smallRedwoodPlate = smallStrike redwoodPlateSize C.redwoodPlate
+redwoodPlate = mediumStrike redwoodPlateSize C.redwoodPlate
+largeRedwoodPlate = largeStrike redwoodPlateSize C.redwoodPlate
+magicRedwoodPlate = magicStrike redwoodPlateSize C.redwoodPlate
+
+smallDouglasFirWoodPlate = smallStrike douglasFirWoodPlateSize C.douglasFirWoodPlate
+douglasFirWoodPlate = mediumStrike douglasFirWoodPlateSize C.douglasFirWoodPlate
+largeDouglasFirWoodPlate = largeStrike douglasFirWoodPlateSize C.douglasFirWoodPlate
+magicDouglasFirWoodPlate = magicStrike douglasFirWoodPlateSize C.douglasFirWoodPlate
+
+smallUniformWoodenBar = smallStrike uniformWoodenBarSize C.uniformWoodenBar
+uniformWoodenBar = mediumStrike uniformWoodenBarSize C.uniformWoodenBar
+largeUniformWoodenBar = largeStrike uniformWoodenBarSize C.uniformWoodenBar
+magicUniformWoodenBar = magicStrike uniformWoodenBarSize C.uniformWoodenBar
+
+smallUniformAluminumBar = smallStrike uniformAluminumBarSize C.uniformAluminumBar
+uniformAluminumBar = mediumStrike uniformAluminumBarSize C.uniformAluminumBar
+largeUniformAluminumBar = largeStrike uniformAluminumBarSize C.uniformAluminumBar
+magicUniformAluminumBar = magicStrike uniformAluminumBarSize C.uniformAluminumBar
+
+smallVibraphone1 = smallStrike vibraphone1Size C.vibraphone1
+vibraphone1 = mediumStrike vibraphone1Size C.vibraphone1
+largeVibraphone1 = largeStrike vibraphone1Size C.vibraphone1
+magicVibraphone1 = magicStrike vibraphone1Size C.vibraphone1
+
+smallVibraphone2 = smallStrike vibraphone2Size C.vibraphone2
+vibraphone2 = mediumStrike vibraphone2Size C.vibraphone2
+largeVibraphone2 = largeStrike vibraphone2Size C.vibraphone2
+magicVibraphone2 = magicStrike vibraphone2Size C.vibraphone2
+
+smallChalandiPlates = smallStrike chalandiPlatesSize C.chalandiPlates
+chalandiPlates = mediumStrike chalandiPlatesSize C.chalandiPlates
+largeChalandiPlates = largeStrike chalandiPlatesSize C.chalandiPlates
+magicChalandiPlates = magicStrike chalandiPlatesSize C.chalandiPlates
+
+smallTibetanBowl152 = smallStrike tibetanBowl152Size C.tibetanBowl152
+tibetanBowl152 = mediumStrike tibetanBowl152Size C.tibetanBowl152
+largeTibetanBowl152 = largeStrike tibetanBowl152Size C.tibetanBowl152
+magicTibetanBowl152 = magicStrike tibetanBowl152Size C.tibetanBowl152
+
+smallTibetanBowl140 = smallStrike tibetanBowl140Size C.tibetanBowl140
+tibetanBowl140 = mediumStrike tibetanBowl140Size C.tibetanBowl140
+largeTibetanBowl140 = largeStrike tibetanBowl140Size C.tibetanBowl140
+magicTibetanBowl140 = magicStrike tibetanBowl140Size C.tibetanBowl140
+
+smallWineGlass = smallStrike wineGlassSize C.wineGlass
+wineGlass = mediumStrike wineGlassSize C.wineGlass
+largeWineGlass = largeStrike wineGlassSize C.wineGlass
+magicWineGlass = magicStrike wineGlassSize C.wineGlass
+
+smallHandbell = smallStrike smallHandbellSize C.smallHandbell
+handbell = mediumStrike smallHandbellSize C.smallHandbell
+largeHandbell = largeStrike smallHandbellSize C.smallHandbell
+magicHandbell = magicStrike smallHandbellSize C.smallHandbell
+
+smallAlbertClockBellBelfast = smallStrike albertClockBellBelfastSize C.albertClockBellBelfast
+albertClockBellBelfast = mediumStrike albertClockBellBelfastSize C.albertClockBellBelfast
+largeAlbertClockBellBelfast = largeStrike albertClockBellBelfastSize C.albertClockBellBelfast
+magicAlbertClockBellBelfast = magicStrike albertClockBellBelfastSize C.albertClockBellBelfast
+
+smallWoodBlock = smallStrike woodBlockSize C.woodBlock
+woodBlock = mediumStrike woodBlockSize C.woodBlock
+largeWoodBlock = largeStrike woodBlockSize C.woodBlock
+magicWoodBlock = magicStrike woodBlockSize C.woodBlock
+
+---------------------------------------------------------------
+-- scrape
+
+-- scrapePatch
+
+names = ["dahina","banyan","xylophone","tibetanBowl180","spinelSphere","potLid","redCedarWoodPlate","tubularBell","redwoodPlate","douglasFirWoodPlate","uniformWoodenBar","uniformAluminumBar","vibraphone1","vibraphone2","chalandiPlates","tibetanBowl152","tibetanBowl140","wineGlass","smallHandbell","albertClockBellBelfast","woodBlock"]
+toUpperName (x:xs) = toUpper x : xs
+
+-- scrapePatch
+
+scrapeRelease :: (D, D) -> D -> D
+scrapeRelease (amp, cps) rel = (0.85 * rel * amp) * amp + rel - (cps / 10000)
+
+scrapeFast k m = Patch
+ { patchInstr = \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.02 (scrapeRelease x 0.25)) . at fromMono . C.scrapeModes m) (sig cps)
+ , patchFx = fx1 0.15 largeHall2 }
+
+scrape k m = Patch
+ { patchInstr = \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.5 (scrapeRelease x 0.97)) . at fromMono . C.scrapeModes m) (sig cps)
+ , patchFx = fx1 0.15 largeHall2 }
+
+scrapePad k m = Patch
+ { patchInstr = \x@(amp, cps) -> (mul (0.75 * sig amp * k * fades 0.5 (scrapeRelease x 2.27 )) . at fromMono . C.scrapeModes m) (sig cps)
+ , patchFx = fx1 0.15 largeHall2 }
+
+scaleScrapeDahina = 1.32
+scaleScrapeBanyan = 0.95
+scaleScrapeXylophone = 1
+scaleScrapeTibetanBowl180 = 0.55
+scaleScrapeSpinelSphere = 1.4
+scaleScrapePotLid = 0.65
+scaleScrapeRedCedarWoodPlate = 1
+scaleScrapeTubularBell = 0.75
+scaleScrapeRedwoodPlate = 1
+scaleScrapeDouglasFirWoodPlate = 1
+scaleScrapeUniformWoodenBar = 1
+scaleScrapeUniformAluminumBar = 0.75
+scaleScrapeVibraphone1 = 0.9
+scaleScrapeVibraphone2 = 0.9
+scaleScrapeChalandiPlates = 1
+scaleScrapeTibetanBowl152 = 0.65
+scaleScrapeTibetanBowl140 = 0.75
+scaleScrapeWineGlass = 0.6
+scaleScrapeSmallHandbell = 1
+scaleScrapeAlbertClockBellBelfast = 0.5
+scaleScrapeWoodBlock = 1.32
+
+scrapeDahina = scrape scaleScrapeDahina C.dahinaModes
+scrapeBanyan = scrape scaleScrapeBanyan C.banyanModes
+scrapeXylophone = scrape scaleScrapeXylophone C.xylophoneModes
+scrapeTibetanBowl180 = scrape scaleScrapeTibetanBowl180 C.tibetanBowlModes180
+scrapeSpinelSphere = scrape scaleScrapeSpinelSphere C.spinelSphereModes
+scrapePotLid = scrape scaleScrapePotLid C.potLidModes
+scrapeRedCedarWoodPlate = scrape scaleScrapeRedCedarWoodPlate C.redCedarWoodPlateModes
+scrapeTubularBell = scrape scaleScrapeTubularBell C.tubularBellModes
+scrapeRedwoodPlate = scrape scaleScrapeRedwoodPlate C.redwoodPlateModes
+scrapeDouglasFirWoodPlate = scrape scaleScrapeDouglasFirWoodPlate C.douglasFirWoodPlateModes
+scrapeUniformWoodenBar = scrape scaleScrapeUniformWoodenBar C.uniformWoodenBarModes
+scrapeUniformAluminumBar = scrape scaleScrapeUniformAluminumBar C.uniformAluminumBarModes
+scrapeVibraphone1 = scrape scaleScrapeVibraphone1 C.vibraphoneModes1
+scrapeVibraphone2 = scrape scaleScrapeVibraphone2 C.vibraphoneModes2
+scrapeChalandiPlates = scrape scaleScrapeChalandiPlates C.chalandiPlatesModes
+scrapeTibetanBowl152 = scrape scaleScrapeTibetanBowl152 C.tibetanBowlModes152
+scrapeTibetanBowl140 = scrape scaleScrapeTibetanBowl140 C.tibetanBowlModes140
+scrapeWineGlass = scrape scaleScrapeWineGlass C.wineGlassModes
+scrapeSmallHandbell = scrape scaleScrapeSmallHandbell C.smallHandbellModes
+scrapeAlbertClockBellBelfast = scrape scaleScrapeAlbertClockBellBelfast C.albertClockBellBelfastModes
+scrapeWoodBlock = scrape scaleScrapeWoodBlock C.woodBlockModes
+
+scrapeFastDahina = scrapeFast scaleScrapeDahina C.dahinaModes
+scrapeFastBanyan = scrapeFast scaleScrapeBanyan C.banyanModes
+scrapeFastXylophone = scrapeFast scaleScrapeXylophone C.xylophoneModes
+scrapeFastTibetanBowl180 = scrapeFast scaleScrapeTibetanBowl180 C.tibetanBowlModes180
+scrapeFastSpinelSphere = scrapeFast scaleScrapeSpinelSphere C.spinelSphereModes
+scrapeFastPotLid = scrapeFast scaleScrapePotLid C.potLidModes
+scrapeFastRedCedarWoodPlate = scrapeFast scaleScrapeRedCedarWoodPlate C.redCedarWoodPlateModes
+scrapeFastTubularBell = scrapeFast scaleScrapeTubularBell C.tubularBellModes
+scrapeFastRedwoodPlate = scrapeFast scaleScrapeRedwoodPlate C.redwoodPlateModes
+scrapeFastDouglasFirWoodPlate = scrapeFast scaleScrapeDouglasFirWoodPlate C.douglasFirWoodPlateModes
+scrapeFastUniformWoodenBar = scrapeFast scaleScrapeUniformWoodenBar C.uniformWoodenBarModes
+scrapeFastUniformAluminumBar = scrapeFast scaleScrapeUniformAluminumBar C.uniformAluminumBarModes
+scrapeFastVibraphone1 = scrapeFast scaleScrapeVibraphone1 C.vibraphoneModes1
+scrapeFastVibraphone2 = scrapeFast scaleScrapeVibraphone2 C.vibraphoneModes2
+scrapeFastChalandiPlates = scrapeFast scaleScrapeChalandiPlates C.chalandiPlatesModes
+scrapeFastTibetanBowl152 = scrapeFast scaleScrapeTibetanBowl152 C.tibetanBowlModes152
+scrapeFastTibetanBowl140 = scrapeFast scaleScrapeTibetanBowl140 C.tibetanBowlModes140
+scrapeFastWineGlass = scrapeFast scaleScrapeWineGlass C.wineGlassModes
+scrapeFastSmallHandbell = scrapeFast scaleScrapeSmallHandbell C.smallHandbellModes
+scrapeFastAlbertClockBellBelfast = scrapeFast scaleScrapeAlbertClockBellBelfast C.albertClockBellBelfastModes
+scrapeFastWoodBlock = scrapeFast scaleScrapeWoodBlock C.woodBlockModes
+
+scrapePadDahina = scrapePad scaleScrapeDahina C.dahinaModes
+scrapePadBanyan = scrapePad scaleScrapeBanyan C.banyanModes
+scrapePadXylophone = scrapePad scaleScrapeXylophone C.xylophoneModes
+scrapePadTibetanBowl180 = scrapePad scaleScrapeTibetanBowl180 C.tibetanBowlModes180
+scrapePadSpinelSphere = scrapePad scaleScrapeSpinelSphere C.spinelSphereModes
+scrapePadPotLid = scrapePad scaleScrapePotLid C.potLidModes
+scrapePadRedCedarWoodPlate = scrapePad scaleScrapeRedCedarWoodPlate C.redCedarWoodPlateModes
+scrapePadTubularBell = scrapePad scaleScrapeTubularBell C.tubularBellModes
+scrapePadRedwoodPlate = scrapePad scaleScrapeRedwoodPlate C.redwoodPlateModes
+scrapePadDouglasFirWoodPlate = scrapePad scaleScrapeDouglasFirWoodPlate C.douglasFirWoodPlateModes
+scrapePadUniformWoodenBar = scrapePad scaleScrapeUniformWoodenBar C.uniformWoodenBarModes
+scrapePadUniformAluminumBar = scrapePad scaleScrapeUniformAluminumBar C.uniformAluminumBarModes
+scrapePadVibraphone1 = scrapePad scaleScrapeVibraphone1 C.vibraphoneModes1
+scrapePadVibraphone2 = scrapePad scaleScrapeVibraphone2 C.vibraphoneModes2
+scrapePadChalandiPlates = scrapePad scaleScrapeChalandiPlates C.chalandiPlatesModes
+scrapePadTibetanBowl152 = scrapePad scaleScrapeTibetanBowl152 C.tibetanBowlModes152
+scrapePadTibetanBowl140 = scrapePad scaleScrapeTibetanBowl140 C.tibetanBowlModes140
+scrapePadWineGlass = scrapePad scaleScrapeWineGlass C.wineGlassModes
+scrapePadSmallHandbell = scrapePad scaleScrapeSmallHandbell C.smallHandbellModes
+scrapePadAlbertClockBellBelfast = scrapePad scaleScrapeAlbertClockBellBelfast C.albertClockBellBelfastModes
+scrapePadWoodBlock = scrapePad scaleScrapeWoodBlock C.woodBlockModes
+
+------------------------------------
+-- woodwind
+
+data Wind = Wind
+ { windAtt :: D
+ , windDec :: D
+ , windSus :: D
+ , windVib :: D
+ , windBright :: D }
+
+woodWind' spec instr = Patch
+ { patchInstr = \(amp, cps) -> mul 1.3 $ do
+ seed <- rnd 1
+ vibDisp <- rnd (0.1 * amp)
+ let dispVib vib = vib * (0.9 + vibDisp)
+ return $ fromMono $ mul (0.8 * sig amp * fadeOut (windDec spec)) $ instr seed (dispVib $ windVib spec) (windAtt spec) (windSus spec) (windDec spec) (0.4 + 0.75 * windBright spec * amp) cps
+ , patchFx = fx1 0.25 smallHall2 }
+
+-- flute
+
+fluteSpec bright vib = Wind
+ { windAtt = 0.08
+ , windDec = 0.1
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+shortFluteSpec bright vib = Wind
+ { windAtt = 0.03
+ , windDec = 0.05
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+flute = woodWind' (fluteSpec br vib) C.flute
+ where
+ br = 0.7
+ vib = 0.015
+
+shortFlute = woodWind' (shortFluteSpec br vib) C.flute
+ where
+ br = 0.7
+ vib = 0.015
+
+fluteVibrato = woodWind' (fluteSpec br vib) C.flute
+ where
+ br = 0.7
+ vib = 0.04
+
+mutedFlute = woodWind' (fluteSpec br vib) C.flute
+ where
+ br = 0.25
+ vib = 0.015
+
+brightFlute = woodWind' (fluteSpec br vib) C.flute
+ where
+ br = 1.2
+ vib = 0.015
+
+-- bass clarinet
+
+bassClarinetSpec bright vib = Wind
+ { windAtt = 0.06
+ , windDec = 0.15
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+shortBassClarinetSpec bright vib = Wind
+ { windAtt = 0.03
+ , windDec = 0.04
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+bassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet
+ where
+ br = 0.7
+ vib = 0.01
+
+shortBassClarinet = woodWind' (shortBassClarinetSpec br vib) C.bassClarinet
+ where
+ br = 0.7
+ vib = 0.01
+
+bassClarinetVibrato = woodWind' (bassClarinetSpec br vib) C.bassClarinet
+ where
+ br = 0.7
+ vib = 0.035
+
+mutedBassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet
+ where
+ br = 0.25
+ vib = 0.01
+
+brightBassClarinet = woodWind' (bassClarinetSpec br vib) C.bassClarinet
+ where
+ br = 1.2
+ vib = 0.01
+
+-- french horn
+
+frenchHornSpec bright vib = Wind
+ { windAtt = 0.08
+ , windDec = 0.25
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+shortFrenchHornSpec bright vib = Wind
+ { windAtt = 0.03
+ , windDec = 0.04
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+frenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn
+ where
+ br = 0.7
+ vib = 0.01
+
+shortFrenchHorn = woodWind' (shortFrenchHornSpec br vib) C.frenchHorn
+ where
+ br = 0.7
+ vib = 0.01
+
+frenchHornVibrato = woodWind' (frenchHornSpec br vib) C.frenchHorn
+ where
+ br = 0.7
+ vib = 0.035
+
+mutedFrenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn
+ where
+ br = 0.25
+ vib = 0.01
+
+brightFrenchHorn = woodWind' (frenchHornSpec br vib) C.frenchHorn
+ where
+ br = 1.2
+ vib = 0.01
+
+-- sheng
+
+shengSpec bright vib = Wind
+ { windAtt = 0.1
+ , windDec = 0.2
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+shortShengSpec bright vib = Wind
+ { windAtt = 0.03
+ , windDec = 0.04
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+sheng = woodWind' (shengSpec br vib) C.sheng
+ where
+ br = 0.7
+ vib = 0.01
+
+shortSheng = woodWind' (shortShengSpec br vib) C.sheng
+ where
+ br = 0.7
+ vib = 0.01
+
+shengVibrato = woodWind' (shengSpec br vib) C.sheng
+ where
+ br = 0.7
+ vib = 0.025
+
+mutedSheng = woodWind' (shengSpec br vib) C.sheng
+ where
+ br = 0.25
+ vib = 0.01
+
+brightSheng = woodWind' (shortShengSpec br vib) C.sheng
+ where
+ br = 1.2
+ vib = 0.01
+
+-- hulusi
+
+hulusiSpec bright vib = Wind
+ { windAtt = 0.12
+ , windDec = 0.14
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+shortHulusiSpec bright vib = Wind
+ { windAtt = 0.03
+ , windDec = 0.04
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+hulusi = woodWind' (hulusiSpec br vib) C.hulusi
+ where
+ br = 0.7
+ vib = 0.015
+
+shortHulusi = woodWind' (shortHulusiSpec br vib) C.hulusi
+ where
+ br = 0.7
+ vib = 0.015
+
+hulusiVibrato = woodWind' (hulusiSpec br vib) C.hulusi
+ where
+ br = 0.7
+ vib = 0.035
+
+mutedHulusi = woodWind' (hulusiSpec br vib) C.hulusi
+ where
+ br = 0.25
+ vib = 0.015
+
+brightHulusi = woodWind' (shortHulusiSpec br vib) C.hulusi
+ where
+ br = 1.2
+ vib = 0.015
+
+
+-- dizi
+
+diziSpec bright vib = Wind
+ { windAtt = 0.03
+ , windDec = 0.2
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+shortDiziSpec bright vib = Wind
+ { windAtt = 0.1
+ , windDec = 0.04
+ , windSus = 20
+ , windVib = vib
+ , windBright = bright }
+
+dizi = woodWind' (diziSpec br vib) C.dizi
+ where
+ br = 0.7
+ vib = 0.01
+
+shortDizi = woodWind' (shortDiziSpec br vib) C.dizi
+ where
+ br = 0.7
+ vib = 0.01
+
+diziVibrato = woodWind' (diziSpec br vib) C.dizi
+ where
+ br = 0.7
+ vib = 0.035
+
+mutedDizi = woodWind' (diziSpec br vib) C.dizi
+ where
+ br = 0.25
+ vib = 0.01
+
+brightDizi = woodWind' (shortDiziSpec br vib) C.dizi
+ where
+ br = 1.2
+ vib = 0.01
+
+------------------------------------
+-- x-rays
+
+pulseWidth = Patch
+ { patchInstr = mul (0.75 * 0.6) . at fromMono . mul (fades 0.07 0.1). onCps (uncurry C.pulseWidth)
+ , patchFx = fx1 0.15 smallHall2 }
+
+xanadu = Patch
+ { patchInstr = mul (1.2 * 0.6) . at fromMono . mul (fades 0.01 2.2). onCps C.xanadu1
+ , patchFx = fx1 0.27 largeHall2 }
+
+alienIsAngry = Patch
+ { patchInstr = at fromMono . mul (0.5 * fades 0.01 2.3). onCps (C.fmMod 5)
+ , patchFx = fx1 0.15 smallRoom2 }
+
+noiz = Patch
+ { patchInstr = at fromMono . mul (1.5 * fades 0.01 0.5). onCps C.noiz
+ , patchFx = fx1 0.15 smallHall2 }
+
+blue = Patch
+ { patchInstr = at fromMono . mul (1.5 * fades 0.01 0.5). onCps (C.blue 5 7 0.24 12)
+ , patchFx = fx1 0.25 smallHall2 }
+
+black = Patch
+ { patchInstr = at fromMono . mul (2 * fades 0.01 0.5). onCps (\cps -> C.black 3 (cps / 2) (cps * 2) 12 (sig cps))
+ , patchFx = fx1 0.25 smallHall2 }
+
+simpleMarimba = Patch
+ { patchInstr = at fromMono . mul (0.8 * fades 0.01 0.5). onCps (C.simpleMarimba 5)
+ , patchFx = fx1 0.25 smallHall2 }
+
+okComputer = Patch
+ { patchInstr = \(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)
+ , patchFx = fx1 0.25 id }
+
+snowCrackle = Patch
+ { patchInstr = \(amp, cps) -> (return . fromMono . mul (0.8 * sig amp * fades 0.001 0.001) . (C.snowCrackle . (/ 25))) (sig cps)
+ , patchFx = fx1 0.25 id }
+
+noiseBell = Patch
+ { patchInstr = at fromMono . mul 0.75 . onCps (C.noiseBell (31, 125) 2.3 0.2 . ( * 8))
+ , patchFx = fx1 0.25 smallHall2 }
+
+------------------------------------
+-- vowels
+
+robotVowels vows latVow = Patch
+ { patchInstr = at fromMono . mul (1.1 * fades 0.1 0.1). onCps (C.vowels 25 vows latVow)
+ , patchFx = fx1 0.15 smallHall2 }
+
+robotLoopVowels loopDur vows = Patch
+ { patchInstr = at fromMono . mul (1.1 * fades 0.1 0.1). onCps (C.loopVowels 25 loopDur vows)
+ , patchFx = fx1 0.15 smallHall2 }
+
+robotVowel vow = Patch
+ { patchInstr = at fromMono . mul (1.1 * fades 0.1 0.1). onCps (C.oneVowel 25 vow)
+ , patchFx = fx1 0.15 smallHall2 }
+
+------------------------------------
+-- nature / effects
+
+windWall = Patch
+ { patchInstr = at fromMono . mul (1.25 * fades 0.1 5). onCps C.windWall
+ , patchFx = fx1 0.25 largeHall2 }
+
+mildWind = Patch
+ { patchInstr = at fromMono . mul (1.25 * fades 0.1 1.5). onCps C.mildWind
+ , patchFx = fx1 0.25 largeHall2 }
+
+wind = Patch
+ { patchInstr = at fromMono . mul (0.8 * fades 0.1 1.5). onCps (\cps -> C.thorWind (cps * 2) 150 (0.3, 1))
+ , patchFx = fx1 0.25 largeHall2 }
+
+------------------------------------
+-- drums
+