diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Anton Kholomiov 2010 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Anton Kholomiov nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/csound-catalog.cabal b/csound-catalog.cabal new file mode 100644 --- /dev/null +++ b/csound-catalog.cabal @@ -0,0 +1,50 @@ +Name: csound-catalog +Version: 0.1 +Cabal-Version: >= 1.6 +License: BSD3 +License-file: LICENSE +Author: Anton Kholomiov +Synopsis: a gallery of Csound instruments. +Stability: Experimental +Tested-With: GHC==7.6 +Build-Type: Simple +Category: Music +Maintainer: + +Description: + A gallery of Csound instruments. + + +Extra-Source-Files : + +Homepage: https://github.com/anton-k/csound-catalog +Bug-Reports: https://github.com/anton-k/csound-catalog/issues + +Source-repository head + Type: git + Location: https://github.com/anton-k/csound-catalog + +Library + Ghc-Options: -Wall + Build-Depends: + base >= 4, base < 5, transformers, csound-expression >= 3.0.0 + Hs-Source-Dirs: src/ + Exposed-Modules: + Csound.Catalog + Csound.Catalog.Drum + Csound.Catalog.Effect + Csound.Catalog.Envelope + Csound.Catalog.Reson + Csound.Catalog.Wave + Other-Modules: + Csound.Catalog.Wave.Woodwind + Csound.Catalog.Wave.WoodwindAlg + Csound.Catalog.Wave.Vowel + Csound.Catalog.Wave.Ac + Csound.Catalog.Wave.VestigeOfTime + Csound.Catalog.Wave.Deserted + Csound.Catalog.Wave.TheHeartbeat + Csound.Catalog.Wave.TrappedInConvert + Csound.Catalog.Wave.Amsterdam + Csound.Catalog.Wave.Misc + diff --git a/src/Csound/Catalog.hs b/src/Csound/Catalog.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog.hs @@ -0,0 +1,23 @@ +-- | The implementation of the instruments that I've found in the Csound catalog +-- and collection of Csond-algorithmic composition (by Michael Gogins) and +-- some other sources. +-- +-- Requirements: +-- +-- * Library strives for modularity and simplicity. +-- +-- * It must be possible to use all instruments live with midi, so the function 'Csound.Base.idur' is forbidden. +module Csound.Catalog + ( module Csound.Catalog.Drum + , module Csound.Catalog.Effect + , module Csound.Catalog.Envelope + , module Csound.Catalog.Reson + , module Csound.Catalog.Wave + ) where + +import Csound.Catalog.Drum +import Csound.Catalog.Effect +import Csound.Catalog.Envelope +import Csound.Catalog.Reson +import Csound.Catalog.Wave + diff --git a/src/Csound/Catalog/Drum.hs b/src/Csound/Catalog/Drum.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Drum.hs @@ -0,0 +1,153 @@ +-- | A gallery of the percussive sounds. +module Csound.Catalog.Drum( + -- * 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 +) where + +import Csound.Base + +-- subtractive + +-- | A \"dumb\" drum. +dumb :: SE Sig +dumb = fmap (bpb 1000 100) $ rand $ expseg [0.0001, 0.01, 1, 0.04, 0.01] + +dumbBass :: SE Sig +dumbBass = fmap (bpb kfreqenv (kfreqenv / 8)) $ rand $ expseg [0.0001, 0.01, 1, 0.08, 0.01] + where kfreqenv = expseg [50, 0.01, 200, 0.08, 50] + +pluckSnare :: Sig +pluckSnare = pluck kampenv4 kptchenv 50 (elins [1, 1]) 4 `withDs` [0.8, 3] + where + kampenv4 = linseg [0, 0.001, 1, xdur - 0.21, 1, 0.02, 0] + kptchenv = linseg [100, 0.01, 300, 0.2, 200, 0.01, 200] + xdur = 1.25 + + +sortaKnockSweep :: SE Sig +sortaKnockSweep = + fmap (resonsBy bpb + [ (kfreqenv41, kfreqenv41 / 8) + , (kfreqenv42, kfreqenv42 / 4) + ] + ) $ rand kampenv4 + where + kfreqenv41 = expseg [ 50, 0.01, 200, 0.08, 50] + kfreqenv42 = linseg [ 150, 0.01, 1000, 0.08, 250] + kampenv4 = linseg [ 0, 0.01, 1, 0.08, 0, 0.01, 0] + +metalBoink :: Sig +metalBoink = foscil kampenv61 30 1 6.726 kampenv62 sine + where + kampenv61 = expseg [ 0.01, 0.01, 1, 0.2, 0.1, 0.1, 0.001 ] + kampenv62 = linseg [ 1, 0.1, 10, 0.1, 0.5, 0.01, 1 ] + +-- fullkit + +bassDrum :: D -> Sig +bassDrum cps= env * osc (sig cps * kgliss * 0.5) + where env = linseg [0, 0.00245, 1, 0.1225, 0] + kgliss = expseg [10, 0.625, 1, 0.25, 1] + + +openHihat :: SE Sig +openHihat = hihat $ linseg [0, 0.004, 1, 0.121, 0] + +closedHihat :: SE Sig +closedHihat = hihat $ linseg [0, 0.00245, 1, 0.1225, 0] + +hihat :: Sig -> SE Sig +hihat kenv = do + asig <- rand kenv + let a1 = moogvcf (butbp asig cf (cf / 2)) cf 0.7 + a2 = comb a1 0.5 (1/cpspch(8)) + return $ a2 * 0.05 + a1 * 0.93 + where cf = cpspch (5.08 + 8) + +snare :: SE Sig +snare = do + asound <- rand 1 + let as1 = butbp asound 210 55 + return $ kenv2 * (as1 * 0.9 + asound * 0.8 * kenv1) + where + kenv1 = linseg [0, 0.00176, 1, 0.1232, 0] + kenv2 = expseg [0.01, 0.0002, 1, 0.0297, 0.01, 0.09, 0.01] + +-- | Recommended values cpspch(13.03) - cpspch(13.10) +crash :: D -> SE Sig +crash cps = do + asig <- rand 1 + return $ 0.5 * (0.5 * aall + resonator (aall + asig * kenv2)) + where + kenv2 = expseg [0.001, 0.0466, 1, 3.95, 0.001] + + resonator asig = 0.7 * a1 + 0.6 * kenv18 * a2 + where + flt a = butbp asig (sig $ a * cps) (sig $ 0.5 * cps) + a1 = sum $ fmap flt [1, 2.1, 2.8] + a2 = comb a1 0.5 (0.5 / cps) + kenv18 = expseg [0.01, 0.02, 1, 3.98, 0.01] + + harm k amp hs = k * amp * mean (fmap (osc . sig . ( * cps)) hs) + + aall = sum $ zipWith3 harm weights envelopes harmonics + + harmonics = + [ [1, 0.89, 1.12341] + , [2.24, 2.4 * 0.98, 2.14 * 1.02] + , [3.312, 3.513312*0.89, 3.123312*1.11] + , [4.89, 5.89*0.89, 6.89 * 1.03] + , [5.12, 5.5612*1.02, 7.7312 * 0.998] + , [6.97, 6.97 * 1.02, 6.97 * 0.98] + , [7.89, 7.89 * 1.02, 7.89 * 0.98] + , [1.25, 1.125 * 1.004, 1.134 * 0.996] + ] + + weights = replicate 7 0.2 ++ [0.1] + + envelopes = fmap (\(a, b) -> expseg [0.01, a, 1, b, 0.01]) + [ (0.0274, 3.972) + , (0.0264, 3.973) + , (0.0209, 3.979) + , (0.0248, 3.975) + , (0.0283, 3.971) + , (0.0330, 3.966) + , (0.0396, 3.960) + , (0.0209, 3.979) + ] + +handClap :: D -> SE Sig +handClap cps = fmap onNoise $ rand 1 + where + kenv1 = expseg [1.25, 0.03, 0.0001] + kenv2 = expseg [0.001, 0.005, 1, 0.35, 0.001] + + onNoise asig = aout + where + anoise1 = kenv1 * asig + anoise2 = kenv2 * asig + + adel1 = anoise1 + adel2 = delay anoise1 0.01 + adel3 = delay anoise1 0.02 + adel4 = delay anoise2 0.03 + + 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) + diff --git a/src/Csound/Catalog/Effect.hs b/src/Csound/Catalog/Effect.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Effect.hs @@ -0,0 +1,160 @@ +-- | A gallery of sound processors (effects). +module Csound.Catalog.Effect( + nightChorus, nightReverb, + vibroDelay, delayLine, bassEnhancment, declick, + sweepFilter, loopSweepFilter, + -- * Presets + bayAtNight, vestigeOfTime +) where + +import Control.Monad + +import Csound.Base + +-- | A signal goes throgh the chain of varible delays. +-- Delay time is affected by vibrato. +-- +-- > aout = vibroDelay n delayBufferSize vibDepth vibRate asig +-- +-- * @n@ -- number of delay lines +-- +-- * @delayBufSize@ -- buffer size for the delay lines (it should be greater +-- than absolute maximum of the depth of the vibrato) +-- +-- * @vibDepth@ -- the amplitude of the delay line time vibrato +-- +-- * @vibRate@ -- the frequency of the delay lie time vibrato +vibroDelay :: Int -> D -> Sig -> Sig -> Sig -> Sig +vibroDelay order delayBufSize vibDepth vibRate asig = balance aout asig + where aout = mean $ take order $ iterate del asig + del x = vdelay x (vibDepth * uosc vibRate) delayBufSize + +-- | Chorus effect, borrowed from http://www.jlpublishing.com/Csound.htm +-- I made some of its parameters accesible trhough score +-- delay in milliseconds (by John Lato in Csound) +-- +-- > nightChorus idlym iscale asig +-- +-- * idlym -- delay in milliseconds +-- +-- * iscale -- amplitude of the vibrato on delay time (in milliseconds). +nightChorus :: D -> D -> Sig -> Sig +nightChorus idlym iscale asig = 0.5 * aout + where + phi cps maxDel = vdelay3 asig (sig (idlym / 5) + sig (idlym / iscale) * osc cps) maxDel + aout = sum $ zipWith phi + [1, 0.995, 1.05, 1] + [900, 700, 700, 900] + +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +-- | Reverb +-- +-- A bunch of delay lines FDN reverb, with feedback matrix based upon +-- physical modeling scattering junction of 8 lossless waveguides +-- of equal characteristic impedance. Based on Julius O. Smith III, +-- \"A New Approach to Digital Reverberation using Closed Waveguide +-- Networks,\" Proceedings of the International Computer Music +-- Conference 1985, p. 47-53 (also available as a seperate +-- publication from CCRMA), as well as some more recent papers by +-- Smith and others. +-- +-- Coded by Sean Costello, October 1999 (in Csound) +-- +-- > nightReverb n igain ipitchmod itone cps +-- +-- * @n@ -- a number of delay lines (typical value is 8) +-- +-- * @igain@ -- gain of reverb. adjust empirically +-- for desired reverb time. 0.6 gives +-- a good small \"live\" room sound, 0.8 +-- a small hall, 0.9 a large hall, +-- 0.99 an enormous stone cavern. +-- +-- * @ipitchmod@ -- amount of random pitch modulation +-- for the delay lines. 1 is the \"normal\" +-- amount, but this may be too high for +-- held pitches such as piano tones. +-- adjust to taste. +-- +-- * @itone@ -- cutoff frequency of lowpass filters +-- in feedback loops of delay lines, +-- in hz. lower cutoff frequencies results +-- in a sound with more high-frequency +-- damping. +-- +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 + 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 + return (mean $ odds afilts2, mean $ evens afilts2) + where + idels = cycle $ fmap ( / getSampleRate) [2473, 2767, 3217, 3557, 3907, 4127, 2143, 1933] + ks = cycle $ zipWith3 (\a b c -> randi a b `withSeed` c) + [0.001, 0.0011, 0.0017, 0.0006, 0.001, 0.0011, 0.0017, 0.0006] + [3.1, 3.5, 1.11, 3.973, 2.341, 1.897, 0.891, 3.221] + [0.06, 0.9, 0.7, 0.3, 0.63, 0.7, 0.9, 0.44] + + del apj idel k afilt = do + _ <- delayr 1 + adel1 <- deltapi $ sig idel + k * sig ipitchmod + delayw $ asig + apj - afilt + return adel1 + + filt adel = tone (adel * sig igain) (sig itone) + +-- | Enhances all frequencies below the give frequency by the given coefficient. +-- Original signal is added to the filtered signal with low-pass filter and scaled. +-- +-- > bassEnhancment centerFrequency coefficient asig +bassEnhancment :: D -> D -> Sig -> Sig +bassEnhancment cfq k asig = sig k * butlp asig (sig cfq) + asig + +-- | A chain of delay lines. +-- +-- > delayLine n k dt asig +-- +-- A signal (@asig@) is passed through the chain of fixed time delays (A @dt@ is the delay time +-- @n@ is a number of filters, k - is scale of the signals that is passed through each delay line). +delayLine :: Int -> D -> D -> Sig -> (Sig, Sig) +delayLine n k dt asig = (mean $ asig : odds asigs, mean $ asig : evens asigs) + where phi x = delay (x * sig k) dt + asigs = take n $ iterate phi (delay asig dt) + +-- | Adds a very short fade in to remove the click at the beggining of the note. +declick :: Sig -> Sig +declick = (fadeIn 0.01 * ) + +-- | Sweep band pass filter (center frequency ramps from one value to another) +-- +-- > sweepFilter dur startCps endCps bandWidth asignal +sweepFilter :: D -> D -> D -> Sig -> Sig -> Sig +sweepFilter dur start end bandWidth = bp centerFreq bandWidth + where centerFreq = linseg [start, dur, end] + +-- | Sweep band pass filter in loops (center frequency ramps from one value to another and back) +-- +-- > sweepFilter dur startCps endCps bandWidth asignal +loopSweepFilter :: D -> D -> D -> Sig -> Sig -> Sig +loopSweepFilter dur start end bandWidth = bp centerFreq bandWidth + where centerFreq = oscLine start end (sig dur) + +-- | The effect that was used in the piece \"Bay at night\". +bayAtNight :: Sig -> SE (Sig, Sig) +bayAtNight + = mapOut (bassEnhancment 100 1.5) + . nightReverb 8 0.98 0.8 20000 + . nightChorus 2 30 + where mapOut f = fmap (\(a, b) -> (f a, f b)) + +-- | The effect that was used in the piece \"Vestige of time\". +vestigeOfTime :: Sig -> (Sig, Sig) +vestigeOfTime + = mapOut ((* 0.3) . (\x -> reverb2 x 2 0.2)) + . delayLine 6 1.2 0.9 + where mapOut f (a, b) = (f a, f b) + diff --git a/src/Csound/Catalog/Envelope.hs b/src/Csound/Catalog/Envelope.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Envelope.hs @@ -0,0 +1,16 @@ +-- | Envelopes +module Csound.Catalog.Envelope( + percussive, revPercussive +) where + +import Csound.Base + +-- | An exponential envelope for the percussive sound. It takes in a time of the decay section. +percussive :: D -> Sig +percussive dec = expsegr [0.001, 0.01, 1, dec, 0.001] 0.001 (dec / 2) + +-- | A reversed exponential envelope for the percussive sound. It takes a time of the decay section +-- of the original envelope. +revPercussive :: D -> Sig +revPercussive dec = expsegr [0.001, dec, 1, 0.01, 0.001] 0.001 0.01 + diff --git a/src/Csound/Catalog/Reson.hs b/src/Csound/Catalog/Reson.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Reson.hs @@ -0,0 +1,266 @@ +-- | Resonators +module Csound.Catalog.Reson( + Reson, + -- * Vowels + + -- | Resonators for the vowel sounds. + anO, anA, anE, anIY, anO2, wow, + + -- * Modal synthesis + + -- ** Instruments + strikeModes, scrapeModes, modesInstr, wetModesInstr, + + -- ** Exciters + strike, scrape, simpleStrike, simpleScrape, + + -- ** Parameters + -- | Parameters for the function 'Csound.Air.modes' + Modes(..), fromModes, + singleModes, dahinaModes, banyanModes, xylophoneModes, tibetanBowlModes180, + spinelSphereModes, potLidModes, redCedarWoodPlateModes, + tubularBellModes, redwoodPlateModes, douglasFirWoodPlateModes, + uniformWoodenBarModes, uniformAluminumBarModes, vibraphoneModes1, + vibraphoneModes2, chalandiPlatesModes, tibetanBowlModes152, + tibetanBowlModes140, wineGlassModes, smallHandbellModes, + albertClockBellBelfastModes, woodBlockModes +) where + +import Csound.Base + +-- | List of pairs of +-- +-- > [(centerFrequency, bandWidth)] +-- +-- It's a list of parameters for a bunch of the band pass filters (like reson, or bp). +-- Reson is intended to be used with functions 'Csound.Air.resons' and 'Csound.Air.resonsBy'. +type Reson = [(Sig, Sig)] + +anO, anA, anE, anIY, anO2 :: Reson + +anO = [(280, 20), (650, 25), (2200, 30), (3450, 40), (4500, 50)] +anA = [(650, 50), (1100, 50), (2860, 50), (3300, 50), (4500, 50)] +anE = [(500, 50), (1750, 50), (2450, 50), (3350, 50), (5000, 50)] +anIY = [(330, 50), (2000, 50), (2800, 50), (3650, 50), (5000, 50)] +anO2 = [(400, 50), (840, 50), (2800, 50), (3250, 50), (4500, 50)] + +-- | Produces a 'wow'-effect if modifier rises and then falls down. +-- +-- > y = wow modifierSig x +wow :: Sig -> Reson -> Reson +wow kmod = fmap $ \(a, b) -> (a + kmod, b) + +--------------------------------------------------- +-- modes instruments + +strikeModes :: Modes Sig -> Sig -> Sig +strikeModes ms cps = modesInstr ms (blp cps simpleStrike) cps + +scrapeModes :: Modes Sig -> Sig -> SE Sig +scrapeModes ms cps = fmap (\exciter -> modesInstr ms exciter cps) simpleScrape + +modesInstr :: Modes Sig -> Sig -> Sig -> Sig +modesInstr = wetModesInstr 0.1 + +wetModesInstr :: D -> Modes Sig -> Sig -> Sig -> Sig +wetModesInstr dryRatio ms exciter cps + = (modesGain ms * ) + $ dryWet (sig dryRatio) (modes (fromModes ms) cps) exciter + +--------------------------------------------------- +-- exciters + +simpleStrike :: Sig +simpleStrike = mpulse 1 0 + +strike :: D -> SE Sig +strike dt' = do + onHighDur <- noise 1 0 + onNormDur <- noise (osciln 1 (1 / dt) decayShape 1) 0 + + return $ guardedTuple + [ (sig dt <* 0.001, onLowDur) + , (sig dt >=* 1, onHighDur) + ] onNormDur + where + onLowDur = mpulse 1 0 + decayShape = estartEnds [1, -0.002, 0] + + dt = maxB dt' 0.00001 + +simpleScrape :: SE Sig +simpleScrape = scrape 5000 50 + +scrape :: Sig -> Sig -> SE Sig +scrape lpCps hpCps = fmap (bhp hpCps . blp lpCps) $ pinkish 0.005 + +--------------------------------------------------- + +data Modes a = Modes + { modesFrequencies :: [a] + , modesQualityFactor :: a + , modesQualityRatios :: [a] + , modesGain :: a } + +fromModes :: Num a => Modes a -> [(a, a)] +fromModes a = zip (modesFrequencies a) (fmap (modesQualityFactor a * ) $ modesQualityRatios a) + +singleModes, dahinaModes, banyanModes, xylophoneModes, tibetanBowlModes180, spinelSphereModes, + potLidModes, redCedarWoodPlateModes, tubularBellModes, redwoodPlateModes, douglasFirWoodPlateModes, + uniformWoodenBarModes, uniformAluminumBarModes, vibraphoneModes1, vibraphoneModes2, chalandiPlatesModes, + tibetanBowlModes152, tibetanBowlModes140, wineGlassModes, smallHandbellModes, albertClockBellBelfastModes, + woodBlockModes :: Fractional a => Modes a + +singleModes = Modes + { modesFrequencies = [1, 1] + , modesQualityFactor = 1000 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +dahinaModes = Modes + { modesFrequencies = [1, 2.89, 4.95, 6.99, 8.01, 9.02] + , modesQualityFactor = 50 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +banyanModes = Modes + { modesFrequencies = [1, 2.0, 3.01, 4.01, 4.69, 5.63] + , modesQualityFactor = 444 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +xylophoneModes = Modes + { modesFrequencies = [1, 3.932, 9.538, 16.688, 24.566, 31.147] + , modesQualityFactor = 200 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +-- (180mm) +tibetanBowlModes180 = Modes + { modesFrequencies = [1, 2.77828, 5.18099, 8.16289, 11.66063, 15.63801, 19.99] + , modesQualityFactor = 2200 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +-- with diameter of 3.6675mm +spinelSphereModes = Modes + { modesFrequencies = + [1, 1.026513174725, 1.4224916858532, 1.4478690202098, 1.4661959580455 + , 1.499452545408, 1.7891839345101, 1.8768994627782, 1.9645945254541 + , 1.9786543873113, 2.0334612432847, 2.1452852391916, 2.1561524686621 + , 2.2533435661294, 2.2905090816065, 2.3331798413917, 2.4567715528268 + , 2.4925556408289, 2.5661806088514, 2.6055768738808, 2.6692760296751 + , 2.7140956766436, 2.7543617293425, 2.7710411870043 + ] + , modesQualityFactor = 80 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +potLidModes = Modes + { modesFrequencies = [ 1, 3.2, 6.23, 6.27, 9.92, 14.15 ] + , modesQualityFactor = 1500 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +redCedarWoodPlateModes = Modes + { modesFrequencies = [ 1, 1.47, 2.09, 2.56 ] + , modesQualityFactor = 100 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +tubularBellModes = Modes + { modesFrequencies = [ 272/437, 538/437, 874/437, 1281/437, 1755/437, 2264/437, 2813/437, 3389/437, 4822/437, 5255/437 ] + , modesQualityFactor = 2000 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +redwoodPlateModes = Modes + { modesFrequencies = [ 1, 1.47, 2.11, 2.57 ] + , modesQualityFactor = 100 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +douglasFirWoodPlateModes = Modes + { modesFrequencies = [ 1, 1.42, 2.11, 2.47 ] + , modesQualityFactor = 100 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +uniformWoodenBarModes = Modes + { modesFrequencies = [ 1, 2.572, 4.644, 6.984, 9.723, 12 ] + , modesQualityFactor = 300 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +uniformAluminumBarModes = Modes + { modesFrequencies = [1, 2.756, 5.423, 8.988, 13.448, 18.680 ] + , modesQualityFactor = 1000 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +vibraphoneModes1 = Modes + { modesFrequencies = [1, 3.984, 10.668, 17.979, 23.679, 33.642] + , modesQualityFactor = 2000 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +vibraphoneModes2 = Modes + { modesFrequencies = [1, 3.997, 9.469, 15.566, 20.863, 29.440] + , modesQualityFactor = 2000 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +chalandiPlatesModes = Modes + { modesFrequencies = [1, 1.72581, 5.80645, 7.41935, 13.91935] + , modesQualityFactor = 500 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +tibetanBowlModes152 = Modes + { modesFrequencies = [1, 2.66242, 4.83757, 7.51592, 10.64012, 14.21019, 18.14027] + , modesQualityFactor = 2200 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +tibetanBowlModes140 = Modes + { modesFrequencies = [1, 2.76515, 5.12121, 7.80681, 10.78409] + , modesQualityFactor = 2200 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +wineGlassModes = Modes + { modesFrequencies = [1, 2.32, 4.25, 6.63, 9.38] + , modesQualityFactor = 1500 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +smallHandbellModes = Modes + { modesFrequencies = + [ 1, 1.0019054878049, 1.7936737804878, 1.8009908536585, 2.5201981707317 + , 2.5224085365854, 2.9907012195122, 2.9940548780488, 3.7855182926829 + , 3.8061737804878, 4.5689024390244, 4.5754573170732, 5.0296493902439 + , 5.0455030487805, 6.0759908536585, 5.9094512195122, 6.4124237804878 + , 6.4430640243902, 7.0826219512195, 7.0923780487805, 7.3188262195122 + , 7.5551829268293 + ] + , modesQualityFactor = 2500 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +albertClockBellBelfastModes = Modes + { modesFrequencies = + [ 2.043260,1.482916,1.000000,3.328848,4.761811,1.477056,0.612007 + ,2.661295,1.002793,4.023776,0.254139,2.043916,4.032463,2.659438 + ,4.775560,5.500494,3.331014,0.809697,2.391301, 0.254098,1.901476,2.366563 + ] + -- ,0.614968,2.046543,1.814887,3.130744,2.484426,0.558874,0.801697,0.070870,3.617036,2.782656 + , modesQualityFactor = 2400 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + +woodBlockModes = Modes + { modesFrequencies = [915/915,1540/915,1863/915,3112/915] + , modesQualityFactor = 60 + , modesQualityRatios = repeat 1 + , modesGain = 15 } + diff --git a/src/Csound/Catalog/Wave.hs b/src/Csound/Catalog/Wave.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave.hs @@ -0,0 +1,118 @@ +-- | Timbres +module Csound.Catalog.Wave( + + -- * Woodwind instruments + flute, bassClarinet, frenchHorn, sheng, hulusi, dizi, + + -- * Michael Gogins gallery + pulseWidth, + xanadu1, xanadu2, stringPad, toneWheel, + guitar, harpsichord, xing, + fmMod, filteredChorus, plainString, fmTubularBell, + delayedString, melody, rhodes, + + -- * Amsterdam catalog instruments + tibetan, + + -- * Bay at night + -- | Instruments from the piece \"Bay at night\" by JL Diaz. + nightPad, + + -- * Vestige of time + -- | Instruments from the piece \"Vestige of time\" by Matthew Mariano. + filteredSaw, filteredSawRising, filteredSawFalling, + filteredNoise, + resonInstr, simpleResonInstr, resonVibrato, + delaySaw, femaleVowel, amBell, + + -- * Desrted + -- | Instruments from the piece \"Desrted\" by Jen Scaturro. + simpleMarimba, marimbaWave, phasingSynth, noiz, wind, + + -- * The Heartbeat + -- | Instruments from the piece \"The Heartbeat\" by Julie Friedman. + heartbeat, monoPluck, chorusel, + + -- * Trapped in convert + -- | Instruments from the piece \"Trapped in convert\" by Richard Boulanger + ivory, blue, black, blackMarimba, + + -- * Modes + -- | Percussive instruments defined with modal synthesis -- (see the functions 'Csound.Air.modes' and 'Csound.Catalog.Reson.modesInstr'). All instruments take in a frequency and produce the output signal with percussive envelope. + dahina, banyan, xylophone, tibetanBowl180, + spinelSphere, potLid, redCedarWoodPlate, + tubularBell, redwoodPlate, douglasFirWoodPlate, + uniformWoodenBar, uniformAluminumBar, vibraphone1, + vibraphone2, chalandiPlates, tibetanBowl152, + tibetanBowl140, wineGlass, smallHandbell, + albertClockBellBelfast, woodBlock, + + -- * Vowel + -- + -- | An emulation of the singing of the vowels with granular synthesis (fof-opcode in the Csound) + -- It's best to use these functions with vibrato. + -- + -- > vibrato 0.12 5 $ oneVowel maleA 330 + vowels, loopVowels, oneVowel, Vowel, + + -- ** Vowels + maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH, + femaleA, femaleE, femaleIY, femaleO, femaleOO, + + -- * Other instruments + okComputer +) where + +import Csound.Base + +import Csound.Catalog.Wave.Ac +import Csound.Catalog.Wave.Amsterdam +import Csound.Catalog.Wave.VestigeOfTime +import Csound.Catalog.Wave.Vowel +import Csound.Catalog.Wave.Woodwind +import Csound.Catalog.Wave.Deserted +import Csound.Catalog.Wave.TheHeartbeat +import Csound.Catalog.Wave.TrappedInConvert + +import Csound.Catalog.Wave.Misc + +import Csound.Catalog.Reson + +-- | +-- > nightPad fadeInTime cps +nightPad :: D -> Sig -> Sig +nightPad dt = (fadeIn dt * ) . stringPad 1 + +-- modal synthesis + +dahina, banyan, xylophone, tibetanBowl180, + spinelSphere, potLid, redCedarWoodPlate, + tubularBell, redwoodPlate, douglasFirWoodPlate, + uniformWoodenBar, uniformAluminumBar, vibraphone1, + vibraphone2, chalandiPlates, tibetanBowl152, + tibetanBowl140, wineGlass, smallHandbell, + albertClockBellBelfast, woodBlock :: Sig -> Sig + +dahina = strikeModes dahinaModes +banyan = strikeModes banyanModes +xylophone = strikeModes xylophoneModes +tibetanBowl180 = strikeModes tibetanBowlModes180 +spinelSphere = strikeModes spinelSphereModes +potLid = strikeModes potLidModes +redCedarWoodPlate = strikeModes redCedarWoodPlateModes +tubularBell = strikeModes tubularBellModes +redwoodPlate = strikeModes redwoodPlateModes +douglasFirWoodPlate = strikeModes douglasFirWoodPlateModes +uniformWoodenBar = strikeModes uniformWoodenBarModes +uniformAluminumBar = strikeModes uniformAluminumBarModes +vibraphone1 = strikeModes vibraphoneModes1 +vibraphone2 = strikeModes vibraphoneModes2 +chalandiPlates = strikeModes chalandiPlatesModes +tibetanBowl152 = strikeModes tibetanBowlModes152 +tibetanBowl140 = strikeModes tibetanBowlModes140 +wineGlass = strikeModes wineGlassModes +smallHandbell = strikeModes smallHandbellModes +albertClockBellBelfast = strikeModes albertClockBellBelfastModes +woodBlock = strikeModes woodBlockModes + + diff --git a/src/Csound/Catalog/Wave/Ac.hs b/src/Csound/Catalog/Wave/Ac.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Ac.hs @@ -0,0 +1,293 @@ +module Csound.Catalog.Wave.Ac( + pulseWidth, + xanadu1, xanadu2, stringPad, toneWheel, + guitar, harpsichord, xing, + fmMod, filteredChorus, plainString, fmTubularBell, + delayedString, melody, rhodes, +) where + +import Data.List + +import Csound.Base + +-- | +-- +-- > aout = pulseWidth amplitude cps +pulseWidth :: Sig -> Sig -> Sig +pulseWidth amp cps = asignal + where + ilforate = 2.3 -- LFO SPEED IN Hz + isawlvl = 0.5 -- LEVEL OF SAWTOOTH WAVEFORM + ipwmlvl = 0.5 -- LEVEL OF PULSE WAVEFORM + ipwm = 0.2 -- DC OFFSET OF PULSE width + ipwmlfo = 0.1 -- DEPTH OF PULSE WIDTH MODULATION + ivcffrq = 800 -- CUTOFF OF GLOBAL LOW PASS FILTER + ienvflt = 200 -- MAX CHANGE IN LPF CUTOFF BY ENVELOPE + ikbdflt = 0.1 -- RELATIVE CHANGE IN LPF CUTOFF TO PITCH + -- the oscillators + klfo = kr $ osc ilforate + asaw = oscBy (elins [-1, 1]) cps + apwm = table (0.5 + asaw / 2 + (klfo * ipwmlfo + ipwm)) (lins [-1, 50, -1, 0, 1, 50, 1]) `withD` 1 + awaves = isawlvl * asaw + ipwmlvl * apwm + -- the envelope + -- the filters + asignal = amp * butlp awaves (ivcffrq + cps * ikbdflt + ienvflt * amp) + +giwave :: Tab +giwave = sines [1, 0.5, 0.33, 0.25, 0.0, 0.1, 0.1, 0.1] + +xanaduPlucks :: D -> D -> D -> (Sig, Sig, Sig) +xanaduPlucks cps vibrAmp vibrCps = (phi vib, phi shift, phi (-shift)) + where phi asig = pluck 1 (cpsoct $ oct + asig) cps giwave 1 + shift = 8/1200 + vib = kr $ poscil (sig vibrAmp) (sig vibrCps) cosine + oct = sig $ octcps cps + +-- | +-- +-- > aout <- xanadu1 cps +xanadu1 :: D -> SE Sig +xanadu1 cps = do + _ <- delayr 2 + [tap1, tap2, d1, d2] <- mapM deltap3 [f1, f2, 2, 1.1] + delayw $ g * damping + return $ damping * mean [gleft, tap1, d1, gright, tap2, d2] + where (g, gleft, gright) = xanaduPlucks cps (1/120) (cps/50) + f1 = expseg [0.01, 10, 1] + f2 = expseg [0.015, 15, 1.055] + damping = 1 + +-- | +-- +-- > aout <- xanadu2 cps +xanadu2 :: D -> SE Sig +xanadu2 cps = do + _ <- delayr 0.4 + [d1, d2] <- mapM deltap3 [0.07, 0.105] + delayw $ g * damping + return $ damping * mean [d1, gleft, d2, gright] + where (g, gleft, gright) = xanaduPlucks cps (1/80) 6.1 + damping = 1 + +-- | +-- +-- > stringPad amplitude cps +stringPad :: Sig -> Sig -> Sig +stringPad amp cps = blp (900 + amp * 300) $ chorus [0, 0.1, -0.1] f cps + where f x = poscil 1 x giwave + +-- | Tone wheel organ by Mikelson +-- +-- > toneWheel cps +toneWheel :: D -> Sig +toneWheel cps = asignal + where + ikey = 12 * int' (cps - 6) + 100 * (cps - 6) + wheels = + [ ifB (ikey - 12 >* 12) gitonewheel1 gitonewheel2 + , ifB (ikey + 7 >* 12) gitonewheel1 gitonewheel2 + , ifB (ikey >* 12) gitonewheel1 gitonewheel2 + , sine ] + iphase = 0.5 + harm w fqc tabId phs = poscil (sig w) (sig $ fqc * cps) (wheels !! tabId) `withD` (iphase / (ikey - phs)) + asignal = ( / 9) $ mean $ zipWith4 harm + [8, 8, 8, 8, 3, 2, 1, 0, 4] + [0.5, 1.4983, 1, 2, 2.9966, 4, 5.0397, 5.9932, 8] + ([0, 1, 2, 3] ++ repeat 3) + [-12, 7, 0, 12, 19, 24, 28, 31, 36] + + gitonewheel1 = sines [1, 0.02, 0.01] + gitonewheel2 = sines [1, 0, 0.2, 0, 0.1, 0, 0.05, 0, 0.02] + +-- | Guitar, Michael Gogins +-- +-- > guitar cps +guitar :: D -> Sig +guitar cps = asignal + where + asigcomp = pluck 1 440 440 def 1 + asig = pluck 1 (sig cps) cps def 1 + af x cf wid = x * reson asig cf wid + asignal = balance (0.4 * asig + sum [af 0.6 110 80, af 1 220 100, af 0.6 440 80]) asigcomp + +-- Harpsichord, James Kelley +-- +-- > harpsicord cps +harpsichord :: D -> Sig +harpsichord cps = 0.5 * asignal + where + aenvelope = ar $ transeg [1, 10, -5.0, 0] + apluck = pluck 1 (sig cps) cps def 1 + aharp = poscil aenvelope (sig cps) (lins [-1, 1024, 1, 1024, -1]) + asignal = apluck + balance apluck aharp + +-- | Xing by Andrew Horner +-- +-- > xing cycleDuration cps +xing :: D -> Sig -> Sig +xing xdur cps = asignal + where + amps xs dt vib freq phs = ar (loopseg (sig $ 1/xdur) 0 0 xs) * (1 + poscil vibEnv freq sine `withD` phs) + where vibEnv = ar $ loopseg (sig $ 1/xdur) 0 0 [0, dt, vib, sig xdur - dt, 0] + + f vol freq = poscil vol (sig freq * cps) sine + + norm = 32310 + asignal = (sig $ 1 / norm) * sum + [ f (amps env1 0.05 0.3 6.7 0.8) 1 + , f (amps env2 0.12 0.5 10.5 0 ) 2.7 + , f (amps env3 0.02 0.8 70 0 ) 4.95 + ] + + env1 = [ 0,0.001,5200,0.001,800,0.001,3000,0.0025,1100,0.002 + , 2800,0.0015,1500,0.001,2100,0.011,1600,0.03,1400,0.95 + , 700,1,320,1,180,1,90,1,40,1,20,1,12,1,6,1,3,1,0,1,0] + + env2 = [ 0,0.0009,22000,0.0005,7300,0.0009,11000,0.0004,5500 + , 0.0006,15000,0.0004,5500,0.0008,2200,0.055,7300,0.02 + , 8500,0.38,5000,0.5,300,0.5,73,0.5,5,5,0,1,1] + + env3 = [ 0,0.001,3000,0.001,1000,0.0017,12000,0.0013 + , 3700,0.001,12500,0.0018,3000,0.0012,1200,0.001 + , 1400,0.0017,6000,0.0023,200,0.001,3000,0.001,1200 + , 0.0015,8000,0.001,1800,0.0015,6000,0.08,1200,0.2 + , 200,0.2,40,0.2,10,0.4,0,1,0] + +-- | FM modulated left and right detuned chorusing, Thomas Kung +-- +-- > fmMod cycleDuration cps +fmMod :: D -> Sig -> Sig +fmMod xdur cps = asignal + where + iattack = 0.25 + irelease = 0.3333 + ip6 = 0.3 + ip7 = 2.2 + ishift = 4 / 12000 + ipch = cps + ioct = octcps cps + amodi = ar $ loopseg (sig $ 1 / xdur) 0 0 [0, iattack, 5, sig xdur, 2, irelease, 0] + amodr = ar $ loopseg (sig $ 0.5 / xdur) 0 0 [ip6, 1, ip7, 1, ip6] + a1 = amodi * (amodr - 1 / amodr) / 2 + a2 = amodi * (amodr + 1 / amodr) / 2 + a1ndx = abs $ a1 / 10 + a3 = tablei a1ndx (skipNorm $ bessels 20) `withD` 1 + ao1 = poscil a1 ipch cosine + a4 = exp $ -0.5 * a3 + ao1 + ao2 = poscil (a2 * ipch) cps cosine + aleft = poscil a4 (ao2 + cpsoct (ioct + ishift)) sine + aright = poscil a4 (ao2 + cpsoct (ioct - ishift)) sine + asignal = 0.5 * (aleft + aright) + +-- | Filtered chorus, Michael Bergeman +-- +-- > filteredChorus cycleDuration cps +filteredChorus :: D -> Sig -> Sig +filteredChorus xdur cps = asignal + where + a ~~ b = loopseg (sig $ 1 / (xdur * 2)) 0 0 [sig a, 1, sig b, 1, sig a] + filt cf1 bw1 cf2 bw2 x = balance (bp cf2 bw2 $ bp cf1 bw1 x) x + harm fqc = poscil ((sig $ idb)) fqc $ sines + [ 0.28, 1, 0.74, 0.66, 0.78, 0.48, 0.05, 0.33, 0.12 + , 0.08, 0.01, 0.54, 0.19, 0.08, 0.05, 0.16, 0.01, 0.11, 0.3, 0.02, 0.2] + a1s x = mean $ fmap (harm . (* cpsoct (octcps cps + x))) [1, 0.999, 1.001] + rvb dt dh x = 0.5 * (x + reverb2 x dt dh) + + idb = 1.5 + + asignal = mean + [ rvb 5 0.3 $ filt (40 ~~ 800) 40 (220 ~~ 440) ((440 ~~ 220) * 0.8) $ a1s (-0.01) + , rvb 4 0.2 $ filt (800 ~~ 40) 40 (440 ~~ 220) ((220 ~~ 440) * 0.8) $ a1s 0.01 + ] + +-- | Plain plucked string, Michael Gogins +-- +-- > plainString cps +plainString :: D -> Sig +plainString cps = wgpluck2 0.1 1.0 cps 0.25 0.05 + +-- | Rhodes electric piano model, Perry Cook +-- +-- > rhodes cps +rhodes :: Sig -> Sig +rhodes cps = asignal + where + iindex = 4.1 + icrossfade = 3.1 + ivibedepth = 0.2 + iviberate = 6 + ifn1 = sine + ifn2 = cosine + ifn3 = sine + ifn4 = sines [0] + ivibefn = sine + asignal = fmrhode 1 cps iindex icrossfade ivibedepth iviberate ifn1 ifn2 ifn3 ifn4 ivibefn + +-- | Tubular bell model, Perry Cook +-- +-- > fmTubularBell cps +fmTubularBell :: Sig -> Sig +fmTubularBell cps = asignal + where + iindex = 1.5 + icrossfade = 2.03 + ivibedepth = 0.2 + iviberate = 6 + ifn1 = sine + ifn2 = sines [1, 0.4, 0.2, 0.1, 0.1, 0.05] + ifn3 = sine + ifn4 = sine + ivibefn = cosine + asignal = fmbell 1 cps iindex icrossfade ivibedepth iviberate `withTabs` [ifn1, ifn2, ifn3, ifn4, ivibefn] + +-- | Delayed plucked string, Michael Gogins +-- +-- > delayedString cps +delayedString :: D -> Sig +delayedString cps = asignal + where + ioctave = octcps cps + -- Detuning of strings by 4 cents each way + idetune = 4 / 1200 + kvibrato = poscil (1 / 120) 7 sine + awave det fn = pluck 1 (cpsoct $ sig ioctave + det) cps fn 1 + ag = awave kvibrato sine + agleft = awave idetune sine + agright = awave (- idetune) cosine + imsleft = 0.2 * 1000 + imsright = 0.21 * 1000 + noclick x = linseg [0, 0.1, x, 1, x] + adelayleft = vdelay ag (noclick imsleft) (imsleft + 100) + adelayright = vdelay ag (noclick imsright) (imsright + 100) + asignal = mean [agleft, adelayleft, agright, adelayright] + + +-- | Melody (Chebyshev / FM / additive), Jon Nelson +-- +-- > melody cycleDuration cps +melody :: D -> Sig -> SE Sig +melody xdur cps = do + k1000 <- randi 1 10 + let k100 = cps + loopseg (sig $ 1/xdur) 0 0 [0, 0.5, 1, sig xdur, 1] * poscil 1 (5 + k1000) sine + -- a1-3 are for cheby with p6=1-4 + a1 = poscil k1 k100 (sines [1, 0.4, 0.2, 0.1, 0.1, 0.05]) + a2 = tablei a1 ip6 `withDs` [1, 0.5] + a3 = balance a2 a1 + -- try other waveforms as well + a4 = foscil 1 (k100 + 0.04) 1 2.005 k20 sine + a5 = poscil 1 k100 sine + a6 = a3 * 0.1 + a4 * 0.1 + a5 * 0.8 + a7 = comb a6 0.5 (1 / ir cps) + a8 = a6 * 0.9 + a7 * 0.1 + asignal = balance a8 a1 + return asignal + where + iattack = 0.05 + isustain = xdur + irelease = 0.1 + ip6 = skipNorm $ lins [-1, 150, 0.1, 110, 0, 252, 0] + -- Envelope for driving oscillator + k1 = linseg [1, xdur, 0.5] * linenr 0.5 (xdur * 0.3) (xdur * 0.2) 0.01 + -- Power to partials + k20 = linseg [1.485, iattack, 1.5, isustain + irelease, 1.485] + diff --git a/src/Csound/Catalog/Wave/Amsterdam.hs b/src/Csound/Catalog/Wave/Amsterdam.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Amsterdam.hs @@ -0,0 +1,23 @@ +-- | Instruments from Csound amsterdam catalog by Jean-Claude Risset +module Csound.Catalog.Wave.Amsterdam( + tibetan +) where + +import Csound.Base + +-- | Tibetan chant. It's a chorus of many sinusoids. +-- +-- > tibetan n off cps +-- +-- * n - the number of sinusoids (the best is 9) +-- +-- * off - frequency step of the harmonics ~ (0.01, 0.03) +-- +-- * cps - the frequency of the note +tibetan :: Int -> Sig -> D -> Sig +tibetan n off cps = chorus dts (oscBy wave) (sig cps) + where wave = ifB (cps <* 230) (waveBy 5) (ifB (cps <* 350) (waveBy 3) (waveBy 1)) + waveBy x = sines $ [0.3, 0, 0, 0] ++ replicate x 0.1 + + dts = fmap ((* off) . fromIntegral) $ let dx = div n 2 in fmap (\x -> x - dx) [0 .. n - 1] + diff --git a/src/Csound/Catalog/Wave/Deserted.hs b/src/Csound/Catalog/Wave/Deserted.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Deserted.hs @@ -0,0 +1,90 @@ +module Csound.Catalog.Wave.Deserted( + simpleMarimba, marimbaWave, phasingSynth, noiz, wind +) where + +import Csound.Base + +-- | Simple marimba (by John Fitch) with percussive envelope. +-- +-- > simpleMarimba noteDur cps +simpleMarimba :: D -> Sig -> Sig +simpleMarimba xdur = marimbaWave xdur kenv + where kenv = expseg [0.0001, 0.03, 1, xdur - 0.03, 0.001] + * linseg [1, 0.03, 1, xdur - 0.03, 3] + +-- | Simple marimba (by John Fitch) without fixed envelope. +-- +-- > marimba noteDur amp cps +marimbaWave :: D -> Sig -> Sig -> Sig +marimbaWave xdur amp cps = a6 + where + k10 = linseg [2.25, 0.03, 3, xdur - 0.03, 2] + a1 = gbuzz amp cps k10 0 35 (sines3 [(1, 1, 90)]) + a2 = reson' a1 500 50 + a3 = reson' a2 150 100 + a4 = reson' a3 3500 150 + a5 = reson' a4 3500 150 + a6 = balance a5 a1 + reson' a b c = reson a b c `withD` 1 + +-- | Sound of the wind. +-- +-- > wind noteDur (bandRise, bandDecay) (freqRise, freqDecay) attackDecayRatio +-- +-- -* bandRise, banDecay, freqRise, freqDecay -- (50, 1000) +-- +-- * attackDecayRatio -- (0, 1) +wind :: D -> (D, D) -> (D, D) -> D -> SE Sig +wind xdur (bandRise, bandDec) (freqRise, freqDec) winds = + fmap fromRnd $ rand 1 + where + valu1 = 100 + valu2 = 50 + winde = 1 - winds + ramp a b = linseg [a, xdur, b] + fromRnd a = aout + where + a2 = butbp a (ramp freqRise freqDec) (ramp bandRise bandDec) + a3 = butbp a2 (ramp (freqRise - valu1) (freqDec + valu2)) + (ramp (bandRise + valu1) (bandDec - valu2)) + + aout = (a2 + a3) * linseg [0, xdur * winds, 1, xdur * winde, 0] + +-- | +-- > noiz cps +noiz :: Sig -> SE Sig +noiz cps = fmap a2 k2 + where + k1 = linseg [1, 0.05, 100, 0.2, 100, 2, 1, idur, 1] + k2 = fmap ( `withD` 1) $ rand 500 + + buzz' kamp kcps = buzz kamp (sig kcps * cps) k1 sine + + a1 = mean $ zipWith buzz' [0.3, 1, 1] [1, 0.5, 0.501] + a2 k = a1 * osc k + +-- | +-- > phasingSynth amp cps +phasingSynth :: Sig -> Sig -> Sig +phasingSynth amp cps = aout + where + osc' ftab k ph = oscBy ftab (cps * k) `withD` ph + osc1 = osc' sine + osc2 = osc' $ sines [1, 0, 0.9, 0, 0.8, 0, 0.7, 0, 0.6, 0, 0.5, 0, 0.4, 0, 0.3, 0, 0.2, 0, 0.1] + asum = amp * mean + [ osc1 1 0 + , osc2 1.008 0.02 + , osc1 0.992 0.04 + , osc2 2 0.06 + , osc2 1 0.08 + , osc1 1 0.01 ] + kosc1 = 0.5 * once sine + kosc2 = 0.5 * once sine `withD` 0.4 + kosc3 = 1.0 * once sine `withD` 0.8 + + afilt = sum + [ butbp asum kosc1 1000 + , butbp asum kosc2 300 + , butbp asum kosc3 20 ] + + aout = mean [afilt, asum] diff --git a/src/Csound/Catalog/Wave/Misc.hs b/src/Csound/Catalog/Wave/Misc.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Misc.hs @@ -0,0 +1,16 @@ +module Csound.Catalog.Wave.Misc ( + okComputer +) where + +import Csound.Base + +-- | Tech sound. Random sinusoids palyed at the very fast rate. +-- +-- > okComputer rate +-- +-- * @rate@ -- rate of new notes ~ (5, 20) +okComputer :: Sig -> SE Sig +okComputer cps = fmap go $ noise 11000 0.99 + where + go anoise = osc (samphold anoise kgate) + kgate = kr $ oscil 1 cps (elins [1, 0, 0]) diff --git a/src/Csound/Catalog/Wave/TheHeartbeat.hs b/src/Csound/Catalog/Wave/TheHeartbeat.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/TheHeartbeat.hs @@ -0,0 +1,73 @@ +module Csound.Catalog.Wave.TheHeartbeat ( + heartbeat, monoPluck, chorusel +) where + +import Csound.Base + +-- | Deep kick sound. +heartbeat :: Sig +heartbeat = phi 0.0024 f12 + phi 0.0078 f13 + where phi dec ftab = oscili (linseg [1, xdur, dec, 1, dec]) 4 ftab + f12 = sines2 [(10, 1), (16, 1.5), (22, 2), (23, 1.5)] + f13 = sines2 [(25, 1), (29, 0.5), (32, 0.2)] + xdur = 0.25 + +-- | +-- > monoPluck xdur cps +monoPluck :: D -> D -> Sig +monoPluck xdur cps = a3 + where repluck' freq a = repluck plk (sig amp) freq (sig pick) 0.5 a + a1 = mean + [ repluck' (cps - 1) (osc $ sig $ cps - 2) + , repluck' (cps + 1) (osc $ sig $ cps + 2) ] + a2 = linen (a1/2) (0.2 * xdur) xdur (0.8 * xdur) + arev = reverb2 a2 1.5 1 + a3 = (a2 + 0.6 * arev) / 1.6 + pick = 0.8 + plk = 0.3 + amp = 1 +-- | +-- > chorusel dur rise dec cps +-- +-- * dur - note duration +-- +-- * rise - rise time +-- +-- * dec - decay time +-- +-- * cps - frequency of the note +chorusel :: D -> D -> D -> Sig -> (Sig, Sig) +chorusel xdur rise dec cps = (a1, a2) + where k1 = linen 1 rise xdur dec + k2 = linseg [1, xdur, 0] + k3 = kr $ osc 2 + k4 = kr $ 0.5 * osc 2 + inote = cps + as = fmap (\(d, a, f) -> k1 * f (inote + d + a)) [ + (-1, k3, saw), + (1, k4, f9), + (-0.5, 0, f9), + (0.5, 0, saw), + (-2, k4, saw), + (2, k3, f9), + (-1.5, k3, saw), + (1.5, k3, f9), + (-0.25, 0, f9), + (0.25, 0, saw), + (-0.8, k4, saw), + (0.8, k4, f9)] + + ars = zipWith3 (\a k d -> withInits (areson a k d) (1::D)) as (k2:(k2*k3):repeat k2) (fmap (sig . double) $ [10, 20 .. 80] ++ [50, 60 .. 80]) + meanArs = (/ 5.5) . sum . fmap (ars !!) + asig1 = meanArs [0, 3, 5, 7, 8] + asig2 = meanArs [1, 2, 4, 6, 9] + asig3 = 0.5 * (ars !! 10 + ars !! 11) + + a1 = 0.5 * (asig1 + asig3) + a2 = 0.5 * (asig2 + asig3) + + f9 phs = oscil 1 phs $ sines + [ 0.28, 1, 0.74, 0.66, 0.78, 0.48, 0.05, 0.33, 0.12 + , 0.08, 0.01, 0.54, 0.19, 0.08, 0.05, 0.16, 0.01 + , 0.11, 0.3, 0.02, 0.2] + diff --git a/src/Csound/Catalog/Wave/TrappedInConvert.hs b/src/Csound/Catalog/Wave/TrappedInConvert.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/TrappedInConvert.hs @@ -0,0 +1,83 @@ +module Csound.Catalog.Wave.TrappedInConvert ( + ivory, blue, black, blackMarimba +) where + +import Csound.Base + +-- | +-- > ivory xdur glisDur vibRate cpsCoeff cps +ivory :: D -> D -> Sig -> D -> Sig -> Sig +ivory xdur glisDur vibRate cpsCoeff cps = mean + -- vibrato env amplitude env freq bias phase vibrato coeff wave + [ alg (linseg [0, xdur, 5]) (lincone 0 0.7 1 0.3 0) 0 0 1 sine + , alg (lincone 0 0.6 6 0.4 0) (lincone 0 0.9 1 0.1 0) 0.009 0.2 0.9 (sines [10, 9 .. 1]) + , alg (lincone 9 0.7 1 0.3 1) (linenXdur 0.5 0.333) 0.007 0.3 1.2 (sines [10, 0, 9, 0, 8, 0, 7, 0, 6, 0, 5]) + , alg (expcone 1 0.4 3 0.6 0.02) + (expcone 0.0001 0.8 1 0.2 0.0001) 0.005 0.5 0.97 (sines [10, 10, 9, 0, 0, 0, 3, 2, 0, 0, 1]) + , alg (expcone 1 0.4 3 0.6 0.02) + (expdur [0.001, 0.5, 1, 0.1, 0.6, 0.2, 0.97, 0.2, 0.001]) + 0.003 0.8 0.99 (sines [10, 0, 0, 0, 5, 0, 0, 0, 0, 0, 3]) + , alg (expcone 4 0.91 1 0.09 1) + (expdur [0.001, 0.6, 1, 0.2, 0.8, 0.1, 0.98, 0.1, 0.001]) + 0.001 1.3 1.4 (sines [10, 0, 0, 0, 0, 3, 1]) + ] + where + alg :: Sig -> Sig -> D -> D -> D -> Tab -> Sig + alg vibrEnv ampEnv cpsBias phsBias vibrCoeff wave = + ampEnv * (oscBy wave ((cps + sig cpsBias + kvibr) * glis) `withD` phsBias) + where glis = expseg [1, glisDur, 1, xdur - glisDur, cpsCoeff] + kvibr = vibrEnv * osc (vibRate * sig vibrCoeff) + + cone a x1 b x2 c = [a, x1 * xdur, b, x2 * xdur, c] + lincone a x1 b x2 c = linseg $ cone a x1 b x2 c + expcone a x1 b x2 c = expseg $ cone a x1 b x2 c + linenXdur a b = linen 1 (a * xdur) xdur (b * xdur) + + +-- snow flakes + +-- | +-- > blue noteDuration numberOfHarmonics sweepRate lfoCps cps +-- +-- * numberOfHarmonics ~ (6, 10) +-- +-- * sweepRate ~ (0, 1) +-- +-- * lfoCps ~ 20 +blue :: D -> D -> D -> Sig -> Sig -> SE Sig +blue xdur harmNum sweepRate lfoCps cps = fmap aout k1 + where + k1 = randi 1 50 + k2 = lindurBy xdur [0, 0.5, 1, 0.5, 0] + k3 = lindurBy xdur [0.005, 0.71, 0.015, 0.29, 0.01] + k4 = k2 * (kr $ osc lfoCps `withD` 0.2) + k5 = k4 + 2 + + ksweep = lindurBy xdur [harmNum, sweepRate, 1, 1 - sweepRate, 1] + kenv = expdurBy xdur [0.001, 0.01, 1, 0.99, 0.001] + aout k = gbuzz kenv (cps + k3) k5 ksweep k (sines3 [(1, 1, 90)]) + +-- | Noise filtered with sweep filter. +-- +-- > black noteDuration filterSweepStart filterSweepEnd bandWidth cps +-- +-- * @filterSweepStart@, @filterSweepEnd@ - hearing range +-- +-- * @bandWidth@ - (10, 50) +black :: D -> D -> D -> Sig -> Sig -> SE Sig +black xdur filterSweepStart filterSweepEnd bandWidth cps = + fmap aout $ rand 1 + where + k1 = expdurBy xdur [filterSweepStart, 1, filterSweepEnd] + a1 anoise = reson anoise k1 (k1 / bandWidth) `withD` 1 + k3 = expdurBy xdur [0.001, 0.001, 1, 0.999, 0.001] + a2 = k3 * osc (cps + 0.6 * (osc 11.3 `withD` 0.1)) + aout anoise = mean [a1 anoise, a2] + + +-- | Black with fixed parameters. +-- +-- > blackMarimba cps +blackMarimba :: Sig -> SE Sig +blackMarimba = black 3 100 500 50 + diff --git a/src/Csound/Catalog/Wave/VestigeOfTime.hs b/src/Csound/Catalog/Wave/VestigeOfTime.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/VestigeOfTime.hs @@ -0,0 +1,120 @@ +{-# Language FlexibleInstances #-} +module Csound.Catalog.Wave.VestigeOfTime ( + filteredSaw, filteredSawRising, filteredSawFalling, + filteredNoise, + resonInstr, simpleResonInstr, resonVibrato, + delaySaw, femaleVowel, amBell +) where + +import Csound.Base + +import Csound.Catalog.Effect(vibroDelay) +import Csound.Catalog.Reson(Reson) + +-- instruments + +-- | Filtered saw with rising envelope. Centere frequency starts at 500 Hz +-- and then rises to 5000 by @riseDur@ seconds. +-- +-- > filteredSawRising riseDur cps +filteredSawRising :: D -> Sig -> Sig +filteredSawRising riseDur = filteredSaw (linseg [500, riseDur, 5000]) + +-- | Filtered saw with falling envelope. Centere frequency starts at 5000 Hz +-- and then falls down to 500 by @riseDur@ seconds. +-- +-- > filteredSawFalling riseDur cps +filteredSawFalling :: D -> Sig -> Sig +filteredSawFalling fallDur = filteredSaw (linseg [5000, fallDur, 500]) + +-- | The saw is filtered with band pass filter. Centere frequency of the filter +-- can vary. +-- +-- > filteredSaw centerFrequency sawCps +filteredSaw :: Sig -> Sig -> Sig +filteredSaw kcf cps = aout + where + a1 = chorus [0, 0.998, 1.003] saw cps + aout = reson a1 kcf 100 `withD` 2 + +-- | The white noise is filtered with band pass filter. Centere frequency of the filter +-- can vary. +-- +-- > filteredNoise centerFrequency sawCps +filteredNoise :: Sig -> Sig -> SE Sig +filteredNoise cfq bw = do + anoise <- rand 1 + return $ balance (reson anoise cfq bw `withD` 2) anoise + +-- | +-- > simpleResonInstr cycleLength cps +simpleResonInstr :: D -> Sig -> Sig +simpleResonInstr dt = resonInstr (f f21) (f f22) (f f23) 1 + where + f = onceBy dt + + f21 = lins [1.000, 16, 0.950, 17, 0.830, 18, 0.680, 7, 0.530, 11, 0.390, 24, 0.200, 25, 0.120, 28, 0.050, 110, 0.000 ] + + f22 = lins [0.000, 20, 0.790, 8, 0.920, 14, 0.980, 14, 0.880, 11, 0.730, 17, 0.580, 17, 0.420, 16, 0.280, 21, 0.210, 19, 0.140, 99, 0.000 ] + + f23 = lins [0.000, 46, 0.690, 14, 0.880, 22, 0.980, 17, 0.880, 17, 0.700, 14, 0.570, 19, 0.400, 16, 0.310, 25, 0.220, 30, 0.090, 36, 0.000] + + + +-- | Signal is passed through three band-pass filters. +-- We can alter the relative center frequencies of the filters. +-- +-- > resonInstr filt1 filt2 filt3 amp cps = aout +resonInstr :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig +resonInstr filt1 filt2 filt3 amp cps = aout + where + asig = amp * oscBy f19 cps + asig2 = amp * 0.7 * osc cps + + phi cf bw filt = reson asig (cf * filt) bw `withD` 2 + aout = balance (sum + [ 0.6 * phi 110 20 filt1 + , phi 220 30 filt2 + , 0.6 * phi 440 40 filt3 + , 0.4 * asig + , 2 * asig2 ]) + asig2 + + f19 = sines [1, 0.1, 0.1, 0.278, 0.245, 0.3, 0.352, 0.846, 0.669, 0, 0, 0, 0.1, 0.1, 0.1] + +-- | Vibrato and resonant filter with varying center frequency. +-- +-- > resonVibrato vibDepth vibRate filtCps amp cps = aout +resonVibrato :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig +resonVibrato vibDepth vibRate filt amp cps = gain 8 aout + where + asig = vibrate vibDepth vibRate ((amp * ) . oscBy waveTab) cps + aout = reson asig (5000 * filt) 50 `withD` 2 + + waveTab = sines [1, 0.832, 0.5, 0.215, 0.6, 0.133, 0.785, 0.326, 0.018, 0.028, 0.0647, 0.0143, 0.0213] + +-- | Singing a reson's vowels (see "Csound.Catalog.Reson"). +femaleVowel :: Reson -> Sig -> Sig +femaleVowel vowel cps = aout + where + afilt1 = chorus [0, 1.003] (\x -> buzz 1 x 15 sine) cps + aout = blp 2000 $ resonsBy (\cf bw x -> reson x cf bw `withD` 2) vowel afilt1 + +-- | Delayed saw wave. +delaySaw :: Sig -> Sig +delaySaw cps = vibroDelay 6 3 2 0.25 $ saw cps + +-- | Detuned bell. +-- +-- > amBell amp cps +amBell :: D -> Sig -> Sig +amBell amp cps = kenv * aout + where + phi a b c = (a + b) * osc (c + cps) + a5 = phi 0.25 0 1729 + a4 = phi 0.3 a5 973 + a1 = phi 0.5 a4 513 + a2 = phi 1 a1 0 + aout = balance a2 (osc 440) + + kenv = sig amp * expseg [0.0001, 0.01, 1,amp * 0.3, 0.6, amp * 8, 0.0001] diff --git a/src/Csound/Catalog/Wave/Vowel.hs b/src/Csound/Catalog/Wave/Vowel.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Vowel.hs @@ -0,0 +1,189 @@ +module Csound.Catalog.Wave.Vowel( + -- * Singing a vowel. + -- + -- | It's best to use this functions with vibrato. + -- + -- > vibrato 0.12 5 $ oneVowel maleA 330 + + vowels, loopVowels, oneVowel, Vowel, + + -- * Vowels + maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH, + femaleA, femaleE, femaleIY, femaleO, femaleOO +) where + +import Data.List(transpose) + +import Csound.Base + +-- | Sings a sequence of vowels with the given frequency. +-- +-- > vowels maxDur [(vowel1, dur1), (vowel2, dur2), (vowel3, dur3), ...] lastVowel cps +-- +-- * maxDur - total duration of the note +-- +-- * @vowel1@, @vowel2@, ... lastVowel -- vowels +-- +-- * dur1, dur2, ... - durations +-- +-- * cps - frequency of the note. +vowels :: D -> [(Vowel, D)] -> Vowel -> Sig -> Sig +vowels = vowelsBy mkEnv + where mkEnv xs x = linseg ( ( ++ [x, 1, x]) $ (\(a, b) -> [a, b]) =<< xs) + +-- | Sings a loop of vowels with the given frequency. +-- +-- > loopVowels maxDur xdur [(vowel1, dur1), (vowel2, dur2), (vowel3, dur3), ...] cps +-- +-- * maxDur - total duration of the note +-- +-- * xdur - the duration of the loop of vowels. +-- +-- * @vowel1@, @vowel2@, ... -- vowels +-- +-- * dur1, dur2, ... - durations +-- +-- * cps - frequency of the note. +loopVowels :: D -> Sig -> [(Vowel, D)] -> Sig -> Sig +loopVowels maxDur xdur params = vowelsBy mkEnv maxDur params lastVowel + where + mkEnv xs x = loopseg (1 / xdur) 0 0 ((++ [sig x]) $ (\(a, b) -> [sig a, sig b]) =<< xs) + lastVowel = fst $ head params + +-- | Generic construcotr for the signals that interpolate between vowel sounds. +-- It takes a function that constructs an envelope to proceed from one vowel to another. +-- The envelope function takes two parameters. It's list of vowels with durations +-- and the value of the final vowel. +-- +-- > vowelsBy makeEnvelope vowelSquence lastVowel cps +vowelsBy :: ([(D, D)] -> D -> Sig) -> D -> [(Vowel, D)] -> Vowel -> Sig -> Sig +vowelsBy mkEnv maxDur params lastVowel cps = case params of + [(vow, _)] -> oneVowel maxDur vow cps + _ -> (/100) $ sum $ zipWith3 harm + [fmt1, fmt2, fmt3, fmt4, fmt5] + [amp1, amp2, amp3, amp4, amp5] + [bw1, bw2, bw3, bw4, bw5] + where + (vs, dts) = unzip params + [ fmt1, amp1, bw1, fmt2, amp2, bw2, fmt3, amp3, bw3 + , fmt4, amp4, bw4, fmt5, amp5, bw5, ris, dur, dec + ] = zipWith (\xs lastV -> mkEnv (zip xs dts) lastV) (transpose $ fmap vowelParams vs) (vowelParams lastVowel) + + harm fmt amp bw = fof amp cps fmt ioct bw ris dur dec iolaps sine sigmoid maxDur `withDs` [0, 1] + ioct = 0 + iolaps = 20 + + +-- | Sings a single vowel with the given frequency. +-- +-- > oneVowel maxDur vowel cps +-- +-- * maxDur - total duration of the note. +oneVowel :: D -> Vowel -> Sig -> Sig +oneVowel maxDur v cps = (/100) $ sum $ zipWith3 harm + [fmt1, fmt2, fmt3, fmt4, fmt5] + [amp1, amp2, amp3, amp4, amp5] + [bw1, bw2, bw3, bw4, bw5] + where + [ fmt1, amp1, bw1, fmt2, amp2, bw2, fmt3, amp3, bw3 + , fmt4, amp4, bw4, fmt5, amp5, bw5, ris, dur, dec + ] = vowelParams v + + harm fmt amp bw = fof (sig amp) cps (sig fmt) ioct (sig bw) (sig ris) (sig dur) (sig dec) iolaps sine sigmoid maxDur `withDs` [0, 1] + ioct = 0 + iolaps = 20 + + +vowelParams :: Vowel -> [D] +vowelParams v = fmap (flip table vowelTab . (+ index)) $ fmap int [0 .. 17] + where index = vowelIndex v + +-- | Abstract type that represents a vowel. +newtype Vowel = Vowel { unVowel :: D } + +instance Tuple Vowel where + tupleMethods = makeTupleMethods Vowel unVowel + +instance Arg Vowel + +maleA, maleE, maleIY, maleO, maleOO, maleU, maleER, maleUH, + femaleA, femaleE, femaleIY, femaleO, femaleOO :: Vowel + +maleA = Vowel 0; maleE = Vowel 1; maleIY = Vowel 2 +maleO = Vowel 3; maleOO = Vowel 4; maleU = Vowel 5 +maleER = Vowel 6; maleUH = Vowel 7; femaleA = Vowel 8 +femaleE = Vowel 9; femaleIY = Vowel 10; femaleO = Vowel 11 +femaleOO = Vowel 12 + +vowelIndex :: Vowel -> D +vowelIndex = (* 18) . unVowel + +vowelTab :: Tab +vowelTab = skipNorm $ doubles +-- 1 - male voice singing A +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + [ 609, 0, 100, 1000, -6, 100, 2450, -12, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 2700, -11, 100, 3240, -24, 100, 0.003, 0.02, 0.007 +-- 2 - male voice singing E +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 400, 0, 100, 1700, -9, 100, 2300, -8, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 2900, -11, 100, 3400, -19, 100, 0.003, 0.02, 0.007 +-- 3 - male voice singing IY +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 238, 0, 100, 1741, -20, 100, 2450, -16, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 2900, -20, 100, 4000, -32, 100, 0.003, 0.02, 0.007 +-- 4 - male voice singing O +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 325, 0, 100, 700, -12, 100, 2550, -26, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 2850, -22, 100, 3100, -28, 100, 0.003, 0.02, 0.007 +-- 5 - male voice singing OO +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 360, 0, 100, 750, -12, 100, 2400, -29, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 2675, -26, 100, 2950, -35, 100, 0.003, 0.02, 0.007 +-- 6 - male voice singing U +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 415, 0, 100, 1400, -12, 100, 2200, -16, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 2800, -18, 100, 3300, -27, 100, 0.003, 0.02, 0.007 +-- 7 - male voice singing ER +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 300, 0, 100, 1600, -14, 100, 2150, -12, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 2700, -15, 100, 3100, -23, 100, 0.003, 0.02, 0.007 +-- 8 - male voice singing UH +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 400, 0, 100, 1050, -12, 100, 2200, -19, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 2650, -20, 100, 3100, -29, 100, 0.003, 0.02, 0.007 +-- 9 - female voice singing A +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 650, 0, 100, 1100, -8, 100, 2860, -13, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 3300, -12, 100, 4500, -19, 100, 0.003, 0.02, 0.007 +-- 10 - female voice singing E +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 500, 0, 100, 1750, -9, 100, 2450, -10, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 3350, -14, 100, 5000, -23, 100, 0.003, 0.02, 0.007 +-- 11 - female voice singing IY +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 330, 0, 100, 2000, -14, 100, 2800, -11, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 3450, -50, 100, 4500, -52, 100, 0.003, 0.02, 0.007 +-- 12 - female voice singing O +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 400, 0, 100, 840, -12, 100, 2800, -26, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 3250, -24, 100, 4500, -31, 100, 0.003, 0.02, 0.007 +-- 13 - female voice singing OO +-- fmt1 amp1 bw1 fmt2 amp2 bw2 fmt3 amp3 bw3 + , 280, 0, 100, 650, -18, 100, 2200, -48, 100 +-- fmt4 amp4 bw4 fmt5 amp5 bw5 ilris ildur ildec + , 3450, -50, 100, 4500, -52, 100, 0.003, 0.02, 0.007 + ] + diff --git a/src/Csound/Catalog/Wave/Woodwind.hs b/src/Csound/Catalog/Wave/Woodwind.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/Woodwind.hs @@ -0,0 +1,1025 @@ +module Csound.Catalog.Wave.Woodwind + ( flute + , bassClarinet + , frenchHorn + , sheng + , hulusi + , dizi + ) where + +import Csound.Base + +import Csound.Catalog.Wave.WoodwindAlg + +totalDur :: (D, D, D) -> D +totalDur (att, sus, dec) = att + sus + dec + +------------------------------------------------------------------------- +-- Flute + +-- | An emulation of the flute. Parameters +-- +-- > flute seed vibDepth attack sustain decay brightnessLevel cps = +-- +-- * seed - a seed for the random signals/numbers. It's in (0, 1) +-- +-- * vibDepth - Amount of the vibrato. It's in [-1, 1] +-- +-- * attack - duration of the attack. +-- Recommended value: 0.12 for slurred notes, +-- 0.06 for tongued notes, +-- 0.03 for short notes. +-- +-- * sustain - duration of the sustain +-- +-- * decay - duration of the decay. +-- Recommended value: 0.1 (0.05 for short notes). +-- +-- * brightnessLevel - filter cutoff factor. It's in (0, 1). The 0 is 40 Hz, the 1 s 10240 Hz +-- +-- * cps - frequency of the note +flute :: D -> D -> D -> D -> D -> D -> D -> Sig +flute = woodwind $ WoodwindSpec + { woodwindRange = fromSpec fluteRangeSpec + , woodwindVibratoDur = totalDur + , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012)) + } + +fluteRangeSpec :: [RangeSpec] +fluteRangeSpec = + [ RangeSpec + { rangeFreq = 427.28 + , rangeNorm = 3949 + , rangeHarms = + [ HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0, 0.002, 0.045, 0.146, 0.272, 0.072, 0.043] + , ampSustain = [0.043, 0.230, 0.000, 0.118, 0.923] + , ampDecay = [0.923, 1.191, 0.794, 0.418, 0.172, 0.053, 0] + } + , harmWave = [2000, 489, 74, 219, 125, 9, 33, 5, 5] + } + , HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0, 0.009, 0.022, -0.049, -0.120, 0.297, 1.890] + , ampSustain = [1.890, 1.543, 0.000, 0.546, 0.690] + , ampDecay = [0.690, -0.318, -0.326, -0.116, -0.035, -0.020, 0] + } + , harmWave = [2729, 1926, 346, 662, 537, 110, 61, 29, 7] + } + , HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0, 0.005, -0.026, 0.023, 0.133, 0.060, -1.245] + , ampSustain = [-1.245, -0.760, 1.000, 0.360, -0.526] + , ampDecay = [-0.526, 0.165, 0.184, 0.060, 0.010, 0.013, 0] + } + , harmWave = [2558, 2012, 390, 361, 534, 139, 53, 22, 10, 13, 10] + } + ] + } + , RangeSpec + { rangeFreq = 608.22 + , rangeNorm = 27668.2 + , rangeHarms = + [ HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0.000, 0.000, -0.005, 0.000, 0.030, 0.198, 0.664] + , ampSustain = [0.664, 1.451, 1.782, 1.316, 0.817] + , ampDecay = [0.817, 0.284, 0.171, 0.082, 0.037, 0.012, 0] + } + , harmWave = [12318, 8844, 1841, 1636, 256, 150, 60, 46, 11] + } + , HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.000,0.320,0.882,1.863,4.175,4.355] + , ampSustain = [4.355,-5.329,-8.303,-1.480,-0.472] + , ampDecay = [-0.472,1.819,-0.135,-0.082,-0.170,-0.065,0] + } + , harmWave = [1229, 16, 34, 57, 32] + } + , HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,1.000,0.520,-0.303,0.059,-4.103,-6.784] + , ampSustain = [-6.784,7.006,11,12.495,-0.562] + , ampDecay = [-0.562,-4.946,-0.587,0.440,0.174,-0.027,0] + } + , harmWave = [163, 31, 1, 50, 31] + } + ] + } + , RangeSpec + { rangeFreq = 1013.7 + , rangeNorm = 3775 + , rangeHarms = + [ HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.005,0.000,-0.082,0.36,0.581,0.416] + , ampSustain = [0.416,1.073,0.000,0.356,0.86] + , ampDecay = [0.86,0.532,0.162,0.076,0.064,0.031,0] + } + , harmWave = [4128, 883, 354, 79, 59, 23] + } + , HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.005,0.000,0.205,-0.284,-0.208,0.326] + , ampSustain = [0.326,-0.401,1.540,0.589,-0.486] + , ampDecay = [-0.486,-0.016,0.141,0.105,-0.003,-0.023,0] + } + , harmWave = [1924, 930, 251, 50, 25, 14] + } + , HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.722,1.500,3.697,0.080,-2.327,-0.684] + , ampSustain = [-0.684,-2.638,0.000,1.347,0.485] + , ampDecay = [0.485,-0.419,-0.700,-0.278,0.167,-0.059,0] + } + , harmWave = [94, 6, 22, 8] + } + ] + } + , RangeSpec + { rangeFreq = 22000 + , rangeNorm = 4909.05 + , rangeHarms = + [ HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.000,0.000,0.211,0.526,0.989,1.216] + , ampSustain = [1.216,1.727,1.881,1.462,1.28] + , ampDecay = [1.28,0.75,0.34,0.154,0.122,0.028,0] + } + , harmWave = [2661, 87, 33, 18] + } + , HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.500,0.000,0.181,0.859,-0.205,-0.430] + , ampSustain = [-0.430,-0.725,-0.544,-0.436,-0.109] + , ampDecay = [-0.109,-0.03,-0.022,-0.046,-0.071,-0.019,0] + } + , harmWave = [174, 12] + } + , HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.000,1.000,0.426,0.222,0.175,-0.153] + , ampSustain = [-0.153,0.355,0.175,0.16,-0.246] + , ampDecay = [-0.246,-0.045,-0.072,0.057,-0.024,0.002,0] + } + , harmWave = [314, 13] + } + ] + } + ] + +----------------------------------------------------------------- +-- Bass clarinet + +-- | An emulation of the bass clarinet. Parameters +-- +-- > bassClarinet seed vibDepth attack sustain decay brightnessLevel cps = +-- +-- * seed - a seed for the random signals/numbers. It's in (0, 1) +-- +-- * vibDepth - Amount of the vibrato. It's in [-1, 1] +-- +-- * attack - duration of the attack. +-- Recommended value: 0.06 for tongued notes, +-- 0.03 for short notes. +-- +-- * sustain - duration of the sustain +-- +-- * decay - duration of the decay. +-- Recommended value: 0.15 (0.04 for short notes). +-- +-- * brightnessLevel - filter cutoff factor. It's in (0, 1). The 0 is 40 Hz, the 1 s 10240 Hz +-- +-- * cps - frequency of the note +bassClarinet :: D -> D -> D -> D -> D -> D -> D -> Sig +bassClarinet = woodwind $ WoodwindSpec + { woodwindRange = fromSpec bassClarinetRangeSpec + , woodwindVibratoDur = totalDur + , woodwindFreqDeviation = ((0, 0.015), (-0.005, 0), (0, 0.003), (0, 0.017)) + } + + +bassClarinetRangeSpec :: [RangeSpec] +bassClarinetRangeSpec = + [RangeSpec + { rangeFreq = 67.13 + , rangeNorm = 29786.7 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.012,0.000,0.494,0.717,1.005,1.396] + , ampSustain = [1.396,1.838,1.616,1.579,1.343] + , ampDecay = [1.343,1.231,0.958,0.581,0.000,-0.089,0] + } + , harmWave = [5321,43,5458,112,7869,166,2338,211,5575,104,3280,127,1184,296,1290,742,419,238,248,481,605,585,619,691,93,242,762,826,831,830,440,62,286,310,409,200,422,101,170,51,177,44,114,93,27,26,48,80,98,61,69,45,31,13,7,11,33,0,38,21,11] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.301,1.000,0.891,0.753,0.499,0.333] + , ampSustain = [0.333,0.065,0.125,0.166,-0.002] + , ampDecay = [-0.002,0.023,-0.018,0.029,0.000,0.389,0] + } + , harmWave = [2390,251,2895,266,1251,148,358,146,300,93,81,65,50,20,28,3,19,2,8,12,60,38,39,61,9,34,25,42,37,6] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.009,0.000,-0.166,-0.298,-0.446,-0.837] + , ampSustain = [-0.837,-0.945,-0.644,-0.573,-0.341] + , ampDecay = [-0.341,-0.254,0.047,0.405,1.000,0.486,0] + } + , harmWave = [4231,54,3544,101,4989,146,1459,122,3251,157,1310,147,779,6,1326,396,720,235,238,260,516,123,519,45,36,112,320,112,253,83,216,62,107,52,94,126,32,49,33,35,32,32,15,14] + }] + } + ,RangeSpec + { rangeFreq = 95.56 + , rangeNorm = 23524.2 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.023,0.062,0.140,0.605,0.902,1.302] + , ampSustain = [1.302,1.355,1.355,1.202,0.934] + , ampDecay = [0.934,0.891,0.654,0.225,0.000,-0.012,0] + } + , harmWave = [6317,51,6402,115,4155,81,1130,67,609,372,1333,427,1708,490,1817,798,2287,553,1410,385,421,208,448,70,347,146,753,482,572,119,222,101,158,216,75,155,67,14,27,38,74,3,61,105,109,71,34,12,14,27,15,23,28,46,24,35,13,10,27,7,42,33,44,24,56,50,53,13] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.035,0.230,0.637,0.410,0.279,-0.240] + , ampSustain = [-0.240,-0.259,-0.248,-0.086,-0.090] + , ampDecay = [-0.090,-0.109,-0.074,-0.037,0.000,0.016,0] + } + , harmWave = [3464,54,4267,457,84,217,49,29,21,48,38,27,16,21,65,34,224,461,312,102] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.070,-0.144,-0.167,-0.230,-0.350,-0.500] + , ampSustain = [-0.500,-0.650,-0.435,-0.083,0.009] + , ampDecay = [0.009,0.030,0.485,1.477,1.000,0.278,0] + } + , harmWave = [1516,179,890,59,566,60,257,17,94,39,172,44,40,41,77,10] + }] + } + ,RangeSpec + { rangeFreq = 135.16 + , rangeNorm = 19174.7 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.023,0.062,0.140,0.605,0.902,1.302] + , ampSustain = [1.302,1.355,1.355,1.202,0.934] + , ampDecay = [0.934,0.891,0.654,0.225,0.000,-0.012,0] + } + , harmWave = [10317,51,3402,115,3855,81,2130,67,1009,872,1233,427,1208,490,1217,398,1187,153,710,285,261,28,278,10,277,26,153,92,82,9,22,11,28,26,15,25,7] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.035,0.230,0.637,0.410,0.279,-0.240] + , ampSustain = [-0.240,-0.259,-0.248,-0.086,-0.090] + , ampDecay = [-0.090,-0.109,-0.074,-0.037,0.000,0.016,0] + } + , harmWave = [3464,54,2267,257,44,117,29,29,21] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.070,-0.144,-0.167,-0.230,-0.350,-0.500] + , ampSustain = [-0.500,-0.650,-0.435,-0.083,0.009] + , ampDecay = [0.009,0.030,0.485,1.477,1.000,0.278,0] + } + , harmWave = [1516,179,990,59,266,60,157,17,94,39] + }] + } + ,RangeSpec + { rangeFreq = 191.11 + , rangeNorm = 27370.2 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.015,0.000,0.504,0.294,0.334,0.000] + , ampSustain = [0.000,0.580,1.166,1.017,0.996] + , ampDecay = [0.996,1.015,0.308,0.002,0.010,-0.005,0] + } + , harmWave = [14794,31,882,197,3524,218,3723,61,2540,1574,1262,333,689,395,602,165,85,265,147,22,119,149,28,61,17,69,100,26,143,46,118,65,12] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.115,1.000,0.567,0.275,-0.427,0.000] + , ampSustain = [0.000,-1.425,-1.222,-0.760,-0.270] + , ampDecay = [-0.270,-0.026,1.483,1.819,0.549,0.188,0] + } + , harmWave = [3278,18,70,4,39,10,16,5,12,57,7,13,11,12,9] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.002,0.000,-0.020,0.519,0.743,1.000] + , ampSustain = [1.000,0.853,0.365,0.371,0.110] + , ampDecay = [0.110,-0.004,0.185,0.011,0.001,0.003,0] + } + , harmWave = [16146,44,1093,292,4965,1047,6341,28,4423,760,1292,1316,659,1498,421,535,116,482,103,38,134,274,265,47,65,59,142,15,75,84,70,78,12] + }] + } + ,RangeSpec + { rangeFreq = 22000 + , rangeNorm = 22329.4 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.015,0.000,0.504,0.294,0.334,0.000] + , ampSustain = [0.000,0.580,1.166,1.017,0.996] + , ampDecay = [0.996,1.015,0.308,0.002,0.010,-0.005,0] + } + , harmWave = [14794,31,882,197,3524,218,1823,61,1540,774,662,233,289,195,152,65,45,12] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.115,1.000,0.567,0.275,-0.427,0.000] + , ampSustain = [0.000,-1.425,-1.222,-0.760,-0.270] + , ampDecay = [-0.270,-0.026,1.483,1.819,0.549,0.188,0] + } + , harmWave = [3278,18,70,4,39,10] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.002,0.000,-0.020,0.519,0.743,1.000] + , ampSustain = [1.000,0.853,0.365,0.371,0.110] + , ampDecay = [0.110,-0.004,0.185,0.011,0.001,0.003,0] + } + , harmWave = [16146,44,1093,292,2965,1047,3341,128,2423,760,392,316,159,148,61,45,26] + }] + }] + + +------------------------------------------------------------------ +-- French horn + +-- | An emulation of the french horn. Parameters +-- +-- > frenchHorn seed vibDepth attack sustain decay brightnessLevel cps = +-- +-- * seed - a seed for the random signals/numbers. It's in (0, 1) +-- +-- * vibDepth - Amount of the vibrato. It's in [-1, 1] +-- +-- * attack - duration of the attack. +-- Recommended value: 0.06 for tongued notes (up to 0.12 for lower notes, up to G2), +-- 0.03 for short notes. +-- +-- * sustain - duration of the sustain +-- +-- * decay - duration of the decay. +-- Recommended value: 0.25 (0.04 for short notes). +-- +-- * brightnessLevel - filter cutoff factor. It's in (0, 1). The 0 is 40 Hz, the 1 s 10240 Hz +-- +-- * cps - frequency of the note +frenchHorn :: D -> D -> D -> D -> D -> D -> D -> Sig +frenchHorn = woodwind $ WoodwindSpec + { woodwindRange = fromSpec frenchHornRangeSpec + , woodwindVibratoDur = totalDur + , woodwindFreqDeviation = ((-0.012, 0), (0, 0.005), (-0.005, 0), (0, 0.009)) + } + +frenchHornRangeSpec :: [RangeSpec] +frenchHornRangeSpec = + [RangeSpec + { rangeFreq = 113.26 + , rangeNorm = 5137 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.000,0.000,0.298,1.478,1.901,2.154] + , ampSustain = [2.154,2.477,2.495,2.489,1.980] + , ampDecay = [1.980,1.759,1.506,1.000,0.465,0.006,0] + } + , harmWave = [478,1277,2340,4533,2413,873,682,532,332,364,188,258,256,114,80,68,36] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.000,1.000,2.127,0.694,-0.599,-1.807] + , ampSustain = [-1.807,-2.485,-2.125,-2.670,-0.798] + , ampDecay = [-0.798,-0.056,-0.038,0.000,0.781,0.133,0] + } + , harmWave = [414,906,831,507,268,36] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,1.000,0.000,-4.131,-6.188,-1.422,1.704] + , ampSustain = [1.704,6.362,3.042,5.736,-0.188] + , ampDecay = [-0.188,-2.558,-2.409,0.000,-1.736,0.167,0] + } + , harmWave = [74,50,68,156,50,48,52,66] + }] + } + ,RangeSpec + { rangeFreq = 152.055 + , rangeNorm = 35685 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.000,0.000,0.000,0.308,0.926,1.370] + , ampSustain = [1.370,3.400,3.205,3.083,2.722] + , ampDecay = [2.722,2.239,2.174,1.767,1.098,0.252,0] + } + , harmWave = [677,2663,4420,1597,1236,780,581,325,415,201,212,202,156,26] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.478,1.000,0.000,4.648,1.843,5.242] + , ampSustain = [5.242,-0.853,-0.722,-0.860,-0.547] + , ampDecay = [-0.547,-0.462,-0.380,-0.387,-0.355,-0.250,0] + } + , harmWave = [648,1635,828,149,89,41] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.107,0.000,1.000,-0.570,0.681,-1.097] + , ampSustain = [-1.097,1.495,0.152,0.461,0.231] + , ampDecay = [0.231,0.228,0.256,0.152,0.087,0.042,0] + } + , harmWave = [1419,3414,901,503,204,146] + }] + } + ,RangeSpec + { rangeFreq = 202.74 + , rangeNorm = 39632 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.039,0.000,0.000,0.230,0.216,0.647] + , ampSustain = [0.647,1.764,1.961,1.573,1.408] + , ampDecay = [1.408,1.312,1.125,0.802,0.328,0.061,0] + } + , harmWave = [1722,14359,5103,1398,2062,696,652,266,264,176,164,75] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,1.142,1.000,0.000,-1.181,-3.005,-1.916] + , ampSustain = [-1.916,2.325,3.249,2.154,1.766] + , ampDecay = [1.766,2.147,1.305,0.115,0.374,0.162,0] + } + , harmWave = [1237,2287,237,72] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.361,0.000,1.000,1.369,1.865,1.101] + , ampSustain = [1.101,-0.677,-0.833,-0.437,-0.456] + , ampDecay = [-0.456,-0.465,-0.395,-0.144,-0.061,-0.012,0] + } + , harmWave = [2345,7796,1182,266,255,193,85] + }] + } + ,RangeSpec + { rangeFreq = 270.32 + , rangeNorm = 26576.1 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.000,-0.147,-0.200,-0.453,-0.522,0.000] + , ampSustain = [0.000,2.164,1.594,2.463,1.506] + , ampDecay = [1.506,1.283,0.618,0.222,0.047,0.006,0] + } + , harmWave = [9834,16064,2259,1625,1353,344,356,621,195,155,77,98] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,1.000,16.034,24.359,12.399,3.148,0.000] + , ampSustain = [0.000,8.986,-2.516,13.268,0.541] + , ampDecay = [0.541,-2.107,-11.221,-14.179,-7.152,5.327,0] + } + , harmWave = [377,193,41] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.000,-0.318,-0.181,0.861,1.340,1.000] + , ampSustain = [1.000,-1.669,-0.669,-2.208,-0.709] + , ampDecay = [-0.709,-0.388,0.641,1.101,0.817,0.018,0] + } + , harmWave = [8905,10946,1180,1013,506,125,48] + }] + } + ,RangeSpec + { rangeFreq = 360.43 + , rangeNorm = 26866.7 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,2.298,2.017,2.099,1.624,0.536,1.979] + , ampSustain = [1.979,-2.465,-4.449,-4.176,-1.518] + , ampDecay = [-1.518,-0.593,0.000,0.384,0.386,0.256,0] + } + , harmWave = [16460,4337,1419,1255,43,205,81,73,60,38] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-1.498,-1.342,-0.983,-0.402,0.572,-0.948] + , ampSustain = [-0.948,4.490,6.433,5.822,1.845] + , ampDecay = [1.845,0.618,0.000,-0.345,-0.295,-0.164,0] + } + , harmWave = [16569,5563,1838,1852,134,340,129,159,162,99] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.320,0.179,-0.551,-0.410,-0.417,-0.028] + , ampSustain = [-0.028,-1.517,-1.523,-1.057,0.883] + , ampDecay = [0.883,1.273,1.000,0.660,0.271,0.026,0] + } + , harmWave = [10383,4175,858,502,241,165] + }] + } + ,RangeSpec + { rangeFreq = 480.29 + , rangeNorm = 31013.2 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,6.711,4.998,3.792,-0.554,-1.261,-5.584] + , ampSustain = [-5.584,-4.633,-0.384,-0.555,-0.810] + , ampDecay = [-0.810,0.112,0.962,1.567,0.881,0.347,0] + } + , harmWave = [15341,5092,1554,640,101] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-5.829,-4.106,-3.135,1.868,1.957,6.851] + , ampSustain = [6.851,5.135,0.097,0.718,1.679] + , ampDecay = [1.679,0.881,-0.009,-0.927,-0.544,-0.225,0] + } + , harmWave = [16995,6133,1950,788,136] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.220,0.177,0.333,-0.302,0.071,-0.563] + , ampSustain = [-0.563,0.338,1.214,0.840,0.103] + , ampDecay = [0.103,0.003,-0.114,-0.049,-0.031,-0.017,0] + } + , harmWave = [22560,9285,4691,1837,342,294,307,222,288,103] + }] + } + ,RangeSpec + { rangeFreq = 22000 + , rangeNorm = 26633.5 + , rangeHarms = [HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.046,0.000,0.127,0.686,1.000,1.171] + , ampSustain = [1.171,0.000,0.667,0.969,1.077] + , ampDecay = [1.077,1.267,1.111,0.964,0.330,0.047,0] + } + , harmWave = [19417,5904,1666,913,266,55,81,46] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,0.262,1.000,1.026,0.419,0.000,-0.172] + , ampSustain = [-0.172,0.000,-0.764,-0.547,-0.448] + , ampDecay = [-0.448,-0.461,-0.199,-0.015,0.432,0.120,0] + } + , harmWave = [11940,1211,111,38] + } + ,HarmSpec + { harmAmp = AmpSpec + { ampAttack = [0,-0.014,0.000,0.102,0.006,0.000,-0.016] + , ampSustain = [-0.016,1.000,0.753,0.367,0.163] + , ampDecay = [0.163,-0.030,-0.118,-0.207,-0.103,-0.007,0] + } + , harmWave = [25132,6780,2886,1949,507,505,466,488,336,121] + }] + }] + + +------------------------------------------------------------------ +-- Sheng + +-- | An emulation of the sheng. Parameters +-- +-- > sheng seed vibDepth attack sustain decay brightnessLevel cps = +-- +-- * seed - a seed for the random signals/numbers. It's in (0, 1) +-- +-- * vibDepth - Amount of the vibrato. It's in [-1, 1] +-- +-- * attack - duration of the attack. +-- Recommended value: 0.1, +-- 0.03 for short notes. +-- +-- * sustain - duration of the sustain +-- +-- * decay - duration of the decay. +-- Recommended value: 0.2 (0.04 for short notes). +-- +-- * brightnessLevel - filter cutoff factor. It's in (0, 1). The 0 is 40 Hz, the 1 s 10240 Hz +-- +-- * cps - frequency of the note +sheng :: D -> D -> D -> D -> D -> D -> D -> Sig +sheng = woodwind $ WoodwindSpec + { woodwindRange = shengRange + , woodwindVibratoDur = const 0.625 + , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012)) + } + +shengRange :: (D, D, D) -> D -> ([(Sig, Tab)], D) +shengRange (iattack, isustain, idecay) ifreq = ([(amp1, iwt1), (amp2, iwt2), (amp3, iwt3)], inorm) + where + amp1 = ar $ linseg + [ 0, 0.20*iattack, 2000, 0.40*iattack, 2050, 0.4*iattack, 2250, 0.18*isustain, 2500 + , 0.78*isustain, 2300, 0.04*isustain, 2000, 1.0*idecay, 0, 1, 0] + amp2 = ar $ linseg + [ 0, 0.11*iattack, 100, 0.12*iattack, 5000, 0.12*iattack, 7500, 0.3*iattack, 9500 + , 0.35*iattack, 10500, 0.18*isustain, 12000, 0.3*isustain, 11000, 0.48*isustain, 10000 + , 0.04*isustain, 9000, 0.23*idecay, 7000, 0.67*idecay, 0, 1, 0] + amp3 = ar $ linseg + [ 0, 0.18*iattack, 10, 0.15*iattack, 1250, 0.2*iattack, 1800, 0.24*iattack, 1900 + , 0.23*iattack, 2200, 0.03*isustain, 2600, 0.2*isustain, 2900, 0.35*isustain, 2700 + , 0.23*isustain, 2400, 0.15*isustain, 2000, 0.04*isustain, 1800, 0.23*idecay, 1200 + , 0.42*idecay, 20, 0.15*idecay, 0, 1, 0] + + inorm = byRange [ 34991, 32586, 35331, 37480 ] + + iwt1 = f11 + iwt2 = ifB (ifreq <* 1025) f31 f35 + iwt3 = byRange [f32, f33, f34, f36] + + f11 = sine + f31 = skipNorm $ sines2 [(2, 1), (3, 0.16), (4, 1.16), (5, 0.45), (6, 0.33)] + f32 = skipNorm $ sines2 + [ (7, 1), (8, 0.83), (9, 0.85), (10, 0.16), (11, 0.5), (12, 0.38) + , (13, 0.05), (14, 0.26), (15, 0.16), (16, 0.13), (17, 0.12), (18, 0.05), (19, 0.11)] + f33 = skipNorm $ sines2 [ (7, 0.21), (8, 0.33), (9, 0.36), (10, 0.3), (11, 0.76), (12, 0.38), (13, 0.5), (14, 0.07)] + f34 = skipNorm $ sines2 [ (7, 0.43), (8, 1.2), (9, 0.4), (10, 0.3), (11, 0.1) ] + f35 = skipNorm $ sines2 [ (2, 0.58), (3, 0.83), (4, 0.83) ] + f36 = skipNorm $ sines2 [ (5, 2.1), (6, 1.2), (7, 0.4) ] + + byRange :: Tuple a => [a] -> a + byRange = byFreq ifreq . zip freqs + freqs = [538, 760, 1025, 22000] + +---------------------------------------------------------------- +-- Hulusi + +-- | An emulation of the hulusi. Parameters +-- +-- > hulusi seed vibDepth attack sustain decay brightnessLevel cps = +-- +-- * seed - a seed for the random signals/numbers. It's in (0, 1) +-- +-- * vibDepth - Amount of the vibrato. It's in [-1, 1] +-- +-- * attack - duration of the attack. +-- Recommended value: 0.03 +-- +-- * sustain - duration of the sustain +-- +-- * decay - duration of the decay. +-- Recommended value: 0.1 (0.04 for short notes). +-- +-- * brightnessLevel - filter cutoff factor. It's in (0, 1). The 0 is 40 Hz, the 1 s 10240 Hz +-- +-- * cps - frequency of the note +hulusi :: D -> D -> D -> D -> D -> D -> D -> Sig +hulusi = woodwind $ WoodwindSpec + { woodwindRange = hulusiRange + , woodwindVibratoDur = const 20 + , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012)) + } + + +hulusiRange :: (D, D, D) -> D -> ([(Sig, Tab)], D) +hulusiRange (iattack, isustain, idecay) ifreq = + ( [ (amp1, iwt1), (amp2, iwt2), (amp3, iwt3) ] + , inorm + ) + where + byRange :: Tuple a => [a] -> a + byRange = byFreq ifreq . zip [320, 427, 680, 22000] + + amp1 = byRange [amp1_0, amp1_1, amp1_2, amp1_3] + amp2 = byRange [amp2_0, amp2_1, amp2_2, amp2_3] + amp3 = byRange [amp3_0, amp3_1, amp3_2, amp3_3] + + iwt1 = byRange [iwt1_0, iwt1_1, iwt1_2, iwt1_3] + iwt2 = byRange [iwt2_0, iwt2_1, iwt2_2, iwt2_3] + iwt3 = byRange [iwt3_0, iwt3_1, iwt3_2, iwt3_3] + + inorm = byRange [ inorm_0, inorm_1, inorm_2, inorm_3 ] + + -- range 0 + amp1_0 = ar $ linseg + [ 0, 0.33*iattack, 750, 0.17*iattack, 2000, 0.17*iattack + , 5000, 0.16*iattack, 13000, 0.17*iattack, 15000, 0.03*isustain + , 16000, 0.47*isustain, 15000, 0.5*isustain, 13500, 0.2*idecay + , 13000, 0.2*idecay, 11000, 0.2*idecay, 6000, 0.2*idecay, 150, 0.2*idecay, 0 + ] + amp2_0 = ar $ linseg + [ 0, 0.67*iattack, 30, 0.33*iattack, 9000, 0.05*isustain + , 11000, 0.05*isustain, 12000, 0.4*isustain, 9500, 0.5*isustain + , 7200, 0.2*idecay, 5600, 0.2*idecay, 3200, 0.2*idecay + , 1000, 0.2*idecay, 50, 0.1*idecay, 0, 0.1*idecay, 0 + ] + amp3_0 = ar $ linseg + [ 0, 0.33*iattack, 0, 0.4*iattack, 30, 0.27*iattack + , 3600, 0.07*isustain, 2000, 0.43*isustain, 2800, 0.5*isustain + , 3000, 0.2*idecay, 2700, 0.2*idecay, 1500, 0.2*idecay, 150 + , 0.2*idecay, 50, 0.08*idecay, 0, 0.12*idecay, 0] + + iwt1_0 = f11 + iwt2_0 = f31 + iwt3_0 = f32 + + inorm_0 = 26985 + + -- range 1 + amp1_1 = ar $ linseg + [ 0, 0.43*iattack, 1600, 0.27*iattack, 9000, 0.3*iattack + , 5400, 0.5*isustain, 5500, 0.5*isustain, 5300, 0.2*idecay + , 4200, 0.2*idecay, 3000, 0.2*idecay, 1000, 0.2*idecay + , 100, 0.2*idecay, 0 + ] + amp2_1 = ar $ linseg + [ 0, 0.43*iattack, 20, 0.13*iattack, 700, 0.30*iattack + , 6300, 0.14*iattack, 7500, 0.03*isustain, 9000, 0.14*isustain + , 9200, 0.65*isustain, 7000, 0.14*isustain, 6000, 0.04*isustain + , 5000, 0.2*idecay, 4600, 0.2*idecay, 3600, 0.2*idecay, 2400, 0.2*idecay + , 600, 0.15*idecay, 0, 0.05*idecay, 0 + ] + amp3_1 = ar $ linseg + [ 0, 0.52*iattack, 10, 0.26*iattack, 1500, 0.22*iattack + , 7000, 0.03*isustain, 9000, 0.02*isustain, 10500, 0.15*isustain + , 9700, 0.65*isustain, 8000, 0.15*isustain, 6400, 0.2*idecay + , 4600, 0.2*idecay, 2600, 0.2*idecay, 800, 0.2*idecay + , 10, 0.1*idecay, 0, 0.1*idecay, 0 ] + iwt1_1 = f11 + iwt2_1 = f33 + iwt3_1 = f34 + inorm_1 = 36133 + + -- range2: ; for high middle range tones + amp1_2 = ar $ linseg + [ 0, 0.27*iattack, 1500, 0.22*iattack, 8000, 0.51*iattack + , 9000, 0.02*isustain, 11000, 0.04*isustain, 10600, 0.81*isustain + , 10000, 0.09*isustain, 9000, 0.04*isustain, 7000, 0.2*idecay + , 6000, 0.2*idecay, 4000, 0.2*idecay, 2000, 0.2*idecay, 600, 0.2*idecay, 0 + ] + amp2_2 = ar $ linseg + [ 0, 0.38*iattack, 20, 0.17*iattack, 3800, 0.45*iattack, 5500, 0.02*isustain + , 6000, 0.5*isustain, 3800, 0.35*isustain, 3300, 0.09*isustain + , 1000, 0.04*isustain, 750, 0.2*idecay, 600, 0.2*idecay, 350, 0.2*idecay + , 150, 0.2*idecay, 40, 0.2*idecay, 0 + ] + amp3_2 = ar $ linseg + [ 0, 0.44*iattack, 20, 0.1*iattack, 1300, 0.08*iattack, 750, 0.38*iattack + , 600, 0.5*isustain, 800, 0.35*isustain, 750, 0.1*isustain, 550, 0.05*isustain + , 50, 0.2*idecay, 30, 0.2*idecay, 15, 0.2*idecay, 7, 0.2*idecay, 0, 0.2*idecay, 0 + ] + iwt1_2 = f35 + iwt2_2 = f36 + iwt3_2 = f37 + inorm_2 = 27905 + + -- range3: ; for high range tones + amp1_3 = ar $ linseg + [ 0, 0.15*iattack, 300, 0.15*iattack, 1100, 0.15*iattack + , 4000, 0.15*iattack, 9000, 0.15*iattack, 20000, 0.15*iattack + , 27000, 0.10*iattack, 29000, 0.12*isustain, 26000, 0.56*isustain + , 27000, 0.32*isustain, 24000, 0.33*idecay, 23000, 0.33*idecay + , 6000, 0.17*idecay, 1000, 0.16*idecay, 0 ] + amp2_3 = ar $ linseg + [ 0, 0.45*iattack, 15, 0.15*iattack, 250, 0.15*iattack, 850, 0.15*iattack + , 1800, 0.1*iattack, 2100, 0.03*isustain, 2250, 0.07*isustain, 2000 + , 0.25*isustain, 2100, 0.4*isustain, 2000, 0.15*isustain, 1400, 0.1*isustain + , 800, 0.45*idecay, 170, 0.22*idecay, 120, 0.11*idecay, 40, 0.11*idecay + , 15, 0.11*idecay, 0 + ] + amp3_3 = ar $ linseg + [ 0, 0.52*iattack, 15, 0.15*iattack, 400, 0.22*iattack + , 2050, 0.11*iattack, 2200, 0.06*isustain, 1000, 0.15*isustain + , 1500, 0.13*isustain, 1250, 0.5*isustain, 2500, 0.04*isustain + , 2300, 0.12*isustain, 2000, 0.2*idecay, 1600, 0.2*idecay + , 900, 0.2*idecay, 150, 0.2*idecay, 20, 0.1*idecay, 0, 0.1*idecay, 0 + ] + iwt1_3 = f11 + iwt2_3 = f12 + iwt3_3 = f13 + inorm_3 = 27507 + + f11 = sine + f12 = skipNorm $ sines2 [(2, 1)] + f13 = skipNorm $ sines2 [(3, 1)] + f31 = skipNorm $ sines2 [(2, 0.46), (3, 1), (5, 0.31), (6, 0.17), (9, 0.12)] + f32 = skipNorm $ sines2 [(4, 1), (7, 0.34), (8, 0.25), (10, 0.19), (11, 0.25)] + f33 = skipNorm $ sines2 [(2, 1), (7, 0.33), (10, 0.23), (11, 0.07)] + f34 = skipNorm $ sines2 [(3, 0.77), (4, 0.29), (5, 1), (6, 0.5), (8, 0.2), (9, 0.07)] + f35 = skipNorm $ sines2 [(1, 1), (2, 0.36), (3, 1.1), (4, 0.3)] + f36 = skipNorm $ sines2 [(5, 1), (6, 0.22)] + f37 = skipNorm $ sines2 [(7, 1), (8, 0.42), (9, 0.17), (10, 0.35), (11, 0.2)] + +------------------------------------------------------------------------ +-- dizi + +-- | An emulation of the dizi. Parameters +-- +-- > dizi seed vibDepth attack sustain decay brightnessLevel cps = +-- +-- * seed - a seed for the random signals/numbers. It's in (0, 1) +-- +-- * vibDepth - Amount of the vibrato. It's in [-1, 1] +-- +-- * attack - duration of the attack. +-- Recommended value: 0.12 for slurred notes, 0.07 for tongued notes, 0.03 for short notes. +-- +-- * sustain - duration of the sustain +-- +-- * decay - duration of the decay. +-- Recommended value: 0.14 (0.04 for short notes). +-- +-- * brightnessLevel - filter cutoff factor. It's in (0, 1). The 0 is 40 Hz, the 1 s 10240 Hz +-- +-- * cps - frequency of the note +dizi :: D -> D -> D -> D -> D -> D -> D -> Sig +dizi = woodwind $ WoodwindSpec + { woodwindRange = diziRange + , woodwindVibratoDur = const 0.625 + , woodwindFreqDeviation = ((-0.03, 0), (0, 0.003), (-0.0015, 0), (0, 0.012)) + } + + +diziRange :: (D, D, D) -> D -> ([(Sig, Tab)], D) +diziRange (iattack, isustain, idecay) ifreq = + ( [ (amp1, iwt1), (amp2, iwt2), (amp3, iwt3) ] + , inorm + ) + where + byRange :: Tuple a => [a] -> a + byRange = byFreq ifreq . zip [320, 480, 680, 905, 1280, 1710, 22000] + + amp1 = byRange [amp1_1, amp1_2, amp1_3, amp1_4, amp1_5, amp1_6, amp1_7] + amp2 = byRange [amp2_1, amp2_2, amp2_3, amp2_4, amp2_5, amp2_6, amp2_7] + amp3 = byRange [amp3_1, amp3_2, amp3_3, amp3_4, amp3_5, amp3_6, amp3_7] + + iwt1 = byRange [iwt1_1, iwt1_2, iwt1_3, iwt1_4, iwt1_5, iwt1_6, iwt1_7] + iwt2 = byRange [iwt2_1, iwt2_2, iwt2_3, iwt2_4, iwt2_5, iwt2_6, iwt2_7] + iwt3 = byRange [iwt3_1, iwt3_2, iwt3_3, iwt3_4, iwt3_5, iwt3_6, iwt3_7] + + inorm = byRange [inorm_1, inorm_2, inorm_3, inorm_4, inorm_5, inorm_6, inorm_7 ] + + iatt = iattack / 6 + isus = isustain / 4 + idec = iattack / 6 + + + -- range1: ; for very low range tones + amp1_1 = ar $ linseg + [ 0, 0.4*iattack, 1500, 0.6*iattack, 10000, 0.5*isustain, 11000 + , 0.5*isustain, 9000, 0.4*idecay, 8000, 0.3*idecay, 1500, 0.3*idecay, 0 + ] + amp2_1 = ar $ linseg + [ 0, 0.4*iattack, 200, 0.1*iattack, 1000, 0.5*iattack, 6000 + , 0.1*isustain, 11000, 0.3*isustain, 13000, 0.6*isustain, 12000 + , 0.6*idecay, 1500, 0.4*idecay, 0 ] + amp3_1 = ar $ linseg + [ 0, 0.5*iattack, 30, 0.5*iattack, 500, 0.1*isustain, 1200 + , 0.7*isustain, 2200, 0.2*isustain, 1750, 0.5*idecay, 250 + , 0.2*idecay, 0, 1, 0 ] + iwt1_1 = f11 + iwt2_1 = f20 + iwt3_1 = f21 + inorm_1 = 32875 + + -- range2: ; for very low range tones + amp1_2 = ar $ linseg + [ 0, 0.4*iattack, 2000, 0.3*iattack, 6000, 0.3*iattack, 25000 + , 0.5*isustain, 24000, 0.5*isustain, 20000, 0.4*idecay, 5000 + , 0.3*idecay, 1500, 0.3*idecay, 0 ] + amp2_2 = ar $ linseg + [ 0, 0.5*iattack, 100, 0.5*iattack, 3000, 0.1*isustain, 4500 + , 0.4*isustain, 2000, 0.4*isustain, 2200, 0.1*isustain, 500 + , 0.5*idecay, 150, 0.5*idecay, 0 ] + amp3_2 = ar $ linseg + [ 0, 0.5*iattack, 30, 0.5*iattack, 500, 0.1*isustain, 1200 + , 0.7*isustain, 2200, 0.2*isustain, 1750, 0.5*idecay, 250, 0.2*idecay, 0, 1, 0 ] + iwt1_2 = f11 + iwt2_2 = f22 + iwt3_2 = f23 + inorm_2 = 26080 + + -- range3: ; for low range tones + amp1_3 = ar $ linseg + [ 0, iatt, 0.000, iatt, 0.219, iatt, 0.500, iatt, 0.889, iatt, 1.035 + , iatt, 0.963, isus, 0.424, isus, 0.135, isus, 0.108, isus, 0.204 + , idec, 0.445, idec, 0.531, idec, 0.513, idec, 0.365, idec, 0.053, idec, 0 + ] + amp2_3 = ar $ linseg + [ 0, iatt, 0.000, iatt, -0.106, iatt, -0.112, iatt, -0.187, iatt + , -0.091, iatt, 0.056, isus, 0.558, isus, 0.901, isus, 0.904, isus + , 0.729, idec, 0.303, idec, 0.057, idec, 0.016, idec, -0.076, idec, -0.016, idec, 0 + ] + amp3_3 = ar $ linseg + [ 0, iatt, 1.000, iatt, 0.607, iatt, -0.116, iatt, -0.205, iatt, -0.530, iatt + , -0.195, isus, 0.601, isus, 0.478, isus, -0.371, isus, -0.916, idec + , -0.782, idec, -0.107, idec, -0.811, idec, -0.189, idec, -0.036, idec, 0 + ] + iwt1_3 = f24 + iwt2_3 = f25 + iwt3_3 = f26 + inorm_3 = 24364 + + -- range4: ; for low mid-range tones + amp1_4 = ar $ linseg + [ 0, iatt, 0.000, iatt, 0.049, iatt, 0.027, iatt, 0.005, iatt + , -0.020, iatt, 0.378, isus, 0.925, isus, 1.032, isus, 1.106, isus + , 0.915, idec, 0.858, idec, 0.722, idec, 0.250, idec, -0.002, idec + , 0.004, idec, 0 + ] + amp2_4 = ar $ linseg + [ 0, iatt, 0.000, iatt, -0.182, iatt, -0.029, iatt, 0.397, iatt + , 2.065, iatt, 3.136, isus, 0.250, isus, -0.685, isus, -1.369, isus + , -1.176, idec, -1.023, idec, -0.212, idec, 0.810, idec, 0.469, idec + , 0.018, idec, 0 + ] + amp3_4 = ar $ linseg + [ 0, iatt, 1.000, iatt, 0.007, iatt, 1.039, iatt, 0.466, iatt + , 0.627, iatt, 4.181, isus, -2.481, isus, -2.529, isus + , -4.838, isus, 0.137, idec, -2.823, idec, -1.899, idec + , 4.910, idec, 0.319, idec, 0.039, idec, 0 + ] + iwt1_4 = f27 + iwt2_4 = f28 + iwt3_4 = f29 + inorm_4 = 27832 + + -- range5: ; for high mid-range tones + amp1_5 = ar $ linseg + [ 0, iatt, 0.000, iatt, 0.000, iatt, 0.018, iatt, 0.000, iatt + , 0.450, iatt, 1.130, isus, 1.475, isus, 1.682, isus, 1.533, isus + , 1.243, idec, 0.945, idec, 0.681, idec, 0.210, idec, 0.046, idec + , 0.004, idec, 0 + ] + amp2_5 = ar $ linseg + [ 0, iatt, 0.000, iatt, 0.102, iatt, 0.196, iatt, 1.000, iatt + , 1.108, iatt, -0.024, isus, -1.557, isus, -2.443, isus + , -1.553, isus, -0.979, idec, -0.268, idec, -0.271, idec + , -0.015, idec, 0.017, idec, 0.108, idec, 0 + ] + amp3_5 = ar $ linseg + [ 0, iatt, 1.000, iatt, 0.423, iatt, 0.287, iatt, 0.000, iatt + , -0.987, iatt, -0.621, isus, 3.030, isus, 2.349, isus, 3.075, isus + , 0.331, idec, 0.994, idec, -1.319, idec, -0.378, idec, 0.000, idec + , -0.023, idec, 0 + ] + iwt1_5 = f30 + iwt2_5 = f31 + iwt3_5 = f32 + inorm_5 = 27918 + + -- range6: ; for high range tones + amp1_6 = ar $ linseg + [ 0, iatt, 0.000, iatt, 0.322, iatt, 0.115, iatt, 0.090, iatt + , -0.148, iatt, 1.743, isus, 2.079, isus, 0.844, isus + , 0.889, isus, 1.914, idec, 0.718, idec, 0.206, idec + , 0.361, idec, -0.278, idec, -0.272, idec, 0 + ] + amp2_6 = ar $ linseg + [ 0, iatt, 1.000, iatt, 2.675, iatt, 1.579, iatt, -0.879, iatt + , -4.025, iatt, -9.342, isus, 4.570, isus, -3.372, isus + , -2.904, isus, 0.755, idec, 5.796, idec, -3.764, idec + , 2.193, idec, 0.718, idec, 1.029, idec, 0 ] + amp3_6 = ar $ linseg + [ 0, iatt, 0.000, iatt, -0.334, iatt, -0.108, iatt, 0.028, iatt + , 0.765, iatt, -0.874, isus, -1.222, isus, 0.236, isus + , 0.187, isus, -1.036, idec, 0.276, idec, 0.532, idec + , -0.204, idec, 0.311, idec, 0.283, idec, 0 ] + iwt1_6 = f33 + iwt2_6 = f34 + iwt3_6 = f35 + inorm_6 = 23538 + + -- range7: ; for very high range tones + amp1_7 = ar $ linseg + [ 0, iatt, 0.000, iatt, -0.071, iatt, 0.017, iatt, 0.134, iatt + , -0.068, iatt, 0.192, isus, 1.375, isus, 1.875, isus, 1.463, isus + , 1.446, idec, 0.932, idec, 0.561, idec, 0.100, idec, 0.036, idec + , 0.000, idec, 0 + ] + amp2_7 = ar $ linseg + [ 0, iatt, 1.000, iatt, 3.541, iatt, 3.665, iatt, -0.651, iatt + , 1.017, iatt, 1.331, isus, -4.611, isus, -2.534, isus, -4.241, isus + , -2.738, idec, -0.609, idec, -1.065, idec, 1.122, idec, 0.605, idec + , 0.093, idec, 0 ] + amp3_7 = ar $ linseg + [ 0, iatt, 0.000, iatt, 0.061, iatt, 0.093, iatt, 0.323, iatt + , 1.011, iatt, 0.819, isus, 0.162, isus, -0.152, isus, 0.080, isus + , -0.139, idec, 0.051, idec, -0.054, idec, -0.019, idec, -0.013, idec + , 0.003, idec, 0 ] + iwt1_7 = f36 + iwt2_7 = f37 + iwt3_7 = f38 + inorm_7 = 30675 + + f11 = sine + + f20 = skipNorm $ sines [ 0, 1, 0.21 ] + f21 = skipNorm $ sines [ 0, 0, 0, 1, 1.3, 0.66, 0.9, 0.5, 0.8, 0.6, 1.2, 0.5, 0.8, 0.6, 0.75, 0.6, 0.9, 1.2, 0.9, 1.1, 0.85, 0.9, 0.4, 0.3, 0.45, 0.3, 0.25, 0.15 ] + f22 = skipNorm $ sines [ 0, 1, 0, 0.33 ] + f23 = skipNorm $ sines [ 0, 0, 0.75, 0, 0.28, 0.45, 0.36, 1, 0.54, 0.5, 0.81, 1, 0.95, 0.9, 0.08, 0.24, 0.45, 0.41, 0.25, 0.07 ] + f24 = skipNorm $ sines [ 20742, 2870, 929, 899, 1567, 958, 318, 1168, 838, 781, 192 ] + f25 = skipNorm $ sines [ 18419, 4615, 1255, 689, 3851, 1889, 498, 3127, 3041, 2262, 422, 136 ] + f26 = skipNorm $ sines [ 1700, 331, 615, 259, 188, 164, 79, 393, 191, 108 ] + f27 = skipNorm $ sines [ 17040, 1836, 3609, 4228, 3600, 1910, 9599, 3722, 925, 862, 1292, 227 ] + f28 = skipNorm $ sines [ 4206, 283, 125, 465, 341, 168, 201, 196, 199, 140 ] + f29 = skipNorm $ sines [ 24, 22, 129, 209, 54, 127 ] + f30 = skipNorm $ sines [ 13283, 1588, 2948, 337, 9009, 1040, 2175, 222 ] + f31 = skipNorm $ sines [ 3831, 572, 332, 252, 209, 243, 91 ] + f32 = skipNorm $ sines [ 61, 59, 120, 196, 26 ] + f33 = skipNorm $ sines [ 22605, 2267, 3470, 1604, 2849, 86 ] + f34 = skipNorm $ sines [ 97, 92, 113, 75, 63 ] + f35 = skipNorm $ sines [ 21615, 1982, 3912, 1422, 2987 ] + f36 = skipNorm $ sines [ 17863, 3388, 257 ] + f37 = skipNorm $ sines [ 97, 136, 50 ] + f38 = skipNorm $ sines [ 28207, 1745, 499 ] + diff --git a/src/Csound/Catalog/Wave/WoodwindAlg.hs b/src/Csound/Catalog/Wave/WoodwindAlg.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Catalog/Wave/WoodwindAlg.hs @@ -0,0 +1,181 @@ +module Csound.Catalog.Wave.WoodwindAlg( + WoodwindSpec(..), RangeSpec(..), HarmSpec(..), AmpSpec(..), WaveSpec, + fromSpec, byFreq, + woodwind +) where + +import Data.List (transpose, intersperse) +import Control.Monad.Trans.State + +import Csound.Base + +---------------------------------------------------------------- +-- Deterministic random numbers + +newtype Rnd a = Rnd { unRnd :: State D a } + +instance Functor Rnd where + fmap f (Rnd a) = Rnd $ fmap f a + +instance Monad Rnd where + return = Rnd . return + (Rnd a) >>= f = Rnd $ a >>= unRnd . f + +evalRnd :: Rnd a -> D -> a +evalRnd = evalState . unRnd + +rndNext :: Rnd () +rndNext = Rnd $ modify $ frac' . (* 105.947) + +rndGet :: Rnd D +rndGet = Rnd $ get + +rndWithin :: (D, D) -> Rnd D +rndWithin (imin, imax) = do + iseed <- rndGet + rndNext + return $ imin + (imax - imin) * iseed + +---------------------------------------------------------------- +-- tools + +randiPct :: D -> D -> Sig -> Rnd Sig +randiPct pct cps asig = do + iseed <- rndWithin (0, 1) + return $ asig * (1 + (randi (sig pct) (sig cps) `withSeed` iseed)) + +minDt :: D -> D -> D +minDt n x = maxB x (n / getControlRate) + +---------------------------------------------------------------- +-- algorithm parameters + +-- | Winds algorithm specification. +data WoodwindSpec = WoodwindSpec + { woodwindRange :: (D, D, D) -> D -> ([(Sig, Tab)], D) + , woodwindVibratoDur :: (D, D, D) -> D + , woodwindFreqDeviation :: ((D, D), (D, D), (D, D), (D, D)) } + +-- | Harmonics per pitch range. +data RangeSpec = RangeSpec + { rangeFreq :: D + , rangeNorm :: D + , rangeHarms :: [HarmSpec] } + +-- | The harmonics. +data HarmSpec = HarmSpec + { harmAmp :: AmpSpec + , harmWave :: WaveSpec } + +-- | Envelopes for linseg +data AmpSpec = AmpSpec + { ampAttack :: [D] + , ampSustain :: [D] + , ampDecay :: [D] } + +-- | Not scaled sine harmonics. +type WaveSpec = [Double] + +---------------------------------------------------------------- +-- The algorithm + +-- | An emulation of the woodwindinstruments. Parameters +-- +-- > woodwind spec seed vibDepth attack sustain decay brightnessLevel cps = +-- +-- +-- * spec - a specification of the algorithm +-- +-- * seed - a seed for the random signals/numbers. It's in (0, 1) +-- +-- * vibDepth - Amount of the vibrato. It's in [-1, 1] +-- +-- * attack - duration of the attack +-- +-- * sustain - duration of the sustain +-- +-- * decay - duration of the decay +-- +-- * brightnessLevel - Controls the frequency of the low-pass filter. It's in (0, 1) +woodwind :: WoodwindSpec -> D -> D -> D -> D -> D -> D -> D -> Sig +woodwind spec seedVal vibPercent attack sustain decay brightnessLevel cps = + evalRnd (rndWoodwind spec vibPercent attack sustain decay brightnessLevel cps) seedVal + +rndWoodwind :: WoodwindSpec -> D -> D -> D -> D -> D -> D -> Rnd Sig +rndWoodwind spec vibCoeff attack sustain decay brightnessLevel cps = do + iphase <- rndWithin (0, 1) + durs <- initDurations + kfreq <- woodwindVibrato (woodwindVibratoDur spec durs) =<< (freqDeviation (woodwindFreqDeviation spec) durs $ sig cps) + + let (harms1, inorm) = woodwindRange spec durs cps + harms2 <- mapM (ampVarOnHarm 0.02) harms1 + return $ brightness durs brightnessLevel $ sumHarms harms2 inorm iphase kfreq + where + initDurations :: Rnd (D, D, D) + initDurations = do + iattack <- rndWithin (attack * 0.9, attack * 1.1) + idecay <- rndWithin (decay * 0.9, decay * 1.1) + return (minDt 6 iattack, minDt 5 sustain, minDt 6 idecay) + + woodwindVibrato :: D -> Sig -> Rnd Sig + woodwindVibrato xdur asig = do + let ivibdepth = abs (vibCoeff * cps) + kvibdepth <- randiPct 0.1 5 $ sig ivibdepth * linseg [0.1, 0.8 * xdur, 1, 0.2 * xdur, 0.7] + [ivibr1, ivibr2, ivibr3] <- mapM rndWithin $ replicate 3 (0, 1) + kvibrate <- randiPct 0.1 5 $ + ifB (sig vibCoeff >* 0) + -- if vibrato is positive it gets faster + (linseg [2.5 + ivibr1, xdur, 4.5 + ivibr2]) + -- if vibrato is negative it gets slower + (linseg [3.5 + ivibr1, 0.1, 4.5 + ivibr2, xdur - 0.1, 2.5 + ivibr3]) + return $ asig + kvibdepth * osc kvibrate + + freqDeviation :: ((D, D), (D, D), (D, D), (D, D)) -> (D, D, D) -> Sig -> Rnd Sig + freqDeviation (f1, f2, f3, f4) (iattack, isustain, idecay) asig = do + [fdev1, fdev2, fdev3, fdev4] <- mapM rndWithin [f1, f2, f3, f4] + return $ asig * (1 + linseg [fdev1, iattack, fdev2, isustain, fdev3, idecay, fdev4]) + + ampVar :: D -> Sig -> Rnd Sig + ampVar pct = randiPct pct 10 + + ampVarOnHarm :: D -> (Sig, Tab) -> Rnd (Sig, Tab) + ampVarOnHarm perct (amp, wt) = fmap (\x -> (x, wt)) $ ampVar perct amp + + sumHarms :: [(Sig, Tab)] -> D -> D -> Sig -> Sig + sumHarms hs norm iphase kfreq = ( / sig norm) $ mean $ + fmap (\(amp, wt) -> oscili amp kfreq wt `withD` iphase) hs + + brightness :: (D, D, D) -> D -> Sig -> Sig + brightness (iattack, isustain, idecay) level asig = balance (tone asig env) asig + where ifiltcut = tablei (9 * level) (skipNorm $ doubles [40, 40, 80, 160, 320, 640, 1280, 2560, 5120, 10240, 10240]) + env = linseg [0, iattack, ifiltcut, isustain, ifiltcut, idecay, 0] + +---------------------------------------------------------------- +-- Converting specification to signals + +fromSpec :: [RangeSpec] -> (D, D, D) -> D -> ([(Sig, Tab)], D) +fromSpec specs durs ifreq = (hs, inorm) + where + inorm = byFreq ifreq $ fmap (\x -> (rangeFreq x, rangeNorm x)) specs + hs = fmap (byFreq ifreq . zip freqs . fmap (fromHarmSpec durs)) $ transpose $ fmap rangeHarms specs + + 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) + + +fromHarmSpec :: (D, D, D) -> HarmSpec -> (Sig, Tab) +fromHarmSpec durs spec = (fromAmpSpec durs $ harmAmp spec, fromWaveSpec $ harmWave spec) + +fromAmpSpec :: (D, D, D) -> AmpSpec -> Sig +fromAmpSpec (attack, sustain, decay) spec = linseg $ att ++ (tail sus) ++ (tail dec) + where phi dt select = intersperse (dt / fromIntegral (pred $ length $ select spec)) (select spec) + att = phi attack ampAttack + sus = phi sustain ampSustain + dec = phi decay ampDecay + +fromWaveSpec :: WaveSpec -> Tab +fromWaveSpec = skipNorm . sines + +