diff --git a/csound-expression.cabal b/csound-expression.cabal --- a/csound-expression.cabal +++ b/csound-expression.cabal @@ -1,5 +1,5 @@ Name: csound-expression -Version: 5.3.1 +Version: 5.3.2 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE @@ -33,7 +33,7 @@ * Thanks a lot to all who patiently answered my questions and provided skillful solutions, encouragement and ideas: . - Iain McCurdy, Victor Lazzarini, Rory Walsh, Steven Yi, John Ffitch, Joachim Heintz, Peter Burgess, Dr. Richard Boulanger, Michael Gogins, Oeyvind Brandtsegg, + Iain McCurdy, Victor Lazzarini, Rory Walsh, Steven Yi, John Ffitch, Jon Downing, Joachim Heintz, Peter Burgess, Dr. Richard Boulanger, Michael Gogins, Oeyvind Brandtsegg, Richard Dobson, Partev Barr Sarkissian, Dave Phillips, Guillermo Senna, Art Hunkins, Ben McAllister, Michael Rhoades, Gleb Rogozinsky, Eugene Cherny, Brian Merchant, Wolf Peuker, Hlöðver Sigurðsson, Aaron Krister Johnson, Andy Fillebrown and friends :) @@ -79,7 +79,7 @@ Ghc-Options: -Wall Build-Depends: base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0, transformers >= 0.3, containers, - csound-expression-typed >= 0.2.1.0, csound-expression-dynamic >= 0.3.2, temporal-media >= 0.6.1, + csound-expression-typed >= 0.2.2.0, csound-expression-dynamic >= 0.3.3, temporal-media >= 0.6.3, csound-expression-opcodes >= 0.0.4.0 Hs-Source-Dirs: src/ Exposed-Modules: diff --git a/examples/Color.hs b/examples/Color.hs --- a/examples/Color.hs +++ b/examples/Color.hs @@ -17,12 +17,12 @@ k1 = (0.1 * ) $ once $ lins [0.00001, 30, 1, 50, 0.5, 100, 0.00001] -- k1 = expseg [0.0001, 0.03, amp * 0.7, idur - 0.03, 0.001] -- * linseg [1, 0.03, 1, idur - 0.03, 3] - k10 = linseg [2.25, 0.03, 3, idur - 0.03, 2] + k10 = linseg [2.25, 0.03, 3, idur - 0.03, 2] a1 = gbuzz k1 (sig 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 + 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 @@ -34,19 +34,19 @@ env = linen (sig amp) rise idur dec osc' tab k ph = oscBy tab (sig $ 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 = env * mean + 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 = env * 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 + kosc1 = 0.5 * once sine kosc2 = 0.5 * once sine `withD` 0.4 kosc3 = 1.0 * once sine `withD` 0.8 - afilt = sum + afilt = sum [ butbp asum kosc1 1000 , butbp asum kosc2 300 , butbp asum kosc3 20 ] @@ -55,15 +55,15 @@ blurp amp = do cps <- acps - return $ 0.1 * sig amp * osc cps + return $ 0.1 * sig amp * osc cps where dec = linseg [11, idur * 0.75, 11, idur * 0.25, 0] kgate = kr $ oscil 1 dec (elins [1, 0, 0]) anoise = noise 11000 0.99 acps = fmap (flip samphold kgate) anoise - -wind (amp, bandRise, bandDec, freqRise, freqDec, pan, winds) = + +wind (amp, bandRise, bandDec, freqRise, freqDec, pan, winds) = fmap fromRnd $ rand (sig $ amp / 400) where valu1 = 100 @@ -72,19 +72,19 @@ ramp a b = linseg [a, idur, b] fromRnd a = (sig pan * aout, (1 - sig pan) * aout ) where - a2 = butbp a (ramp freqRise freqDec) (ramp bandRise bandDec) + 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, idur * winds, 1, idur * winde, 0] noiz (amp, cps) = fmap a2 k2 - where + where k1 = linseg [1, 0.05, 100, 0.2, 100, 2, 1, idur, 1] - k2 = fmap ( `withD` 1) $ rand 500 + 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 = 0.5 * a1 * sig amp * osc k @@ -97,27 +97,27 @@ ares a = reson (a * osc (sig cps)) 100 100 `withD` 2 -ivory (amp, cps, vibRate, glisDur, cpsCoeff) = sig amp * mean +ivory (amp, cps, vibRate, glisDur, cpsCoeff) = sig amp * mean -- vibrato env amplitude env freq bias phase vibrato coeff wave [ alg (linseg [0, idur, 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) (linenIdur 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) + , 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) + , 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 = + alg :: Sig -> Sig -> D -> D -> D -> Tab -> Sig + alg vibrEnv ampEnv cpsBias phsBias vibrCoeff wave = ampEnv * (oscBy wave ((sig (cps + cpsBias) + vibr) * glis) `withD` phsBias) where glis = expseg [1, glisDur, 1, idur - glisDur, cpsCoeff] vibr = vibrEnv * osc (sig $ vibRate * vibrCoeff) - + cone a x1 b x2 c = [a, x1 * idur, b, x2 * idur, 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 @@ -126,7 +126,7 @@ -- snow flakes blue (amp, cps, lfoCps, harmNum, sweepRate) = fmap aout k1 - where + where k1 = randi 1 50 k2 = lindur [0, 0.5, 1, 0.5, 0] k3 = lindur [0.005, 0.71, 0.015, 0.29, 0.01] @@ -137,18 +137,18 @@ kenv = expdur [0.001, 0.01, amp, 0.99, 0.001] aout k = gbuzz kenv (sig cps + k3) k5 ksweep k (sines3 [(1, 1, 90)]) -i2 t0 dt amp cps lfoCps harmNum sweepRate = +i2 t0 dt amp cps lfoCps harmNum sweepRate = t0 +| (dt *| temp (amp, cps, lfoCps, harmNum, sweepRate)) -blueSco = sco blue $ har +blueSco = sco blue $ har [ i2 0 4 0.5 440 23 10 0.72 , i2 0 4 0.5 330 20 6 0.66 ] -- 4pok -black (amp, cps, filterSweepStart, filterSweepEnd, bandWidth) = +black (amp, cps, filterSweepStart, filterSweepEnd, bandWidth) = fmap aout $ rand 1 - where + where k1 = expdur [filterSweepStart, 1, filterSweepEnd] a1 noise = reson noise k1 (k1 / sig bandWidth) `withD` 1 k3 = expdur [0.001, 0.001, amp, 0.999, 0.001] @@ -158,7 +158,7 @@ i4 t0 dt amp cps filt0 filt1 bw = t0 +| (dt *| temp (amp, cps, filt0, filt1, bw)) -blackSco = str 1.5 $ sco black $ har +blackSco = str 1.5 $ sco black $ har [ i4 0 1 0.7 220 6000 30 10 , i4 0 1 0.7 330 8000 20 6 ] diff --git a/examples/DubBass.hs b/examples/DubBass.hs --- a/examples/DubBass.hs +++ b/examples/DubBass.hs @@ -20,15 +20,15 @@ spb = dspb dspb = 0.45 -instr (coeff, cps) = return $ wobbly (sig spb) (sig coeff) (sig $ cpspch cps) +instr (coeff, cps) = return $ wobbly spb (sig coeff) (sig $ cpspch cps) -main = dac $ mix $ str (dspb * 2) $ loopBy 2 $ sco instr $ melMap temp $ +main = dac $ mix $ str (dspb * 2) $ loopBy 2 $ sco instr $ melMap temp $ [ (2, 6.04) , (1/3, 7.04) , (2, 6.04) , (1/1.5, 7.07) - + , (2, 5.09) , (1, 6.09) , (1/1.5, 5.09) @@ -37,13 +37,13 @@ , (1, 6.04) , (1/3, 7.04) , (2, 6.04) - , (1/1.5, 7.07) - + , (1/1.5, 7.07) + , (2, 6.09) , (1, 7.09) , (1/1.5, 6.11) - , (1/3, 6.07) - + , (1/3, 6.07) + , (2, 6.04) , (1/3, 7.04) , (2, 6.04) diff --git a/examples/Gui/Button.hs b/examples/Gui/Button.hs --- a/examples/Gui/Button.hs +++ b/examples/Gui/Button.hs @@ -9,7 +9,7 @@ appGui = dac $ vlift3 f masterVolume (toggle "play" False) (button "Hi!") where f vol evt1 evt2 = vol * sum [sig1, sig2] - where + where (evtOn, evtOff) = splitToggle evt1 instr cps _ = return $ fades 0.5 0.5 * osc cps sig1 = schedUntil (instr 440) evtOn evtOff @@ -17,7 +17,7 @@ -- | Monadic style guis -monadGui = dac $ do +monadGui = dac $ do -- Let's create a toggle button with label "play". -- The toggle button emmits ones and zeros. (gbut1, evt1) <- toggle "play" False @@ -45,4 +45,4 @@ -- Sends the sum to the output scaled with given master volume. return $ vol * sum [sig1, sig2] - + diff --git a/examples/Gui/EnvelopeAndHarmonics.hs b/examples/Gui/EnvelopeAndHarmonics.hs --- a/examples/Gui/EnvelopeAndHarmonics.hs +++ b/examples/Gui/EnvelopeAndHarmonics.hs @@ -7,14 +7,14 @@ main = dac $ do -- Creates a bank of 15 sliders. We specify the label - -- and initial values for slider (0 is minimum and 1 is maximum + -- and initial values for slider (0 is minimum and 1 is maximum -- for each slider. (gharms, ks) <- sliderBank "harmonics" (1 : replicate 14 0) -- We create an Adsr envelope (see example Envelope.hs) (gadsr, env) <- linAdsr "amplitude envelope" (AdsrBound 1 1 3) (AdsrInit 0.1 0.1 0.5 0.1) -- Creates a master volume slider (gvol, vol) <- masterVolume - (gcps, cps) <- slider "frequency" (expSpan 50 1000) 220 + (gcps, cps) <- slider "frequency" (expSpan 50 1000) 220 -- Places everything on window. Elements are aligned vertically. -- The volume slider is smaller than the ADSR-envelope. The element @@ -22,7 +22,7 @@ -- (it's short for scale) panel $ ver [sca 0.1 gvol, sca 0.1 gcps, sca 0.25 gadsr, gharms] - -- Let's create a simple instrument with the custom harmonics + -- Let's create a simple instrument with the custom harmonics -- and amplitude envelope. let instr = env * harms ks cps return $ mul vol $ sched (const $ return instr) $ withDur 1 $ metro 0.5 diff --git a/examples/Gui/Harmonics.hs b/examples/Gui/Harmonics.hs --- a/examples/Gui/Harmonics.hs +++ b/examples/Gui/Harmonics.hs @@ -1,7 +1,7 @@ -- Experiments with harmonics. module Harmonics where -import Csound.Base +import Csound.Base -- a sum of pure tones that form a hormanic series. harms :: [Sig] -> Sig -> Sig @@ -13,7 +13,7 @@ (g, ks) <- sliderBank "Harmonics" (1 : replicate 13 0) (gv, v) <- masterVolume (gcps, cps) <- slider "frequency" (expSpan 50 1000) 220 - + -- A simple instrument that plays a harmonic series -- with the given coefficients. let instr = onMsg $ harms ks diff --git a/examples/Gui/Key.hs b/examples/Gui/Key.hs --- a/examples/Gui/Key.hs +++ b/examples/Gui/Key.hs @@ -3,16 +3,16 @@ import Csound.Base -main = dac $ do - -- a pure tone instrument that plays a single frequency +main = dac $ do + -- a pure tone instrument that plays a single frequency let instr x = const $ return $ osc x -- triggers the instrument with frequency on the give event stream -- and holds the note wile second stream is silent. asig cps evtOn evtOff = schedUntil (instr cps) evtOn evtOff - - mean [ asig 330 (charOn 's') (charOff 's') + + mean [ asig 330 (charOn 's') (charOff 's') , asig 440 (charOn 'a') (charOff 'a') ] - --- Due to inner limitation only one keyboard event can be --- registered at one control cycle. So if you press + +-- Due to inner limitation only one keyboard event can be +-- registered at one control cycle. So if you press -- the two buttons at the same time only one event will be registered. diff --git a/examples/Heartbeat.hs b/examples/Heartbeat.hs --- a/examples/Heartbeat.hs +++ b/examples/Heartbeat.hs @@ -4,7 +4,7 @@ import Csound.Base linenIdur :: Sig -> D -> D -> Sig -linenIdur a rise dec = linen a (idur * rise) idur (idur * dec) +linenIdur a rise dec = linen a (idur * rise) idur (idur * dec) -------------------------------------- @@ -14,7 +14,7 @@ kpan = 0.5 * (1 + osc (5 * sig idur)) a2 = fof a1 (a1 + sig cps) (a1 * sig amp / 50) k1 200 0.003 0.017 0.005 20 f1 f2 cps arev = reverb2 a2 5 1 - a3 = 0.2 * (a2 + arev) + a3 = 0.2 * (a2 + arev) f1 = sines [1] -- SINE WAVE f2 = sines [1, 0.5, 0.3, 0.25, 0.2, 0.167, 0.14, 0.111] -- SAWTOOTH @@ -23,20 +23,20 @@ heartbeat amp = phi amp 0.0024 f12 + phi amp 0.0078 f13 where phi amp dec tab = oscili (sig amp * linseg [1, idur, dec]) 4 tab f12 = sines2 [(10, 1), (16, 1.5), (22, 2), (23, 1.5)] - f13 = sines2 [(25, 1), (29, 0.5), (32, 0.2)] + f13 = sines2 [(25, 1), (29, 0.5), (32, 0.2)] monoPluck :: D -> D -> D -> D -> Sig -monoPluck amp cps pick plk = a3 - where repluck' freq a = repluck plk (sig amp) freq (sig pick) 0.5 a +monoPluck amp cps pick plk = a3 + where repluck' freq a = repluck plk (sig amp) freq (sig pick) 0.5 a a1 = 0.5 * ( - repluck' (cps - 1) (osc $ sig $ cps - 2) + repluck' (cps - 1) (osc $ sig $ cps - 2) + repluck' (cps + 1) (osc $ sig $ cps + 2)) a2 = linenIdur (a1/2) 0.2 0.8 arev = reverb2 a2 1.5 1 a3 = (a2 + 0.6 * arev) / 1.6 - + chorusel amp cps rise dec = (ar1, ar2) where k1 = linen (sig amp) rise idur dec k2 = linseg [1, idur, 0] @@ -56,21 +56,21 @@ (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 !!) + 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) - + asig3 = 0.5 * (ars !! 10 + ars !! 11) + ar1 = 0.5 * (asig1 + asig3) - ar2 = 0.5 * (asig2 + asig3) - - f9 phs = oscil 1 phs $ sines + ar2 = 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] - + , 0.11, 0.3, 0.02, 0.2] + instr1 :: D -> Sig2 instr1 amp = (a, a) where a = 0.8 * heartbeat amp @@ -87,12 +87,12 @@ scoBeat = sco (onArg instr1) $ del 2 $ loopBy 32 $ mel [0.25 *| melTemp [0.5, 0.3], rest 1.5] -scoPluck = sco (onArg instrPluck) $ del 8 $ mel $ take n $ zipWith (\amp pan -> 0.5 *| temp (amp, pan)) +scoPluck = sco (onArg instrPluck) $ del 8 $ mel $ take n $ zipWith (\amp pan -> 0.5 *| temp (amp, pan)) (fmap double $ [0, (v/40) .. v] ++ repeat v) (cycle [0.2, 0.8]) where v = 0.6 dur = 65 n = floor $ (dur - 8)/0.5 - + scoChorusel = sco (onArg instrChorusel) $ har $ unroll =<< [ (0, 15, (0.4, [7, 7.07, 6, 8], 10, 5)), (18, 17, (0.27, [6, 7, 7.07, 8.02, 8.03, 5], 9, 6)), @@ -101,13 +101,13 @@ (48, 7, (0.35, [7.05], 3.5, 3.5)), (55, 10, (0.35, [7, 8, 7.07, 6], 5, 8))] where unroll (t, dur, (amp, cps, rise, dec)) = [del t $ str dur $ temp (amp, c, rise, dec) | c <- cps] - + scoCrackle = sco (onArg instrCrackle) $ har [ str 8 $ temp 100, - del 13 $ str 5 $ temp 50] - + del 13 $ str 5 $ temp 50] + main = dac $ mix $ har [ - scoBeat, + scoBeat, scoChorusel, scoPluck, rest 0 diff --git a/examples/Live.hs b/examples/Live.hs --- a/examples/Live.hs +++ b/examples/Live.hs @@ -25,7 +25,7 @@ c3 = infSig1 $ tri 440 main2 = dac $ do - (g, sam) <- live 4 ["triangle", "square"] + (g, sam) <- live 4 ["triangle", "square"] [ c1, b1 , c2, b3 , c3, b3] @@ -53,12 +53,12 @@ ----------------------------- main5 = dac $ do - (gui, fx) <- fxHor + (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 + , uiChorus False 0.5 0.5 0.5 0.5 + , uiPhaser False 0.5 0.5 0.5 0.5 , uiReverb True 0.5 0.5 - , uiGain True 0.5 + , uiGain 0.5 ] win "main" (900, 400) gui fx $ fromMono $ saw 110 diff --git a/examples/Midi.hs b/examples/Midi.hs --- a/examples/Midi.hs +++ b/examples/Midi.hs @@ -1,23 +1,23 @@ module Main where - + -- imports everything import Csound.Base --- Let's define a simple sound unit that +-- Let's define a simple sound unit that -- reads in cycles the table that contains a single sine partial. -- oscil1 is the standard oscillator with linear interpolation. -- 1 - means the amplitude, cps - is cycles per second and the last argument --- is the table that we want to read. +-- is the table that we want to read. myOsc :: Sig -> Sig myOsc cps = oscili 1 cps (sines [1]) -- Let's define a simple instrument that plays a sound on the specified frequency. --- We use @sig@ to convert a constant value to signal and then plug it in the osc unit. +-- We use @sig@ to convert a constant value to signal and then plug it in the osc unit. -- We make it a bit quieter by multiplying with 0.5. pureTone :: (D, D) -> Sig -pureTone (amp, cps) = 0.4 * sig amp * fades 0.2 1.5 * (myOsc $ sig cps) +pureTone (amp, cps) = 0.4 * sig amp * fades 0.2 1.5 * (myOsc $ sig cps) --- Renders generated csd-file to the "tmp.csd" and runs it with flags +-- Renders generated csd-file to the "tmp.csd" and runs it with flags -- for real time output and listening for the midi events from all devices. main :: IO () main = vdac $ midi $ onMsg pureTone diff --git a/examples/Tibetan.hs b/examples/Tibetan.hs --- a/examples/Tibetan.hs +++ b/examples/Tibetan.hs @@ -1,10 +1,10 @@ {- | Example requires the package `random` to be installed -This remarkable tibetan harmonic chant like effect is created by nine sinusoidal -oscillators, whose frequencies are almost identical: separated by a fraction of -1 Hz from each other. Thus for each component, amplitude modulation leads to its -enhancement or cancelling out in turn. In his composition 'Mutations', Risset -gives the instrument two different envelopes: one with sharp rise and one is a +This remarkable tibetan harmonic chant like effect is created by nine sinusoidal +oscillators, whose frequencies are almost identical: separated by a fraction of +1 Hz from each other. Thus for each component, amplitude modulation leads to its +enhancement or cancelling out in turn. In his composition 'Mutations', Risset +gives the instrument two different envelopes: one with sharp rise and one is a more gradual rise. -} module Tibetan where @@ -28,7 +28,7 @@ pureTibetan :: (D, D, D, D, D) -> Sig pureTibetan (amp, cps, off, rise, dec) = mean $ fmap partial $ 0 : offs ++ (fmap negate offs) where offs = fmap int [1 .. 4] - partial rat = linen (sig amp) rise idur dec * oscBy wave (sig $ cps + off * rat) + partial rat = linen (sig amp) rise idur dec * oscBy wave (sig $ cps + off * rat) wave = ifB (cps `lessThan` 230) (waveBy 5) (ifB (cps `lessThan` 350) (waveBy 3) (waveBy 1)) waveBy n = sines $ [0.3, 0, 0, 0] ++ replicate n 0.1 @@ -57,16 +57,16 @@ r = Repeat w = Wait -instance Num Act where +instance Num Act where fromInteger = Tone . fromInteger -type N = (D, D, D, D, D, D) +type N = (Sig, Sig, D, D, D, D) -data St = St +data St = St { stRepeat :: Int , stWait :: Double - , stSpan :: (Double, Double) + , stSpan :: (Double, Double) , stRnds :: [Double] } -- constants @@ -88,12 +88,12 @@ turtle :: Act -> State St [N] turtle x = case x of Repeat n -> updateSt $ \s -> s{ stRepeat = n } - Wait n -> updateSt $ \s -> s{ stWait = n } + Wait n -> updateSt $ \s -> s{ stWait = n } -- tones Tone t -> state (getNotes t) getNotes :: Int -> St -> ([N], St) -getNotes k st = (notes, st') +getNotes k st = (notes, st') where t0s = startTimes (offsetStartTime (stWait st) $ stSpan st) durStep dts = durs noteLength cpss = freqs (ts !! (k - 1)) @@ -102,8 +102,8 @@ decs = decays dec riss = rises rise - notes = take (stRepeat st) $ getZipList $ (\t0 dt amp cps ris dec -> - (double t0, double dt, double amp, double cps, double ris, double dec)) <$> + notes = take (stRepeat st) $ getZipList $ (\t0 dt amp cps ris dec -> + (sig $ double t0, sig $ double dt, double amp, double cps, double ris, double dec)) <$> ZipList t0s <*> ZipList dts <*> ZipList amps <*> ZipList cpss <*> ZipList decs <*> ZipList riss st' = st{ stSpan = getSpan (stRepeat st) t0s dts } @@ -125,7 +125,7 @@ freqs k = fmap (* base) octs where octs = cycle [1, 0.5, 2, 1, 2, 1, 1, 0.5] - base = k * baseTone + base = k * baseTone cps2amp a = 0.5 * full a where full x @@ -138,17 +138,17 @@ run :: [Act] -> IO [N] run as = fmap concat $ fmap (evalState (mapM turtle as)) initSt where initSt = fmap (St initRepeat initWait initSpan) $ fmap (randomRs (0, 1)) newStdGen - + acts :: [Act] acts = concat $ replicate 1 $ [1, 1, 5, 2, 5, 7, 5, 1, 1, 3, 5, 3, 1, 1, 5, 1 ] - -note (start, dur, amp, cps, rise, dec) = del start $ str dur $ + +note (start, dur, amp, cps, rise, dec) = del start $ str dur $ temp (amp, cps, rise, dec) globalEffect = eff (bindSig $ return . blp 5000 . (0.3 * )) . eff rever -res2 ns = har [res ns, del 13 $ res ns] +res2 ns = har [res ns, del 13 $ res ns] res ns = sco tibetan $ har $ fmap note ns @@ -193,25 +193,25 @@ starChord = [0, 1, 2, 4, 7] starSco = sco blue $ - flip evalState starParams $ traverse addParam $ + flip evalState starParams $ traverse addParam $ har $ zipWith3 phi starInitDelays starPeriods starChord - where phi dt period note = del dt $ loopBy 50 $ har [4 *| temp (double $ id2cps 2 note), rest period] + where phi dt period note = del dt $ loopBy 50 $ har [4 *| temp (double $ id2cps 2 note), rest period] - addParam cps = state $ \((amp, lfo, harm, sweep) : params) -> - ((amp, cps, lfo, harm, sweep), params) - + addParam cps = state $ \((amp, lfo, harm, sweep) : params) -> + ((amp, cps, lfo, harm, sweep), params) + ------------------------------------------------------------ main = do notes <- run acts - dac $ mix $ har + dac $ mix $ har [ introBlurp - , del (introDur * 0.70) $ har - [ globalEffect $ har + , del (introDur * 0.70) $ har + [ globalEffect $ har [ res2 notes , del starTotalDelay $ starSco , del (2 * starTotalDelay) $ starSco] , blurpSco ]] - + diff --git a/examples/Wind.hs b/examples/Wind.hs --- a/examples/Wind.hs +++ b/examples/Wind.hs @@ -7,7 +7,7 @@ -- orchestra -- | An instrument that implements a wind sound. -wind (amp, bandRise, bandDec, freqRise, freqDec, pan, winds) = +wind (amp, bandRise, bandDec, freqRise, freqDec, pan, winds) = fmap fromRnd $ rand (sig $ amp / 400) where valu1 = 100 @@ -16,10 +16,10 @@ ramp a b = linseg [a, idur, b] fromRnd a = (sig pan * aout, (1 - sig pan) * aout ) where - a2 = butbp a (ramp freqRise freqDec) (ramp bandRise bandDec) + 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, idur * winds, 1, idur * winde, 0] ------------------------------------------------------------- @@ -27,7 +27,7 @@ -- | This example shows the flexibility of the Haskell. Here we can -- write the scores in the manner of the native Csound style. -i21 t0 dt amp bandRise bandDec freqRise freqDec pan winds = +i21 t0 dt amp bandRise bandDec freqRise freqDec pan winds = del t0 $ dt *| temp (amp, bandRise, bandDec, freqRise, freqDec, pan, winds) windRes :: Sco (Mix Sig2) @@ -55,7 +55,7 @@ , i21 40 15 70 500 0 555 111 0 0.4 , i21 44 10 74 600 0 444 111 0.5 0.6 , i21 48 8 77 500 0 333 111 0.7 0.7 - , i21 48.5 9 76 500 0 222 111 0.9 0.9 + , i21 48.5 9 76 500 0 222 111 0.9 0.9 , i21 50 12 72 500 0 666 222 0.1 0.6 , i21 55 15 74 500 0 333 333 0.5 0.7 diff --git a/src/Csound/Air/Envelope.hs b/src/Csound/Air/Envelope.hs --- a/src/Csound/Air/Envelope.hs +++ b/src/Csound/Air/Envelope.hs @@ -7,24 +7,24 @@ adsr140, trigTab, -- * Relative duration onIdur, lindur, expdur, linendur, - onDur, lindurBy, expdurBy, linendurBy, + onDur, lindurBy, expdurBy, linendurBy, -- * Faders fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades, slope, expSlope, - -- * Humanize + -- * Humanize HumanizeValue(..), HumanizeTime(..), HumanizeValueTime(..), hval, htime, hvalTime, - -- * Looping envelopes + -- * Looping envelopes -- ** Simple lpshold, loopseg, loopxseg, lpsholdBy, loopsegBy, loopxsegBy, holdSeq, linSeq, expSeq, - linloop, exploop, sah, stepSeq, + linloop, exploop, sah, stepSeq, constSeq, triSeq, sqrSeq, sawSeq, isawSeq, xsawSeq, ixsawSeq, isqrSeq, xtriSeq, pwSeq, ipwSeq, rampSeq, irampSeq, xrampSeq, ixrampSeq, - adsrSeq, xadsrSeq, adsrSeq_, xadsrSeq_, + adsrSeq, xadsrSeq, adsrSeq_, xadsrSeq_, -- ** Complex Seq, toSeq, onBeat, onBeats, @@ -70,7 +70,7 @@ -- -- > onIdur [a, t1, b, t2, c] -- --- becomes: +-- becomes: -- -- > [a, t1 * idur, b, t2 * idur, c] onIdur :: [D] -> [D] @@ -80,7 +80,7 @@ -- -- > onDur dt [a, t1, b, t2, c] -- --- becomes: +-- becomes: -- -- > [a, t1 * dt, b, t2 * dt, c] onDur :: D -> [D] -> [D] @@ -88,22 +88,22 @@ a:b:as -> a : b * dur : onDur dur as _ -> xs --- | The opcode 'Csound.Opcode.linseg' with time intervals +-- | 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 +-- | 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 +-- | 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 +-- | 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 @@ -121,7 +121,7 @@ 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] @@ -137,7 +137,7 @@ slope :: D -> D -> Sig slope dt1 dt2 = linseg [0, dt1, 0, dt2, 1 ] --- | Exponential slope (See the function @slope@). +-- | Exponential slope (See the function @slope@). expSlope :: D -> D -> Sig expSlope dt1 dt2 = linseg [0.001, dt1, 0.001, dt2, 1 ] @@ -179,7 +179,7 @@ -- The period of the repetition equals to the sum of all durations. sah :: [Sig] -> Sig sah as = stepSeq as (1 / period) - where + where period = sumDts as sumDts xs = case xs of @@ -211,7 +211,7 @@ -- | Sample and hold sequence. It outputs the looping sequence of constan elements. constSeq :: [Sig] -> Sig -> Sig -constSeq = genSeq stepSeq id +constSeq = genSeq stepSeq id -- | Step sequencer with unipolar triangle. triSeq :: [Sig] -> Sig -> Sig @@ -277,18 +277,18 @@ sawList xs = case xs of - [] -> [] + [] -> [] [a] -> a : 1 : 0 : [] a:rest -> a : 1 : 0 : 0 : sawList rest - + isawList xs = case xs of - [] -> [] + [] -> [] [a] -> 0 : 1 : a : [] a:rest -> 0 : 1 : a : 0 : isawList rest triList xs = case xs of [] -> [0, 0] - a:rest -> 0 : 1 : a : 1 : triList rest + a:rest -> 0 : 1 : a : 1 : triList rest pwList k xs = case xs of [] -> [] @@ -301,16 +301,16 @@ rampList a1 duty xs = case xs of [] -> [] [a] -> 0.5 * a : d1 : a : d1 : 0.5 * a : d2 : 0 : d2 : 0.5 * a1 : [] - a:as -> 0.5 * a : d1 : a : d1 : 0.5 * a : d2 : 0 : d2 : rampList a1 duty as - where + a:as -> 0.5 * a : d1 : a : d1 : 0.5 * a : d2 : 0 : d2 : rampList a1 duty as + where d1 = duty / 2 d2 = (1 - duty) / 2 irampList a1 duty xs = case xs of [] -> [] [a] -> 0.5 * a : d1 : 0 : d1 : 0.5 * a : d2 : a : d2 : 0.5 * a1 : [] - a:as -> 0.5 * a : d1 : 0 : d1 : 0.5 * a : d2 : a : d2 : rampList a1 duty as - where + a:as -> 0.5 * a : d1 : 0 : d1 : 0.5 * a : d2 : a : d2 : rampList a1 duty as + where d1 = duty / 2 d2 = (1 - duty) / 2 @@ -325,7 +325,7 @@ intersperseEnd val end xs = case xs of [] -> end [a] -> a : end - a:as -> a : val : intersperseEnd val end as + a:as -> a : val : intersperseEnd val end as ------------------------------------------------------------------ @@ -342,7 +342,7 @@ -- It's a list of values and durations. The durations are relative -- to the period of repetition. The period is specified with the second argument. -- The second argument is the frequency of repetition measured in Hz. --- +-- -- > lpshold valDurs frequency lpshold :: [Sig] -> Sig -> Sig lpshold as cps = smooth $ C.lpshold cps 0 0 as @@ -354,7 +354,7 @@ -- It's a list of values and durations. The durations are relative -- to the period of repetition. The period is specified with the second argument. -- The second argument is the frequency of repetition measured in Hz. --- +-- -- > loopseg valDurs frequency loopseg :: [Sig] -> Sig -> Sig loopseg as cps = smooth $ C.loopseg cps 0 0 (fixEnd as) @@ -366,7 +366,7 @@ -- It's a list of values and durations. The durations are relative -- to the period of repetition. The period is specified with the second argument. -- The second argument is the frequency of repetition measured in Hz. --- +-- -- > loopxseg valDurs frequency loopxseg :: [Sig] -> Sig -> Sig loopxseg as cps = smooth $ C.loopxseg cps 0 0 (fixEnd as) @@ -387,7 +387,7 @@ -- -- > xadsrSeq attack decay sustain release weights frequency -- --- The sum of attack, decay, sustain and release time durations +-- The sum of attack, decay, sustain and release time durations -- should be equal to one. adsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig adsrSeq a d s r = linSeq (adsrList a d s r) @@ -397,7 +397,7 @@ -- -- > xadsrSeq attack decay sustain release weights frequency -- --- The sum of attack, decay, sustain and release time durations +-- The sum of attack, decay, sustain and release time durations -- should be equal to one. xadsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig xadsrSeq a d s r = expSeq (adsrList a d s r) @@ -406,7 +406,7 @@ -- -- > adsrSeq attack decay sustain release rest weights frequency -- --- The sum of attack, decay, sustain, release and rest time durations +-- The sum of attack, decay, sustain, release and rest time durations -- should be equal to one. adsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig adsrSeq_ a d s r rest = linSeq (adsrList_ a d s r rest) @@ -416,7 +416,7 @@ -- -- > xadsrSeq_ attack decay sustain release rest weights frequency -- --- The sum of attack, decay, sustain, release and rest time durations +-- The sum of attack, decay, sustain, release and rest time durations -- should be equal to one. xadsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig xadsrSeq_ a d s r rest = expSeq (adsrList_ a d s r rest) @@ -477,18 +477,18 @@ genSegSeq :: ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> Sig -> Sig genSegSeq mkSeg shape weights cps = mkSeg (groupSegs $ fmap (scaleVals shape) weights) (cps / len) - where + where len = sig $ int $ length weights scaleVals xs k = case xs of [] -> [] [a] -> [a * k] - a:da:rest -> (a * k) : da : scaleVals rest k + a:da:rest -> (a * k) : da : scaleVals rest k groupSegs :: [[Sig]] -> [Sig] groupSegs as = concat $ intersperse [0] as --- | The seq is a type for step sequencers. +-- | The seq is a type for step sequencers. -- The step sequencer is a monophonic control signal. -- Most often step sequencer is a looping segment of -- some values. It's used to create bas lines or conrtrol the frequency of @@ -501,8 +501,8 @@ -- -- each pair defines a segment of height valN that lasts for durN. -- The sequence is repeated with the given frequency. Each segment --- has certain shape. It can be a constant or line segment or --- fragment of square wave or fragment of an adsr envelope. +-- has certain shape. It can be a constant or line segment or +-- fragment of square wave or fragment of an adsr envelope. -- There are many predefined functions. -- -- With Seq we can construct control signals in very flexible way. @@ -520,7 +520,7 @@ newtype Seq = Seq { unSeq :: [Seq1] } data Seq1 = Rest { - seq1Dur :: Sig } + seq1Dur :: Sig } | Seq1 { seq1Dur :: Sig , seq1Val :: Sig @@ -538,13 +538,13 @@ del t a = mel [rest t, a] instance Melody Seq where - mel as = Seq $ as >>= unSeq + mel as = Seq $ as >>= unSeq instance Stretch Seq where str t (Seq as) = Seq $ fmap (updateDur t) as where updateDur k a = a { seq1Dur = k * seq1Dur a } --- | Creates a +-- | Creates a toSeq :: Sig -> Seq toSeq a = Seq [Seq1 1 a] @@ -692,14 +692,14 @@ renderSeq0 :: (Sig -> Sig -> [Sig]) -> Seq -> [Sig] renderSeq0 f (Seq as) = as >>= phi - where + where phi x = case x of Seq1 dt val -> f dt val Rest dt -> [0, dt] renderSeq1 :: (Sig -> Sig -> [Sig]) -> Seq -> [Sig] renderSeq1 f (Seq as) = as >>= phi - where + where phi x = case x of Seq1 dt val -> f dt val Rest dt -> [0, dt, 0, 0] @@ -708,12 +708,12 @@ genSeqPat :: (Int -> [Double]) -> [Int] -> Seq genSeqPat g ns = mel (ns >>= f) - where f n + where f n | n <= 0 = [] | n == 1 = [1] | otherwise = fmap (toSeq . sig . double) $ g n --- | Function for creation of accented beats. +-- | Function for creation of accented beats. -- The steady beat pattern of accents is repeated. -- The first argument describes the list of integers. -- Each integer is a main beat and the length of the beat. @@ -722,7 +722,7 @@ -- > dac $ mul (seqSaw [seqPat [3, 3, 2]] 1) white seqPat :: [Int] -> Seq seqPat ns = mel (ns >>= f) - where f n + where f n | n <= 0 = [] | n == 1 = [1] | otherwise = [1, rest $ sig $ int $ n - 1] @@ -736,7 +736,7 @@ -- > dac $ mul (seqSaw [seqDesc [3, 3, 2]] 1) white seqDesc :: [Int] -> Seq seqDesc = genSeqPat rowDesc - + -- | It's like @seqPat@ but inplace of rests it fills the gaps with -- segments ascending in value. -- @@ -771,7 +771,7 @@ -- so that all values are sumed with some random value. The amplitude of the -- random value is given with the first argument. -- --- It can transform linseg, expseg, sequence producers and simplified sequence producers. +-- It can transform linseg, expseg, sequence producers and simplified sequence producers. -- -- An example: -- @@ -821,7 +821,7 @@ -- so that all durations are sumed with some random value. The amplitude of the -- random value is given with the first argument. -- --- It can transform linseg, expseg, sequence producers and simplified sequence producers. +-- It can transform linseg, expseg, sequence producers and simplified sequence producers. -- -- An example: -- @@ -860,7 +860,7 @@ -- so that all values and durations are sumed with some random value. The amplitude of the -- random value is given with the first two arguments. -- --- It can transform linseg, expseg, sequence producers and simplified sequence producers. +-- It can transform linseg, expseg, sequence producers and simplified sequence producers. -- -- An example: -- @@ -902,7 +902,7 @@ -- -- > trigTab table dur trigger trigTab :: Tab -> Sig -> Sig -> Sig -trigTab ifn kdur ktrig = +trigTab ifn kdur ktrig = tablei (lineto ktrig (kdur * delay1 ktrig)) ifn `withD` 1 @@ -912,3 +912,4 @@ -- > trigTabEvt table dur trigger trigTabEvt :: Tab -> Sig -> Evt a -> Sig trigTabEvt ifn kdur ktrig = trigTab ifn kdur (evtToTrig ktrig) + diff --git a/src/Csound/Air/Fx.hs b/src/Csound/Air/Fx.hs --- a/src/Csound/Air/Fx.hs +++ b/src/Csound/Air/Fx.hs @@ -55,12 +55,11 @@ fxRingModulator, , -} fxCompress, - -- Eq + -- * Eq audaciousEq, -- * Misc trackerSplice, pitchShifterDelay - ) where import Data.Boolean @@ -76,11 +75,11 @@ import Csound.Air.Filter import Csound.Typed.Plugins hiding(pitchShifterDelay, fxAnalogDelay, fxDistortion, fxEnvelopeFollower, fxFlanger, fxFreqShifter, fxLoFi, - fxPanTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2) + fxPanTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2, tapeEcho) import qualified Csound.Typed.Plugins as P(pitchShifterDelay, fxAnalogDelay, fxDistortion, fxEnvelopeFollower, fxFlanger, fxFreqShifter, fxLoFi, - fxPanTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2, fxPingPong, tapeRead, tapeWrite) + fxPanTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2, fxPingPong, tapeRead, tapeWrite, tapeEcho) -- | Mono version of the cool reverberation opcode reverbsc. -- @@ -867,23 +866,6 @@ ------------------------------- -- tape echo -{-} -opcode TapeEcho4, a, akkkkk - aIn, kDelay, kEchoGain, kFbGain, kTone, kRandomSpread xin - - aDummy delayr 16 - aEcho1 tapeRead aIn, kDelay, kRandomSpread - aEcho2 tapeRead aIn, (kDelay * 2), kRandomSpread - aEcho3 tapeRead aIn, (kDelay * 4), kRandomSpread - aEcho4 tapeRead aIn, (kDelay * 8), kRandomSpread - aOut = aIn + kEchoGain * aEcho1 + 0.5 * kEchoGain * aEcho2 + 0.25 * kEchoGain * aEcho3 + 0.2 * kEchoGain * aEcho4 - - aOut tone aOut, kTone - tapeWrite aIn, aOut, kFbGain - xout aOut -endop --} - type EchoGain = Sig type RandomSpreadSig = Sig @@ -896,19 +878,9 @@ -- * echo gain -- * tone - normalized center frequency of the filter (0 to 1) -- * randomSpread - quality of the tape (the higher - the worser) -tapeEcho :: Int -> DelayTime -> Feedback -> EchoGain -> ToneSig -> RandomSpreadSig -> Sig -> SE Sig -tapeEcho n dt fb echoGain ktoneNorm spread ain = do - aDummy <- delayr minDt - aout <- fmap ((\echoes -> tone (ain + echoGain * echoes) ktone) . sum . zipWith (*) halves) $ - mapM (\step -> tapeRead ain (dt * step) spread) doubles - tapeWrite ain aout fb - return aout +tapeEcho :: D -> DelayTime -> Feedback -> EchoGain -> ToneSig -> RandomSpreadSig -> Sig -> Sig +tapeEcho n dt fb echoGain ktoneNorm spread ain = P.tapeEcho n dt echoGain fb ktone spread ain where - halves = take n $ iterate ( / 2) 1 - doubles = take n $ iterate ( * 2) 1 - - minDt = int $ 16 `max` (n * 4) - ktone = fromNormTone ktoneNorm fromNormTone :: Sig -> Sig diff --git a/src/Csound/Air/Fx/FxBox.hs b/src/Csound/Air/Fx/FxBox.hs --- a/src/Csound/Air/Fx/FxBox.hs +++ b/src/Csound/Air/Fx/FxBox.hs @@ -181,12 +181,16 @@ uiCrusher, -- ** Ring modulation - uiRingo', uiRingo1, uiRingo2, uiRingo3, uiRingo4, uiRingo5 + uiRingo', uiRingo1, uiRingo2, uiRingo3, uiRingo4, uiRingo5, -- ** Compressor -- | TODO + -- * Misc + + -- ** Ambi guitar + ambiGuitar ) where import Data.Default @@ -211,7 +215,7 @@ import Csound.Air.Live(fxBox, fxColor) import Csound.Air.Wav(toMono) -import Csound.Air.Misc(fromMono) +import Csound.Air.Misc(fromMono, ambiEnv, saturator) import qualified Data.Colour as C import qualified Data.Colour.SRGB as C @@ -468,9 +472,17 @@ adele4m = adeleByM size4 adele5m = adeleByM size5 --- Tape echo -magnus :: Sigs a => Int -> DelayTime -> Feedback -> EchoGain -> ToneSig -> RandomSpreadSig -> a -> SE a -magnus size delt fb echoGain ktone randomSpread = bindSig (tapeEcho size delt fb echoGain ktone randomSpread) +-- | magnus - simulates magnetic tape echo/delay +-- +-- > magnus size feedback echoGain tone randomSpread ain +-- +-- * size - how many heads in the tape +-- * feedback +-- * echo gain +-- * tone - normalized center frequency of the filter (0 to 1) +-- * randomSpread - quality of the tape (the higher - the worser) +magnus :: Sigs a => D -> DelayTime -> Feedback -> EchoGain -> ToneSig -> RandomSpreadSig -> a -> a +magnus size delt fb echoGain ktone randomSpread = mapSig (tapeEcho size delt fb echoGain ktone randomSpread) -- Ping Pong delay @@ -779,7 +791,7 @@ uiMagnus :: Sigs a => Int -> Double -> Double -> Double -> Double -> Double -> Source (Fx a) uiMagnus size initDelayTime initFeedback initEchoGain initTone initSpread = mapSource bindSig $ paintTo adeleColor $ fxBox "Tape echo" fx True [("del time", initDelayTime), ("fbk", initFeedback), ("echo gain", initEchoGain), ("tone", initTone), ("tape qty", initSpread)] where - fx [delayTime, feedback, echoGain, tone, spread] = magnus size delayTime feedback echoGain tone spread + fx [delayTime, feedback, echoGain, tone, spread] = return . magnus (int size) delayTime feedback echoGain tone spread -- Ping-pong delay @@ -1180,4 +1192,27 @@ uiCave4m = uiMonoCave size4 uiCave5m = uiMonoCave size5 +type ThreshSig = Sig +------------------------------------- +-- ambient guitar + +-- | Ambient guitar patch. It uses @ambiEnv@ with stack of delays and a bit of compression and distortion. +-- No reverb is added. The reverb is for user to add. +-- +-- > ambiGuitar thresh delayTime feedback tone driveLevel sig +-- +-- For thresh try out values like 0.01, 0.02 +-- +-- Example, we read guitar input from soundcard first input, +-- apply ambient guitar effect and a bit of reverb: +-- +-- > main = dac proc +-- > +-- > proc :: Sig2 -> SE Sig2 +-- > proc (x, _) = hall 0.25 $ ambiGuitar 0.02 1 0.7 0.4 0.1 x +ambiGuitar :: ThreshSig -> DelayTime -> Feedback -> ToneSig -> DriveSig -> Sig -> SE Sig +ambiGuitar thresh dt fbk toneSig drv ain = do + envSig <- ambiEnv thresh ain + return $ ( adele 0.35 dt fbk toneSig . adele 0.5 (dt / 4) (fbk * 1.25) toneSig . + saturator 0.3 . tort drv 0.25) envSig diff --git a/src/Csound/Air/Live.hs b/src/Csound/Air/Live.hs --- a/src/Csound/Air/Live.hs +++ b/src/Csound/Air/Live.hs @@ -61,13 +61,13 @@ genMixer :: (Sigs a) => ([Gui] -> Gui, [Gui] -> Gui) -> [(String, SE a)] -> Source a genMixer (parentGui, childGui) as = source $ do - gTags <- mapM (unDisplay . box) names - (gs, vols) <- fmap unzip $ mapM (const $ unSource $ defSlider "") names - (gMutes, mutes) <- fmap unzip $ mapM (const $ unSource $ toggleSig "" False) names + gTags <- mapM box names + (gs, vols) <- fmap unzip $ mapM (const $ defSlider "") names + (gMutes, mutes) <- fmap unzip $ mapM (const $ toggleSig "" False) names - gMasterTag <- unDisplay $ box "master" - (gMaster, masterVol) <- unSource $ defSlider "" - (gMasterMute, masterMute) <- unSource $ toggleSig "" False + 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 @@ -116,12 +116,12 @@ -- fxBox :: forall a. (FxUI a, Num (FxArg a), Tuple (FxArg a)) => String -> a -> Bool -> [(String, Double)] -> Source (Fx (FxArg a)) fxBox :: forall a. Sigs a => String -> ([Sig] -> Fx a) -> Bool -> [(String, Double)] -> Source (Fx a) fxBox name fx onOff args = source $ do - (gOff0, off) <- unSource $ toggleSig name onOff + (gOff0, off) <- toggleSig name onOff let gOff = setFontSize 25 gOff0 offRef <- newGlobalRef (0 :: Sig) writeRef offRef off let (names, initVals) = unzip args - (gs, as) <- fmap unzip $ mapM (\(name, initVal) -> unSource $ slider name (linSpan 0 1) initVal) $ zip names initVals + (gs, as) <- fmap unzip $ mapM (\(name, initVal) -> slider name (linSpan 0 1) initVal) $ zip names initVals let f x = do ref <- newRef (0 :: a) goff <- readRef offRef @@ -155,7 +155,7 @@ uiGroupGui a b =ver [sca uiOnOffSize a, sca uiBoxSize b] sourceColor2 :: Color -> Source a -> Source a -sourceColor2 col (Source a) = source $ do +sourceColor2 col a = source $ do (g, x) <- a return (setColor2 col g, x) @@ -166,22 +166,22 @@ -- combine effects fxGroupMS :: ([Gui] -> Gui) -> [Source Fx1] -> Maybe (Source (Sig -> SE Sig2)) -> [Source Fx2] -> Source (Sig -> SE Sig2) -fxGroupMS guiGroup as bridge bs = Source $ do +fxGroupMS guiGroup as bridge bs = do (gsA, fA) <- getChain as (gsB, fB) <- getChain bs case bridge of Nothing -> return $ (guiGroup $ gsA ++ gsB, fA >=> fB . fromMono) Just widget -> do - (gBridge, fBridge) <- unSource widget + (gBridge, fBridge) <- widget return $ (guiGroup $ gsA ++ gBridge : gsB, fA >=> fBridge >=> fB) where getChain xs = do - (gs, fs) <- fmap unzip $ sequence $ fmap unSource xs + (gs, fs) <- fmap unzip $ sequence xs return (gs, foldl (\a b -> a >=> b) return fs) fxGroup :: ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a) -fxGroup guiGroup as = Source $ do - (gs, fs) <- fmap unzip $ sequence $ fmap unSource as +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. @@ -343,8 +343,8 @@ -- | the widget for mixing in a signal to the signal. uiSig :: (Sigs a) => String -> Bool -> Source a -> Source (Fx a) uiSig name onOff widget = source $ do - (gs, asig) <- unSource widget - (gOff0, off) <- unSource $ toggleSig name onOff + (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) @@ -380,10 +380,10 @@ genAdsr :: (D -> D -> D -> D -> Sig) -> String -> AdsrBound -> AdsrInit -> Source Sig genAdsr mkAdsr name b inits = source $ do - (gatt, att) <- unSource $ knob "A" (linSpan expEps $ attBound b) (attInit inits) - (gdec, dec) <- unSource $ knob "D" (linSpan expEps $ decBound b) (decInit inits) - (gsus, sus) <- unSource $ knob "S" (linSpan expEps 1) (susInit inits) - (grel, rel) <- unSource $ knob "R" (linSpan expEps $ relBound b) (relInit inits) + (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) diff --git a/src/Csound/Air/Looper.hs b/src/Csound/Air/Looper.hs --- a/src/Csound/Air/Looper.hs +++ b/src/Csound/Air/Looper.hs @@ -166,14 +166,14 @@ , (\f -> f "through" False) $ maybe toggleSig (toggleSig' . evtToSig (-1)) (loopThrough a)) genLoop :: forall a. (BoolSig -> a -> SE Sig2) -> LoopSpec -> D -> [D] -> [a] -> Source Sig2 -genLoop playInstr spec dtBpm times' instrs = Source $ do - (preFxKnobGui, preFxKnobWrite, preFxKnobRead) <- unSinkSource $ setKnob "pre" (linSpan 0 1) 0.5 - (postFxKnobGui, postFxKnobWrite, postFxKnobRead) <- unSinkSource $ setKnob "post" (linSpan 0 1) 0.5 - (mixKnobGui, mixKnobWrite, mixKnobRead) <- unSinkSource $ setKnob "mix" (linSpan 0 1) 0.5 +genLoop playInstr spec dtBpm times' instrs = do + (preFxKnobGui, preFxKnobWrite, preFxKnobRead) <- setKnob "pre" (linSpan 0 1) 0.5 + (postFxKnobGui, postFxKnobWrite, postFxKnobRead) <- setKnob "post" (linSpan 0 1) 0.5 + (mixKnobGui, mixKnobWrite, mixKnobRead) <- setKnob "mix" (linSpan 0 1) 0.5 let knobGuis = ver [mixKnobGui, preFxKnobGui, postFxKnobGui] - unSource $ mapGuiSource (\gs -> hor [knobGuis, sca 12 gs]) $ joinSource $ vlift3 (\(thr, delEvt) x sils -> do + mapGuiSource (\gs -> hor [knobGuis, sca 12 gs]) $ joinSource $ vlift3 (\(thr, delEvt) x sils -> do -- knobs mixCoeffs <- tabSigs mixKnobWrite mixKnobRead x initMixVals preCoeffs <- tabSigs preFxKnobWrite preFxKnobRead x initPreVals diff --git a/src/Csound/Air/Misc.hs b/src/Csound/Air/Misc.hs --- a/src/Csound/Air/Misc.hs +++ b/src/Csound/Air/Misc.hs @@ -1,12 +1,12 @@ {-# Language FlexibleContexts #-} -- | Patterns module Csound.Air.Misc( - mean, vibrate, randomPitch, chorusPitch, resons, resonsBy, modes, dryWet, + mean, vibrate, randomPitch, chorusPitch, resons, resonsBy, modes, dryWet, once, onceBy, several, fromMono, -- * List functions odds, evens, -- * Random functions - rndPan, rndPan2, rndVol, gaussVol, + rndPan, rndPan2, rndVol, gaussVol, -- * Choose signals selector, -- * Saving to file @@ -27,21 +27,28 @@ -- * Function composition funSeq, funPar, - -- * Metronome + -- * Metronome ticks, nticks, ticks2, nticks2, ticks3, nticks3, ticks4, nticks4, -- * Drone - testDrone, testDrone2, testDrone3, testDrone4 + testDrone, testDrone2, testDrone3, testDrone4, + + -- * Attack detection + attackTrig, + attackTrigSig, + + -- * Ambient guitar FX + ambiEnv ) where import Control.Monad import Data.Boolean import Data.Default -import Csound.Dynamic hiding (int) +import Csound.Dynamic hiding (int, when1) import Csound.Typed import Csound.Typed.Opcode hiding (metro) @@ -63,23 +70,23 @@ -- | Selects odd elements from the list. odds :: [a] -> [a] -odds as = fmap snd $ filter fst $ zip (cycle [True, False]) as +odds as = fmap snd $ filter fst $ zip (cycle [True, False]) as -- | Selects even elements from the list. evens :: [a] -> [a] -evens as +evens as | null as = [] | otherwise = odds $ tail as --- | Reads table once during the note length. +-- | Reads table once during the note length. once :: Tab -> Sig once = onceBy idur --- | Reads table once during a given period of time. +-- | Reads table once during a given period of time. onceBy :: D -> Tab -> Sig -onceBy dt tb = kr $ oscBy tb (1 / sig dt) +onceBy dt tb = kr $ oscBy tb (1 / sig dt) --- | Reads table several times during the note length. +-- | Reads table several times during the note length. several :: Tab -> Sig -> Sig several tb rate = kr $ oscil3 1 (rate / sig idur) tb @@ -87,12 +94,12 @@ 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. +-- | 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) + where kvib = vibDepth * kr (osc vibRate) --- | Adds a random vibrato to the sound unit. Sound units is a function that takes in a frequency. +-- | 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) @@ -104,7 +111,7 @@ 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] + dts = fmap (\x -> - wid + fromIntegral x * dt) [0 .. n-1] dt = 2 * wid / fromIntegral n @@ -123,7 +130,7 @@ resonsBy :: (cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig resonsBy filt ps asig = mean $ fmap (( $ asig) . uncurry filt) ps --- | Mixes dry and wet signals. +-- | Mixes dry and wet signals. -- -- > dryWet ratio effect asig -- @@ -138,7 +145,7 @@ -- | Chain of mass-spring-damping filters. -- --- > modes params baseCps exciter +-- > modes params baseCps exciter -- -- * params - a list of pairs @(resonantFrequencyRatio, filterQuality)@ -- @@ -150,11 +157,11 @@ 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 + 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 + gate cps = ifB (sig getSampleRate >* pi * cps) 1 0 normFactor = sum $ fmap (gate . (* baseCps) . fst) ms @@ -174,11 +181,11 @@ -- | Random panning rndPan :: Sig -> SE Sig2 -rndPan a = do +rndPan a = do fmap (pan2 a . sig) (rnd (1 :: D)) -- | Random volume (with gauss distribution) --- +-- -- > gaussVol radiusOfDistribution gaussVol :: SigSpace a => D -> a -> SE a gaussVol k a = do @@ -186,7 +193,7 @@ return $ mul (sig $ level + 1) a -- | Random volume --- +-- -- > gaussVol (minVolume, maxVolume) rndVol :: SigSpace a => (D, D) -> a -> SE a rndVol (kMin, kMax) a = do @@ -207,16 +214,16 @@ selector as k = sum $ zipWith choice [0..] as where choice n a = mul (port (ifB (sig (int n) ==* k) 1 0) 0.02) a --- | Creates running arpeggios. +-- | Creates running arpeggios. -- -- > arpeggiBy ampWeights pitches instrument cps -- -- It plays an instrument with fast sequence of notes. We can specify -- the pitches and amplitude weights of the notes as well as frequency of repetition. arpeggi :: SigSpace a => [Sig] -> [Sig] -> (Sig -> a) -> Sig -> a -arpeggi = arpBy triSeq sqrSeq +arpeggi = arpBy triSeq sqrSeq --- | Creates running arpeggios. +-- | Creates running arpeggios. -- -- > arpeggiBy ampWave pitchwave ampWeights pitches instrument cps -- @@ -271,7 +278,7 @@ rndVal :: D -> D -> D -> SE D rndVal total amount x = do - k <- birnd amount + k <- birnd amount return $ x + k * total rndDur amt x = rndVal x amt x @@ -283,11 +290,11 @@ dur <- rndDur' tune <- rndTune' cps <- rndCps' - return $ spec - { trDur = dur + return $ spec + { trDur = dur , trTune = tune , trCps = cps } - where + where rndDur' = (maybe return rndDur $ (trRnd spec)) $ trDur spec rndTune' = (maybe return rndTune $ (trRnd spec)) $ trTune spec rndCps' = (maybe return rndCps $ (trRnd spec)) $ trCps spec @@ -316,7 +323,7 @@ nticks4 = nticks' highConga' nticks' :: (TrSpec -> SE Sig) -> [Int] -> Sig -> Sig -nticks' drum ns = genTicks drum (cycleE $ ns >>= getAccent) +nticks' drum ns = genTicks drum (cycleE $ ns >>= getAccent) -- | Metronome. -- @@ -334,13 +341,13 @@ ticks4 = ticks' highConga' ticks' :: (TrSpec -> SE Sig) -> Int -> Sig -> Sig -ticks' drum n +ticks' drum n | n <= 1 = genTicks drum (devt 0.5) | otherwise = genTicks drum (cycleE $ getAccent n) genTicks :: (TrSpec -> SE Sig) -> (Tick -> Evt D) -> Sig -> Sig -genTicks drum f x = mul 3 $ mlp 4000 0.1 $ - sched (\amp -> mul (sig amp) $ drum (TrSpec (amp + 1) 0 (1200 * (amp + 0.5)) (Just 0.05))) $ +genTicks drum f x = mul 3 $ mlp 4000 0.1 $ + sched (\amp -> mul (sig amp) $ drum (TrSpec (amp + 1) 0 (1200 * (amp + 0.5)) (Just 0.05))) $ withDur 0.5 $ f $ metro (x / 60) rimShot' spec = pureRimShot' =<< rndSpec spec @@ -357,7 +364,7 @@ -- ring aenv1 = expsega [1,fullDur,0.001] - ifrq1 = sig $ cps * octave tune + ifrq1 = sig $ cps * octave tune aring = mul (0.5 * (aenv1 - 0.001)) $ at (bbp ifrq1 (ifrq1 * 8)) $ rndOscBy tabTR808RimShot ifrq1 -- noise @@ -418,7 +425,7 @@ testDrone3 cps = atNote (deepPad caveOvertonePad) (0.8, cps) testDrone4 cps = atNote (deepPad pwEnsemble) (0.8, cps) -pwEnsemble = withSmallHall $ polySynt $ at fromMono . mul 0.55 . onCps impPwEnsemble +pwEnsemble = withSmallHall $ polySynt $ at fromMono . mul 0.55 . onCps impPwEnsemble nightPad = withLargeHall $ polySynt $ mul 0.48 . at fromMono . onCps (mul (fadeOut 1) . impNightPad 0.5) data RazorPad = RazorPad { razorPadSpeed :: Sig } @@ -427,12 +434,12 @@ def = RazorPad 0.5 razorPad = razorPad' def -razorPad' (RazorPad speed) = withLargeHall' 0.35 $ polySynt $ at fromMono . mul 0.6 . onCps (uncurry $ impRazorPad speed) +razorPad' (RazorPad speed) = withLargeHall' 0.35 $ polySynt $ at fromMono . mul 0.6 . onCps (uncurry $ impRazorPad speed) overtonePad = withLargeHall' 0.35 $ polySynt overtoneInstr - + overtoneInstr :: CsdNote D -> SE Sig2 -overtoneInstr = mul 0.65 . at fromMono . mixAt 0.25 (mlp 1500 0.1) . onCps (\cps -> mul (fades 0.25 1.2) (tibetan 11 0.012 cps) + mul (fades 0.25 1) (tibetan 13 0.015 (cps * 0.5))) +overtoneInstr = mul 0.65 . at fromMono . mixAt 0.25 (mlp 1500 0.1) . onCps (\cps -> mul (fades 0.25 1.2) (tibetan 11 0.012 cps) + mul (fades 0.25 1) (tibetan 13 0.015 (cps * 0.5))) caveOvertonePad = FxChain (fx1 0.2 (magicCave2 . mul 0.8)) $ polySynt overtoneInstr @@ -452,7 +459,7 @@ -- * 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 = chorusPitch n (2 * off * fromIntegral n) (oscBy wave) (sig cps) @@ -464,7 +471,7 @@ genRazor filter speed amp cps = mul amp $ do a1 <- ampSpline 0.01 - a2 <- ampSpline 0.02 + a2 <- ampSpline 0.02 return $ filter (1000 + 2 * cps + 500 * amp) 0.1 $ mean [ fosc 1 3 (a1 * uosc (speed)) cps @@ -473,12 +480,12 @@ where ampSpline c = rspline ( amp) (3.5 + amp) ((speed / 4) * (c - 0.1)) ((speed / 4) * (c + 0.1)) --- | +-- | -- > nightPad fadeInTime cps impNightPad :: D -> Sig -> Sig impNightPad dt = (fadeIn dt * ) . stringPad 1 --- | +-- | -- -- > stringPad amplitude cps stringPad :: Sig -> Sig -> Sig @@ -519,15 +526,15 @@ -- -- > wshaper table amount asig -- --- wave shaper transforms the input signal with the table. --- The amount of transformation scales the signal from 0 to 1. +-- wave shaper transforms the input signal with the table. +-- The amount of transformation scales the signal from 0 to 1. -- the amount is ratio of scaling. It expects the values from the interval [0, 1]. --- +-- wshaper :: Tab -> Sig -> Sig -> Sig wshaper t amt asig = tablei (10 * amt * asig / 20) t `withDs` [1, 0.5] -- | Wave shaper with sigmoid. --- +-- -- > genSaturator sigmoidRadius amount asig -- -- * sigmoid radius is 5 to 100. @@ -560,3 +567,80 @@ hardSaturator2 :: Sig -> Sig -> Sig hardSaturator2 = genSaturator 6.5 + +----------------------------------------- +-- attack detection + +-- | Detects attacks in the signal. Outputs event stream of attack events. +-- +-- > attackTrig threshold sigIn +-- +-- threshhold cnmtrols the sensitivity of attack detection. +-- Try out different values in [0, 0.2] +attackTrig :: Sig -> Sig -> SE (Evt Unit) +attackTrig thresh ain = fmap sigToEvt $ attackTrigSig thresh ain + +-- | Detects attacks in the signal. Outputs trigger-signal +-- where 1 is when attack happens and 0 otherwise. +attackTrigSig :: Sig -> Sig -> SE Sig +attackTrigSig thresh x = do + kTime <- newCtrlRef (iWait + 1) + kTrig <- newCtrlRef 0 + + writeRef kTrig 0 + timeVal <- readRef kTime + + when1 (da >* thresh &&* timeVal >* iWait) $ do + printk 0 timeVal + writeRef kTrig 1 + writeRef kTime 0 + + modifyRef kTime (+1) + + readRef kTrig + where + da = diffSig 0.01 $ rms x + iWait :: Sig + iWait = 100 + + diffSig :: D -> Sig -> Sig + diffSig dt x = x - delaySig dt x + + +------------------------------ +-- ambient envelope + +-- | Make smooth attacks for the input guitar or piano-like sounds. +-- It simulates automatic volume control pedal. It detects striken attacks +-- and makes them sound more PAD-like. +-- +-- first argument is threshold that controls sensitivity of attack detection. +-- The values like ~ 0.01, 0.02 is good start. +-- +-- To use it with guitar it's good to add a bit of distortion and compression +-- to the signal to make it brighter and then to apply several delays to prolong the sustain +-- and release phases. And it's good to add some reverb at the end. +-- +-- Here is an example of how to make ambient guitar with this effect: +-- +-- > main = dac proc +-- > +-- > -- | Let's assume we read guitar from the first input of sound card +-- > proc :: Sig2 -> SE Sig2 +-- > proc (x, _) = mul 1 $ hall 0.25 $ +-- > fmap ( fromMono . (adele 0.35 1 0.65 0.34) . (adele 0.35 0.25 0.75 0.34) . +-- > saturator 0.3 . tort 0.1 0.25 . +-- > magnus 2 0.25 1.1 0.6 0.4 1.8) $ +-- > ambiEnv 0.02 x +-- > +-- +-- So I've added a tape echo with magnus, +-- then goes combo of saturator (compressor) and tort (distortion) +-- then goes a couple of delays (adele) +-- and the last part is sweet reverb (hall). +ambiEnv :: Sig -> Sig -> SE Sig +ambiEnv thresh ain = do + attacks <- attackTrigSig thresh ain + return $ delaySig 0.1 (env attacks) * ain + where + env tr = adsr140 (rms ain - 0.05) tr 4 1 1 3 diff --git a/src/Csound/Air/Sampler.hs b/src/Csound/Air/Sampler.hs --- a/src/Csound/Air/Sampler.hs +++ b/src/Csound/Air/Sampler.hs @@ -14,7 +14,7 @@ syncCharTrig, syncCharTap, syncCharPush,syncCharToggle, syncCharGroup, syncCharCycle, -- * Midi sampler - midiTrig, midiTap, midiPush, midiToggle, midiGroup, + midiTrig, midiTap, midiPush, midiToggle, midiGroup, -- * Generic functions midiTrigBy, midiTapBy, midiPushBy, midiToggleBy, midiGroupBy, @@ -25,7 +25,7 @@ -- * Misc -- | Keyboard char columns - keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, + keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0, keyColumns @@ -51,7 +51,7 @@ evtTrig minitVal x st a = case minitVal of Nothing -> ons Just v0 -> ons + offs v0 + first v0 - where + where ons = evtTrigNoInit x st a offs v = evtTrigNoInit st x v first v = evtTrigger loadbang x v @@ -59,7 +59,7 @@ evtTrigNoInit x st a = runSeg $ loop $ lim st $ del x $ loop (lim x $ toSeg a) syncEvtTrig :: (Sigs a) => Sig -> Maybe a -> Tick -> Tick -> a -> a -syncEvtTrig bpm minitVal x st a = evtTrig minitVal (syncBpm bpm x) (syncBpm bpm st) a +syncEvtTrig bpm minitVal x st a = evtTrig minitVal (syncBpm bpm x) (syncBpm bpm st) a -- | Toggles the signal with event stream. evtToggle :: (Sigs a) => Maybe a -> Tick -> a -> a @@ -73,21 +73,21 @@ -- every note is held to infinity and it continues to produce zeroes. -- No it's not every sequence note triggers it -- but it's best to limit them anyway -evtTap :: (Sigs a) => D -> Tick -> a -> a +evtTap :: (Sigs a) => Sig -> Tick -> a -> a evtTap dt x a = runSeg $ del x $ loop $ lim x $ toSeg $ takeSnd dt a -syncEvtTap :: (Sigs a) => Sig -> D -> Tick -> a -> a +syncEvtTap :: (Sigs a) => Sig -> Sig -> Tick -> a -> a syncEvtTap bpm dt x = evtTap dt (syncBpm bpm x) -- | Plays a list signals. It triggers the signal with event stream and silences -- all the rest in the list so that only one signal is playing. We can create simple -- costum monosynthes with this function. The last event stream stops all signals. evtGroup :: (Sigs a) => Maybe a -> [(Tick, a)] -> Tick -> a -evtGroup initVal as stop = sum $ fmap (\(a, b, c) -> evtTrig initVal a (mappend b stop) c) +evtGroup initVal as stop = sum $ fmap (\(a, b, c) -> evtTrig initVal a (mappend b stop) c) $ zipWith (\n (a, sam) -> (a, mconcat $ fmap snd $ filter ((/= n) . fst) allEvts, sam)) [(0 :: Int)..] as - where + where allEvts :: [(Int, Tick)] - allEvts = zip [0 ..] (fmap fst as) + allEvts = zip [0 ..] (fmap fst as) syncEvtGroup :: (Sigs a) => Sig -> Maybe a -> [(Tick, a)] -> Tick -> a syncEvtGroup bpm initVal as stop = evtGroup initVal (fmap (\(e, a) -> (syncBpm bpm e, a)) as) (syncBpm bpm stop) @@ -96,8 +96,8 @@ evtCycle :: (Sigs a) => Maybe a -> Tick -> Tick -> [a] -> a evtCycle minitVal start stop sigs = case minitVal of Nothing -> ons - Just _ -> ons + offs - where + Just _ -> ons + offs + where ons = evtCycleNoInit start stop sigs offs = evtGroup minitVal [(start, 0)] stop @@ -117,7 +117,7 @@ Nothing -> ons Just initVal -> ons + offs initVal + first initVal where - ons = charTrigNoInit starts stops asig + ons = charTrigNoInit starts stops asig offs initVal = charTrigNoInit stops starts initVal first initVal = evtTrigger loadbang (strOn starts) initVal @@ -125,13 +125,13 @@ -- | Triggers a signal when one of the chars from the first string is pressed. -- Stops signal from playing when one of the chars from the second string is pressed. --- Synchronizes the signal with bpm (first argument). +-- Synchronizes the signal with bpm (first argument). syncCharTrig :: (Sigs a) => Sig -> Maybe a -> String -> String -> a -> a syncCharTrig bpm minitVal starts stops asig = case minitVal of Nothing -> ons Just initVal -> ons + offs initVal + first initVal where - ons = charTrigNoInit starts stops asig + ons = charTrigNoInit starts stops asig offs initVal = charTrigNoInit stops starts initVal first initVal = syncEvtTrigger bpm loadbang (strOn starts) initVal @@ -152,7 +152,7 @@ genCharPush trig minitVal ch asig = case minitVal of Nothing -> ons Just v0 -> ons + offs v0 + first v0 - where + where ons = trig (charOn ch) (charOff ch) asig offs v = trig (charOff ch) (charOn ch) v first v = trig loadbang (charOn ch) v @@ -168,12 +168,12 @@ -- | Toggles the signal when key is pressed. genCharToggle :: (Sigs a) => (Tick -> Tick) -> Maybe a -> Char -> a -> a -genCharToggle needSync minitVal key asig = retrig (togInstr minitVal asig) - $ accumE (1 :: D) (\_ s -> (s, mod' (s + 1) 2)) +genCharToggle needSync minitVal key asig = retrig (togInstr minitVal asig) + $ accumE (1 :: D) (\_ s -> (s, mod' (s + 1) 2)) $ needSync $ charOn key - where + where togInstr mv0 asig isPlay = do - ref <- newRef 0 + ref <- newRef 0 case mv0 of Nothing -> return () Just v0 -> writeRef ref v0 @@ -185,10 +185,10 @@ -- every note is held to infinity and it continues to produce zeroes. -- No it's not every sequence note triggers it -- but it's best to limit them anyway -charTap :: Sigs a => D -> String -> a -> a +charTap :: Sigs a => Sig -> String -> a -> a charTap stop starts = evtTap stop (strOn starts) -syncCharTap :: Sigs a => Sig -> D -> String -> a -> a +syncCharTap :: Sigs a => Sig -> Sig -> String -> a -> a syncCharTap bpm stop starts = syncEvtTap bpm stop (strOn starts) -- | Plays a list of signals when corresponding key is pressed. @@ -212,10 +212,10 @@ offs initVal = charGroupNoInit (fmap (\ch -> (ch, initVal)) stop) onKeys first initVal = trig loadbang (mconcat $ fmap charOn onKeys) initVal - onKeys = fmap fst as - + onKeys = fmap fst as + charGroupNoInit as stop = sum $ fmap f as - where + where allKeys = fmap fst as ++ stop f (key, asig) = trig ons offs asig where @@ -223,13 +223,13 @@ offs = strOn allKeys -- | Plays signals one after another when key is pressed. --- Stops the group from playing when the char from the last +-- Stops the group from playing when the char from the last -- argument is pressed. charCycle :: Sigs a => (Maybe a) -> Char -> String -> [a] -> a charCycle initVal start stops sigs = evtCycle initVal (charOn start) (strOn stops) sigs -- | Plays signals one after another when key is pressed. --- Stops the group from playing when the char from the last +-- Stops the group from playing when the char from the last -- argument is pressed. Events are syncronised with BPM (first argument). syncCharCycle :: Sigs a => Sig -> Maybe a -> Char -> String -> [a] -> a syncCharCycle bpm initVal start stops sigs = syncEvtCycle bpm initVal (charOn start) (strOn stops) sigs @@ -273,7 +273,7 @@ -- | Plays a signal when the key is pressed. Retriggers the signal when the key is pressed again. -- Turns off the signal after specified duration (n seconds). -- The key is an integer midi code. The C1 is 60 and the A1 is 69. -midiTap :: (SigSpace a, Sigs a) => MidiChn -> D -> Int -> a -> SE a +midiTap :: (SigSpace a, Sigs a) => MidiChn -> Sig -> Int -> a -> SE a midiTap = midiTapBy midiAmpInstr -- | Plyas a signal while the key is pressed. @@ -281,14 +281,14 @@ midiPush :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a midiPush = midiPushBy midiAmpInstr --- | Plays and stops a signal in the toggle mode. +-- | Plays and stops a signal in the toggle mode. -- The key is an integer midi code. The C1 is 60 and the A1 is 69. midiToggle :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a midiToggle = midiToggleBy midiAmpInstr --- | Plays a set of signals on the list of keys. When certain +-- | Plays a set of signals on the list of keys. When certain -- key is pressed the corresponding signal starts to play and all --- the rest are stopped. +-- the rest are stopped. -- -- -- The key is an integer midi code. The C1 is 60 and the A1 is 69. midiGroup :: (SigSpace a, Sigs a) => MidiChn -> [(Int, a)] -> SE a @@ -303,7 +303,7 @@ -- | The generic midiTap. We can specify the midi function. -- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1). -- It produces some output. The default is scaling the signal with the amplitude. -midiTapBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> D -> Int -> a -> SE a +midiTapBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Sig -> Int -> a -> SE a midiTapBy midiInstr midiChn dt key asig = midiTrigBy midiInstr midiChn key (takeSnd dt asig) -- | The generic midiPush. We can specify the midi function. @@ -313,15 +313,15 @@ midiPushBy midiInstr midiChn key asig = do ons <- midiKeyOn midiChn (int key) offs <- midiKeyOff midiChn (int key) - return $ midiEvtTriggerBy midiInstr ons offs asig + return $ midiEvtTriggerBy midiInstr ons offs asig -- | The generic midiToggle. We can specify the midi function. -- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1). -- It produces some output. The default is scaling the signal with the amplitude. midiToggleBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a -midiToggleBy midiInstr midiChn key asig = fmap (\evt -> retrig (togMidiInstr asig) evt) +midiToggleBy midiInstr midiChn key asig = fmap (\evt -> retrig (togMidiInstr asig) evt) (fmap (accumE (1 :: D) (\a s -> ((a, s), mod' (s + 1) 2))) $ midiKeyOn midiChn $ int key) - where + where togMidiInstr asig (amp, isPlay) = do ref <- newRef 0 when1 (sig isPlay ==* 1) $ do @@ -333,7 +333,7 @@ -- It produces some output. The default is scaling the signal with the amplitude. midiGroupBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> [(Int, a)] -> SE a midiGroupBy midiInstr midiChn as = fmap sum $ mapM f as - where + where allKeys = fmap fst as f (key, asig) = do ons <- midiKeyOn midiChn (int key) diff --git a/src/Csound/Air/Seg.hs b/src/Csound/Air/Seg.hs --- a/src/Csound/Air/Seg.hs +++ b/src/Csound/Air/Seg.hs @@ -1,6 +1,6 @@ {-# Language TypeFamilies #-} module Csound.Air.Seg ( - Seg, toSeg, runSeg, + Seg, toSeg, runSeg, constLim, constDel, constRest, limSnd ) where @@ -16,20 +16,20 @@ import Csound.Air.Wav hiding (Loop) --- | A segment of the signal. +-- | A segment of the signal. -- The signal segment is a limited span of signal in time. -- The time can be measured in seconds or in events! -- The time span which is measured in events is the first --- occurence of the event in the event stream. +-- occurence of the event in the event stream. -- -- There are handy functions for scheduling the signal segments. -- we can delay the segment or loop over it or limit it with tme interval -- or play a sequence of segments. The main feature of the segments is the --- ability to schedule the signals with event streams (like button clicks or midi-events). -data Seg a +-- ability to schedule the signals with event streams (like button clicks or midi-events). +data Seg a = Unlim a | Lim Tick (Seg a) - | ConstLim D (Seg a) + | ConstLim Sig (Seg a) | Seq [Seg a] | Par [Seg a] | Loop (Seg a) @@ -51,7 +51,7 @@ instance Sigs a => Melody (Seg a) where mel = sflow -instance Sigs a => Harmony (Seg a) where +instance Sigs a => Harmony (Seg a) where har = spar instance Sigs a => Compose (Seg a) where @@ -83,7 +83,7 @@ _ -> Lim da x -- | Limits the length of the segment with constant length in seconds. -constLim :: D -> Seg a -> Seg a +constLim :: Sig -> Seg a -> Seg a constLim da x = case x of Par as -> Par (fmap (constLim da) as) _ -> ConstLim da x @@ -91,7 +91,7 @@ -- | Plays the sequence of segments one ofter another. sflow :: [Seg a] -> Seg a sflow as = Seq $ flatten =<< as - where + where flatten x = case x of Seq as -> as _ -> [x] @@ -100,7 +100,7 @@ -- the total length equals to the biggest length of all segments. spar :: [Seg a] -> Seg a spar as = Par $ flatten =<< as - where + where flatten x = case x of Par as -> as _ -> [x] @@ -126,15 +126,15 @@ Unlim a -> a Lim dt (Unlim a) -> elim dt a - Lim dt (Seq as) -> uncurry (evtLoopOnce (Just dt)) (getEvtAndSig $ rmTailAfterUnlim as) + Lim dt (Seq as) -> uncurry (evtLoopOnce (Just dt)) (getEvtAndSig $ rmTailAfterUnlim as) Lim dt (Loop (Seq as)) -> uncurry (evtLoop (Just dt)) (getEvtAndSig $ rmTailAfterUnlim as) Lim dt (Loop a) -> elim dt (runSeg (Loop a)) Lim dt a -> elim dt (runSeg a) ConstLim dt (Unlim a) -> takeSnd dt a - ConstLim dt (Seq as) -> uncurry (evtLoopOnce (Just $ impulseE dt)) (getEvtAndSig $ rmTailAfterUnlim as) - ConstLim dt (Loop (Seq as)) -> uncurry (evtLoop (Just $ impulseE dt)) (getEvtAndSig $ rmTailAfterUnlim as) + ConstLim dt (Seq as) -> uncurry (evtLoopOnce (Just $ impulseE $ ir dt)) (getEvtAndSig $ rmTailAfterUnlim as) + ConstLim dt (Loop (Seq as)) -> uncurry (evtLoop (Just $ impulseE $ ir dt)) (getEvtAndSig $ rmTailAfterUnlim as) ConstLim dt (Loop a) -> takeSnd dt (runSeg (Loop a)) ConstLim dt a -> takeSnd dt (runSeg a) @@ -146,18 +146,18 @@ Par as -> maybeElim (getDur x) $ sum $ fmap (\a -> maybeElim (getDur a) $ runSeg a) as -getDur :: Seg a -> Maybe (Either D Tick) +getDur :: Seg a -> Maybe (Either Sig Tick) getDur x = case x of Unlim _ -> Nothing - Loop _ -> Nothing + Loop _ -> Nothing Lim dt _ -> Just $ Right dt ConstLim dt _ -> Just $ Left dt Seq as -> fromListT sum aftT' as Par as -> fromListT (foldl1 maxB) simT' as - where - fromListT g f as + where + fromListT g f as | all isJust ds = Just $ phi g f $ fmap fromJust ds - | otherwise = Nothing + | otherwise = Nothing where ds = fmap getDur as phi g f xs @@ -169,21 +169,21 @@ Left d -> Just d _ -> Nothing - toEvt = either impulseE id + toEvt = either (impulseE . ir) id getEvtAndSig :: (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick]) getEvtAndSig as = unzip $ fmap (\x -> (return (runSeg x), getTick $ getDur x)) as - where getTick = maybe mempty (either impulseE id) + where getTick = maybe mempty (either (impulseE . ir) id) rmTailAfterUnlim :: [Seg a] -> [Seg a] -rmTailAfterUnlim = takeByIncludeLast isUnlim - where +rmTailAfterUnlim = takeByIncludeLast isUnlim + where isUnlim x = case x of Unlim _ -> True Loop _ -> True Par as -> any isUnlim as - _ -> False + _ -> False takeByIncludeLast :: (a -> Bool) -> [a] -> [a] takeByIncludeLast f xs = case xs of @@ -202,11 +202,11 @@ sdel dt a = sflow [srest dt, a] -- | A pause. Plays nothing for the given time interval in seconds. -constRest :: Num a => D -> Seg a +constRest :: Num a => Sig -> Seg a constRest dt = constLim dt $ toSeg 0 -- | Delays a segment by a given time interval in seconds. -constDel :: Num a => D -> Seg a -> Seg a +constDel :: Num a => Sig -> Seg a -> Seg a constDel dt a = sflow [constRest dt, a] ----------------------------------------------------------- @@ -214,10 +214,10 @@ elim :: Sigs a => Tick -> a -> a elim dt asig = schedUntil (const $ return $ asig) (impulseE 0) dt -maybeElim :: (Num a, Sigs a) => Maybe (Either D Tick) -> a -> a +maybeElim :: (Num a, Sigs a) => Maybe (Either Sig Tick) -> a -> a maybeElim mdt a = case mdt of Nothing -> a - Just x -> case x of + Just x -> case x of Left d -> takeSnd d a Right t -> elim t a @@ -230,7 +230,7 @@ aftT' :: [Tick] -> Tick aftT' evts = take1 $ sigToEvt $ evtLoop Nothing asigs evts - where + where asigs :: [SE Sig] asigs = fmap (return . sig) $ (replicate (length evts - 1) 0) ++ [1] @@ -246,7 +246,7 @@ when1 (sig isAwaiting ==* 1 &&* sig countDown ==* 0) $ do bam unit writeRef isAwaitingRef 0 - where + where mkEvt ref e = do notFiredRef <- newRef (1 :: D) notFired <- readRef notFiredRef diff --git a/src/Csound/Air/Wav.hs b/src/Csound/Air/Wav.hs --- a/src/Csound/Air/Wav.hs +++ b/src/Csound/Air/Wav.hs @@ -67,39 +67,39 @@ -- Signal manipulation -- | Takes only given amount (in seconds) from the signal (the rest is silence). -takeSnd :: Sigs a => D -> a -> a +takeSnd :: Sigs a => Sig -> a -> a takeSnd dt asig = sched (const $ return asig) $ withDur dt $ loadbang -- | Delays signals by the given amount (in seconds). -delaySnd :: Sigs a => D -> a -> a +delaySnd :: Sigs a => Sig -> a -> a delaySnd dt = segmentSnd dt infiniteDur -- | 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 ::Sigs a => Sig -> Sig -> a -> a segmentSnd dt dur asig = sched (const $ return asig) $ fmap (del dt) $ withDur dur $ loadbang -- | Repeats the signal with the given period. -repeatSnd :: Sigs a => D -> a -> a +repeatSnd :: Sigs a => Sig -> a -> a repeatSnd dt asig = sched (const $ return asig) $ segments dt -- | Plays the first signal for some time (in seconds) and then switches to the next one. -- -- > afterSnd dur sig1 sig2 -afterSnd :: (Num b, Sigs b) => D -> b -> b -> b +afterSnd :: (Num b, Sigs b) => Sig -> b -> b -> b afterSnd dt a b = takeSnd dt a + delaySnd dt b -- | Creates a sequence of signals. Each segment lasts for -- fixed amount of time given in the first argument. -lineSnd :: (Num a, Sigs a) => D -> [a] -> a +lineSnd :: (Num a, Sigs a) => Sig -> [a] -> a lineSnd dt xs = foldr1 go xs where go a b = afterSnd dt a b -- | Creates a sequence of signals and loops over the sequence. -- Each segment lasts for fixed amount of time given in the first argument. -loopLineSnd :: (Num a, Sigs a) => D -> [a] -> a -loopLineSnd dt xs = repeatSnd (dt * (int $ length xs)) $ lineSnd dt xs +loopLineSnd :: (Num a, Sigs a) => Sig -> [a] -> a +loopLineSnd dt xs = repeatSnd (dt * (sig $ int $ length xs)) $ lineSnd dt xs -------------------------------------------------------------------------- -- sound files playback @@ -118,8 +118,8 @@ | otherwise = filelen $ text fileName -- | Produces repeating segments with the given time in seconds. -segments :: D -> Evt (Sco Unit) -segments dt = withDur dt $ metroE (sig $ recip dt) +segments :: Sig -> Evt (Sco Unit) +segments dt = withDur dt $ metroE (recip dt) -- Stereo @@ -131,13 +131,13 @@ -- | 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 :: Sig -> 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 +loopSnd fileName = loopSndBy (sig $ 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. @@ -150,7 +150,7 @@ -- | Reads a segment from wav file. readSegWav :: D -> D -> Sig -> String -> (Sig, Sig) -readSegWav start end speed fileName = takeSnd (end - start) $ (diskin2 (text fileName) `withSig` speed) `withDs` [start, 1] +readSegWav start end speed fileName = takeSnd (sig $ end - start) $ (diskin2 (text fileName) `withSig` 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. @@ -170,12 +170,12 @@ | otherwise = diskin2 (text fileName) -- | The mono variant of the function @loopSndBy@. -loopSndBy1 :: D -> String -> Sig +loopSndBy1 :: Sig -> 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 +loopSnd1 fileName = loopSndBy1 (sig $ lengthSnd fileName) fileName -- | The mono variant of the function @readWav@. readWav1 :: Sig -> String -> Sig @@ -187,7 +187,7 @@ -- | Reads a segment from wav file. readSegWav1 :: D -> D -> Sig -> String -> Sig -readSegWav1 start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) `withSig` speed `withDs` [start, 1] +readSegWav1 start end speed fileName = takeSnd (sig $ end - start) $ diskin2 (text fileName) `withSig` 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. diff --git a/src/Csound/Air/Wave.hs b/src/Csound/Air/Wave.hs --- a/src/Csound/Air/Wave.hs +++ b/src/Csound/Air/Wave.hs @@ -31,7 +31,7 @@ urawTri, urawSaw, urawSqr, urawPw, urawTri', urawSaw', urawSqr', urawPw', urndRawTri, urndRawSaw, urndRawSqr, urndRawPw, -- * Noise - rndh, urndh, rndi, urndi, white, pink, + rndh, urndh, rndi, urndi, white, pink, brown, -- * Frequency modulation fosc, @@ -253,6 +253,10 @@ -- | Pink noise. pink :: SE Sig pink = pinkish 1 + +-- | Brownian noise +brown :: SE Sig +brown = fmap (dcblock . integ . (* 0.1)) white -------------------------------------------------------------------------- -- lfo diff --git a/src/Csound/Base.hs b/src/Csound/Base.hs --- a/src/Csound/Base.hs +++ b/src/Csound/Base.hs @@ -2,11 +2,11 @@ -- -- This module re-exports everything. -- --- WARNING (for Csound users): the maximum amplitude is 1.0. There is no way to alter it. +-- WARNING (for Csound users): the maximum amplitude is 1.0. There is no way to alter it. -- Don't define your amplitudes with 9000 or 11000. But the good news are: all signals -- are clipped by 1 so that you can not damage your ears and your speakers by a little typo. module Csound.Base( - module Csound.Types, + module Csound.Types, module Csound.Control, module Csound.IO, module Csound.Air, @@ -28,7 +28,7 @@ module Csound.Typed.Opcode ) where -import Csound.Air +import Csound.Air import Csound.Tab import Csound.Tuning import Csound.Types @@ -44,10 +44,10 @@ import Data.Default import Data.Monoid import Control.Applicative hiding ((<*)) - + import Csound.Typed.Opcode hiding ( button, display, space, lfo, initc7, ctrl7, - oscInit, oscListen, oscSend, + oscInit, oscListen, oscSend, lpshold, loopseg, loopxseg, partikkel, syncgrain, granule, sndwarp, sndwarpst, fof2, line, delay, diff --git a/src/Csound/Control/Evt.hs b/src/Csound/Control/Evt.hs --- a/src/Csound/Control/Evt.hs +++ b/src/Csound/Control/Evt.hs @@ -107,7 +107,7 @@ impulseE = sigToEvt . impulse -- | Makes an event stream from list of events. -eventList :: [(D, D, a)] -> Evt (Sco a) +eventList :: [(Sig, Sig, a)] -> Evt (Sco a) eventList es = fmap (const $ har $ fmap singleEvent es) loadbang where singleEvent (start, duration, content) = del start $ str duration $ temp content diff --git a/src/Csound/Control/Gui.hs b/src/Csound/Control/Gui.hs --- a/src/Csound/Control/Gui.hs +++ b/src/Csound/Control/Gui.hs @@ -123,14 +123,14 @@ -- | Hides the SE inside Source. joinSource :: Source (SE a) -> Source a -joinSource a = Source $ do - (g, mv) <- unSource a +joinSource a = do + (g, mv) <- a v <- mv return (g, v) fromSource :: Source a -> SE a fromSource a = do - (gui, asig) <- unSource a + (gui, asig) <- a panel gui return asig @@ -175,7 +175,7 @@ applyProportionsToList props f as = f $ zipWith sca (props ++ repeat 1) as genLifts :: ([Gui] -> Gui) -> ([a] -> b) -> [Source a] -> Source b -genLifts gf f as = Source $ fmap phi $ mapM unSource as +genLifts gf f as = fmap phi $ sequence as where phi xs = (gf gs, f vs) where (gs, vs) = unzip xs @@ -187,8 +187,8 @@ lift2 :: (Gui -> Gui -> Gui) -> (a -> b -> c) -> Source a -> Source b -> Source c lift2 gf f ma mb = source $ do - (ga, a) <- unSource ma - (gb, b) <- unSource mb + (ga, a) <- ma + (gb, b) <- mb return $ (gf ga gb, f a b) lift2' a b gf = lift2 (tfm2 a b gf) @@ -214,9 +214,9 @@ lift3 :: (Gui -> Gui -> Gui -> Gui) -> (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d lift3 gf f ma mb mc = source $ do - (ga, a) <- unSource $ ma - (gb, b) <- unSource $ mb - (gc, c) <- unSource $ mc + (ga, a) <- ma + (gb, b) <- mb + (gc, c) <- mc return $ (gf ga gb gc, f a b c) lift3' sa sb sc gf = lift3 (tfm3 sa sb sc gf) @@ -240,10 +240,10 @@ lift4 :: (Gui -> Gui -> Gui -> Gui -> Gui) -> (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e lift4 gf f ma mb mc md = source $ do - (ga, a) <- unSource $ ma - (gb, b) <- unSource $ mb - (gc, c) <- unSource $ mc - (gd, d) <- unSource $ md + (ga, a) <- ma + (gb, b) <- mb + (gc, c) <- mc + (gd, d) <- md return $ (gf ga gb gc gd, f a b c d) lift4' sa sb sc sd gf = lift4 (tfm3 sa sb sc sd gf) @@ -268,11 +268,11 @@ lift5 :: (Gui -> Gui -> Gui -> Gui -> Gui -> Gui) -> (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b lift5 gf f ma1 ma2 ma3 ma4 ma5 = source $ do - (ga1, a1) <- unSource $ ma1 - (ga2, a2) <- unSource $ ma2 - (ga3, a3) <- unSource $ ma3 - (ga4, a4) <- unSource $ ma4 - (ga5, a5) <- unSource $ ma5 + (ga1, a1) <- ma1 + (ga2, a2) <- ma2 + (ga3, a3) <- ma3 + (ga4, a4) <- ma4 + (ga5, a5) <- ma5 return $ (gf ga1 ga2 ga3 ga4 ga5, f a1 a2 a3 a4 a5) lift5' sa sb sc sd se gf = lift5 (tfm3 sa sb sc sd se gf) @@ -333,8 +333,8 @@ genBind :: (Gui -> Gui -> Gui) -> Source a -> (a -> Source b) -> Source b genBind gui ma mf = source $ do - (ga, a) <- unSource ma - (gb, b) <- unSource $ mf a + (ga, a) <- ma + (gb, b) <- mf a return (gui ga gb, b) -- | Creates a list of sources with mapping a function and stacks them horizontally. @@ -360,5 +360,5 @@ genMapM :: ([Gui] -> Gui) -> (a -> Source b) -> [a] -> Source [b] genMapM gui f xs = source $ do - (gs, vs) <- fmap unzip $ mapM (unSource . f) xs + (gs, vs) <- fmap unzip $ mapM f xs return (gui gs, vs) diff --git a/src/Csound/Control/Gui/Widget.hs b/src/Csound/Control/Gui/Widget.hs --- a/src/Csound/Control/Gui/Widget.hs +++ b/src/Csound/Control/Gui/Widget.hs @@ -79,8 +79,8 @@ -- | A radio button. It takes a list of values with labels. radioButton :: Arg a => String -> [(String, a)] -> Int -> Source (Evt a) radioButton title as initVal = source $ do - (g, ind) <- unSource $ butBank1 "" 1 (length as) (0, initVal) - gnames <- mapM (unDisplay . box) names + (g, ind) <- butBank1 "" 1 (length as) (0, initVal) + gnames <- mapM box names let val = listAt vals ind gui <- setTitle title $ padding 0 $ hor [sca 0.15 g, ver gnames] return (gui, val) @@ -89,7 +89,7 @@ -- | A matrix of values. matrixButton :: Arg a => String -> Int -> Int -> [a] -> (Int, Int) -> Source (Evt a) matrixButton name xn yn vals initVal = source $ do - (gui, ind) <- unSource $ butBank1 name xn yn initVal + (gui, ind) <- butBank1 name xn yn initVal let val = listAt allVals ind return (gui, val) where allVals = readMatrix xn yn vals @@ -97,7 +97,7 @@ -- | Radio button that returns functions. Useful for picking a waveform or type of filter. funnyRadio :: Tuple b => String -> [(String, a -> b)] -> Int -> Source (a -> b) funnyRadio name as initVal = source $ do - (gui, ind) <- unSource $ radioButton name (zip names (fmap int [0 ..])) initVal + (gui, ind) <- radioButton name (zip names (fmap int [0 ..])) initVal contInd <- stepper (sig $ int initVal) $ fmap sig ind let instr x = guardedTuple ( zipWith (\n f -> (contInd ==* (sig $ int n), f x)) [0 ..] funs @@ -108,7 +108,7 @@ -- | Matrix of functional values. funnyMatrix :: Tuple b => String -> Int -> Int -> [(a -> b)] -> (Int, Int) -> Source (a -> b) funnyMatrix name xn yn funs initVal@(x0, y0) = source $ do - (gui, ind) <- unSource $ butBank1 name xn yn initVal + (gui, ind) <- butBank1 name xn yn initVal contInd <- stepper flattenInitVal $ fmap sig ind let instr x = guardedTuple ( zipWith (\n f -> (contInd ==* (sig $ int n), f x)) [0 ..] allFuns @@ -187,7 +187,7 @@ genNumbers :: ([Gui] -> Gui) -> [Double] -> Source Sig genNumbers gx as@(d:ds) = source $ do ref <- newGlobalCtrlRef (sig $ double d) - (gs, evts) <- fmap unzip $ mapM (unSource . button . show) as + (gs, evts) <- fmap unzip $ mapM (button . show) as zipWithM_ (\x e -> runEvt e $ \_ -> writeRef ref (sig $ double x)) as evts res <- readRef ref return (gx gs, res) @@ -241,7 +241,7 @@ let f x y = (vals !! y) !! x return $ (gui, f) where - mkRow xs = fmap reGroupRow $ mapM (unSource . uncurry mk) xs + mkRow xs = fmap reGroupRow $ mapM (uncurry mk) xs inits = split height width $ zip (names ++ repeat "") (as ++ repeat initVal) @@ -277,7 +277,7 @@ radioGroupSig :: ([Gui] -> Gui) -> [String] -> Int -> Source Sig radioGroupSig gcat names initVal = source $ do - (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> unSinkSource $ flip setToggleSig (i == initVal) tag) $ zip [0 ..] names + (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> flip setToggleSig (i == initVal) tag) $ zip [0 ..] names curRef <- newGlobalCtrlRef (sig $ int initVal) current <- readRef curRef zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids @@ -399,7 +399,7 @@ -- The first argument is for external control. toggle' :: Evt D -> String -> Bool -> Source (Evt D) toggle' ctrl name initVal = source $ do - (gui, output, input) <- unSinkSource $ setToggle name initVal + (gui, output, input) <- setToggle name initVal output ctrl return $ (gui, mappend ctrl input) @@ -452,7 +452,7 @@ radioGroupSig' :: ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig radioGroupSig' gcat ctrl names initVal = source $ do - (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> unSinkSource $ flip setToggleSig (i == initVal) tag) $ zip [0 ..] names + (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> flip setToggleSig (i == initVal) tag) $ zip [0 ..] names curRef <- newGlobalCtrlRef (sig $ int initVal) when1 (changed [ctrl] ==* 1) $ writeRef curRef ctrl @@ -474,7 +474,7 @@ ctrlSig :: D -> Sig -> SinkSource Sig -> Source Sig ctrlSig initVal ctrl v = source $ do - (gui, output, input) <- unSinkSource v + (gui, output, input) <- v ref <- newGlobalCtrlRef (sig initVal) when1 (changed [ctrl] ==* 1) $ writeRef ref ctrl when1 (changed [input] ==* 1) $ writeRef ref input diff --git a/src/Csound/Control/Instr.hs b/src/Csound/Control/Instr.hs --- a/src/Csound/Control/Instr.hs +++ b/src/Csound/Control/Instr.hs @@ -1,5 +1,5 @@ {-# Language TypeFamilies, FlexibleContexts, FlexibleInstances, ScopedTypeVariables #-} --- | We can convert notes to sound signals with instruments. +-- | We can convert notes to sound signals with instruments. -- An instrument is a function: -- -- > (Arg a, Sigs b) => a -> SE b @@ -17,72 +17,72 @@ -- * By using midi-instruments (see @Csound.Control.Midi@). -- -- Sometimes we don't want to produce any sound. Our instrument is just --- a procedure that makes something useful without being noisy about it. +-- a procedure that makes something useful without being noisy about it. -- It's type is: -- -- > (Arg a) => a -> SE () --- +-- -- To invoke the procedures there are functions with trailing underscore. -- For example we have the function @trig@ to convert event stream to sound: -- --- > trig :: (Arg a, Sigs b) => (a -> SE b) -> Evts (D, D, a) -> b +-- > trig :: (Arg a, Sigs b) => (a -> SE b) -> Evts (D, D, a) -> b -- -- and we have a @trig@ with underscore to convert the event stream to -- the sequence of the procedure invkations: -- --- > trig_ :: (Arg a) => (a -> SE ()) -> Evts (D, D, a) -> SE () +-- > trig_ :: (Arg a) => (a -> SE ()) -> Evts (D, D, a) -> SE () -- -- To invoke instruments from another instrumetnts we use artificial closures -- made with functions with trailing xxxBy. For example: -- -- > trigBy :: (Arg a, Arg c, Sigs b) => (a -> SE b) -> (c -> Evts (D, D, a)) -> (c -> b) --- +-- -- Notice that the event stream depends on the argument of the type c. Here goes -- all the parameters that we want to pass from the outer instrument. Unfortunately -- we can not just create the closure, because our values are not the real values. -- It's a text of the programm (a tiny snippet of it) to be executed. For a time being --- I don't know how to make it better. So we need to pass the values explicitly. +-- I don't know how to make it better. So we need to pass the values explicitly. -- -- For example, if we want to make an arpeggiator: -- -- > pureTone :: D -> SE Sig -- > pureTone cps = return $ mul env $ osc $ sig cps -- > where env = linseg [0, 0.01, 1, 0.25, 0] --- > +-- > -- > majArpeggio :: D -> SE Sig -- > majArpeggio = return . schedBy pureTone evts -- > where evts cps = withDur 0.5 $ fmap (* cps) $ cycleE [1, 5/3, 3/2, 2] $ metroE 5 --- > +-- > -- > main = dac $ mul 0.5 $ midi $ onMsg majArpeggio -- -- We should use 'Csound.Base.schedBy' to pass the frequency as a parameter to the event stream. module Csound.Control.Instr( -- * Mix - -- | We can invoke instrument with specified notes. - -- Eqch note happens at some time and lasts for some time. It contains - -- the argument for the instrument. + -- | We can invoke instrument with specified notes. + -- Eqch note happens at some time and lasts for some time. It contains + -- the argument for the instrument. -- -- We can invoke the instrument on the sequence of notes (@sco@), process -- the sequence of notes with an effect (@eff@) and convert everything in - -- the plain sound signals (to send it to speakers or write to file or + -- the plain sound signals (to send it to speakers or write to file or -- use it in some another instrument). -- -- The sequence of notes is represented with type class @CsdSco@. Wich - -- has a very simple methods. So you can use your own favorite library - -- to describe the list of notes. If your type supports the scaling in + -- has a very simple methods. So you can use your own favorite library + -- to describe the list of notes. If your type supports the scaling in -- the time domain (stretching the timeline) you can do it in the Mix-version -- (after the invokation of the instrument). All notes are rescaled all the - -- way down the Score-structure. + -- way down the Score-structure. Sco, Mix, sco, mix, eff, monoSco, - mixLoop, sco_, mix_, mixLoop_, mixBy, + mixLoop, sco_, mix_, mixLoop_, mixBy, infiniteDur, module Temporal.Media, - - -- * Evt + -- * Evt + sched, retrig, schedHarp, schedUntil, schedToggle, - sched_, schedUntil_, + sched_, schedUntil_, schedBy, schedHarpBy, withDur, monoSched, @@ -90,7 +90,7 @@ -- | We can create named instruments. then we can trigger the named instruments with Csound API. -- Csound can be used not as a text to audio converter but also as a shared C-library. There are -- many bindings to many languages. For example we can use Python or Android SDK to create UI - -- and under the hood we can use the audio engine created with Haskell. The concept of named instruments + -- and under the hood we can use the audio engine created with Haskell. The concept of named instruments -- is the bridge for other lnguages to use our haskell-generated code. trigByName, trigByName_, trigByNameMidi, trigByNameMidi_, @@ -122,25 +122,25 @@ -- | Mixes the scores and plays them in the loop. mixLoop :: (Sigs a) => Sco (Mix a) -> a -mixLoop a = sched instr $ withDur dt $ repeatE unit $ metroE $ sig $ 1 / dt - where - dt = dur a +mixLoop a = sched instr $ withDur dt $ repeatE unit $ metroE $ 1 / dt + where + dt = dur a instr _ = return $ mix a -- | Mixes the procedures and plays them in the loop. mixLoop_ :: Sco (Mix Unit) -> SE () -mixLoop_ a = sched_ instr $ withDur dt $ repeatE unit $ metroE $ sig $ 1 / dt - where +mixLoop_ a = sched_ instr $ withDur dt $ repeatE unit $ metroE $ 1 / dt + where dt = dur a instr _ = mix_ a --- | Invokes an instrument with first event stream and +-- | Invokes an instrument with first event stream and -- holds the note until the second event stream is active. schedUntil :: (Arg a, Sigs b) => (a -> SE b) -> Evt a -> Evt c -> b schedUntil instr onEvt offEvt = sched instr' $ withDur infiniteDur onEvt - where - instr' x = do + where + instr' x = do res <- instr x runEvt offEvt $ const $ turnoff return res @@ -148,21 +148,21 @@ -- | Invokes an instrument with toggle event stream (1 stands for on and 0 stands for off). schedToggle :: (Sigs b) => SE b -> Evt D -> b schedToggle res evt = schedUntil instr on off - where + where instr = const res (on, off) = splitToggle evt --- | Invokes an instrument with first event stream and +-- | Invokes an instrument with first event stream and -- holds the note until the second event stream is active. schedUntil_ :: (Arg a) => (a -> SE ()) -> Evt a -> Evt c -> SE () schedUntil_ instr onEvt offEvt = sched_ instr' $ withDur infiniteDur onEvt - where - instr' x = do + where + instr' x = do res <- instr x runEvt offEvt $ const $ turnoff return res --- | Transforms an instrument from always on to conditional one. +-- | Transforms an instrument from always on to conditional one. -- The routput instrument plays only when condition is true otherwise -- it produces silence. playWhen :: forall a b. Sigs a => BoolSig -> (b -> SE a) -> (b -> SE a) @@ -176,8 +176,8 @@ ------------------------------------------------------------------------- -- singular --- | Sets the same duration for all events. It's useful with the functions @sched@, @schedBy@, @sched_@. -withDur :: D -> Evt a -> Evt (Sco a) +-- | Sets the same duration for all events. It's useful with the functions @sched@, @schedBy@, @sched_@. +withDur :: Sig -> Evt a -> Evt (Sco a) withDur dt = fmap (str dt . temp) retrig :: (Arg a, Sigs b) => (a -> SE b) -> Evt a -> b @@ -196,13 +196,13 @@ -- name of the instrument (should be defined with @trigByName@ or smth like that). -- -- kmode -- sum of the following values: --- +-- -- 0, 1, or 2: turn off all instances (0), oldest only (1), or newest only (2) -- -- 4: only turn off notes with exactly matching (fractional) instrument number, rather than ignoring fractional part -- -- 8: only turn off notes with indefinite duration (p3 < 0 or MIDI) --- +-- -- krelease -- if non-zero, the turned off instances are allowed to release, otherwise are deactivated immediately (possibly resulting in clicks) turnoffByName :: String -> Sig -> Sig -> SE () turnoffByName name kmode krelease = strTurnoff2 (text name) kmode krelease diff --git a/src/Csound/Control/Osc.hs b/src/Csound/Control/Osc.hs --- a/src/Csound/Control/Osc.hs +++ b/src/Csound/Control/Osc.hs @@ -1,8 +1,8 @@ -- | Open Sound Control. module Csound.Control.Osc( - OscHost, OscPort, OscAddress, OscType, + OscHost, OscPort, OscAddress, OscType, OscRef, -- * Server - initOsc, listenOsc, ListenOsc, OscVal, + initOsc, listenOsc, ListenOsc, OscVal, listenOscVal, listenOscSig, listenOscSig2, -- * Client sendOsc diff --git a/src/Csound/IO.hs b/src/Csound/IO.hs --- a/src/Csound/IO.hs +++ b/src/Csound/IO.hs @@ -1,4 +1,4 @@ -{-# Language FlexibleInstances, UndecidableInstances #-} +{-# Language FlexibleInstances, UndecidableInstances, CPP #-} -- | Rendering of Csound files and playing the music in real time. -- -- How are we going to get the sound out of Haskell code? @@ -76,7 +76,7 @@ import Csound.Typed import Csound.Control.Gui -import Csound.Options(setSilent, setDac, setCabbage) +import Csound.Options(setSilent, setDac, setAdc, setCabbage) render :: Sigs a => Options -> SE a -> IO String render = renderOutBy @@ -90,12 +90,20 @@ instance {-# OVERLAPPING #-} RenderCsd (SE ()) where renderCsdBy = render_ +#if __GLASGOW_HASKELL__ >= 710 instance {-# OVERLAPPABLE #-} Sigs a => RenderCsd a where renderCsdBy opt a = render opt (return a) instance {-# OVERLAPPABLE #-} Sigs a => RenderCsd (SE a) where renderCsdBy opt a = render opt a +instance {-# OVERLAPPABLE #-} Sigs a => RenderCsd (Source a) where + renderCsdBy opt a = renderCsdBy opt (fromSource a) + +instance {-# OVERLAPPABLE #-} Sigs a => RenderCsd (Source (SE a)) where + renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) +#endif + instance {-# OVERLAPPABLE #-} (Sigs a, Sigs b) => RenderCsd (a -> b) where renderCsdBy opt f = renderEffBy opt (return . f) @@ -111,15 +119,9 @@ instance {-# OVERLAPPING #-} (Sigs a) => RenderCsd (a -> Source (SE Sig2)) where renderCsdBy opt f = renderEffBy opt (fromSourceSE . f) -instance {-# OVERLAPPABLE #-} Sigs a => RenderCsd (Source a) where - renderCsdBy opt a = renderCsdBy opt (fromSource a) - -instance {-# OVERLAPPABLE #-} Sigs a => RenderCsd (Source (SE a)) where - renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) - instance {-# OVERLAPPING #-} RenderCsd (Source ()) where renderCsdBy opt src = renderCsdBy opt $ do - (ui, _) <- unSource src + (ui, _) <- src panel ui instance {-# OVERLAPPING #-} RenderCsd (Source (SE ())) where @@ -173,7 +175,7 @@ where phi file = do runWithUserInterrupt $ player ++ " " ++ file --- | Renders csound code to file @tmp.csd@ with flags set to @-odac@ and @-Ma@ +-- | Renders csound code to file @tmp.csd@ with flags set to @-odac@, @-iadc@ and @-Ma@ -- (sound output goes to soundcard in real time). dac :: (RenderCsd a) => a -> IO () dac = dacBy def @@ -183,7 +185,7 @@ dacBy opt' a = do writeCsdBy opt "tmp.csd" a runWithUserInterrupt $ "csound " ++ "tmp.csd" - where opt = opt' <> setDac + where opt = opt' <> setDac <> setAdc -- | Output to dac with virtual midi keyboard. vdac :: (RenderCsd a) => a -> IO () @@ -275,3 +277,64 @@ -- | Alias to process inputs of audio-card with 8 inputs. onCard8 :: (Sig8 -> a) -> (Sig8 -> a) onCard8= id + + +#if __GLASGOW_HASKELL__ < 710 + +-- Sig + +instance RenderCsd Sig where { renderCsdBy opt a = render opt (return a) } +instance RenderCsd (SE Sig) where { renderCsdBy opt a = render opt a } +instance RenderCsd (Source Sig) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) } +instance RenderCsd (Source (SE Sig)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) } + +-- Sig2 + +instance RenderCsd Sig2 where { renderCsdBy opt a = render opt (return a) } +instance RenderCsd (SE Sig2) where { renderCsdBy opt a = render opt a } +instance RenderCsd (Source Sig2) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) } +instance RenderCsd (Source (SE Sig2)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) } + +-- Sig3 + +instance RenderCsd Sig3 where { renderCsdBy opt a = render opt (return a) } +instance RenderCsd (SE Sig3) where { renderCsdBy opt a = render opt a } +instance RenderCsd (Source Sig3) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) } +instance RenderCsd (Source (SE Sig3)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) } + +-- Sig4 + +instance RenderCsd Sig4 where { renderCsdBy opt a = render opt (return a) } +instance RenderCsd (SE Sig4) where { renderCsdBy opt a = render opt a } +instance RenderCsd (Source Sig4) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) } +instance RenderCsd (Source (SE Sig4)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) } + +-- Sig5 + +instance RenderCsd Sig5 where { renderCsdBy opt a = render opt (return a) } +instance RenderCsd (SE Sig5) where { renderCsdBy opt a = render opt a } +instance RenderCsd (Source Sig5) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) } +instance RenderCsd (Source (SE Sig5)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) } + +-- Sig6 + +instance RenderCsd Sig6 where { renderCsdBy opt a = render opt (return a) } +instance RenderCsd (SE Sig6) where { renderCsdBy opt a = render opt a } +instance RenderCsd (Source Sig6) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) } +instance RenderCsd (Source (SE Sig6)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) } + +-- Sig7 + +instance RenderCsd Sig7 where { renderCsdBy opt a = render opt (return a) } +instance RenderCsd (SE Sig7) where { renderCsdBy opt a = render opt a } +instance RenderCsd (Source Sig7) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) } +instance RenderCsd (Source (SE Sig7)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) } + +-- Sig8 + +instance RenderCsd Sig8 where { renderCsdBy opt a = render opt (return a) } +instance RenderCsd (SE Sig8) where { renderCsdBy opt a = render opt a } +instance RenderCsd (Source Sig8) where { renderCsdBy opt a = renderCsdBy opt (fromSource a) } +instance RenderCsd (Source (SE Sig8)) where { renderCsdBy opt a = renderCsdBy opt (fromSourceSE a) } + +#endif diff --git a/src/Csound/Options.hs b/src/Csound/Options.hs --- a/src/Csound/Options.hs +++ b/src/Csound/Options.hs @@ -3,16 +3,16 @@ -- * Shortcuts setDur, - setRates, setBufs, setGain, + setRates, setBufs, setGain, setJack, setAlsa, setCoreAudio, setMme, - setOutput, setInput, + setOutput, setInput, setDac, setAdc, setDacBy, setAdcBy, setThru, setSilent, setMidiDevice, setMa, setMessageLevel, noTrace, - setCabbage, + setCabbage, -- * Flags - -- | Csound's command line flags. See original documentation for + -- | Csound's command line flags. See original documentation for -- detailed overview: Flags(..), @@ -23,7 +23,7 @@ -- * Realtime Audio Input/Output Rtaudio(..), PulseAudio(..), - + -- * MIDI File Input/Ouput MidiIO(..), @@ -34,7 +34,7 @@ Displays(..), DisplayMode(..), -- * Performance Configuration and Control - Config(..) + Config(..) ) where import Data.Monoid @@ -45,7 +45,7 @@ -- -- > setRates sampleRate blockSize setRates :: Int -> Int -> Options -setRates sampleRate blockSize = def +setRates sampleRate blockSize = def { csdSampleRate = Just sampleRate , csdBlockSize = Just blockSize } @@ -55,10 +55,12 @@ setBufs :: Int -> Int -> Options setBufs hw io = def { csdFlags = def { config = def { hwBuf = Just hw, ioBuf = Just io } } } +-- | Sets the default gain for the output signal (should be in range 0 to 1). setGain :: Double -> Options setGain d = def { csdGain = Just d' } where d' = max 0 $ min 1 $ d +-- | Runs as JACK unit with given name (first argument). setJack :: String -> Options setJack name = def { csdFlags = def { rtaudio = Just $ Jack name "input" "output" } } @@ -69,39 +71,49 @@ setJacko :: Jacko -> Options setJacko jackoSpec = def { csdJacko = Just jackoSpec } +-- | Sets real-time driver to Core Audio (use on OSX). setCoreAudio :: Options setCoreAudio = def { csdFlags = def { rtaudio = Just $ CoreAudio } } +-- | Sets real-time driver to Alsa (use on Linux). setAlsa :: Options setAlsa = def { csdFlags = def { rtaudio = Just $ Alsa } } +-- | Sets real-time driver to Mme (use on Windows). setMme :: Options setMme = def { csdFlags = def { rtaudio = Just $ Mme } } +-- | Sends output to speakers. setDac :: Options setDac = setDacBy "" +-- | Reads input from audio-card inputs. setAdc :: Options setAdc = setAdcBy "" +-- | Set's the input name of the device or file. setInput :: String -> Options setInput a = def { csdFlags = def { audioFileOutput = def { input = Just a } } } +-- | Set's the output name of the device or file. setOutput :: String -> Options setOutput a = def { csdFlags = def { audioFileOutput = def { output = Just a } } } +-- | Provides name identifier for dac. setDacBy :: String -> Options setDacBy port = setOutput name - where name + where name | null port = "dac" | otherwise = "dac:" ++ port - + +-- | Provides name identifier for adc. setAdcBy :: String -> Options setAdcBy port = setInput name - where name + where name | null port = "adc" | otherwise = "adc:" ++ port +-- | Sets both dac and adc. setThru :: Options setThru = mappend setDac setAdc @@ -109,7 +121,15 @@ setSilent :: Options setSilent = (def { csdFlags = def { audioFileOutput = def { nosound = True } } }) --- | Sets midi device +-- | Sets midi device. It's an string identifier of the device. +-- +-- Read MIDI events from device DEVICE. If using ALSA MIDI (-+rtmidi=alsa), +-- devices are selected by name and not number. So, you need to use an option +-- like -M hw:CARD,DEVICE where CARD and DEVICE are the card and device numbers (e.g. -M hw:1,0). +-- In the case of PortMidi and MME, DEVICE should be a number, and if it is out of range, +-- an error occurs and the valid device numbers are printed. When using PortMidi, +-- you can use '-Ma' to enable all devices. This is also convenient when you +-- don't have devices as it will not generate an error. setMidiDevice :: String -> Options setMidiDevice a = def { csdFlags = def { midiRT = def { midiDevice = Just a } } } @@ -117,14 +137,20 @@ setMa :: Options setMa = setMidiDevice "a" +-- | Sets message level. For input integer value consult +-- the Csound docs +-- +-- setMessageLevel :: Int -> Options setMessageLevel n = def { csdFlags = def { displays = def { messageLevel = Just n }}} +-- | Sets the tracing or debug info of csound console to minimum. noTrace :: Options noTrace = setMessageLevel 0 --------------------------------------------- +-- | Provides options for Cabbage VST-engine. setCabbage :: Options setCabbage = setRates 48000 64 <> setNoRtMidi <> setMidiDevice "0" - where setNoRtMidi = def { csdFlags = def { rtmidi = Just NoRtmidi, audioFileOutput = def { nosound = True } }} + where setNoRtMidi = def { csdFlags = def { rtmidi = Just NoRtmidi, audioFileOutput = def { nosound = True } }} diff --git a/src/Csound/Types.hs b/src/Csound/Types.hs --- a/src/Csound/Types.hs +++ b/src/Csound/Types.hs @@ -32,6 +32,9 @@ -- ** Constants idur, getSampleRate, getControlRate, getBlockSize, + -- ** BPM + getBpm, setBpm, syn, takt, + -- ** Converters ar, kr, ir, sig, @@ -140,5 +143,14 @@ (less, more) = splitAt (length conds `div` 2) conds rootCond = fst $ last less - +-- | It's used to synchronize changes with BPM. +-- Useful with LFO's or delay times. +syn :: Sig -> Sig +syn x = (bpm / 60) * x + where bpm = getBpm +-- | Calculates seconds in ratio to global BPM. +-- It measures time according to changes in the BPM. +-- It's reciprocal to @syn@. +takt :: Sig -> Sig +takt = recip . syn