csound-expression 4.1.0 → 4.2.0
raw patch · 16 files changed
+1676/−989 lines, 16 filesdep +colourdep ~csound-expression-typed
Dependencies added: colour
Dependency ranges changed: csound-expression-typed
Files
- csound-expression.cabal +12/−3
- examples/Live.hs +64/−0
- src/Csound/Air.hs +26/−966
- src/Csound/Air/Envelope.hs +163/−0
- src/Csound/Air/Filter.hs +79/−0
- src/Csound/Air/Fx.hs +427/−0
- src/Csound/Air/Live.hs +356/−0
- src/Csound/Air/Misc.hs +123/−0
- src/Csound/Air/Spec.hs +40/−0
- src/Csound/Air/Wav.hs +226/−0
- src/Csound/Air/Wave.hs +128/−0
- src/Csound/Control/Gui.hs +21/−10
- src/Csound/Control/Gui/Widget.hs +1/−0
- src/Csound/Control/SE.hs +1/−1
- src/Csound/IO.hs +5/−5
- src/Csound/SigSpace.hs +4/−4
csound-expression.cabal view
@@ -1,5 +1,5 @@ Name: csound-expression-Version: 4.1.0+Version: 4.2.0 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE@@ -41,6 +41,7 @@ examples/Gm.hs examples/Tibetan.hs examples/Wind.hs+ examples/Live.hs examples/Midi.hs examples/Events.hs@@ -66,13 +67,21 @@ Library Ghc-Options: -Wall Build-Depends:- base >= 4, base < 5, process, data-default, Boolean >= 0.1.0,- csound-expression-typed >= 0.0.5.4, csound-expression-opcodes >= 0.0.1+ base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0,+ csound-expression-typed >= 0.0.6.0, csound-expression-opcodes >= 0.0.1 Hs-Source-Dirs: src/ Exposed-Modules: Csound.Base Csound.Air+ Csound.Air.Wave+ Csound.Air.Envelope+ Csound.Air.Filter+ Csound.Air.Wav+ Csound.Air.Spec+ Csound.Air.Fx+ Csound.Air.Live+ Csound.Air.Misc Csound.Types Csound.Tab
+ examples/Live.hs view
@@ -0,0 +1,64 @@+module Main where++import Csound.Base+import Csound.Sam++main = main4++a1 = infSig1 $ osc 220+a2 = infSig1 $ osc 330+a3 = infSig1 $ osc 440++main1 = dac $ do+ (g, sam) <- tog 4 [("220", a1), ("330", a2)]+ panel g+ mul 0.5 $ runSam 120 sam++-----------------------------++b1 = infSig1 $ sqr 220+b2 = infSig1 $ sqr 330+b3 = infSig1 $ sqr 440++c1 = infSig1 $ tri 220+c2 = infSig1 $ tri 330+c3 = infSig1 $ tri 440++main2 = dac $ do+ (g, sam) <- live 4 ["triangle", "square"] + [ c1, b1+ , c2, b3+ , c3, b3]+ panel g+ mul 0.3 $ runSam 120 sam++-----------------------------++main3 = dac $ do+ (g, res) <- mixer $ fmap (\x -> mixMono (show x) (osc $ sig $ int x)) [220, 330, 440]+ win "mixer" (600, 300) g+ return $ mul 0.5 $ res++-----------------------------++run = runSam 120++main4 = dac $ do+ (g1, sam1) <- tog 4 [("220", a1), ("330", a2)]+ (g2, sam2) <- sim 4 [("220", a1), ("330", a2)]+ (g3, res) <- mixer [("tog", run sam1), ("sim", run sam2)]+ win "main" (600, 400) $ ver [sca 0.6 $ hor [g1, g2], g3]+ return res++-----------------------------++main5 = dac $ do+ (gui, fx) <- fxHor + [ uiFilter False 0.5 0.5 0.5+ , uiChorus False 0.5 0.5 0.5 0.5 + , uiPhaser False 0.5 0.5 0.5 0.5 0.5 + , uiReverb True 0.5 0.5+ , uiGain True 0.5 + ]+ win "main" (900, 400) gui+ fx $ fromMono $ saw 110
src/Csound/Air.hs view
@@ -1,975 +1,35 @@-module Csound.Air ( - -- * Basic waveforms- -- | Basic waveforms that are used most often. A waveform function take in a time varied frequency (in Hz).-- -- ** Bipolar- osc, oscBy, saw, isaw, pulse, sqr, tri, blosc,-- -- ** Unipolar- unipolar, bipolar, on, uon, uosc, uoscBy, usaw, uisaw, upulse, usqr, utri, ublosc,-- -- * Noise- rndh, urndh, rndi, urndi, white, pink,-- -- * Envelopes-- leg, xeg,-- -- ** Relative duration- onIdur, lindur, expdur, linendur,- onDur, lindurBy, expdurBy, linendurBy,- once, onceBy, several, - -- ** Looping envelopes- oscLins, oscElins, oscExps, oscEexps, oscLine, - -- ** Faders- fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades,-- -- * Low frequency oscillators- Lfo, lfo,-- -- * Filters- -- | Arguemnts are inversed to get most out of curruing. First come parameters and the last one is the signal.- - -- ** Simple filters- lp, hp, bp, br, alp,- - -- ** Butterworth filters- blp, bhp, bbp, bbr,-- -- ** Specific filters- mlp,-- -- * Sound files playback- - -- ** Stereo- readSnd, loopSnd, loopSndBy, - readWav, loopWav, readSegWav, - tempoLoopWav, tempoReadWav,- - -- ** Mono- readSnd1, loopSnd1, loopSndBy1, - readWav1, loopWav1, readSegWav1,- tempoLoopWav1, tempoReadWav1,- - -- ** Read sound with RAM- -- - -- Loads the sample in the table and plays it back from RAM. The sample should be short. The size of the table is limited.- -- It's up to 6 minutes for 44100 sample rate, 5 minutes for 48000 and 2.8 minutes for 96000.- LoopMode(..), ramSnd, ramSnd1, -- -- * Writing sound files- SampleFormat(..),- writeSigs, writeWav, writeAiff, writeWav1, writeAiff1,-- -- ** Utility- lengthSnd, segments,-- -- * Signal manipulation- takeSnd, delaySnd, segmentSnd, repeatSnd, toMono,-- -- * Spectral functions- toSpec, fromSpec, mapSpec, scaleSpec, addSpec, scalePitch,-- -- * Patterns- mean, vibrate, randomPitch, chorusPitch, resons, resonsBy, modes, dryWet, -- -- ** List functions- odds, evens,-- -- * Widgets- AdsrBound(..), AdsrInit(..),- linAdsr, expAdsr, - classicWaves,- masterVolume, masterVolumeKnob,+-- | The vital tools.+module Csound.Air ( + -- | The basic sound waves: pure sine, sawtooth, square, triangle, LFOs.+ module Csound.Air.Wave, - -- Effects- - -- ** Reverbs- reverbsc1, rever1, rever2, reverTime,- smallRoom, smallHall, largeHall, magicCave,- smallRoom2, smallHall2, largeHall2, magicCave2,+ -- | Envelope generators.+ module Csound.Air.Envelope, - -- ** Delays- echo, fdelay, fvdelay, fvdelays, funDelays,+ -- | Filters+ module Csound.Air.Filter, - -- ** Distortion- distortion,+ -- | Sound file playback+ module Csound.Air.Wav, - -- ** Chorus- chorus,+ -- | Spectral Processing+ module Csound.Air.Spec, - -- ** Flanger- flange,+ -- | Effects: reverbs, choruses, delays etc.+ module Csound.Air.Fx, - -- ** Phase- phase1, harmPhase, powerPhase+ -- | Widgets to make live performances.+ module Csound.Air.Live, + -- | Other usefull stuff.+ module Csound.Air.Misc ) where -import Data.List(intersperse, isSuffixOf)-import Data.Boolean--import Csound.Typed-import Csound.Typed.Opcode hiding (display, lfo)-import Csound.Typed.Gui-import Csound.Control.Gui(funnyRadio)-import Csound.Control.Evt(metroE, eventList)-import Csound.Control.Instr(withDur, sched)--import Csound.Types(Sig2)-import Csound.Tab(sine, sines4, mp3s, wavs)-import Csound.SigSpace(mapSig)------------------------------------------------------------------------ waveforms---- | A pure tone (sine wave).-osc :: Sig -> Sig-osc cps = oscil3 1 cps sine---- | An oscillator with user provided waveform.-oscBy :: Tab -> Sig -> Sig-oscBy tb cps = oscil3 1 cps tb---- unipolar waveforms---- | Turns a bipolar sound (ranges from -1 to 1) to unipolar (ranges from 0 to 1)-unipolar :: Sig -> Sig-unipolar a = 0.5 + 0.5 * a---- | Turns an unipolar sound (ranges from 0 to 1) to bipolar (ranges from -1 to 1)-bipolar :: Sig -> Sig-bipolar a = 2 * a - 1---- | Unipolar pure tone.-uosc :: Sig -> Sig-uosc = unipolar . osc---- | Unipolar 'Csound.Air.oscBy'.-uoscBy :: Tab -> Sig -> Sig-uoscBy tb = unipolar . oscBy tb---- | Unipolar sawtooth.-usaw :: Sig -> Sig-usaw = unipolar . saw---- | Unipolar integrated sawtooth.-uisaw :: Sig -> Sig-uisaw = unipolar . isaw---- | Unipolar square wave.-usqr :: Sig -> Sig-usqr = unipolar . sqr---- | Unipolar triangle wave.-utri :: Sig -> Sig-utri = unipolar . tri---- | Unipolar pulse.-upulse :: Sig -> Sig-upulse = unipolar . pulse---- | Unipolar band-limited oscillator.-ublosc :: Tab -> Sig -> Sig-ublosc tb = unipolar . blosc tb---- rescaling---- | Rescaling of the bipolar signal (-1, 1) -> (a, b)--- --- > on a b biSig-on :: Sig -> Sig -> Sig -> Sig-on a b x = uon a b $ unipolar x ---- | Rescaling of the unipolar signal (0, 1) -> (a, b)--- --- > on a b uniSig-uon :: Sig -> Sig -> Sig -> Sig-uon a b x = a + (b - a) * x------------------------------------------------------------------------------- noise---- | Constant random signal. It updates random numbers with given frequency.------ > constRnd freq -rndh :: Sig -> SE Sig-rndh = randh 1---- | Linear random signal. It updates random numbers with given frequency.------ > rndi freq -rndi :: Sig -> SE Sig-rndi = randi 1---- | Unipolar @rndh@-urndh :: Sig -> SE Sig-urndh = fmap unipolar . rndh---- | Unipolar @rndi@-urndi :: Sig -> SE Sig-urndi = fmap unipolar . rndi---- | White noise.-white :: SE Sig -white = noise 1 0---- | Pink noise.-pink :: SE Sig-pink = pinkish 1------------------------------------------------------------------------------- envelopes---- | Linear adsr envelope generator with release------ > leg attack decay sustain release-leg :: D -> D -> D -> D -> Sig-leg = madsr---- | Exponential adsr envelope generator with release------ > xeg attack decay sustain release-xeg :: D -> D -> D -> D -> Sig-xeg a d s r = mxadsr a d (s + 0.00001) r---- | Makes time intervals relative to the note's duration. So that:------ > onIdur [a, t1, b, t2, c]------ becomes: ------ > [a, t1 * idur, b, t2 * idur, c]-onIdur :: [D] -> [D]-onIdur = onDur idur---- | Makes time intervals relative to the note's duration. So that:------ > onDur dt [a, t1, b, t2, c]------ becomes: ------ > [a, t1 * dt, b, t2 * dt, c]-onDur :: D -> [D] -> [D]-onDur dur xs = case xs of- a:b:as -> a : b * dur : onDur dur as- _ -> xs---- | The opcode 'Csound.Opcode.linseg' with time intervals --- relative to the total duration of the note.-lindur :: [D] -> Sig-lindur = linseg . onIdur---- | The opcode 'Csound.Opcode.expseg' with time intervals --- relative to the total duration of the note.-expdur :: [D] -> Sig-expdur = expseg . onIdur---- | The opcode 'Csound.Opcode.linseg' with time intervals --- relative to the total duration of the note given by the user.-lindurBy :: D -> [D] -> Sig-lindurBy dt = linseg . onDur dt---- | The opcode 'Csound.Opcode.expseg' with time intervals --- relative to the total duration of the note given by the user.-expdurBy :: D -> [D] -> Sig-expdurBy dt = expseg . onDur dt---- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of idur.------ > linendur asig rise decay-linendur :: Sig -> D -> D -> Sig-linendur = linendurBy idur---- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of--- the first argument.------ > linendurBy dt asig rise decay-linendurBy :: D -> Sig -> D -> D -> Sig-linendurBy dt asig ris dec = linen asig (ris * dt) dt (dec * dt)-- --- | Fades in with the given attack time.-fadeIn :: D -> Sig-fadeIn att = linseg [0, att, 1]---- | Fades out with the given attack time.-fadeOut :: D -> Sig-fadeOut dec = linsegr [1] dec 0- --- | Fades in by exponent with the given attack time.-expFadeIn :: D -> Sig-expFadeIn att = expseg [0.0001, att, 1]---- | Fades out by exponent with the given attack time.-expFadeOut :: D -> Sig-expFadeOut dec = expsegr [1] dec 0.0001---- | A combination of fade in and fade out.------ > fades attackDuration decayDuration-fades :: D -> D -> Sig-fades att dec = fadeIn att * fadeOut dec---- | A combination of exponential fade in and fade out.------ > expFades attackDuration decayDuration-expFades :: D -> D -> Sig-expFades att dec = expFadeIn att * expFadeOut dec------------------------------------------------------------------------------- lfo---- | Low frequency oscillator-type Lfo = Sig---- | Low frequency oscillator------ > lfo shape depth rate-lfo :: (Sig -> Sig) -> Sig -> Sig -> Sig-lfo shape depth rate = depth * shape rate------------------------------------------------------------------------------- filters---- | Low-pass filter.------ > lp cutoff resonance sig-lp :: Sig -> Sig -> Sig -> Sig-lp cf q a = bqrez a cf q---- | High-pass filter.------ > hp cutoff resonance sig-hp :: Sig -> Sig -> Sig -> Sig-hp cf q a = bqrez a cf q `withD` 1---- | Band-pass filter.------ > bp cutoff resonance sig-bp :: Sig -> Sig -> Sig -> Sig-bp cf q a = bqrez a cf q `withD` 2---- | Band-reject filter.------ > br cutoff resonance sig-br :: Sig -> Sig -> Sig -> Sig-br cf q a = bqrez a cf q `withD` 3---- | All-pass filter.------ > alp cutoff resonance sig-alp :: Sig -> Sig -> Sig -> Sig-alp cf q a = bqrez a cf q `withD` 4---- Butterworth filters---- | High-pass filter.------ > bhp cutoff sig-bhp :: Sig -> Sig -> Sig-bhp = flip buthp---- | Low-pass filter.------ > blp cutoff sig-blp :: Sig -> Sig -> Sig-blp = flip butlp---- | Band-pass filter.------ > bbp cutoff bandwidth sig-bbp :: Sig -> Sig -> Sig -> Sig-bbp freq band a = butbp a freq band---- | Band-regect filter.------ > bbr cutoff bandwidth sig-bbr :: Sig -> Sig -> Sig -> Sig -bbr freq band a = butbr a freq band----- | Moog's low-pass filter.------ > mlp centerFrequency qResonance signal-mlp :: Sig -> Sig -> Sig -> Sig-mlp cf q asig = moogladder asig cf q-------------------------------------------------------------------------------- Signal manipulation---- | Takes only given amount (in seconds) from the signal (the rest is silence).-takeSnd :: Sigs a => D -> a -> a-takeSnd dt asig = trigs (const $ return asig) $ eventList [(0, dt, unit)]---- | Delays signals by the given amount (in seconds).-delaySnd :: Sigs a => D -> a -> a-delaySnd dt asig = trigs (const $ return asig) $ eventList [(dt, -1, unit)]---- | Delays a signal by the first argument and takes only second argument amount--- of signal (everything is measured in seconds).-segmentSnd ::Sigs a => D -> D -> a -> a-segmentSnd del dur asig = trigs (const $ return asig) $ eventList [(del, dur, unit)]---- | Repeats the signal with the given period.-repeatSnd :: Sigs a => D -> a -> a-repeatSnd dt asig = sched (const $ return asig) $ segments dt------------------------------------------------------------------------------- sound files playback--isMp3 :: String -> Bool-isMp3 name = ".mp3" `isSuffixOf` name---- | Converts stereosignal to mono with function mean.-toMono :: (Sig, Sig) -> Sig-toMono (a, b) = 0.5 * a + 0.5 * b---- | Length in seconds of the sound file.-lengthSnd :: String -> D-lengthSnd fileName- | isMp3 fileName = mp3len $ text fileName- | otherwise = filelen $ text fileName---- | Produces repeating segments with the given time in seconds.-segments :: D -> Evt (D, Unit)-segments dt = withDur dt $ metroE (sig $ recip dt)---- Stereo---- | Reads stereo signal from the sound-file (wav or mp3 or aiff).-readSnd :: String -> (Sig, Sig)-readSnd fileName- | isMp3 fileName = mp3in (text fileName) - | otherwise = diskin2 (text fileName) 1---- | Reads stereo signal from the sound-file (wav or mp3 or aiff)--- and loops it with the given period (in seconds).-loopSndBy :: D -> String -> (Sig, Sig)-loopSndBy dt fileName = repeatSnd dt $ readSnd fileName---- | Reads stereo signal from the sound-file (wav or mp3 or aiff)--- and loops it with the file length.-loopSnd :: String -> (Sig, Sig)-loopSnd fileName = loopSndBy (lengthSnd fileName) fileName---- | Reads the wav file with the given speed (if speed is 1 it's a norma playback).--- We can use negative speed to read file in reverse.-readWav :: Sig -> String -> (Sig, Sig)-readWav speed fileName = diskin2 (text fileName) speed---- | Reads th wav file and loops over it.-loopWav :: Sig -> String -> (Sig, Sig)-loopWav speed fileName = flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) speed---- | Reads a segment from wav file. -readSegWav :: D -> D -> Sig -> String -> (Sig, Sig)-readSegWav start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) speed `withDs` [start, 1]---- | Reads the wav file with the given speed (if speed is 1 it's a norma playback).--- We can use negative speed to read file in reverse. Scales the tempo with first argument.-tempoReadWav :: Sig -> String -> (Sig, Sig)-tempoReadWav speed fileName = mapSig (scaleSpec (1 / abs speed)) $ diskin2 (text fileName) speed---- | Reads th wav file and loops over it. Scales the tempo with first argument.-tempoLoopWav :: Sig -> String -> (Sig, Sig)-tempoLoopWav speed fileName = mapSig (scaleSpec (1 / abs speed)) $ flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) speed---- Mono---- | The mono variant of the function @readSnd@.-readSnd1 :: String -> Sig-readSnd1 fileName - | isMp3 fileName = toMono $ readSnd fileName- | otherwise = diskin2 (text fileName) 1---- | The mono variant of the function @loopSndBy@.-loopSndBy1 :: D -> String -> Sig-loopSndBy1 dt fileName = repeatSnd dt $ readSnd1 fileName---- | The mono variant of the function @loopSnd@.-loopSnd1 :: String -> Sig-loopSnd1 fileName = loopSndBy1 (lengthSnd fileName) fileName---- | The mono variant of the function @readWav@.-readWav1 :: Sig -> String -> Sig-readWav1 speed fileName = diskin2 (text fileName) speed---- | The mono variant of the function @loopWav@.-loopWav1 :: Sig -> String -> Sig-loopWav1 speed fileName = flip withDs [0, 1] $ diskin2 (text fileName) speed---- | Reads a segment from wav file.-readSegWav1 :: D -> D -> Sig -> String -> Sig-readSegWav1 start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) speed `withDs` [start, 1]---- | Reads the mono wav file with the given speed (if speed is 1 it's a norma playback).--- We can use negative speed to read file in reverse. Scales the tempo with first argument.-tempoReadWav1 :: Sig -> String -> Sig-tempoReadWav1 speed fileName = scaleSpec (1 / abs speed) $ readWav1 speed fileName---- | Reads th mono wav file and loops over it. Scales the tempo with first argument.-tempoLoopWav1 :: Sig -> String -> Sig-tempoLoopWav1 speed fileName = scaleSpec (1 / abs speed) $ loopWav1 speed fileName------------------------------------------------------------------------------- With RAM--data LoopMode = Once | Loop | Bounce- deriving (Show, Eq, Enum)---- | Loads the sample in the table. The sample should be short. The size of the table is limited.--- It's up to 6 minutes for -ramSnd :: LoopMode -> Sig -> String -> Sig2-ramSnd loopMode speed file = loscil3 1 speed t `withDs` [1, int $ fromEnum loopMode]- where t - | isMp3 file = mp3s file 0- | otherwise = wavs file 0 0--ramSnd1 :: LoopMode -> Sig -> String -> Sig-ramSnd1 loopMode speed file - | isMp3 file = (\(aleft, aright) -> 0.5 * (aleft + aright)) $ loscil3 1 speed (mp3s file 0) `withDs` [1, int $ fromEnum loopMode]- | otherwise = loscil3 1 speed (wavs file 0 1) `withDs` [1, int $ fromEnum loopMode]------------------------------------------------------------------------------- writing sound files---- | The sample format.-data SampleFormat - = NoHeaderFloat32 -- ^ 32-bit floating point samples without header- | NoHeaderInt16 -- ^ 16-bit integers without header- | HeaderInt16 -- ^ 16-bit integers with a header. The header type depends on the render (-o) format- | UlawSamples -- ^ u-law samples with a header- | Int16 -- ^ 16-bit integers with a header- | Int32 -- ^ 32-bit integers with a header - | Float32 -- ^ 32-bit floats with a header- | Uint8 -- ^ 8-bit unsigned integers with a header- | Int24 -- ^ 24-bit integers with a header- | Float64 -- ^ 64-bit floats with a header- deriving (Eq, Ord, Enum)---- | Writes a sound signal to the file with the given format.--- It supports only four formats: Wav, Aiff, Raw and Ircam.-writeSigs :: FormatType -> SampleFormat -> String -> [Sig] -> SE ()-writeSigs fmt sample file = fout (text file) formatToInt - where - formatToInt = int $ formatTypeToInt fmt * 10 + fromEnum sample-- formatTypeToInt :: FormatType -> Int- formatTypeToInt x = case x of- Wav -> 1- Aiff -> 2- Raw -> 3- Ircam -> 4- _ -> error $ "Format " ++ (show x) ++ " is not supported in the writeSnd."---- | Writes wav files.-writeWav :: String -> (Sig, Sig) -> SE ()-writeWav file = writeSigs Wav Int16 file . \(a, b) -> [a, b]---- | Writes aiff files.-writeAiff :: String -> (Sig, Sig) -> SE ()-writeAiff file = writeSigs Aiff Int16 file . \(a, b) -> [a, b]---- | Writes mono signals to wav files.-writeWav1 :: String -> Sig -> SE ()-writeWav1 file = writeWav file . \x -> (x, x)---- | Writes mono signals to aiff files.-writeAiff1 :: String -> Sig -> SE ()-writeAiff1 file = writeAiff file . \x -> (x, x)------------------------------------------------------------------------------- spectral functions---- | Converts signal to spectrum.-toSpec :: Sig -> Spec-toSpec asig = pvsanal asig 1024 256 1024 1---- | Converts spectrum to signal.-fromSpec :: Spec -> Sig-fromSpec = pvsynth---- | Applies a transformation to the spectrum of the signal.-mapSpec :: (Spec -> Spec) -> Sig -> Sig-mapSpec f = fromSpec . f . toSpec---- | Scales all frequencies. Usefull for transposition. --- For example, we can transpose a signal by the given amount of semitones: ------ > scaleSpec (semitone 1) asig-scaleSpec :: Sig -> Sig -> Sig-scaleSpec k = mapSpec $ \x -> pvscale x k---- | Adds given amount of Hz to all frequencies.------ > addSpec hz asig-addSpec :: Sig -> Sig -> Sig-addSpec hz = mapSpec $ \x -> pvshift x hz 0---- | Scales frequency in semitones.-scalePitch :: Sig -> Sig -> Sig-scalePitch n = scaleSpec (semitone n)------------------------------------------------------------------------------- patterns---- | Selects odd elements from the list.-odds :: [a] -> [a]-odds as = fmap snd $ filter fst $ zip (cycle [True, False]) as ---- | Selects even elements from the list.-evens :: [a] -> [a]-evens as - | null as = []- | otherwise = odds $ tail as---- | Reads table once during the note length. -once :: Tab -> Sig-once = onceBy idur---- | Reads table once during a given period of time. -onceBy :: D -> Tab -> Sig-onceBy dt tb = kr $ oscBy tb (1 / sig dt) ---- | Reads table several times during the note length. -several :: Tab -> Sig -> Sig-several tb rate = kr $ oscil3 1 (rate / sig idur) tb---- | Loops over line segments with the given rate.------ > oscLins [a, durA, b, durB, c, durC ..] cps------ where ------ * @a@, @b@, @c@ ... -- values------ * durA, durB, durC -- durations of the segments relative to the current frequency.-oscLins :: [D] -> Sig -> Sig-oscLins points cps = loopseg cps 0 0 (fmap sig points) ---- | Loops over equally spaced line segments with the given rate.------ > oscElins [a, b, c] === oscLins [a, 1, b, 1, c]-oscElins :: [D] -> Sig -> Sig-oscElins points = oscLins (intersperse 1 points)---- | ------ > oscLine a b cps------ Goes from @a@ to @b@ and back by line segments. One period is equal to @2\/cps@ so that one period is passed by @1\/cps@ seconds.-oscLine :: D -> D -> Sig -> Sig-oscLine a b cps = oscElins [a, b, a] (cps / 2)---- | Loops over exponential segments with the given rate.------ > oscLins [a, durA, typeA, b, durB, typeB, c, durC, typeC ..] cps------ where ------ * @a@, @b@, @c@ ... -- values------ * durA, durB, durC -- durations of the segments relative to the current frequency.------ * typeA, typeB, typeC, ... -- shape of the envelope. If the value is 0 then the shap eis linear; otherwise it is an concave exponential (positive type) or a convex exponential (negative type).-oscExps :: [D] -> Sig -> Sig-oscExps points cps = looptseg cps 0 (fmap sig points)---- | Loops over equally spaced exponential segments with the given rate.------ > oscLins [a, typeA, b, typeB, c, typeC ..] === oscLins [a, 1, typeA, b, 1, typeB, c, 1, typeC ..]-oscEexps :: [D] -> Sig -> Sig-oscEexps points = oscExps (insertOnes points)- where insertOnes xs = case xs of- a:b:as -> a:1:b:insertOnes as- _ -> xs---- | Mean value.-mean :: Fractional a => [a] -> a-mean xs = sum xs / (fromIntegral $ length xs)----- | Adds vibrato to the sound unit. Sound units is a function that takes in a frequency. -vibrate :: Sig -> Sig -> (Sig -> a) -> (Sig -> a)-vibrate vibDepth vibRate f cps = f (cps * (1 + kvib))- where kvib = vibDepth * kr (osc vibRate) ---- | Adds a random vibrato to the sound unit. Sound units is a function that takes in a frequency. -randomPitch :: Sig -> Sig -> (Sig -> a) -> (Sig -> SE a)-randomPitch rndAmp rndCps f cps = fmap go $ randh (cps * rndAmp) rndCps- where go krand = f (cps + krand)----- | Chorus takes a number of copies, chorus width and wave shape.-chorusPitch :: Int -> Sig -> (Sig -> Sig) -> Sig -> Sig-chorusPitch n wid = phi dts- where- phi :: [Sig] -> (Sig -> Sig) -> Sig -> Sig- phi ks f = \cps -> mean $ fmap (f . (+ cps)) ks-- dts = fmap (\x -> - wid + fromIntegral x * dt) [0 .. n-1] -- dt = 2 * wid / fromIntegral n---- | Applies a resonator to the signals. A resonator is--- a list of band pass filters. A list contains the parameters for the filters:------ > [(centerFrequency, bandWidth)]-resons :: [(Sig, Sig)] -> Sig -> Sig-resons = resonsBy bp---- | A resonator with user defined band pass filter.--- Warning: a filter takes in a center frequency, band width and the signal.--- The signal comes last (this order is not standard in the Csound but it's more--- convinient to use with Haskell).-resonsBy :: (cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig-resonsBy filt ps asig = mean $ fmap (( $ asig) . uncurry filt) ps---- | Mixes dry and wet signals. ------ > dryWet ratio effect asig------ * @ratio@ - of dry signal to wet------ * @effect@ - means to wet the signal------ * @asig@ -- processed signal-dryWet :: Sig -> (Sig -> Sig) -> Sig -> Sig-dryWet k ef asig = k * asig + (1 - k) * ef asig----- | Chain of mass-spring-damping filters.------ > modes params baseCps exciter ------ * params - a list of pairs @(resonantFrequencyRatio, filterQuality)@------ * @baseCps@ - base frequency of the resonator------ * exciter - an impulse that starts a resonator.-modes :: [(Sig, Sig)] -> Sig -> Sig -> Sig-modes = relResonsBy (\cf q asig -> mode asig cf q)--relResonsBy :: (Sig -> a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig -> Sig-relResonsBy resonator ms baseCps apulse = (recip normFactor * ) $ sum $ fmap (\(cf, q) -> harm cf q apulse) ms- where - -- limit modal frequency to prevent explosions by - -- skipping if the maximum value is exceeded (with a little headroom)- gate :: Sig -> Sig- gate cps = ifB (sig getSampleRate >* pi * cps) 1 0 -- normFactor = sum $ fmap (gate . (* baseCps) . fst) ms-- -- an ugly hack to make filter stable for forbidden values)- harm cf q x = g * resonator (1 - g + g * cps) q x- where cps = cf * baseCps- g = gate cps ------ | Mono version of the cool reverberation opcode reverbsc.------ > reverbsc1 asig feedbackLevel cutOffFreq-reverbsc1 :: Sig -> Sig -> Sig -> Sig-reverbsc1 x k co = 0.5 * (a + b)- where (a, b) = ar2 $ reverbsc x x k co---------------------------------------------------------------------------- Widgets--data AdsrBound = AdsrBound- { attBound :: Double- , decBound :: Double- , relBound :: Double }--data AdsrInit = AdsrInit- { attInit :: Double- , decInit :: Double- , susInit :: Double- , relInit :: Double }--expEps :: Fractional a => a-expEps = 0.00001--linAdsr :: String -> AdsrBound -> AdsrInit -> Source Sig-linAdsr = genAdsr $ \a d s r -> linsegr [0, a, 1, d, s] r 0--expAdsr :: String -> AdsrBound -> AdsrInit -> Source Sig-expAdsr = genAdsr $ \a d s r -> expsegr [double expEps, a, 1, d, s] r (double expEps)--genAdsr :: (D -> D -> D -> D -> Sig)- -> String -> AdsrBound -> AdsrInit -> Source Sig-genAdsr mkAdsr name b inits = source $ do- (gatt, att) <- knob "A" (linSpan expEps $ attBound b) (attInit inits)- (gdec, dec) <- knob "D" (linSpan expEps $ decBound b) (decInit inits)- (gsus, sus) <- knob "S" (linSpan expEps 1) (susInit inits) - (grel, rel) <- knob "R" (linSpan expEps $ relBound b) (relInit inits)- let val = mkAdsr (ir att) (ir dec) (ir sus) (ir rel)- gui <- setTitle name $ hor [gatt, gdec, gsus, grel]- return (gui, val)---- | A widget with four standard waveforms: pure tone, triangle, square and sawtooth.--- The last parameter is a default waveform (it's set at init time).-classicWaves :: String -> Int -> Source (Sig -> Sig)-classicWaves name initVal = funnyRadio name - [ ("osc", osc)- , ("tri", tri)- , ("sqr", sqr)- , ("saw", saw)]- initVal---- | Slider for master volume-masterVolume :: Source Sig-masterVolume = slider "master" uspan 0.5---- | Knob for master volume-masterVolumeKnob :: Source Sig-masterVolumeKnob = knob "master" uspan 0.5-------------------------------------------------------------------------------- Reverbs---- | Reverb with given time.-reverTime :: Sig -> Sig -> Sig-reverTime dt a = nreverb a dt 0.3 ---- | Mono reverb (based on reverbsc)------ > rever1 feedback asig-rever1 :: Sig -> Sig -> (Sig, Sig)-rever1 fbk a = reverbsc a a fbk 12000---- | Mono reverb (based on reverbsc)------ > rever2 feedback asigLeft asigRight-rever2 :: Sig -> Sig2 -> Sig2-rever2 fbk (a1, a2) = (a1 + wa1, a2 + wa2)- where (wa1, wa2) = reverbsc a1 a2 fbk 12000---- | Mono reverb for small room.-smallRoom :: Sig -> (Sig, Sig)-smallRoom = rever1 0.6---- | Mono reverb for small hall.-smallHall :: Sig -> (Sig, Sig)-smallHall = rever1 0.8---- | Mono reverb for large hall.-largeHall :: Sig -> (Sig, Sig)-largeHall = rever1 0.9---- | The magic cave reverb (mono).-magicCave :: Sig -> (Sig, Sig)-magicCave = rever1 0.99---- | Stereo reverb for small room.-smallRoom2 :: Sig2 -> Sig2-smallRoom2 = rever2 0.6---- | Stereo reverb for small hall.-smallHall2 :: Sig2 -> Sig2-smallHall2 = rever2 0.8---- | Stereo reverb for large hall.-largeHall2 :: Sig2 -> Sig2-largeHall2 = rever2 0.9---- | The magic cave reverb (stereo).-magicCave2 :: Sig2 -> Sig2-magicCave2 = rever2 0.99---- Delays---- | The simplest delay with feedback. Arguments are: delay length and decay ratio.------ > echo delayLength ratio-echo :: D -> Sig -> Sig -> SE Sig-echo len fb = fdelay len fb 1---- | Delay with feedback. ------ > fdelay maxDelayLength delayLength decayRatio-fdelay :: D -> Sig -> Sig -> Sig -> SE Sig-fdelay len = fvdelay len (sig len)----- | Delay with feedback. ------ > fdelay maxDelayLength delayLength feedbackLevel decayRatio-fvdelay :: D -> Sig -> Sig -> Sig -> Sig -> SE Sig-fvdelay len dt fb mx a = do- _ <- delayr len- aDel <- deltap3 dt- delayw $ a + fb * aDel- return $ a + (aDel * mx)---- | Multitap delay. Arguments are: max delay length, list of pairs @(delayLength, decayRatio)@,--- balance of mixed signal with processed signal.------ > fdelay maxDelayLength delays balance asig-fvdelays :: D -> [(Sig, Sig)] -> Sig -> Sig -> SE Sig-fvdelays len dtArgs mx a = funDelays len (zip dts fs) mx a- where - (dts, fbks) = unzip dtArgs- fs = map (*) fbks----- | Generic multitap delay. It's just like @fvdelays@ but instead of constant feedbackLevel --- it expects a function for processing a delayed signal on the tap.------ > fdelay maxDelayLength delays balance asig-funDelays :: D -> [(Sig, Sig -> Sig)] -> Sig -> Sig -> SE Sig-funDelays len dtArgs mx a = do- _ <- delayr len- aDels <- mapM deltap3 dts- delayw $ a + sum (zipWith ($) fs aDels)- return $ a + mx * sum aDels - where (dts, fs) = unzip dtArgs---- Distortion---- | Distortion. ------ > distort distLevel asig-distortion :: Sig -> Sig -> Sig-distortion pre asig = distort1 asig pre 0.5 0 0 `withD` 1---- Chorus---- | Chorus.------ > chorus depth rate balance asig-chorus :: Sig -> Sig -> Sig -> Sig -> SE Sig-chorus depth rate mx asig = do- _ <- delayr 1.2- adelSig <- deltap3 (0.03 * depth * oscBy fn (3 * rate) + 0.01)- delayw asig- return $ ntrpol asig adelSig mx- where fn = sines4 [(0.5, 1, 180, 1)] -- U-shape parabola---- Flanger---- | Flanger. Lfo depth ranges in 0 to 1.------ flanger lfo feedback balance asig-flange :: Lfo -> Sig -> Sig -> Sig -> Sig-flange alfo fbk mx asig = ntrpol asig (flanger asig ulfo fbk) mx- where ulfo = 0.0001 + 0.02 * unipolar alfo---- Phaser---- | First order phaser.-phase1 :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig-phase1 ord alfo fbk mx asig = ntrpol asig (phaser1 asig (20 + unipolar alfo) ord fbk) mx ---- | Second order phaser. Sweeping gaps in the timbre are placed harmonicaly-harmPhase :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig-harmPhase ord alfo q sep fbk mx asig = ntrpol asig (phaser2 asig (20 + unipolar alfo) q ord 1 sep fbk) mx---- | Second order phaser. Sweeping gaps in the timbre are placed by powers of the base frequency.-powerPhase :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig-powerPhase ord alfo q sep fbk mx asig = ntrpol asig (phaser2 asig (20 + unipolar alfo) q ord 2 sep fbk) mx-+import Csound.Air.Wave+import Csound.Air.Envelope+import Csound.Air.Filter+import Csound.Air.Wav+import Csound.Air.Spec+import Csound.Air.Fx+import Csound.Air.Live+import Csound.Air.Misc
+ src/Csound/Air/Envelope.hs view
@@ -0,0 +1,163 @@+-- | Envelopes+module Csound.Air.Envelope (+ leg, xeg,+ -- * Relative duration+ onIdur, lindur, expdur, linendur,+ onDur, lindurBy, expdurBy, linendurBy, + -- * Looping envelopes+ oscLins, oscElins, oscExps, oscEexps, oscLine, + -- * Faders+ fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades,+) where++import Data.List(intersperse)++import Csound.Typed+import Csound.Typed.Opcode+import Csound.Air.Misc++-- | Linear adsr envelope generator with release+--+-- > leg attack decay sustain release+leg :: D -> D -> D -> D -> Sig+leg = madsr++-- | Exponential adsr envelope generator with release+--+-- > xeg attack decay sustain release+xeg :: D -> D -> D -> D -> Sig+xeg a d s r = mxadsr a d (s + 0.00001) r++-- | Makes time intervals relative to the note's duration. So that:+--+-- > onIdur [a, t1, b, t2, c]+--+-- becomes: +--+-- > [a, t1 * idur, b, t2 * idur, c]+onIdur :: [D] -> [D]+onIdur = onDur idur++-- | Makes time intervals relative to the note's duration. So that:+--+-- > onDur dt [a, t1, b, t2, c]+--+-- becomes: +--+-- > [a, t1 * dt, b, t2 * dt, c]+onDur :: D -> [D] -> [D]+onDur dur xs = case xs of+ a:b:as -> a : b * dur : onDur dur as+ _ -> xs++-- | The opcode 'Csound.Opcode.linseg' with time intervals +-- relative to the total duration of the note.+lindur :: [D] -> Sig+lindur = linseg . onIdur++-- | The opcode 'Csound.Opcode.expseg' with time intervals +-- relative to the total duration of the note.+expdur :: [D] -> Sig+expdur = expseg . onIdur++-- | The opcode 'Csound.Opcode.linseg' with time intervals +-- relative to the total duration of the note given by the user.+lindurBy :: D -> [D] -> Sig+lindurBy dt = linseg . onDur dt++-- | The opcode 'Csound.Opcode.expseg' with time intervals +-- relative to the total duration of the note given by the user.+expdurBy :: D -> [D] -> Sig+expdurBy dt = expseg . onDur dt++-- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of idur.+--+-- > linendur asig rise decay+linendur :: Sig -> D -> D -> Sig+linendur = linendurBy idur++-- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of+-- the first argument.+--+-- > linendurBy dt asig rise decay+linendurBy :: D -> Sig -> D -> D -> Sig+linendurBy dt asig ris dec = linen asig (ris * dt) dt (dec * dt)++ +-- | Fades in with the given attack time.+fadeIn :: D -> Sig+fadeIn att = linseg [0, att, 1]++-- | Fades out with the given attack time.+fadeOut :: D -> Sig+fadeOut dec = linsegr [1] dec 0+ +-- | Fades in by exponent with the given attack time.+expFadeIn :: D -> Sig+expFadeIn att = expseg [0.0001, att, 1]++-- | Fades out by exponent with the given attack time.+expFadeOut :: D -> Sig+expFadeOut dec = expsegr [1] dec 0.0001++-- | A combination of fade in and fade out.+--+-- > fades attackDuration decayDuration+fades :: D -> D -> Sig+fades att dec = fadeIn att * fadeOut dec++-- | A combination of exponential fade in and fade out.+--+-- > expFades attackDuration decayDuration+expFades :: D -> D -> Sig+expFades att dec = expFadeIn att * expFadeOut dec+++-- | Loops over line segments with the given rate.+--+-- > oscLins [a, durA, b, durB, c, durC ..] cps+--+-- where +--+-- * @a@, @b@, @c@ ... -- values+--+-- * durA, durB, durC -- durations of the segments relative to the current frequency.+oscLins :: [D] -> Sig -> Sig+oscLins points cps = loopseg cps 0 0 (fmap sig points) ++-- | Loops over equally spaced line segments with the given rate.+--+-- > oscElins [a, b, c] === oscLins [a, 1, b, 1, c]+oscElins :: [D] -> Sig -> Sig+oscElins points = oscLins (intersperse 1 points)++-- | +--+-- > oscLine a b cps+--+-- Goes from @a@ to @b@ and back by line segments. One period is equal to @2\/cps@ so that one period is passed by @1\/cps@ seconds.+oscLine :: D -> D -> Sig -> Sig+oscLine a b cps = oscElins [a, b, a] (cps / 2)++-- | Loops over exponential segments with the given rate.+--+-- > oscLins [a, durA, typeA, b, durB, typeB, c, durC, typeC ..] cps+--+-- where +--+-- * @a@, @b@, @c@ ... -- values+--+-- * durA, durB, durC -- durations of the segments relative to the current frequency.+--+-- * typeA, typeB, typeC, ... -- shape of the envelope. If the value is 0 then the shap eis linear; otherwise it is an concave exponential (positive type) or a convex exponential (negative type).+oscExps :: [D] -> Sig -> Sig+oscExps points cps = looptseg cps 0 (fmap sig points)++-- | Loops over equally spaced exponential segments with the given rate.+--+-- > oscLins [a, typeA, b, typeB, c, typeC ..] === oscLins [a, 1, typeA, b, 1, typeB, c, 1, typeC ..]+oscEexps :: [D] -> Sig -> Sig+oscEexps points = oscExps (insertOnes points)+ where insertOnes xs = case xs of+ a:b:as -> a:1:b:insertOnes as+ _ -> xs
+ src/Csound/Air/Filter.hs view
@@ -0,0 +1,79 @@+-- | Filters+module Csound.Air.Filter(+ -- | Arguemnts are inversed to get most out of curruing. First come parameters and the last one is the signal.+ + -- * Simple filters+ lp, hp, bp, br, alp,+ + -- * Butterworth filters+ blp, bhp, bbp, bbr,++ -- * Specific filters+ mlp+) where++import Csound.Typed+import Csound.Typed.Opcode++-- | Low-pass filter.+--+-- > lp cutoff resonance sig+lp :: Sig -> Sig -> Sig -> Sig+lp cf q a = bqrez a cf q++-- | High-pass filter.+--+-- > hp cutoff resonance sig+hp :: Sig -> Sig -> Sig -> Sig+hp cf q a = bqrez a cf q `withD` 1++-- | Band-pass filter.+--+-- > bp cutoff resonance sig+bp :: Sig -> Sig -> Sig -> Sig+bp cf q a = bqrez a cf q `withD` 2++-- | Band-reject filter.+--+-- > br cutoff resonance sig+br :: Sig -> Sig -> Sig -> Sig+br cf q a = bqrez a cf q `withD` 3++-- | All-pass filter.+--+-- > alp cutoff resonance sig+alp :: Sig -> Sig -> Sig -> Sig+alp cf q a = bqrez a cf q `withD` 4++-- Butterworth filters++-- | High-pass filter.+--+-- > bhp cutoff sig+bhp :: Sig -> Sig -> Sig+bhp = flip buthp++-- | Low-pass filter.+--+-- > blp cutoff sig+blp :: Sig -> Sig -> Sig+blp = flip butlp++-- | Band-pass filter.+--+-- > bbp cutoff bandwidth sig+bbp :: Sig -> Sig -> Sig -> Sig+bbp freq band a = butbp a freq band++-- | Band-regect filter.+--+-- > bbr cutoff bandwidth sig+bbr :: Sig -> Sig -> Sig -> Sig +bbr freq band a = butbr a freq band+++-- | Moog's low-pass filter.+--+-- > mlp centerFrequency qResonance signal+mlp :: Sig -> Sig -> Sig -> Sig+mlp cf q asig = moogladder asig cf q
+ src/Csound/Air/Fx.hs view
@@ -0,0 +1,427 @@+-- | Effects+module Csound.Air.Fx( + -- * Reverbs+ reverbsc1, rever1, rever2, reverTime,+ smallRoom, smallHall, largeHall, magicCave,+ smallRoom2, smallHall2, largeHall2, magicCave2,++ -- * Delays+ echo, fdelay, fvdelay, fvdelays, funDelays,++ -- * Distortion+ distortion,++ -- * Chorus+ chorus,++ -- * Flanger+ flange,++ -- * Phase+ phase1, harmPhase, powerPhase,++ -- * Effects with unit parameters+ fxDistort, fxDistort2, stChorus2, fxPhaser, fxPhaser2,+ fxFlanger, fxFlanger2, analogDelay, analogDelay2, fxEcho, fxEcho2,+ fxFilter, fxFilter2,+ fxWhite, fxWhite2, fxPink, fxPink2, equalizer, equalizer2, eq4, eq7,+ fxGain ++) where++import Csound.Typed+import Csound.Tab(sines4, startEnds, setSize, elins)+import Csound.Typed.Opcode+import Csound.Types(Sig2)+import Csound.SigSpace++import Csound.Air.Wave(Lfo, unipolar, oscBy, utri, white, pink)+import Csound.Air.Filter+import Csound.Air.Misc(mean)++-- | Mono version of the cool reverberation opcode reverbsc.+--+-- > reverbsc1 asig feedbackLevel cutOffFreq+reverbsc1 :: Sig -> Sig -> Sig -> Sig+reverbsc1 x k co = 0.5 * (a + b)+ where (a, b) = ar2 $ reverbsc x x k co+++---------------------------------------------------------------------------+-- Reverbs++-- | Reverb with given time.+reverTime :: Sig -> Sig -> Sig+reverTime dt a = nreverb a dt 0.3 ++-- | Mono reverb (based on reverbsc)+--+-- > rever1 feedback asig+rever1 :: Sig -> Sig -> (Sig, Sig)+rever1 fbk a = reverbsc a a fbk 12000++-- | Mono reverb (based on reverbsc)+--+-- > rever2 feedback asigLeft asigRight+rever2 :: Sig -> Sig2 -> Sig2+rever2 fbk (a1, a2) = (a1 + wa1, a2 + wa2)+ where (wa1, wa2) = reverbsc a1 a2 fbk 12000++-- | Mono reverb for small room.+smallRoom :: Sig -> (Sig, Sig)+smallRoom = rever1 0.6++-- | Mono reverb for small hall.+smallHall :: Sig -> (Sig, Sig)+smallHall = rever1 0.8++-- | Mono reverb for large hall.+largeHall :: Sig -> (Sig, Sig)+largeHall = rever1 0.9++-- | The magic cave reverb (mono).+magicCave :: Sig -> (Sig, Sig)+magicCave = rever1 0.99++-- | Stereo reverb for small room.+smallRoom2 :: Sig2 -> Sig2+smallRoom2 = rever2 0.6++-- | Stereo reverb for small hall.+smallHall2 :: Sig2 -> Sig2+smallHall2 = rever2 0.8++-- | Stereo reverb for large hall.+largeHall2 :: Sig2 -> Sig2+largeHall2 = rever2 0.9++-- | The magic cave reverb (stereo).+magicCave2 :: Sig2 -> Sig2+magicCave2 = rever2 0.99++-- Delays++-- | The simplest delay with feedback. Arguments are: delay length and decay ratio.+--+-- > echo delayLength ratio+echo :: D -> Sig -> Sig -> SE Sig+echo len fb = fdelay len fb 1++-- | Delay with feedback. +--+-- > fdelay delayLength decayRatio balance+fdelay :: D -> Sig -> Sig -> Sig -> SE Sig+fdelay len = fvdelay len (sig len)++-- | Delay with feedback. +--+-- > fdelay maxDelayLength delayLength feedback balance+fvdelay :: D -> Sig -> Sig -> Sig -> Sig -> SE Sig+fvdelay len dt fb mx a = do+ _ <- delayr len+ aDel <- deltap3 dt+ delayw $ a + fb * aDel+ return $ a + (aDel * mx)++-- | Multitap delay. Arguments are: max delay length, list of pairs @(delayLength, decayRatio)@,+-- balance of mixed signal with processed signal.+--+-- > fdelay maxDelayLength delays balance asig+fvdelays :: D -> [(Sig, Sig)] -> Sig -> Sig -> SE Sig+fvdelays len dtArgs mx a = funDelays len (zip dts fs) mx a+ where + (dts, fbks) = unzip dtArgs+ fs = map (*) fbks+++-- | Generic multitap delay. It's just like @fvdelays@ but instead of constant feedbackLevel +-- it expects a function for processing a delayed signal on the tap.+--+-- > fdelay maxDelayLength delays balance asig+funDelays :: D -> [(Sig, Sig -> Sig)] -> Sig -> Sig -> SE Sig+funDelays len dtArgs mx a = do+ _ <- delayr len+ aDels <- mapM deltap3 dts+ delayw $ a + sum (zipWith ($) fs aDels)+ return $ a + mx * sum aDels + where (dts, fs) = unzip dtArgs++-- Distortion++-- | Distortion. +--+-- > distort distLevel asig+distortion :: Sig -> Sig -> Sig+distortion pre asig = distort1 asig pre 0.5 0 0 `withD` 1++-- Chorus++-- | Chorus.+--+-- > chorus depth rate balance asig+chorus :: Sig -> Sig -> Sig -> Sig -> SE Sig+chorus depth rate mx asig = do+ _ <- delayr 1.2+ adelSig <- deltap3 (0.03 * depth * oscBy fn (3 * rate) + 0.01)+ delayw asig+ return $ ntrpol asig adelSig mx+ where fn = sines4 [(0.5, 1, 180, 1)] -- U-shape parabola++-- Flanger++-- | Flanger. Lfo depth ranges in 0 to 1.+--+-- flanger lfo feedback balance asig+flange :: Lfo -> Sig -> Sig -> Sig -> Sig+flange alfo fbk mx asig = ntrpol asig (flanger asig ulfo fbk) mx+ where ulfo = 0.0001 + 0.02 * unipolar alfo++-- Phaser++-- | First order phaser.+phase1 :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig+phase1 ord alfo fbk mx asig = ntrpol asig (phaser1 asig (20 + unipolar alfo) ord fbk) mx ++-- | Second order phaser. Sweeping gaps in the timbre are placed harmonicaly+harmPhase :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig+harmPhase ord alfo q sep fbk mx asig = ntrpol asig (phaser2 asig (20 + unipolar alfo) q ord 1 sep fbk) mx++-- | Second order phaser. Sweeping gaps in the timbre are placed by powers of the base frequency.+powerPhase :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig+powerPhase ord alfo q sep fbk mx asig = ntrpol asig (phaser2 asig (20 + unipolar alfo) q ord 2 sep fbk) mx+++-----------------------------------------------------------------+-- new effects++expScale :: Sig -> (Sig, Sig) -> Sig -> Sig+expScale steep (min, max) a = scale (expcurve a steep) max min++logScale :: Sig -> (Sig, Sig) -> Sig -> Sig+logScale steep (min, max) a = scale (logcurve a steep) max min++dryWetMix :: Sig -> (Sig, Sig)+dryWetMix kmix = (kDry, kWet) + where+ iWet = setSize 1024 $ elins [0, 1, 1]+ iDry = setSize 1024 $ elins [1, 1, 0]+ kWet = kr $ table kmix iWet `withD` 1+ kDry = kr $ table kmix iDry `withD` 1++fxWet :: (Num a, SigSpace a) => Sig -> a -> a -> a+fxWet mix ain aout = mul dry ain + mul wet aout+ where (dry, wet) = dryWetMix mix++-- Distortion ++-- | Distortion+--+-- > fxDistort level drive tone sigIn+fxDistort :: Sig -> Sig -> Sig -> Sig -> Sig+fxDistort klevel kdrive ktone ain = aout * (scale klevel 0.8 0) * kGainComp1+ where+ aout = blp kLPF $ distort1 ain kpregain kpostgain 0 0++ drive = expScale 8 (0.01, 0.4) kdrive+ kGainComp1 = logScale 700 (5,1) ktone++ kpregain = 100 * drive+ kpostgain = 0.5 * ((1 - drive) * 0.4 + 0.6)++ kLPF = logScale 700 (200, 12000) ktone++-- | Stereo distortion.+fxDistort2 :: Sig -> Sig -> Sig -> Sig2 -> Sig2+fxDistort2 klevel kdrive ktone (al, ar) = (fx al, fx ar)+ where fx = fxDistort klevel kdrive ktone++-- Stereo chorus+++-- | Stereo chorus.+--+-- > stChorus2 mix rate depth width sigIn+stChorus2 :: Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2+stChorus2 kmix krate' kdepth kwidth (al, ar) = fxWet kmix (al, ar) (aoutL, aoutR)+ where + krate = expScale 20 (0.001, 7) krate'+ ilfoshape = setSize 131072 $ sines4 [(1, 0.5, 0, 0.5)]+ kporttime = linseg [0, 0.001, 0.02]+ kChoDepth = interp $ portk (kdepth*0.01) kporttime+ amodL = osciliktp krate ilfoshape 0+ amodR = osciliktp krate ilfoshape (kwidth*0.5)+ vdel mod x = vdelay x (mod * kChoDepth * 1000) (1.2 * 1000)+ aChoL = vdel amodL al+ aChoR = vdel amodR ar+ aoutL = 0.6 * (aChoL + al)+ aoutR = 0.6 * (aChoR + ar)++-- Phaser++-- | Phaser+--+-- > fxPhaser mix rate depth freq feedback sigIn+fxPhaser :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig+fxPhaser kmix fb krate' kdepth kfreq ain = fxWet kmix ain aout+ where + krate = expScale 10 (0.01, 14) krate'+ klfo = kdepth * utri krate+ aout = phaser1 ain (cpsoct $ klfo + kfreq) 8 fb ++-- | Stereo phaser.+fxPhaser2 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2+fxPhaser2 kmix fb krate kdepth kfreq (al, ar) = (fx al, fx ar)+ where fx = fxPhaser kmix fb krate kdepth kfreq ++-- Flanger++-- | Flanger+--+-- > fxFlanger mix feedback rate depth delay sigIn+fxFlanger :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig+fxFlanger kmix kfback krate' kdepth kdelay' ain = fxWet kmix ain aout+ where+ krate = expScale 50 (0.001, 14) krate'+ kdelay = expScale 200 (0.0001, 0.1) kdelay'+ ilfoshape = setSize 131072 $ sines4 [(0.5, 1, 180, 1)]+ kporttime = linseg [0, 0.001, 0.1]+ adlt = interp $ portk kdelay kporttime+ kdep = portk (kdepth*0.01) kporttime + amod = oscili kdep krate ilfoshape + adelsig = flanger ain (adlt + amod) kfback `withD` 1.2+ aout = mean [ain, adelsig]++-- | Stereo flanger+fxFlanger2 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2+fxFlanger2 kmix kfback krate kdepth kdelay (al ,ar) = (fx al, fx ar)+ where fx = fxFlanger kmix kfback krate kdepth kdelay++-- Analog delay++-- | Analog delay.+--+-- > analogDelay mix feedback time tone sigIn+analogDelay :: Sig -> Sig -> Sig -> Sig -> Sig -> SE Sig+analogDelay kmix kfback ktime ktone' ain = do+ aBuffer <- delayr 5+ atap <- deltap3 aTime+ let atap1 = tone (clip atap 0 1) kTone+ delayw $ ain + atap1*kfback+ return $ ain*kDry + atap1 * kWet+ where+ ktone = expScale 4 (100, 12000) ktone'+ (kDry, kWet) = dryWetMix kmix+ kporttime = linseg [0,0.001,0.1]+ kTime = portk ktime (kporttime*3)+ kTone = portk ktone kporttime+ aTime = interp kTime++-- | Stereo analog delay.+analogDelay2 :: Sig -> Sig -> Sig -> Sig -> Sig2 -> SE Sig2+analogDelay2 kmix kfback ktime ktone = bindSig fx+ where fx = analogDelay kmix kfback ktime ktone ++-- Filter++-- | Filter effect (a pair of butterworth low and high pass filters).+--+-- > fxFilter lowPassfFreq highPassFreq gain +fxFilter :: Sig -> Sig -> Sig -> Sig -> Sig+fxFilter kLPF' kHPF' kgain' ain = mul kgain $ app (blp kLPF) $ app (bhp kHPF) $ ain + where + app f = f . f+ kLPF = scaleFreq kLPF' + kHPF = scaleFreq kHPF' + kgain = scale kgain' 20 0+ scaleFreq x = expScale 4 (20, 20000) x++-- | Stereo filter effect (a pair of butterworth low and high pass filters).+fxFilter2 :: Sig -> Sig -> Sig -> Sig2 -> Sig2+fxFilter2 kLPF kHPF kgain (al, ar) = (fx al, fx ar)+ where fx = fxFilter kLPF kHPF kgain++-- Equalizer++-- | Equalizer+--+-- > equalizer gainsAndFrequencies gain sigIn+equalizer :: [(Sig, Sig)] -> Sig -> Sig -> Sig+equalizer fs gain ain0 = case fs of+ [] -> ain+ x:[] -> g 0 x ain+ x:y:[] -> mean [g 1 x ain, g 2 y ain]+ x:xs -> mean $ (g 1 x ain : ) $ (fmap (\y -> g 0 y ain) (init xs)) ++ [g 2 (last xs) ain]+ where+ iQ = 1+ iEQcurve = skipNorm $ setSize 4096 $ startEnds [1/64,4096,7.9,64]+ iGainCurve = skipNorm $ setSize 4096 $ startEnds [0.5,4096,3,4]+ g ty (gain, freq) asig = pareq asig freq (table gain iEQcurve `withD` 1) iQ `withD` ty+ kgain = table gain iGainCurve `withD` 1+ ain = kgain * ain0++-- | Stereo equalizer.+equalizer2 :: [(Sig, Sig)] -> Sig -> Sig2 -> Sig2+equalizer2 fs gain (al, ar) = (fx al, fx ar)+ where fx = equalizer fs gain++-- | Equalizer with frequencies: 100, 200, 400, 800, 1600, 3200, 6400+eq7 :: [Sig] -> Sig -> Sig2 -> Sig2+eq7 gs = equalizer2 (zip gs $ fmap (100 * ) [1, 2, 4, 8, 16, 32, 64])++-- | Equalizer with frequencies: 100, 400, 1600, 6400+eq4 :: [Sig] -> Sig -> Sig2 -> Sig2+eq4 gs = equalizer2 (zip gs $ fmap (100 * ) [1, 4, 16, 64])++-- | Gain+--+-- > fxGain gain sigIn+fxGain :: Sig -> Sig2 -> Sig2+fxGain = mul+++-- Noise++-- | Adds filtered white noize to the signal+--+-- > fxWhite lfoFreq depth sigIn+fxWhite :: Sig -> Sig -> Sig -> SE Sig+fxWhite freq depth ain = do+ noise <- white+ return $ ain + 0.5 * depth * blp cps noise+ where cps = expScale 4 (20, 20000) freq++-- | Adds filtered white noize to the stereo signal+fxWhite2 ::Sig -> Sig -> Sig2 -> SE Sig2+fxWhite2 freq depth = bindSig fx + where fx = fxWhite freq depth++-- | Adds filtered pink noize to the signal+--+-- > fxWhite lfoFreq depth sigIn+fxPink :: Sig -> Sig -> Sig -> SE Sig+fxPink freq depth ain = do+ noise <- pink+ return $ ain + 0.5 * depth * blp cps noise+ where cps = expScale 4 (20, 20000) freq++-- | Adds filtered pink noize to the stereo signal+fxPink2 ::Sig -> Sig -> Sig2 -> SE Sig2+fxPink2 freq depth = bindSig fx + where fx = fxPink freq depth++-- Echo++-- | Simplified delay+--+-- > fxEcho maxDelayLength delTime feedback sigIn+fxEcho :: D -> Sig -> Sig -> Sig -> SE Sig+fxEcho maxLen ktime fback = fvdelay (5 * maxLen) (sig maxLen * 0.95 * kTime) fback 1 + where+ kporttime = linseg [0,0.001,0.1]+ kTime = portk ktime (kporttime*3)++-- | Simplified stereo delay.+fxEcho2 :: D -> Sig -> Sig -> Sig2 -> SE Sig2+fxEcho2 maxLen ktime fback = bindSig fx+ where fx = fxEcho maxLen ktime fback+
+ src/Csound/Air/Live.hs view
@@ -0,0 +1,356 @@+{-# Language TypeSynonymInstances, FlexibleInstances #-}+-- | UIs for live performances+module Csound.Air.Live (+ -- * Mixer+ mixer, hmixer, mixMono,++ -- * Effects+ FxFun, FxUI(..), fxBox,+ fxColor, fxVer, fxHor, fxSca, fxApp,++ -- ** Fx units+ uiDistort, uiChorus, uiFlanger, uiPhaser, uiDelay, uiEcho,+ uiFilter, uiReverb, uiGain, uiWhite, uiPink, uiFx, uiRoom,+ uiHall, uiCave, uiSig, uiMix,++ -- * Static widgets+ AdsrBound(..), AdsrInit(..),+ linAdsr, expAdsr, + classicWaves,+ masterVolume, masterVolumeKnob+) where++import Control.Monad++import Data.Colour+import Data.Boolean+import qualified Data.Colour.Names as C++import Csound.Typed+import Csound.Typed.Gui+import Csound.Control.Gui(funnyRadio, mapSource)+import Csound.Typed.Opcode hiding (space)+import Csound.Types(Sig2)+import Csound.SigSpace+import Csound.Air.Wave+import Csound.Air.Fx+import Csound.Air.Misc++----------------------------------------------------------------------+-- mixer++-- | The stereo signal processing function.+type FxFun = Sig2 -> SE Sig2++instance SigSpace FxFun where+ mapSig f g = fmap (mapSig f) . g +++-- | Widget that represents a mixer.+mixer :: [(String, SE Sig2)] -> Source Sig2+mixer = genMixer (ver, hor)++-- | Widget that represents a mixer with horizontal grouping of elements.+hmixer :: [(String, SE Sig2)] -> Source Sig2+hmixer = genMixer (hor, ver)++genMixer :: ([Gui] -> Gui, [Gui] -> Gui) -> [(String, SE Sig2)] -> Source Sig2+genMixer (parentGui, childGui) as = source $ do+ gTags <- mapM box names+ (gs, vols) <- fmap unzip $ mapM (const $ defSlider "") names+ (gMutes, mutes) <- fmap unzip $ mapM (const $ toggleSig "" False) names++ gMasterTag <- box "master"+ (gMaster, masterVol) <- defSlider ""+ (gMasterMute, masterMute) <- toggleSig "" False + let g = parentGui $ zipWith3 (\tag slid mute -> childGui [sca 0.8 tag, sca 8 slid, sca 1.1 mute]) + (gMasterTag : gTags) (gMaster : gs) (gMasterMute : gMutes)+ muteVols = zipWith appMute mutes vols+ masterMuteVol = appMute masterMute masterVol+ res <- mul masterMuteVol $ mean $ zipWith mul muteVols sigs+ return (g, res)+ where + (names, sigs) = unzip as+ appMute mute vol = (port (1 - mute) 0.05) * vol++-- | Transforms the mono signal to the stereo input+-- for the mixer widget.+mixMono :: String -> Sig -> (String, SE Sig2)+mixMono name asig = (name, return (asig, asig))++defSlider :: String -> Source Sig+defSlider tag = slider tag (linSpan 0 1) 0.5++----------------------------------------------------------------------+-- effects++class FxUI a where+ applyFxArgs :: a -> [Sig] -> Sig2 -> SE Sig2+ arityFx :: a -> Int++instance FxUI (Sig2 -> Sig2) where+ applyFxArgs f _ x = return $ f x+ arityFx = const 0++instance FxUI FxFun where+ applyFxArgs f _ x = f x+ arityFx = const 0++instance FxUI a => FxUI (Sig -> a) where+ applyFxArgs f (a:as) x = applyFxArgs (f a) as x+ arityFx f = 1 + arityFx (proxy f)+ where + proxy :: (a -> b) -> b+ proxy _ = undefined++-- | Creates a widget that represents a stereo signal processing function.+-- The parameters of the widget are updated with sliders.+-- For example let's create a simple gain widget. It can be encoded like this:+--+-- > uiGain :: Bool -> Double -> Source FxFun+-- > uiGain isOn gain = fxBox "Gain" fx isOn [("gain", gain)]+-- > where +-- > fx :: Sig -> Sig2 -> Sig2+-- > fx = mul+--+-- Let's look at the arguments of the function+--+-- > fxBox name fx isOn args+--+-- * @name@ -- is the name of the widget+--+-- * @fx@ -- is signal processing function (see the class @FxUI@). +--+-- * @isOn@ -- whether widget in the active state+-- +-- * @args@ -- list of initial values for arguments and names of the arguments.+--+-- It's cool to set the color of the widget with @fxColor@ function.+-- we can make our widgets much more intersting to look at.+fxBox :: FxUI a => String -> a -> Bool -> [(String, Double)] -> Source FxFun+fxBox name fx onOff args = source $ do+ (gOff0, off) <- toggleSig name onOff+ let gOff = setFontSize 25 gOff0+ offRef <- newGlobalSERef (0 :: Sig)+ writeSERef offRef off+ let (names, initVals) = unzip $ take (arityFx fx) args + (gs, as) <- fmap unzip $ mapM (\(name, initVal) -> slider name (linSpan 0 1) initVal) $ zip names initVals + let f x = do+ ref <- newSERef (0 :: Sig, 0 :: Sig)+ goff <- readSERef offRef+ writeSERef ref x + when1 (goff ==* 1) $ do+ x2 <- readSERef ref+ writeSERef ref =<< applyFxArgs fx as x2+ res <- readSERef ref + return res + let gui = setBorder UpBoxBorder $ go (length names) gOff gs+ return (gui, f)+ where + go n gOff gs+ | n == 0 = gOff+ | n < 4 = f (gs ++ replicate (4 - n) space)+ | otherwise = f gs+ where f xs = uiGroupGui gOff (ver xs)++uiGroupGui :: Gui -> Gui -> Gui +uiGroupGui a b =ver [sca 1.7 a, sca 8 b]++sourceColor2 :: Color -> Source a -> Source a+sourceColor2 col a = source $ do+ (g, x) <- a+ return (setColor2 col g, x)++-- | Colors the source widgets.+fxColor :: Color -> Source a -> Source a+fxColor = sourceColor2++-- combine effects++fxGroup :: ([Gui] -> Gui) -> [Source FxFun] -> Source FxFun+fxGroup guiGroup as = do+ (gs, fs) <- fmap unzip $ sequence as + return (guiGroup gs, foldl (\a b -> a >=> b) return fs)++-- | Scales the gui for signal processing widgets.+fxSca :: Double -> Source FxFun -> Source FxFun+fxSca d a = fxGroup (\xs -> sca d $ head xs) [a]++-- | Groups the signal processing widgets. +-- The functions are composed the visuals are+-- grouped horizontaly.+fxHor :: [Source FxFun] -> Source FxFun+fxHor = fxGroup hor++-- | Groups the signal processing widgets. +-- The functions are composed the visuals are+-- grouped verticaly.+fxVer :: [Source FxFun] -> Source FxFun+fxVer = fxGroup ver++-- | Applies a function to a signal processing function.+fxApp :: FxFun -> Source FxFun -> Source FxFun +fxApp f = mapSource (>=> f)++-- | The distortion widget. The arguments are+--+-- > uiDistort isOn levelOfDistortion drive tone+uiDistort :: Bool -> Double -> Double -> Double -> Source FxFun+uiDistort isOn level drive tone = sourceColor2 C.red $ fxBox "Distortion" fxDistort2 isOn + [("level", level), ("drive", drive), ("tone", tone)]++-- | The chorus widget. The arguments are+--+-- > uiChorus isOn mix rate depth width +uiChorus :: Bool -> Double -> Double -> Double -> Double -> Source FxFun+uiChorus isOn mix rate depth width = sourceColor2 C.coral $ fxBox "Chorus" stChorus2 isOn+ [("mix",mix), ("rate",rate), ("depth",depth), ("width",width)]++-- | The flanger widget. The arguments are+--+-- > uiFlanger isOn mix feedback rate depth delay+uiFlanger :: Bool -> Double -> Double -> Double -> Double -> Double -> Source FxFun+uiFlanger isOn mix fback rate depth delay = sourceColor2 C.indigo $ fxBox "Flanger" fxFlanger2 isOn+ [("mix", mix), ("fback", fback), ("rate",rate), ("depth",depth), ("delay",delay)] ++-- | The phaser widget. The arguments are+--+-- > uiPhaser isOn mix feedback rate depth frequency+uiPhaser :: Bool -> Double -> Double -> Double -> Double -> Double -> Source FxFun+uiPhaser isOn mix fback rate depth freq = sourceColor2 C.orange $ fxBox "Phaser" fxPhaser2 isOn+ [("mix", mix), ("fback", fback), ("rate",rate), ("depth",depth), ("freq", freq)]++-- | The delay widget. The arguments are+--+-- > uiDelay isOn mix feedback delayTime tone+uiDelay :: Bool -> Double -> Double -> Double -> Double -> Source FxFun+uiDelay isOn mix fback time tone = sourceColor2 C.dodgerblue $ fxBox "Delay" analogDelay2 isOn+ [("mix",mix), ("fback",fback), ("time",time), ("tone",tone)]++-- | The simplified delay widget. The arguments are+--+-- > uiEcho isOn maxDelayTime delayTime feedback+uiEcho :: Bool -> D -> Double -> Double -> Source FxFun+uiEcho isOn maxDelTime time fback = sourceColor2 C.deepskyblue $ fxBox "Echo" (fxEcho2 maxDelTime) isOn+ [("time", time), ("fback", fback)]++-- | The pair of low and high pass filters+--+-- > uiFilter isOn lowPassfrequency highPassFrequency gain+uiFilter :: Bool -> Double -> Double -> Double -> Source FxFun+uiFilter isOn lpf hpf gain = fxBox "Filter" fxFilter2 isOn+ [("lpf",lpf), ("hpf",hpf), ("gain",gain)]++-- | The reverb widget. The arguments are:+--+-- > uiReverb mix depth+uiReverb :: Bool -> Double -> Double -> Source FxFun+uiReverb isOn mix depth = sourceColor2 C.forestgreen $ fxBox "Reverb" (\mix depth asig -> mul (1 - mix) asig + mul mix (rever2 depth asig)) isOn+ [("mix", mix), ("depth", depth)]++-- | The gain widget. The arguments are+--+-- > uiGain isOn amountOfGain+uiGain :: Bool -> Double -> Source FxFun+uiGain isOn gain = sourceColor2 C.black $ fxBox "Gain" fxGain isOn [("gain", gain)]++-- | The filtered white noize widget. The arguments are+--+-- > uiWhite isOn centerFreqOfFilter amountOfNoize +uiWhite :: Bool -> Double -> Double -> Source FxFun+uiWhite isOn freq depth = sourceColor2 C.dimgray $ fxBox "White" fxWhite2 isOn + [("freq", freq), ("depth", depth)]++-- | The filtered pink noize widget. The arguments are+--+-- > uiPink isOn centerFreqOfFilter amountOfNoize +uiPink :: Bool -> Double -> Double -> Source FxFun+uiPink isOn freq depth = sourceColor2 C.deeppink $ fxBox "Pink" fxPink2 isOn+ [("freq", freq), ("depth", depth)]++-- | The constructor for signal processing functions with no arguments (controlls).+uiFx :: FxUI a => String -> a -> Bool -> Source FxFun+uiFx name f isOn = fxBox name f isOn [] ++-- | The reverb for room.+uiRoom :: Bool -> Source FxFun+uiRoom isOn = sourceColor2 C.limegreen $ uiFx "Room" smallRoom2 isOn++-- | The reverb for hall.+uiHall :: Bool -> Source FxFun+uiHall isOn = sourceColor2 C.mediumseagreen $ uiFx "Hall" largeHall2 isOn++-- | The reverb for magic cave.+uiCave :: Bool -> Source FxFun+uiCave isOn = sourceColor2 C.darkviolet $ uiFx "Cave" magicCave2 isOn++-- | The widget for selecting a midi instrument. +uiMidi :: Bool -> [(String, Msg -> SE Sig2)] -> Source FxFun+uiMidi isOn as = sourceColor2 C.forestgreen $ undefined++-- | the widget for mixing in a signal to the signal.+uiSig :: String -> Bool -> Source Sig2 -> Source FxFun+uiSig name onOff widget = source $ do+ (gs, asig) <- widget+ (gOff0, off) <- toggleSig name onOff+ let gOff = setFontSize 25 gOff0 + f x = return $ x + mul (portk off 0.05) asig + return (setBorder UpBoxBorder $ uiGroupGui gOff gs, f)++-- | A mixer widget represented as an effect.+-- The effect sums the signals with given wieghts.+uiMix :: Bool -> [(String, SE Sig2)] -> Source FxFun+uiMix onOff as = sourceColor2 C.blue $ uiSig "Mix" onOff (mixer as)++----------------------------------------------------------------------+-- Widgets++data AdsrBound = AdsrBound+ { attBound :: Double+ , decBound :: Double+ , relBound :: Double }++data AdsrInit = AdsrInit+ { attInit :: Double+ , decInit :: Double+ , susInit :: Double+ , relInit :: Double }++expEps :: Fractional a => a+expEps = 0.00001++linAdsr :: String -> AdsrBound -> AdsrInit -> Source Sig+linAdsr = genAdsr $ \a d s r -> linsegr [0, a, 1, d, s] r 0++expAdsr :: String -> AdsrBound -> AdsrInit -> Source Sig+expAdsr = genAdsr $ \a d s r -> expsegr [double expEps, a, 1, d, s] r (double expEps)++genAdsr :: (D -> D -> D -> D -> Sig)+ -> String -> AdsrBound -> AdsrInit -> Source Sig+genAdsr mkAdsr name b inits = source $ do+ (gatt, att) <- knob "A" (linSpan expEps $ attBound b) (attInit inits)+ (gdec, dec) <- knob "D" (linSpan expEps $ decBound b) (decInit inits)+ (gsus, sus) <- knob "S" (linSpan expEps 1) (susInit inits) + (grel, rel) <- knob "R" (linSpan expEps $ relBound b) (relInit inits)+ let val = mkAdsr (ir att) (ir dec) (ir sus) (ir rel)+ gui <- setTitle name $ hor [gatt, gdec, gsus, grel]+ return (gui, val)++-- | A widget with four standard waveforms: pure tone, triangle, square and sawtooth.+-- The last parameter is a default waveform (it's set at init time).+classicWaves :: String -> Int -> Source (Sig -> Sig)+classicWaves name initVal = funnyRadio name + [ ("osc", osc)+ , ("tri", tri)+ , ("sqr", sqr)+ , ("saw", saw)]+ initVal++-- | Slider for master volume+masterVolume :: Source Sig+masterVolume = slider "master" uspan 0.5++-- | Knob for master volume+masterVolumeKnob :: Source Sig+masterVolumeKnob = knob "master" uspan 0.5+
+ src/Csound/Air/Misc.hs view
@@ -0,0 +1,123 @@+-- | Patterns+module Csound.Air.Misc(+ mean, vibrate, randomPitch, chorusPitch, resons, resonsBy, modes, dryWet, + once, onceBy, several, fromMono,+ -- * List functions+ odds, evens+) where++import Data.Boolean++import Csound.Typed+import Csound.Typed.Opcode+import Csound.Air.Wave+import Csound.Air.Filter++--------------------------------------------------------------------------+-- patterns++-- | Selects odd elements from the list.+odds :: [a] -> [a]+odds as = fmap snd $ filter fst $ zip (cycle [True, False]) as ++-- | Selects even elements from the list.+evens :: [a] -> [a]+evens as + | null as = []+ | otherwise = odds $ tail as++-- | Reads table once during the note length. +once :: Tab -> Sig+once = onceBy idur++-- | Reads table once during a given period of time. +onceBy :: D -> Tab -> Sig+onceBy dt tb = kr $ oscBy tb (1 / sig dt) ++-- | Reads table several times during the note length. +several :: Tab -> Sig -> Sig+several tb rate = kr $ oscil3 1 (rate / sig idur) tb++-- | Mean value.+mean :: Fractional a => [a] -> a+mean xs = sum xs / (fromIntegral $ length xs)++-- | Adds vibrato to the sound unit. Sound units is a function that takes in a frequency. +vibrate :: Sig -> Sig -> (Sig -> a) -> (Sig -> a)+vibrate vibDepth vibRate f cps = f (cps * (1 + kvib))+ where kvib = vibDepth * kr (osc vibRate) ++-- | Adds a random vibrato to the sound unit. Sound units is a function that takes in a frequency. +randomPitch :: Sig -> Sig -> (Sig -> a) -> (Sig -> SE a)+randomPitch rndAmp rndCps f cps = fmap go $ randh (cps * rndAmp) rndCps+ where go krand = f (cps + krand)++-- | Chorus takes a number of copies, chorus width and wave shape.+chorusPitch :: Int -> Sig -> (Sig -> Sig) -> Sig -> Sig+chorusPitch n wid = phi dts+ where+ phi :: [Sig] -> (Sig -> Sig) -> Sig -> Sig+ phi ks f = \cps -> mean $ fmap (f . (+ cps)) ks++ dts = fmap (\x -> - wid + fromIntegral x * dt) [0 .. n-1] ++ dt = 2 * wid / fromIntegral n+++-- | Applies a resonator to the signals. A resonator is+-- a list of band pass filters. A list contains the parameters for the filters:+--+-- > [(centerFrequency, bandWidth)]+resons :: [(Sig, Sig)] -> Sig -> Sig+resons = resonsBy bp++-- | A resonator with user defined band pass filter.+-- Warning: a filter takes in a center frequency, band width and the signal.+-- The signal comes last (this order is not standard in the Csound but it's more+-- convinient to use with Haskell).+resonsBy :: (cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig+resonsBy filt ps asig = mean $ fmap (( $ asig) . uncurry filt) ps++-- | Mixes dry and wet signals. +--+-- > dryWet ratio effect asig+--+-- * @ratio@ - of dry signal to wet+--+-- * @effect@ - means to wet the signal+--+-- * @asig@ -- processed signal+dryWet :: Sig -> (Sig -> Sig) -> Sig -> Sig+dryWet k ef asig = k * asig + (1 - k) * ef asig+++-- | Chain of mass-spring-damping filters.+--+-- > modes params baseCps exciter +--+-- * params - a list of pairs @(resonantFrequencyRatio, filterQuality)@+--+-- * @baseCps@ - base frequency of the resonator+--+-- * exciter - an impulse that starts a resonator.+modes :: [(Sig, Sig)] -> Sig -> Sig -> Sig+modes = relResonsBy (\cf q asig -> mode asig cf q)++relResonsBy :: (Sig -> a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig -> Sig+relResonsBy resonator ms baseCps apulse = (recip normFactor * ) $ sum $ fmap (\(cf, q) -> harm cf q apulse) ms+ where + -- limit modal frequency to prevent explosions by + -- skipping if the maximum value is exceeded (with a little headroom)+ gate :: Sig -> Sig+ gate cps = ifB (sig getSampleRate >* pi * cps) 1 0 ++ normFactor = sum $ fmap (gate . (* baseCps) . fst) ms++ -- an ugly hack to make filter stable for forbidden values)+ harm cf q x = g * resonator (1 - g + g * cps) q x+ where cps = cf * baseCps+ g = gate cps++-- | Doubles the mono signal to get the stereo signal.+fromMono :: Sig -> (Sig, Sig)+fromMono a = (a, a)
+ src/Csound/Air/Spec.hs view
@@ -0,0 +1,40 @@+ -- | Spectral functions+ module Csound.Air.Spec( + toSpec, fromSpec, mapSpec, scaleSpec, addSpec, scalePitch+) where++import Csound.Typed+import Csound.Typed.Opcode++--------------------------------------------------------------------------+-- spectral functions++-- | Converts signal to spectrum.+toSpec :: Sig -> Spec+toSpec asig = pvsanal asig 1024 256 1024 1++-- | Converts spectrum to signal.+fromSpec :: Spec -> Sig+fromSpec = pvsynth++-- | Applies a transformation to the spectrum of the signal.+mapSpec :: (Spec -> Spec) -> Sig -> Sig+mapSpec f = fromSpec . f . toSpec++-- | Scales all frequencies. Usefull for transposition. +-- For example, we can transpose a signal by the given amount of semitones: +--+-- > scaleSpec (semitone 1) asig+scaleSpec :: Sig -> Sig -> Sig+scaleSpec k = mapSpec $ \x -> pvscale x k++-- | Adds given amount of Hz to all frequencies.+--+-- > addSpec hz asig+addSpec :: Sig -> Sig -> Sig+addSpec hz = mapSpec $ \x -> pvshift x hz 0++-- | Scales frequency in semitones.+scalePitch :: Sig -> Sig -> Sig+scalePitch n = scaleSpec (semitone n)+
+ src/Csound/Air/Wav.hs view
@@ -0,0 +1,226 @@+ -- | Sound file playback+module Csound.Air.Wav(+ -- * Stereo+ readSnd, loopSnd, loopSndBy, + readWav, loopWav, readSegWav, + tempoLoopWav, tempoReadWav,+ + -- * Mono+ readSnd1, loopSnd1, loopSndBy1, + readWav1, loopWav1, readSegWav1,+ tempoLoopWav1, tempoReadWav1,+ + -- * Read sound with RAM+ -- + -- Loads the sample in the table and plays it back from RAM. The sample should be short. The size of the table is limited.+ -- It's up to 6 minutes for 44100 sample rate, 5 minutes for 48000 and 2.8 minutes for 96000.+ LoopMode(..), ramSnd, ramSnd1, ++ -- * Writing sound files+ SampleFormat(..),+ writeSigs, writeWav, writeAiff, writeWav1, writeAiff1,++ -- * Utility+ lengthSnd, segments,++ -- * Signal manipulation+ takeSnd, delaySnd, segmentSnd, repeatSnd, toMono+) where++import Data.List(isSuffixOf)++import Csound.Typed+import Csound.Typed.Opcode+import Csound.Tab(mp3s, wavs)+import Csound.Control.Instr(withDur, sched)++import Csound.SigSpace(mapSig)+import Csound.Types(Sig2)+import Csound.Control.Evt(metroE, eventList)++import Csound.Air.Spec++--------------------------------------------------------------------------+-- Signal manipulation++-- | Takes only given amount (in seconds) from the signal (the rest is silence).+takeSnd :: Sigs a => D -> a -> a+takeSnd dt asig = trigs (const $ return asig) $ eventList [(0, dt, unit)]++-- | Delays signals by the given amount (in seconds).+delaySnd :: Sigs a => D -> a -> a+delaySnd dt asig = trigs (const $ return asig) $ eventList [(dt, -1, unit)]++-- | Delays a signal by the first argument and takes only second argument amount+-- of signal (everything is measured in seconds).+segmentSnd ::Sigs a => D -> D -> a -> a+segmentSnd del dur asig = trigs (const $ return asig) $ eventList [(del, dur, unit)]++-- | Repeats the signal with the given period.+repeatSnd :: Sigs a => D -> a -> a+repeatSnd dt asig = sched (const $ return asig) $ segments dt++--------------------------------------------------------------------------+-- sound files playback++isMp3 :: String -> Bool+isMp3 name = ".mp3" `isSuffixOf` name++-- | Converts stereosignal to mono with function mean.+toMono :: (Sig, Sig) -> Sig+toMono (a, b) = 0.5 * a + 0.5 * b++-- | Length in seconds of the sound file.+lengthSnd :: String -> D+lengthSnd fileName+ | isMp3 fileName = mp3len $ text fileName+ | otherwise = filelen $ text fileName++-- | Produces repeating segments with the given time in seconds.+segments :: D -> Evt (D, Unit)+segments dt = withDur dt $ metroE (sig $ recip dt)++-- Stereo++-- | Reads stereo signal from the sound-file (wav or mp3 or aiff).+readSnd :: String -> (Sig, Sig)+readSnd fileName+ | isMp3 fileName = mp3in (text fileName) + | otherwise = diskin2 (text fileName) 1++-- | Reads stereo signal from the sound-file (wav or mp3 or aiff)+-- and loops it with the given period (in seconds).+loopSndBy :: D -> String -> (Sig, Sig)+loopSndBy dt fileName = repeatSnd dt $ readSnd fileName++-- | Reads stereo signal from the sound-file (wav or mp3 or aiff)+-- and loops it with the file length.+loopSnd :: String -> (Sig, Sig)+loopSnd fileName = loopSndBy (lengthSnd fileName) fileName++-- | Reads the wav file with the given speed (if speed is 1 it's a norma playback).+-- We can use negative speed to read file in reverse.+readWav :: Sig -> String -> (Sig, Sig)+readWav speed fileName = diskin2 (text fileName) speed++-- | Reads th wav file and loops over it.+loopWav :: Sig -> String -> (Sig, Sig)+loopWav speed fileName = flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) speed++-- | Reads a segment from wav file. +readSegWav :: D -> D -> Sig -> String -> (Sig, Sig)+readSegWav start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) speed `withDs` [start, 1]++-- | Reads the wav file with the given speed (if speed is 1 it's a norma playback).+-- We can use negative speed to read file in reverse. Scales the tempo with first argument.+tempoReadWav :: Sig -> String -> (Sig, Sig)+tempoReadWav speed fileName = mapSig (scaleSpec (1 / abs speed)) $ diskin2 (text fileName) speed++-- | Reads th wav file and loops over it. Scales the tempo with first argument.+tempoLoopWav :: Sig -> String -> (Sig, Sig)+tempoLoopWav speed fileName = mapSig (scaleSpec (1 / abs speed)) $ flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) speed++-- Mono++-- | The mono variant of the function @readSnd@.+readSnd1 :: String -> Sig+readSnd1 fileName + | isMp3 fileName = toMono $ readSnd fileName+ | otherwise = diskin2 (text fileName) 1++-- | The mono variant of the function @loopSndBy@.+loopSndBy1 :: D -> String -> Sig+loopSndBy1 dt fileName = repeatSnd dt $ readSnd1 fileName++-- | The mono variant of the function @loopSnd@.+loopSnd1 :: String -> Sig+loopSnd1 fileName = loopSndBy1 (lengthSnd fileName) fileName++-- | The mono variant of the function @readWav@.+readWav1 :: Sig -> String -> Sig+readWav1 speed fileName = diskin2 (text fileName) speed++-- | The mono variant of the function @loopWav@.+loopWav1 :: Sig -> String -> Sig+loopWav1 speed fileName = flip withDs [0, 1] $ diskin2 (text fileName) speed++-- | Reads a segment from wav file.+readSegWav1 :: D -> D -> Sig -> String -> Sig+readSegWav1 start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) speed `withDs` [start, 1]++-- | Reads the mono wav file with the given speed (if speed is 1 it's a norma playback).+-- We can use negative speed to read file in reverse. Scales the tempo with first argument.+tempoReadWav1 :: Sig -> String -> Sig+tempoReadWav1 speed fileName = scaleSpec (1 / abs speed) $ readWav1 speed fileName++-- | Reads th mono wav file and loops over it. Scales the tempo with first argument.+tempoLoopWav1 :: Sig -> String -> Sig+tempoLoopWav1 speed fileName = scaleSpec (1 / abs speed) $ loopWav1 speed fileName++--------------------------------------------------------------------------+-- With RAM++data LoopMode = Once | Loop | Bounce+ deriving (Show, Eq, Enum)++-- | Loads the sample in the table. The sample should be short. The size of the table is limited.+-- It's up to 6 minutes for +ramSnd :: LoopMode -> Sig -> String -> Sig2+ramSnd loopMode speed file = loscil3 1 speed t `withDs` [1, int $ fromEnum loopMode]+ where t + | isMp3 file = mp3s file 0+ | otherwise = wavs file 0 0++ramSnd1 :: LoopMode -> Sig -> String -> Sig+ramSnd1 loopMode speed file + | isMp3 file = (\(aleft, aright) -> 0.5 * (aleft + aright)) $ loscil3 1 speed (mp3s file 0) `withDs` [1, int $ fromEnum loopMode]+ | otherwise = loscil3 1 speed (wavs file 0 1) `withDs` [1, int $ fromEnum loopMode]++--------------------------------------------------------------------------+-- writing sound files++-- | The sample format.+data SampleFormat + = NoHeaderFloat32 -- ^ 32-bit floating point samples without header+ | NoHeaderInt16 -- ^ 16-bit integers without header+ | HeaderInt16 -- ^ 16-bit integers with a header. The header type depends on the render (-o) format+ | UlawSamples -- ^ u-law samples with a header+ | Int16 -- ^ 16-bit integers with a header+ | Int32 -- ^ 32-bit integers with a header + | Float32 -- ^ 32-bit floats with a header+ | Uint8 -- ^ 8-bit unsigned integers with a header+ | Int24 -- ^ 24-bit integers with a header+ | Float64 -- ^ 64-bit floats with a header+ deriving (Eq, Ord, Enum)++-- | Writes a sound signal to the file with the given format.+-- It supports only four formats: Wav, Aiff, Raw and Ircam.+writeSigs :: FormatType -> SampleFormat -> String -> [Sig] -> SE ()+writeSigs fmt sample file = fout (text file) formatToInt + where + formatToInt = int $ formatTypeToInt fmt * 10 + fromEnum sample++ formatTypeToInt :: FormatType -> Int+ formatTypeToInt x = case x of+ Wav -> 1+ Aiff -> 2+ Raw -> 3+ Ircam -> 4+ _ -> error $ "Format " ++ (show x) ++ " is not supported in the writeSnd."++-- | Writes wav files.+writeWav :: String -> (Sig, Sig) -> SE ()+writeWav file = writeSigs Wav Int16 file . \(a, b) -> [a, b]++-- | Writes aiff files.+writeAiff :: String -> (Sig, Sig) -> SE ()+writeAiff file = writeSigs Aiff Int16 file . \(a, b) -> [a, b]++-- | Writes mono signals to wav files.+writeWav1 :: String -> Sig -> SE ()+writeWav1 file = writeWav file . \x -> (x, x)++-- | Writes mono signals to aiff files.+writeAiff1 :: String -> Sig -> SE ()+writeAiff1 file = writeAiff file . \x -> (x, x)+
+ src/Csound/Air/Wave.hs view
@@ -0,0 +1,128 @@+-- | Basic waveforms that are used most often. +-- A waveform function takes in a time varied frequency (in Hz).+module Csound.Air.Wave (+ -- * Bipolar+ osc, oscBy, saw, isaw, pulse, sqr, tri, blosc,++ -- * Unipolar+ unipolar, bipolar, on, uon, uosc, uoscBy, usaw, uisaw, upulse, usqr, utri, ublosc,++ -- * Noise+ rndh, urndh, rndi, urndi, white, pink,++ -- * Low frequency oscillators+ Lfo, lfo+) where++import Csound.Typed+import Csound.Typed.Opcode hiding (lfo)+import Csound.Tab(sine, sines4)++-- | A pure tone (sine wave).+osc :: Sig -> Sig+osc cps = oscil3 1 cps sine++-- | An oscillator with user provided waveform.+oscBy :: Tab -> Sig -> Sig+oscBy tb cps = oscil3 1 cps tb++-- unipolar waveforms++-- | Turns a bipolar sound (ranges from -1 to 1) to unipolar (ranges from 0 to 1)+unipolar :: Sig -> Sig+unipolar a = 0.5 + 0.5 * a++-- | Turns an unipolar sound (ranges from 0 to 1) to bipolar (ranges from -1 to 1)+bipolar :: Sig -> Sig+bipolar a = 2 * a - 1++-- | Unipolar pure tone.+uosc :: Sig -> Sig+uosc = unipolar . osc++-- | Unipolar 'Csound.Air.oscBy'.+uoscBy :: Tab -> Sig -> Sig+uoscBy tb = unipolar . oscBy tb++-- | Unipolar sawtooth.+usaw :: Sig -> Sig+usaw = unipolar . saw++-- | Unipolar integrated sawtooth.+uisaw :: Sig -> Sig+uisaw = unipolar . isaw++-- | Unipolar square wave.+usqr :: Sig -> Sig+usqr = unipolar . sqr++-- | Unipolar triangle wave.+utri :: Sig -> Sig+utri = unipolar . tri++-- | Unipolar pulse.+upulse :: Sig -> Sig+upulse = unipolar . pulse++-- | Unipolar band-limited oscillator.+ublosc :: Tab -> Sig -> Sig+ublosc tb = unipolar . blosc tb++-- rescaling++-- | Rescaling of the bipolar signal (-1, 1) -> (a, b)+-- +-- > on a b biSig+on :: Sig -> Sig -> Sig -> Sig+on a b x = uon a b $ unipolar x ++-- | Rescaling of the unipolar signal (0, 1) -> (a, b)+-- +-- > on a b uniSig+uon :: Sig -> Sig -> Sig -> Sig+uon a b x = a + (b - a) * x++--------------------------------------------------------------------------+-- noise++-- | Constant random signal. It updates random numbers with given frequency.+--+-- > constRnd freq +rndh :: Sig -> SE Sig+rndh = randh 1++-- | Linear random signal. It updates random numbers with given frequency.+--+-- > rndi freq +rndi :: Sig -> SE Sig+rndi = randi 1++-- | Unipolar @rndh@+urndh :: Sig -> SE Sig+urndh = fmap unipolar . rndh++-- | Unipolar @rndi@+urndi :: Sig -> SE Sig+urndi = fmap unipolar . rndi++-- | White noise.+white :: SE Sig +white = noise 1 0++-- | Pink noise.+pink :: SE Sig+pink = pinkish 1++--------------------------------------------------------------------------+-- lfo++-- | Low frequency oscillator+type Lfo = Sig++-- | Low frequency oscillator+--+-- > lfo shape depth rate+lfo :: (Sig -> Sig) -> Sig -> Sig -> Sig+lfo shape depth rate = depth * shape rate++
src/Csound/Control/Gui.hs view
@@ -1,3 +1,4 @@+{-# Language TypeSynonymInstances, FlexibleInstances #-} -- | GUI (Graphical User Interface) elements are handy to change -- the parameters of the sound in real time. It includes sliders, -- knobs, rollers, buttons and other widgets. @@ -49,13 +50,14 @@ -- * Gui Gui, Widget, Input, Output, Inner,- Sink, Source, Display,- widget, sink, source, display,- mapSource,- + Sink, Source, Display, SinkSource,+ widget, sink, source, display, sinkSource,+ mapSource, mapGuiSource, + mhor, mver, msca,+ -- * Panels- panel, panels, panelBy,- keyPanel, keyPanels, keyPanelBy,+ panel, win, panels, panelBy,+ keyPanel, keyWin, keyPanels, keyPanelBy, -- * Re-exports module Csound.Control.Gui.Layout,@@ -63,7 +65,7 @@ module Csound.Control.Gui.Widget ) where -import Control.Arrow(second)+import Csound.Typed import Csound.Typed.Gui @@ -71,7 +73,16 @@ import Csound.Control.Gui.Props import Csound.Control.Gui.Widget +import Csound.SigSpace(SigSpace(..)) --- | Maps over the value of the source-widget.-mapSource :: (a -> b) -> Source a -> Source b-mapSource f = fmap (second f)+-- | Creates a window with the given name, size and content+--+-- > win name (width, height) gui+win :: String -> (Int, Int) -> Gui -> SE ()+win name (x, y) = panelBy name (Just $ Rect 0 0 x y)++keyWin :: String -> (Int, Int) -> Gui -> SE ()+keyWin name (x, y) = keyPanelBy name (Just $ Rect 0 0 x y)++instance SigSpace a => SigSpace (Source a) where+ mapSig f = mapSource (mapSig f)
src/Csound/Control/Gui/Widget.hs view
@@ -21,6 +21,7 @@ butBank1, butBankSig1, radioButton, matrixButton, funnyRadio, funnyMatrix, setNumeric, meter,+ setToggle, setToggleSig, -- * Transformers setTitle, -- * Keyboard
src/Csound/Control/SE.hs view
@@ -1,5 +1,5 @@ module Csound.Control.SE(- SE, SERef(..), newSERef, sensorsSE, newGlobalSERef, globalSensorsSE+ SE, SERef, writeSERef, readSERef, newSERef, sensorsSE, newGlobalSERef, globalSensorsSE ) where import Csound.Typed.Control
src/Csound/IO.hs view
@@ -39,7 +39,7 @@ ) where import System.Process-import Control.Exception+import qualified Control.Exception as E import Data.Monoid import Data.Default@@ -226,10 +226,10 @@ runWithUserInterrupt :: String -> IO () runWithUserInterrupt cmd = do pid <- runCommand cmd- catch (waitForProcess pid >> return ()) (onUserInterrupt pid)+ E.catch (waitForProcess pid >> return ()) (onUserInterrupt pid) where- onUserInterrupt :: ProcessHandle -> AsyncException -> IO ()+ onUserInterrupt :: ProcessHandle -> E.AsyncException -> IO () onUserInterrupt pid x = case x of - UserInterrupt -> terminateProcess pid >> throw x- e -> throw e+ E.UserInterrupt -> terminateProcess pid >> E.throw x+ e -> E.throw e
src/Csound/SigSpace.hs view
@@ -12,7 +12,7 @@ import Csound.Typed.Opcode(pvscross) -- | A class for easy way to process the outputs of the instruments.-class Num a => SigSpace a where+class SigSpace a where mapSig :: (Sig -> Sig) -> a -> a -- | A class for easy way to process the outputs of the instruments.@@ -28,7 +28,7 @@ -- > cfd coeff sig1 sig2 -- -- If coeff equals 0 then we get the first signal and if it equals 1 we get the second signal.-cfd :: SigSpace a => Sig -> a -> a -> a+cfd :: (Num a, SigSpace a) => Sig -> a -> a -> a cfd coeff a b = (1 - coeff) `mul` a + coeff `mul` b genCfds :: a -> (Sig -> a -> a -> a) -> [Sig] -> [a] -> a@@ -40,7 +40,7 @@ -- | Generic crossfade for n coefficients and n+1 signals. -- -- > cfds coeffs sigs-cfds :: SigSpace a => [Sig] -> [a] -> a+cfds :: (Num a, SigSpace a) => [Sig] -> [a] -> a cfds = genCfds 0 cfd -- | Spectral crossfade.@@ -52,7 +52,7 @@ cfdsSpec = genCfds undefined cfdSpec -- | Weighted sum.-wsum :: SigSpace a => [(Sig, a)] -> a+wsum :: (Num a, SigSpace a) => [(Sig, a)] -> a wsum = sum . fmap (uncurry mul) instance SigSpace Sig where mapSig = id