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

    -- * Sean Costello
    RissetBellSpec(..), rissetBell, timpani, timpaniSpec, noiseBell, noiseBellSpec,
    snowCrackle, 
    fmDrone, fmDrones,
    tenorOsc, sopranoOsc,

    -- * Flavio
    amFlavio, fmFlavio, simpleSust, simpleFading,

    -- * Thor
    cathedralOrgan, cathedralOrganFx, hammondOrgan,

    amPiano, amPianoBy,

    pwBass, pwHarpsichord, pwEnsemble,
    pwBassBy, pwHarpsichordBy, pwEnsembleBy,

    simpleBass, 

    ReleaseTime,
    EpianoOsc(..), epiano, epianoBy, pianoEnv, xpianoEnv,

    noisyChoir, thorWind, mildWind, boom, windWall, 

    razorPad, razorLead,

    -- * FM
    fmBass1, fmBass2,

    -- * Bitwig

    pwPad, triPad, triPadFx, triPadBy, pwPadBy,
    Accordeon(..), accordeon, accordeonFx,

    -- * Pads
    polySynthFx, polySynth,
    dreamPad, underwaterPad, lightIsTooBrightPad, whaleSongPad,
    dreamPadBy, lightIsTooBrightPadBy, whaleSongPadBy,

    -- * SHARC instruments
    -- | SHARC ported to Csound. SHARC is a database of musical timbre information by Gregory Sandell.
    -- It's a collection of sustain notes for real orchestra instruments.

    -- ** Oscillators
    sharcOsc, sigSharcOsc, rndSharcOsc, rndSigSharcOsc,
    soloSharcOsc, orcSharcOsc, purePadSharcOsc, padSharcOsc,

    -- ** Padsynth
    PadSharcSpec(..), padsynthSharcOsc, padsynthSharcOsc2,
    padsynthSharcOsc', padsynthSharcOsc2',

    -- ** Instriments
    SharcInstr(..),
    shViolin, shViolinPizzicato, shViolinMuted, shViolinMarteleBowing, shViolinsEnsemble, shViola, shViolaPizzicato, shViolaMuted,
    shViolaMarteleBowing, shTuba, shTromboneMuted, shTrombone, shPiccolo, shOboe, shFrenchHornMuted, shFrenchHorn, shFlute,
    shEnglishHorn, shClarinetEflat, shTrumpetMutedC, shTrumpetC, shContrabassClarinet, shContrabassoon, shCello, shCelloPizzicato,
    shCelloMuted, shCelloMarteleBowing, shContrabassPizzicato, shContrabassMuted, shContrabassMarteleBowing, shContrabass,
    shClarinet, shBassTrombone, shBassClarinet, shBassoon, shBassFlute, shTrumpetBach, shAltoTrombone, shAltoFlute,

    -- ** Low-level getters
    getInstrTab, note2sig, note2tab,

    -- * Other instruments
    okComputer, deepBass,
    impulseMarimba1, impulseMarimba2,
    celloWave

) 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.Sean
import Csound.Catalog.Wave.Flavio
import Csound.Catalog.Wave.Thor
import Csound.Catalog.Wave.Bitwig
import Csound.Catalog.Wave.Fm

import Csound.Catalog.Wave.Misc

import Csound.Catalog.Reson
import Csound.Catalog.Wave.Sharc

-- | 
-- > nightPad fadeInTime cps
nightPad :: D -> Sig -> Sig
nightPad :: D -> Sig -> Sig
nightPad D
dt = (D -> Sig
fadeIn D
dt Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* ) (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig
stringPad Sig
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 :: Sig -> Sig
dahina = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
dahinaModes
banyan :: Sig -> Sig
banyan = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
banyanModes 
xylophone :: Sig -> Sig
xylophone = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
xylophoneModes 
tibetanBowl180 :: Sig -> Sig
tibetanBowl180 = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
tibetanBowlModes180  
spinelSphere :: Sig -> Sig
spinelSphere = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
spinelSphereModes 
potLid :: Sig -> Sig
potLid = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
potLidModes 
redCedarWoodPlate :: Sig -> Sig
redCedarWoodPlate = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
redCedarWoodPlateModes 
tubularBell :: Sig -> Sig
tubularBell = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
tubularBellModes 
redwoodPlate :: Sig -> Sig
redwoodPlate = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
redwoodPlateModes 
douglasFirWoodPlate :: Sig -> Sig
douglasFirWoodPlate = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
douglasFirWoodPlateModes 
uniformWoodenBar :: Sig -> Sig
uniformWoodenBar = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
uniformWoodenBarModes 
uniformAluminumBar :: Sig -> Sig
uniformAluminumBar = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
uniformAluminumBarModes 
vibraphone1 :: Sig -> Sig
vibraphone1 = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
vibraphoneModes1 
vibraphone2 :: Sig -> Sig
vibraphone2 = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
vibraphoneModes2 
chalandiPlates :: Sig -> Sig
chalandiPlates = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
chalandiPlatesModes 
tibetanBowl152 :: Sig -> Sig
tibetanBowl152 = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
tibetanBowlModes152 
tibetanBowl140 :: Sig -> Sig
tibetanBowl140 = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
tibetanBowlModes140 
wineGlass :: Sig -> Sig
wineGlass = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
wineGlassModes 
smallHandbell :: Sig -> Sig
smallHandbell = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
smallHandbellModes 
albertClockBellBelfast :: Sig -> Sig
albertClockBellBelfast = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
albertClockBellBelfastModes 
woodBlock :: Sig -> Sig
woodBlock = Modes Sig -> Sig -> Sig
strikeModes Modes Sig
forall a. Fractional a => Modes a
woodBlockModes