csound-catalog 0.2.2 → 0.3.0

raw patch · 18 files changed

+3018/−154 lines, 18 filesdep +csound-samplerdep ~csound-expressionPVP ok

version bump matches the API change (PVP)

Dependencies added: csound-sampler

Dependency ranges changed: csound-expression

API changes (from Hackage documentation)

Files

• csound-catalog.cabal +10/−2
• src/Csound/Catalog.hs +1/−1
• src/Csound/Catalog/Drum.hs +61/−141
• src/Csound/Catalog/Drum/Hm.hs +197/−0
• src/Csound/Catalog/Drum/MiniPops.hs +444/−0
• src/Csound/Catalog/Drum/Tr808.hs +555/−0
• src/Csound/Catalog/Effect.hs +4/−4
• src/Csound/Catalog/Reson.hs +1/−1
• src/Csound/Catalog/Wave.hs +40/−1
• src/Csound/Catalog/Wave/Amsterdam.hs +1/−1
• src/Csound/Catalog/Wave/Bitwig.hs +51/−0
• src/Csound/Catalog/Wave/Flavio.hs +63/−0
• src/Csound/Catalog/Wave/Misc.hs +54/−1
• src/Csound/Catalog/Wave/Sean.hs +202/−0
• src/Csound/Catalog/Wave/Thor.hs +168/−0
• src/Csound/Catalog/Wave/Woodwind.hs +2/−1
• src/Csound/Catalog/Wave/WoodwindAlg.hs +6/−1
• src/Csound/Patch.hs +1158/−0

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

@@ -12,7 +12,7 @@     , 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

@@ -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+import Csound.Sam -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]  +import qualified Csound.Catalog.Drum.Hm       as H+import qualified Csound.Catalog.Drum.Tr808    as T+import qualified Csound.Catalog.Drum.MiniPops as M  -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]+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 -        onNoise asig = aout-            where -                anoise1 = kenv1 * asig-                anoise2 = kenv2 * asig+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 -                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-                    ]+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 -                rz x y = resonz x (sig $ cps * y) (sig $ cps * 5.5)+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

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

@@ -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'

@@ -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'++

@@ -85,12 +85,12 @@ -- 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]

@@ -79,7 +79,7 @@     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

@@ -59,8 +59,42 @@     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@@ -73,6 +107,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 

@@ -16,6 +16,6 @@ -- * 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 

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

@@ -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+

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

@@ -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	+	}++------------------------------------------------------------------------+-- ++

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

@@ -7,6 +7,7 @@     , dizi     ) where + import Csound.Base hiding (fromSpec)  import Csound.Catalog.Wave.WoodwindAlg@@ -623,7 +624,7 @@         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

@@ -5,6 +5,7 @@ ) where  import Data.List (transpose, intersperse)+import Control.Monad import Control.Monad.Trans.State  import Csound.Base hiding (fromSpec)@@ -17,6 +18,10 @@ 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 @@         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)

@@ -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+