packages feed

csound-expression 4.8.2 → 4.8.3

raw patch · 37 files changed

+970/−386 lines, 37 filesdep ~csound-expression-typeddep ~temporal-media

Dependency ranges changed: csound-expression-typed, temporal-media

Files

csound-expression.cabal view
@@ -1,12 +1,12 @@ Name:          csound-expression-Version:       4.8.2+Version:       4.8.3 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE Author:	       Anton Kholomiov Synopsis:      library to make electronic music Stability:     Experimental-Tested-With:   GHC==7.6+Tested-With:   GHC==7.10 Build-Type:    Simple Category:      Music, Sound Maintainer:    <anton.kholomiov@gmail.com>@@ -47,12 +47,9 @@     examples/Events.hs     examples/DubBass.hs -    examples/Gui/Button.hs      -    examples/Gui/Envelope.hs  -    examples/Gui/Harmonics.hs  -    examples/Gui/Osc.hs-    examples/Gui/EnvelopeAndHarmonics.hs  -    examples/Gui/Filter.hs    +    examples/Gui/Button.hs          +    examples/Gui/Harmonics.hs      +    examples/Gui/EnvelopeAndHarmonics.hs           examples/Gui/Key.hs             examples/Gui/Waves.hs @@ -68,7 +65,7 @@   Ghc-Options:    -Wall   Build-Depends:         base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0, transformers >= 0.3,-        csound-expression-typed >= 0.0.7.7, csound-expression-dynamic >= 0.1.4.3, temporal-media >= 0.6.0,+        csound-expression-typed >= 0.0.7.8, csound-expression-dynamic >= 0.1.4.3, temporal-media >= 0.6.1,         csound-expression-opcodes >= 0.0.3   Hs-Source-Dirs:      src/   Exposed-Modules:@@ -86,6 +83,7 @@         Csound.Air.Seg         Csound.Air.Sampler         Csound.Air.Looper+        Csound.Air.Patch         Csound.Air.Misc         Csound.Air.Hvs
examples/Color.hs view
@@ -1,7 +1,7 @@ -- | A gallery of instruments (found in Csound catalog). module Color where -import Csound+import Csound.Base  bass (amp, cps) = sig amp * once env * osc (sig cps)     where env = eexps [1, 0.00001]
examples/DubBass.hs view
@@ -3,27 +3,27 @@ -- http://codehop.com/2011/07/ module Main where -import Csound+import Csound.Base  wobbly :: Sig -> Sig -> Sig -> Sig wobbly spb coeff cps = a2     where         a1 = mean [saw (cps * 1.005), sqr (cps * 0.495)]         idivision = 1 / (coeff * spb)-        klfo = kr $ oscLins [0, 0.5, 1, 0.5, 0] idivision+        klfo = kr $ triSeq [1] idivision          -- filter         ibase = cps         imod  = ibase * 9         a2    = moogladder a1 (ibase + imod * klfo) 0.6 -spb = double dspb+spb = dspb dspb = 0.45  instr (coeff, cps) = return $ wobbly (sig spb) (sig coeff) (sig $ cpspch cps)  -main = dac $ mix $ str (dspb * 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)
examples/Events.hs view
@@ -17,7 +17,7 @@   -- | A single metronome (four beats per second).-src = metroE 4+src = metro 4  e1, e2, e3, e4, e5, e6, e7, e8 :: Evt D @@ -33,8 +33,8 @@  e51 :: Evt (D, D) e51 = mappend -        (repeatE (0.7, 220) (metroE (2/7)))-        (cycleE [(0.5, 440), (0.5, 330)] (metroE 2))+        (repeatE (0.7, 220) (metro (2/7)))+        (cycleE [(0.5, 440), (0.5, 330)] (metro 2))  -- rands @@ -54,7 +54,7 @@  -- mask -e10 :: Evt (D, D)+e10 :: Evt (Sco D) e10 = withDur 0.5 $ filterE (>* 110) $ mconcat      [ every 0 [5,7] $ repeatE 330 src     , every 3 [11] $ repeatE 550 src
examples/Gm.hs view
@@ -2,7 +2,7 @@ -- | Accords in just intonation Gm with 14/8 beat. module Main where -import Csound hiding (N)+import Csound.Base  import Color(marimbaSynth) @@ -10,8 +10,8 @@     where         env = once $ lins [0.00001, 30, 1, 50, 0.5, 100, 0.00001] -type N = (D, D)-type Sco = Score N+en :: Sco a -> Sco a+en = str (1/8)  -- volumes baseVolume = 0.35@@ -48,20 +48,20 @@ -- main left/right hand pattern  -- the first accent is a bit louder than other ones. v3 vs v2-rhp :: Trip a -> Score (D, a)+rhp :: Trip a -> Sco (D, a) rhp (Trip leads (a, b)) = en $ mel $ zipWith ($) [triple v3, triple v2, quatra, doub, doub] leads     where         triple acc lead = firstLead acc [lead, a, b]           quatra     lead = firstLead v3  [lead, a, b, a]         doub       lead = firstLead v2  [lead, a] -lhp :: Trip a -> Score (D, a)+lhp :: Trip a -> Sco (D, a) lhp (Trip leads (a, b)) = en $ mel $ zipWith ($) [triple v3, triple v2, quatra, quatra]  leads     where         triple acc lead = firstLead acc [lead, a, b]           quatra     lead = firstLead v2  [lead, a, b, a] -firstLead :: D -> [a] -> Score (D, a)+firstLead :: D -> [a] -> Sco (D, a) firstLead accVol (a:as) = melMap temp $ (accVol, a) : fmap (\x -> (v1, x)) as   bass = fmap (\x -> x - 7)@@ -72,7 +72,7 @@  t = (0, 2, 4) -firstPart = loop 2 $ har [leftHand1, rightHand1]+firstPart = loopBy 2 $ har [leftHand1, rightHand1]  rightHand1 = melMap rhp'          [ t@@ -100,9 +100,9 @@  -- Second part -secondPart = loop 2 $ har [leftHand2, rightHand2] +secondPart = loopBy 2 $ har [leftHand2, rightHand2]  -leftHand2 = loop 2 $ melMap lhp' +leftHand2 = loopBy 2 $ melMap lhp'          [ (-2, 1, 2)         , (-3, 1, 2)] @@ -115,8 +115,8 @@          -- all -tot = mel [loop 2 firstPart, secondPart, firstPart]+tot = mel [loopBy 2 firstPart, secondPart, firstPart] -res = str 1.7 $ sco (onCps marimbaSynth) $ sustain 0.35 $ loop 4 $ trip2cps $ tot+res = str 1.7 $ sco (onCps marimbaSynth) $ sustain 0.35 $ loopBy 4 $ trip2cps $ tot  main = dac $ mix res
examples/Gui/Button.hs view
@@ -3,10 +3,24 @@  import Csound.Base -main = dac $ do    +main = appGui++-- | Applicative style guis+appGui = dac $ vlift3 f masterVolume (toggle "play" False) (button "Hi!")+    where+        f vol evt1 evt2 = vol * sum [sig1, sig2]+            where +                (evtOn, evtOff) = splitToggle evt1+                instr cps _ = return $ fades 0.5 0.5 * osc cps+                sig1 = schedUntil (instr 440) evtOn evtOff+                sig2 = sched (instr 330) $ withDur 0.2 $ fmap (const unit) evt2+++-- | Monadic style guis+monadGui = dac $ do         -- Let's create a toggle button with label "play".     -- The toggle button emmits ones and zeros.-    (gbut1, evt1)   <- toggle "play"+    (gbut1, evt1)   <- toggle "play" False      -- Let's create a plain button with label "Hi!".     (gbut2, evt2)   <- button "Hi!"
− examples/Gui/Envelope.hs 
@@ -1,30 +0,0 @@--- | An ADSR-envelope.-module Envelope where--import Csound.Base---- We use `vdac` to activate the virtual midi keyboard.--- We can use just `dac` if we have a hardware midi controller.-main = vdac $ do-    -- Creates an Attack-decay-sustain-release widget.-    -- We specify a label, time bounds for attack, decay and release-    -- and init values. It returns a gui-widget and the signal of-    -- the envelope.-    (genv, env) <- linAdsr "" (AdsrBound 1 1 3) (AdsrInit 0.1 0.5 0.5 0.1)-    -    -- Creates a master volume widget.-    (gvol, vol) <- masterVolume --    -- A simple midi-instrument that plays a triangle wave with-    -- given amplitude envelope.-    let instr = onMsg $ \cps -> env * tri cps--    -- Let's place everything on window. Two elements-    -- are aligned vertically and the master volume slider is-    -- smaller than the envelope widget (we scale it by 0.25).-    panel $ ver [genv, sca 0.25 gvol]--    -- Triggers the midi instrument and scales-    -- the output by given master volume.-    return $ vol * midi instr-
examples/Gui/EnvelopeAndHarmonics.hs view
@@ -5,7 +5,7 @@  import Harmonics(harms) -main = vdac $ do+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      -- for each slider.@@ -14,15 +14,16 @@     (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          -- Places everything on window. Elements are aligned vertically.     -- The volume slider is smaller than the ADSR-envelope. The element     -- for harmonics is the biggest one. We alter the sizes with the function `sca`     -- (it's short for scale)-    panel $ ver [sca 0.1 gvol, sca 0.25 gadsr, gharms]+    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      -- and amplitude envelope.-    let instr = onMsg $ \cps -> env * harms ks cps-    return $ vol * midi instr+    let instr = env * harms ks cps+    return $ mul vol $ sched (const $ return instr) $ withDur 1 $ metro 0.5
− examples/Gui/Filter.hs 
@@ -1,38 +0,0 @@--- | Development of the example Osc.hs (see it first). --- Now oscillators are equipped with filter.-module Filter where--import Csound.Base--import Osc(OscInit(..), moogOscs)--data FilterInit = FilterInit -    { filterInitResonance :: Double     -- the Q-    , filterInitFreq      :: Double     -- the minimum of the center frequency-    , filterInitRange     :: Double }   -- center frequency range---- | A moog like filter with ADSR-envelope for center frequency.-moogFilter :: String -> Sig -> FilterInit -> Source (Sig -> Sig)-moogFilter name env (FilterInit initQ initCfq initRange) = source $ do-    (gq, q) <- knob "resonance" uspan initQ -    (gcfq, cfq) <- knob "freq" (linSpan 0 1000) initCfq  -    (grange, range) <- knob "range" (linSpan 0 10000) initRange-    let cfqSig = cfq + env * range-    gui <- setTitle name $ hor [gq, gcfq, grange]-    return (gui, mlp cfqSig q)--adsrBound = AdsrBound 3 3 5-adsrInit  = AdsrInit  0.1 0.1 0.5 0.2--main = vdac $ do-    (gampEnv, ampEnv) <- linAdsr "amplitude" adsrBound adsrInit-    (gfiltEnv, filtEnv) <- linAdsr "filter" adsrBound adsrInit-    (goscs, oscs) <- moogOscs [OscInit 1 1 1, OscInit 0.5 2 2, OscInit 0.125 3 3]-    (gfilt, filt) <- moogFilter "" filtEnv (FilterInit 0.6 100 3000)-    (gvol, vol) <- masterVolume --    let instr cps = vol * ampEnv * (filt $ oscs cps)-    let gui = hor [goscs, ver [gampEnv, gfiltEnv, gfilt], sca 0.1 gvol]-    panelBy "" (Just $ Rect 50 50 900 800) gui-    return $ midi $ onMsg instr-
examples/Gui/Harmonics.hs view
@@ -8,15 +8,17 @@ harms ks cps = sum $ zipWith f ks (fmap (sig . double) [1 .. ])     where f k n = k * osc (n * cps) -main = vdac $ do+main = dac $ do     -- Let's create a list of coefficients.     (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     -- Places elements on window with vertical alignment.-    panel $ ver [g, sca 0.1 gv]+    panel $ ver [g, sca 0.1 gv, sca 0.1 gcps]     -- Let's trigger the instrument with midi controller.-    return $ vol * midi instr-+    let instr = harms ks cps+    return $ mul v $ sched (const $ return instr) $ withDur 1 $ metro 0.5
examples/Gui/Key.hs view
@@ -3,19 +3,15 @@  import Csound.Base -main = dac $ do     -    -- Creates a window that listens to keyboard events when in focus.-    keyPanel =<< box "hi"-    -    -- 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     -    return $ mean -        [ asig 330 (charOn 's') (charOff 's') -        , asig 440 (charOn 'a') (charOff 'a') ]+    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
− examples/Gui/Osc.hs 
@@ -1,64 +0,0 @@--- | Simulates a moog-like oscillators.--- We create a waveform from the sum of the three oscillators.-module Osc where--import Csound.Base-import Control.Monad---- An oscillator-data OscInit = OscInit -    { oscInitVol   :: Double    -- volume-    , oscInitRange :: Int       -- integer scale for the frequency-    , oscInitWave  :: Int }     -- the waveform identifier-                                -- (0 - osc, 1 - triangle, 2 - square, 3 - saw)---- A single moog oscillator.--- It takes a title and initial values. Produces the waveform function.-moogOsc1 :: String -> OscInit -> Source (Sig -> Sig)-moogOsc1 name (OscInit initVol initRange initWave) = source $ do-    -- Creates a widget to chose between four classic waveforms-    (gf, f) <- classicWaves "" initWave-    -    -- A knob for a volume of the oscillator-    (gvol, vol) <- knob "vol" uspan initVol --    -- A knob for a range of the oscillator (scaling of the frequency)-    -- It's the number of the harmonic.-    (grange, range) <- knob "range" (linSpan 1 10) (fromIntegral initRange)--    -- Creates a gui element with the given title and horizontal placement.-    gui <- setTitle name $ hor [setMaterial NoPlastic $ gf, gvol, grange]--    -- Creates a waveform-    let instr cps = vol * f (floor' range * cps) -    return (gui, instr)---- A list of moog oscillators.-moogOscs :: [OscInit] -> Source (Sig -> Sig)-moogOscs xs = source $ do-    -- Creates a list of single moog oscillators-    (gfs, fs) <- fmap unzip $ zipWithM -        (\n initVal -> moogOsc1 ("osc" ++ show n) initVal) [1 ..] xs --    -- The final waveform is the sum of all oscillators-    let instr cps = sum $ fmap ($ cps) fs -    -- Alligns all elements vertically-    let gui = ver gfs--    -- Creates a source widget.-    return (gui, instr)--main = vdac $ do-    -- Let's create a stack of three oscillators:-    (g, f) <- moogOscs [(OscInit 1 1 0), (OscInit 0.2 1 1), (OscInit 0 1 2)]-    -- Creates a master volume slider.-    (gvol, vol) <- masterVolume -    -- Creates an amplitude envelope (see Envelope.hs).-    (genv, env) <- linAdsr "amplitude envelope" (AdsrBound 3 3 5) (AdsrInit 0.1 0.5 0.5 0.5) -    -    -- Places all elements on window with given title and sizes.-    panelBy "" (Just $ Rect 50 50 600 600) (hor [ver [sca 0.25 genv, g], sca 0.1 gvol])--    -- Triggers the instrument with midi controller.-    return $ midi $ onMsg (mul (vol * env) . f)-
examples/Gui/Waves.hs view
@@ -3,7 +3,7 @@  import Csound.Base -main = vdac $ do+main = dac $ do     -- Creates a master volume slider.     (gvol, vol) <- masterVolume @@ -18,6 +18,6 @@     -- Places elements on window aligned horizontally.     panel $ hor [sca 0.1 gvol, gw] -    -- Triggers the instrument with midi keyboard.-    return $ mul vol $ midi $ onMsg instr+    -- Triggrs the instrument with midi keyboard.+    return $ vol * instr 220
examples/Heartbeat.hs view
@@ -1,11 +1,7 @@ -- | The Heartbeat by Julie Friedman (without crackle)------ requires temporal-csound------ > cabal install temporal-csound module Main where -import Csound+import Csound.Base  linenIdur :: Sig -> D -> D -> Sig linenIdur a rise dec = linen a (idur * rise) idur (idur * dec) @@ -89,7 +85,7 @@ instrCrackle :: D -> Sig2 instrCrackle cps = crackle (0.5::D) cps 12 20 -scoBeat = sco (onArg instr1) $ del 2 $ loop 32 $ mel [0.25 *| melTemp [0.5, 0.3], rest 1.5]+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))      (fmap double $ [0, (v/40) .. v] ++ repeat v) (cycle [0.2, 0.8])
examples/Midi.hs view
@@ -15,16 +15,15 @@ -- 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 * env * (myOsc $ sig cps)-    where env = linsegr [0, 0.2, 1, 1, 0.5] 1.5 0+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  -- for real time output and listening for the midi events from all devices. main :: IO () main = vdac $ midi $ onMsg pureTone --- If we don't have any midi devices --- we can try with virtual midi:+-- If we have a real midi device+-- we can try with hardware midi: --- main = vdac $ midi $ onMsg pureTone+-- main = dac $ midi $ onMsg pureTone
examples/README.txt view
@@ -20,10 +20,11 @@      It should print a long message with version and available flags and libraries. -*   temporal-csound package. It brings together temporal-music-notation and csound-expression packages.-    It's used to make the process of score-writing more convenient.+*   csound-expression and csound-sampler packages. Also the Tibetan example requires the `random` package. -    > cabal install temporal-csound+    > cabal install csound-expression +    > cabal install csound-sampler+    > cabal install random   When  everything is installed examples should work as executable programs.@@ -31,5 +32,14 @@  > runhaskell AnExample.hs  -and get the sound or csound-file. +and get the sound going out of your speakers. ++Also you can load the file into ghci and play with parts of the music+in interactive mode.++------------------------------------------++Lots of examples can be found at the repository: csound-bits++https://github.com/spell-music/csound-bits
examples/Test.hs view
@@ -3,23 +3,7 @@ -- imports everything import Csound.Base --- 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. -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 make it a bit quieter by multiplying with 0.5.-pureTone :: D -> SE Sig-pureTone cps = return $ 0.4 * (myOsc $ sig cps)---- Let's trigger the instrument from the score section. It plays three notes.-res = sco pureTone $ CsdEventList 5 [(0, 1, 440), (1, 1, 330), (2, 1, 220)]- -- Renders generated csd-file to the "tmp.csd".+-- press Ctrl-C to stop main :: IO ()-main = dac $ mixLoop res+main = dac $ osc 440
examples/Tibetan.hs view
@@ -1,4 +1,4 @@-{- | additional parameters: ioff, irise, idec+{- | 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 @@ -17,7 +17,7 @@  import System.Random -import Csound hiding (N)+import Csound.Base import Color(blurp, blue)  -- | A pure tibetan instrument with randomized parameters.@@ -29,7 +29,7 @@ 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)   -          wave = ifB (cps <* 230) (waveBy 5) (ifB (cps <* 350) (waveBy 3) (waveBy 1))+          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  -----------------------------------------------------------@@ -60,7 +60,7 @@ instance Num Act where         fromInteger = Tone . fromInteger -type N = (Double, Double, D, D, D, D)+type N = (D, D, D, D, D, D)   data St = St @@ -103,7 +103,7 @@           riss = rises rise            notes = take (stRepeat st) $ getZipList $ (\t0 dt amp cps ris dec -> -                (t0, dt, double amp, double cps, double ris, double dec)) <$>+                (double t0, 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 }@@ -186,7 +186,7 @@ starHarms       = cycle [10, 6, 7, 10] starSweeps      = cycle [0.7, 0.6, 0.6, 0.5, 0.8, 0.9, 0.25, 0.7, 0.5, 0.5, 0.6] -starTotalDelay  = 5 * 60+starTotalDelay  = 1.5 * 60 starInitDelays  =              [ 0, 11,  2, 8,  21, 25] starPeriods     = fmap (* 2.5) [ 7, 23, 77, 13, 17, 31] @@ -194,12 +194,13 @@  starSco = sco blue $     flip evalState starParams $ traverse addParam $ -    takeS starLength $ har $ zipWith3 phi starInitDelays starPeriods starChord-    where phi dt period note = del dt $ loop 70 $ har [4 *| temp (double $ id2cps 2 note), rest period] +    har $ zipWith3 phi starInitDelays starPeriods starChord+    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) -             + + ------------------------------------------------------------  main = do@@ -208,9 +209,9 @@         [ introBlurp         , del (introDur * 0.70) $ har              [ globalEffect $ har -                [res2 notes+                [ res2 notes                 , del starTotalDelay $ starSco-                , del (3 * starTotalDelay) $ starSco]+                , del (2 * starTotalDelay) $ starSco]             , blurpSco             ]]
examples/Wind.hs view
@@ -1,7 +1,7 @@ -- | A whisper of the wind. module Main where -import Csound+import Csound.Base  ------------------------------------------------------------- -- orchestra@@ -30,6 +30,7 @@ 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) windRes = sco (onArg wind) $ har     [ i21  0    12   60   500  0    555  111  0     0.2     , i21  4    8    70   400  0    444  111  0.3   0.6@@ -67,6 +68,6 @@     , i21  64   12   72   300  0    333  333  0.9   0.8     ] --- | Let's repeat everything 10 times and add the sustain for 2 seconds per note.-main = dac $ mix $ sustain 2 $ loop 3 windRes+-- | Let's repeat everything 4 times and add the sustain for 2 seconds per note.+main = dac $ mix $ sustain 2 $ loopBy 4 windRes
src/Csound/Air.hs view
@@ -25,8 +25,11 @@     module Csound.Air.Live,       -- | A multitap looper.-    module Csound.Air.Looper,   +    module Csound.Air.Looper,  +    -- | Patches.+    module Csound.Air.Patch,   +     -- | Scheduling signals with event streams     module Csound.Air.Seg, @@ -46,6 +49,7 @@ import Csound.Air.Fx import Csound.Air.Live import Csound.Air.Looper+import Csound.Air.Patch import Csound.Air.Seg import Csound.Air.Sampler import Csound.Air.Misc
src/Csound/Air/Fx.hs view
@@ -171,18 +171,18 @@ tabDelay :: (Tab -> Sig -> SE Sig) -> MaxDelayTime -> DelayTime -> Feedback -> Balance -> Sig -> SE Sig tabDelay go maxLength delTim  kfeed kbalance asig = do     buf <- newTab tabLen    -    ptrRef <- newSERef (0 :: Sig)-    aresRef <- newSERef (0 :: Sig)  -    ptr <- readSERef ptrRef+    ptrRef <- newRef (0 :: Sig)+    aresRef <- newRef (0 :: Sig)  +    ptr <- readRef ptrRef     when1 (ptr >=* sig tabLen) $ do-        writeSERef ptrRef 0-    ptr <- readSERef ptrRef +        writeRef ptrRef 0+    ptr <- readRef ptrRef       let kphs = (ptr / sig tabLen) - (delTim/(sig $ tabLen / getSampleRate))     awet <-go buf (wrap kphs 0 1)-    writeSERef aresRef $ asig + kfeed * awet-    ares <- readSERef aresRef-    writeSERef ptrRef =<< tablewa buf ares 0+    writeRef aresRef $ asig + kfeed * awet+    ares <- readRef aresRef+    writeRef ptrRef =<< tablewa buf ares 0     return $ (1 - kbalance) * asig + kbalance * awet     where         tabLen = tabSizeSecondsPower2 maxLength@@ -503,39 +503,39 @@ trackerSplice :: D -> Sig -> Sig -> Sig -> SE Sig trackerSplice maxLength segLengthSeconds kmode asig = do     setksmps 1-    kindxRef <- newSERef (0 :: Sig)-    ksampRef <- newSERef (1 :: D)-    aoutRef  <- newSERef (0 :: Sig)+    kindxRef <- newRef (0 :: Sig)+    ksampRef <- newRef (1 :: D)+    aoutRef  <- newRef (0 :: Sig)      buf <- newTab (tabSizeSecondsPower2 maxLength)     let segLength = segLengthSeconds * sig getSampleRate         andx = phasor (sig $ getSampleRate / ftlen buf)         andx1 = delay andx 1     tabw asig (andx * sig (ftlen buf)) buf-    ksamp <- readSERef ksampRef+    ksamp <- readRef ksampRef     let apos = samphold (andx1 * sig (ftlen buf)) (sig ksamp)      whens [-        (kmode >=* 1 &&* kmode <* 2, do             -                kindx <- readSERef kindxRef                             -                writeSERef kindxRef $ ifB (kindx >* segLength) 0 (kindx + 1)                -                kindx <- readSERef kindxRef+        (kmode >=* 1 &&* kmode `lessThan` 2, do             +                kindx <- readRef kindxRef                             +                writeRef kindxRef $ ifB (kindx >* segLength) 0 (kindx + 1)                +                kindx <- readRef kindxRef                 when1 (kindx + apos >* sig (ftlen buf)) $ do-                    writeSERef kindxRef $ (-segLength)+                    writeRef kindxRef $ (-segLength) -                kindx <- readSERef kindxRef+                kindx <- readRef kindxRef -                writeSERef aoutRef $ table (apos + kindx) buf `withDs` [0, 1]-                writeSERef ksampRef 0-        ), (kmode >=* 2 &&* kmode <* 3, do              -                kindx <- readSERef kindxRef-                writeSERef kindxRef $ ifB ((kindx+apos) <=* 0) (sig (ftlen buf) - apos) (kindx-1)-                kindx <- readSERef kindxRef-                writeSERef aoutRef $ table (apos+kindx) buf `withDs` [0, 1]-                writeSERef ksampRef 0   +                writeRef aoutRef $ table (apos + kindx) buf `withDs` [0, 1]+                writeRef ksampRef 0+        ), (kmode >=* 2 &&* kmode `lessThan` 3, do              +                kindx <- readRef kindxRef+                writeRef kindxRef $ ifB ((kindx+apos) <=* 0) (sig (ftlen buf) - apos) (kindx-1)+                kindx <- readRef kindxRef+                writeRef aoutRef $ table (apos+kindx) buf `withDs` [0, 1]+                writeRef ksampRef 0            )] (do-                writeSERef ksampRef 1-                writeSERef aoutRef asig)+                writeRef ksampRef 1+                writeRef aoutRef asig) -    aout <-readSERef aoutRef+    aout <-readRef aoutRef     return aout
src/Csound/Air/Live.hs view
@@ -11,11 +11,12 @@     -- * Instrument choosers     hinstrChooser, vinstrChooser,     hmidiChooser, vmidiChooser,+    hpatchChooser, vpatchChooser,      -- ** Fx units     uiDistort, uiChorus, uiFlanger, uiPhaser, uiDelay, uiEcho,     uiFilter, uiReverb, uiGain, uiWhite, uiPink, uiFx, uiRoom,-    uiHall, uiCave, uiSig, uiMix, uiMidi,+    uiHall, uiCave, uiSig, uiMix, uiMidi, uiPatch,       -- * Static widgets     AdsrBound(..), AdsrInit(..),@@ -32,6 +33,7 @@  import Csound.Typed import Csound.Typed.Gui+import Csound.Control.Midi import Csound.Control.Evt import Csound.Control.Instr import Csound.Control.Gui@@ -39,6 +41,7 @@ import Csound.SigSpace import Csound.Air.Wave import Csound.Air.Fx+import Csound.Air.Patch import Csound.Air.Misc  ----------------------------------------------------------------------@@ -136,18 +139,18 @@ fxBox name fx onOff args = source $ do     (gOff0, off) <- toggleSig name onOff     let gOff = setFontSize 25 gOff0-    offRef <- newGlobalSERef (0 :: Sig)-    writeSERef offRef off+    offRef <- newGlobalRef (0 :: Sig)+    writeRef offRef off     let (names, initVals) = unzip $ take (arityFx fx) args       (gs, as)  <- fmap unzip $ mapM (\(name, initVal) -> slider name (linSpan 0 1) initVal) $ zip names initVals      let f x = do-        ref <- newSERef (0 :: Sig, 0 :: Sig)-        goff <- readSERef offRef-        writeSERef ref x        +        ref <- newRef (0 :: Sig, 0 :: Sig)+        goff <- readRef offRef+        writeRef ref x                 when1 (goff ==* 1) $ do-            x2 <- readSERef ref-            writeSERef ref =<< applyFxArgs fx as x2-        res <- readSERef ref        +            x2 <- readRef ref+            writeRef ref =<< applyFxArgs fx as x2+        res <- readRef ref                 return res       let gui = setBorder UpBoxBorder $ go (length names) gOff gs     return (gui, f)@@ -305,6 +308,11 @@ uiMidi xs initVal = sourceColor2 C.forestgreen $ uiBox "Midi" fx True     where fx = lift1 (\aout arg -> return $ aout + arg) $ vmidiChooser xs initVal +-- | Patch chooser implemented as FX-box.+uiPatch :: [(String, Patch2)] -> Int -> Source FxFun +uiPatch xs initVal = sourceColor2 C.forestgreen $ uiBox "Patch" fx True+    where fx = lift1 (\aout arg -> return $ aout + arg) $ vpatchChooser xs initVal+ -- | the widget for mixing in a signal to the signal. uiSig :: String -> Bool -> Source Sig2 -> Source FxFun uiSig name onOff widget = source $ do@@ -394,8 +402,29 @@ vinstrChooser = genInstrChooser vradioSig  genInstrChooser :: (Sigs b) => ([String] -> Int -> Source Sig) -> [(String, a -> SE b)] -> Int -> Source (a -> SE b)-genInstrChooser widget xs initVal = lift1 go $ widget names initVal+genInstrChooser widget xs initVal = lift1 (routeInstr instrs) $ widget names initVal+    where (names, instrs) = unzip xs+        -- go instrId arg = fmap sum $ mapM ( $ arg) $ zipWith (\n instr -> playWhen (sig (int n) ==* instrId) instr) [0 ..] instrs++routeInstr :: Sigs b => [a -> SE b] -> Sig -> (a -> SE b)+routeInstr instrs instrId arg = fmap sum $ mapM ( $ arg) $ zipWith (\n instr -> playWhen (sig (int n) ==* instrId) instr) [0 ..] instrs++----------------------------------------------------+-- effect choosers++hpatchChooser :: (SigSpace a, Sigs a) => [(String, Patch a)] -> Int -> Source a +hpatchChooser = genPatchChooser hradioSig++vpatchChooser :: (SigSpace a, Sigs a) => [(String, Patch a)] -> Int -> Source a +vpatchChooser = genPatchChooser vradioSig++genPatchChooser :: (SigSpace a, Sigs a) => ([String] -> Int -> Source Sig) -> [(String, Patch a)] -> Int -> Source a+genPatchChooser widget xs initVal = joinSource $ lift1 go $ widget names initVal     where -        (names, instrs) = unzip xs-        go instrId arg = fmap sum $ mapM ( $ arg) $ zipWith (\n instr -> playWhen (sig (int n) ==* instrId) instr) [0 ..] instrs-            +        (names, patches) = unzip xs                +        go instrId = routeInstr fxs instrId =<< midi (routeInstr instrs instrId . ampCps)++        instrs = fmap patchInstr patches+        fxs    = fmap getPatchFx patches+        +
src/Csound/Air/Looper.hs view
@@ -1,7 +1,8 @@+{-# Language FlexibleContexts, ScopedTypeVariables #-} -- | A multitap looper. module Csound.Air.Looper ( 	LoopSpec(..), LoopControl(..),-	sigLoop, midiLoop, sfLoop+	sigLoop, midiLoop, sfLoop, patchLoop ) where  import Control.Monad@@ -22,6 +23,7 @@ import Csound.Air.Wave import Csound.Air.Fx import Csound.Air.Filter+import Csound.Air.Patch import Csound.Air.Misc  @@ -130,6 +132,10 @@ midiLoop :: LoopSpec -> D -> [D] -> [Msg -> SE Sig2] -> Source Sig2 midiLoop = genLoop $ \cond midiInstr -> midi $ playWhen cond midiInstr  +-- | Some instruments not work well with the looper. Alwo be aware of limitation of software resources.+patchLoop :: LoopSpec -> D -> [D] -> [Patch2] -> Source Sig2+patchLoop = genLoop $ \cond p -> atMidi (patchWhen cond p)+ -- | Simple multitap Looper. We can create as many taps as we like -- also we can create fade outs/ins insert effects and control mix.  --@@ -157,7 +163,7 @@ 	, ( $ "del") $ maybe button button' (loopDel a) 	, (\f -> f "through" False) $ maybe toggleSig (toggleSig' . evtToSig (-1))  (loopThrough a))  -genLoop :: (BoolSig -> a -> SE Sig2) -> LoopSpec -> D -> [D] -> [a] -> Source Sig2+genLoop :: forall a. (BoolSig -> a -> SE Sig2) -> LoopSpec -> D -> [D] -> [a] -> Source Sig2 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@@ -171,8 +177,8 @@ 		preCoeffs <- tabSigs preFxKnobWrite preFxKnobRead x initPreVals 		postCoeffs <- tabSigs postFxKnobWrite postFxKnobRead x initPostVals -		refs <- mapM (const $ newSERef (1 :: Sig)) ids-		delRefs <- mapM (const $ newSERef (0 :: Sig)) ids+		refs <- mapM (const $ newRef (1 :: Sig)) ids+		delRefs <- mapM (const $ newRef (0 :: Sig)) ids 		zipWithM_ (setSilencer refs) silencer sils 		at smallRoom2 $ sum $ zipWith3 (f delEvt thr x) (zip3 times ids repeatFades) (zip5 mixCoeffs preFx preCoeffs postFx postCoeffs) $ zip3 delRefs refs instrs) throughDel sw sil 	where@@ -207,12 +213,13 @@  		maxDel = 3 +		f :: Tick -> Sig -> Sig -> (D, Int, Sig) -> (Sig, FxFun, Sig, FxFun, Sig) -> (Ref Sig, Ref Sig, a) -> SE Sig2 		f delEvt thr x (t, n, repeatFadeWeight) (mixCoeff, preFx, preCoeff, postFx, postCoeff) (delRef, silRef, instr) = do-			silVal <- readSERef silRef	+			silVal <- readRef silRef	 			runEvt delEvt $ \_ -> do-				a <- readSERef delRef-				when1 isCurrent $ writeSERef delRef (ifB (a + 1 <* maxDel) (a + 1) 0)-			delVal <- readSERef delRef+				a <- readRef delRef+				when1 isCurrent $ writeRef delRef (ifB (a + 1 `lessThan` maxDel) (a + 1) 0)+			delVal <- readRef delRef 			echoSig <- playSf 0  			let d0 = delVal ==* 0@@ -228,17 +235,17 @@ 				isCurrent = x ==* (sig $ int n)  		setSilencer refs silIds evt = runEvt evt $ \v -> -			mapM_ (\ref -> writeSERef ref $ sig v) $ fmap (refs !! ) silIds+			mapM_ (\ref -> writeRef ref $ sig v) $ fmap (refs !! ) silIds  tabSigs :: Output Sig -> Input Sig -> Sig -> [Sig] -> SE [Sig] tabSigs writeWidget readWidget switch initVals = do	-	refs <- mapM newGlobalSERef initVals	+	refs <- mapM newGlobalRef initVals	 -	vs <- mapM readSERef refs+	vs <- mapM readRef refs 	runEvt (changedE [switch]) $ \_ -> do 		mapM_  (\(v, x) -> when1 (x ==* switch) $ writeWidget v) $ zip vs $ fmap (sig . int) [0 .. length initVals - 1]  	forM_ (zip [0..] refs) $ \(n, ref) -> do-		when1 ((sig $ int n) ==* switch) $ writeSERef ref readWidget+		when1 ((sig $ int n) ==* switch) $ writeRef ref readWidget  	return vs
src/Csound/Air/Misc.hs view
@@ -1,3 +1,4 @@+{-# Language FlexibleContexts #-} -- | Patterns module Csound.Air.Misc(     mean, vibrate, randomPitch, chorusPitch, resons, resonsBy, modes, dryWet, @@ -21,15 +22,31 @@     delaySig,      -- * Function composition-    funSeq, funPar+    funSeq, funPar,++    -- * Metronome +    ticks, nticks,+    ticks2, nticks2,+    ticks3, nticks3,+    ticks4, nticks4,++    -- * Drone+    testDrone, testDrone2, testDrone3, testDrone4+ ) where +import Control.Monad import Data.Boolean+import Data.Default  import Csound.Typed-import Csound.Typed.Opcode+import Csound.Typed.Opcode hiding (metro) import Csound.Control.Gui+import Csound.Control.Evt+import Csound.Control.Instr+import Csound.Tab import Csound.Air.Wave+import Csound.Air.Patch import Csound.Air.Envelope import Csound.Air.Filter import Csound.SigSpace@@ -228,3 +245,271 @@ -- > delaySig numOfSamples asig delaySig :: D -> Sig -> Sig delaySig nsamples asig = delay asig nsamples+++-----------------------------------------------------+-- metronome++-- It contains a small copy of Csouns.Catalog.Tr808. Just enough to implement a metronome.++data TrSpec = TrSpec {+      trDur     :: D+    , trTune    :: D+    , trCps     :: D+    , trRnd     :: Maybe D+    }++rndAmp :: Sig -> SE Sig+rndAmp a = do+    k <- birnd 0.09+    return $ a * (1 + sig k)++rndVal :: D -> D -> D -> SE D+rndVal total amount x = do+    k <- birnd amount +    return $ x  + k * total++rndDur amt x = rndVal x amt x+rndCps amt x = rndVal x (amt / 10) x+rndTune amt x = rndVal 0.7 amt x++rndSpec ::TrSpec -> SE TrSpec+rndSpec spec = do+    dur  <- rndDur'+    tune <- rndTune'+    cps  <- rndCps'+    return $ spec +        { trDur  = dur +        , trTune = tune+        , trCps  = cps }+    where +        rndDur'  = (maybe return rndDur $ (trRnd spec)) $ trDur spec+        rndTune' = (maybe return rndTune $ (trRnd spec)) $ trTune spec+        rndCps'  = (maybe return rndCps $ (trRnd spec)) $ trCps spec+++addDur' dt x = xtratim dt >> return x+addDur = addDur' 0.1++getAccent :: Int -> [D]+getAccent n = 1 : replicate (n - 1) 0.5++-- | Metronome with a chain of accents.+-- A typical 7/8 for example:+--+-- > dac $ nticks [3, 2, 2] (135 * 2)+nticks :: [Int] -> Sig -> Sig+nticks = nticks' rimShot'++nticks2 :: [Int] -> Sig -> Sig+nticks2 = nticks' claves'++nticks3 :: [Int] -> Sig -> Sig+nticks3 = nticks' maraca'++nticks4 :: [Int] -> Sig -> Sig+nticks4 = nticks' highConga'++nticks' :: (TrSpec -> SE Sig) -> [Int] -> Sig -> Sig+nticks' drum ns = genTicks drum (cycleE $ ns >>= getAccent)    ++-- | Metronome.+--+-- > ticks n bpm+ticks :: Int -> Sig -> Sig+ticks = ticks' rimShot'++ticks2 :: Int -> Sig -> Sig+ticks2 = ticks' claves'++ticks3 :: Int -> Sig -> Sig+ticks3 = ticks' maraca'++ticks4 :: Int -> Sig -> Sig+ticks4 = ticks' highConga'++ticks' :: (TrSpec -> SE Sig) -> Int -> Sig -> Sig+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))) $ +    withDur 0.5 $ f $ metro (x / 60)++rimShot' spec = pureRimShot' =<< rndSpec spec++-- cps = 1700+pureRimShot' :: TrSpec -> SE Sig+pureRimShot' spec = rndAmp =<< addDur =<< (mul 0.8 $ aring + anoise)+    where+        dur     = trDur  spec+        tune    = trTune spec+        cps     = trCps  spec++        fullDur = 0.027 * dur++        -- ring+        aenv1 = expsega [1,fullDur,0.001]+        ifrq1 = sig $ cps * octave tune     +        aring = mul (0.5 * (aenv1 - 0.001)) $ at (bbp ifrq1 (ifrq1 * 8)) $ rndOscBy tabTR808RimShot ifrq1++        -- noise+        aenv2 = expsega [1, 0.002, 0.8, 0.005, 0.5, fullDur-0.002-0.005, 0.0001]+        kcf   = expsegr [4000, fullDur, 20] fullDur 20+        anoise = mul (aenv2 - 0.001) $ fmap (blp kcf) $ noise 1 0++        tabTR808RimShot = setSize 1024 $ sines [0.971,0.269,0.041,0.054,0.011,0.013,0.08,0.0065,0.005,0.004,0.003,0.003,0.002,0.002,0.002,0.002,0.002,0.001,0.001,0.001,0.001,0.001,0.002,0.001,0.001]++claves' :: TrSpec -> SE Sig+claves' spec = rndAmp =<< addDur =<< asig+    where+        dur     = trDur  spec+        tune    = trTune spec+        cps     = trCps  spec++        ifrq = cps * octave tune+        dt   = 0.045 * dur+        aenv = expsega  [1, dt, 0.001]+        afmod = expsega [3,0.00005,1]+        asig = mul (- 0.4 * (aenv-0.001)) $ rndOsc (sig ifrq * afmod)++highConga' :: TrSpec -> SE Sig+highConga' = genConga 0.22++genConga :: D -> TrSpec -> SE Sig+genConga dt spec = rndAmp =<< addDur =<< asig+    where+        dur     = trDur  spec+        tune    = trTune spec+        cps     = trCps  spec++        ifrq = cps * octave tune+        fullDur = dt * dur+        aenv = transeg [0.7,1/ifrq,1,1,fullDur,-6,0.001]+        afmod = expsega [3,0.25/ifrq,1]+        asig = mul (-0.25 * aenv) $ rndOsc (sig ifrq * afmod)++maraca' ::  TrSpec -> SE Sig+maraca' spec = rndAmp =<< addDur =<< anoise+    where+        dur     = trDur  spec+        tune    = trTune spec+        cps     = trCps  spec++        fullDur = 0.07* dur+        otune   = sig $ octave tune+        iHPF    = limit (6000 * otune) 20 (sig getSampleRate / 2)+        iLPF    = limit (12000 * otune) 20 (sig getSampleRate / 3)+        aenv    = expsega [0.4,0.014* dur,1,0.01 * dur, 0.05, 0.05 * dur, 0.001]+        anoise  = mul aenv $ fmap (blp iLPF . bhp iHPF) $ noise 0.75 0++-------------------------------------------+-- drones (copied from csound-catalog)++testDrone  cps = atNote (deepPad razorPad) (0.8, cps)+testDrone2 cps = atNote (deepPad nightPad) (0.8, cps)+testDrone3 cps = atNote (deepPad caveOvertonePad) (0.8, cps)+testDrone4 cps = atNote (deepPad pwEnsemble) (0.8, cps)++pwEnsemble = Patch+    { patchInstr = at fromMono . mul 0.55 . onCps impPwEnsemble+    , patchFx    = fx1 0.25 smallHall2 }++nightPad = Patch+    { patchInstr = mul 0.48 . at fromMono . onCps (mul (fadeOut 1) . impNightPad 0.5)+    , patchFx    = fx1 0.25 largeHall2 }++data RazorPad = RazorPad { razorPadSpeed :: Sig }++instance Default RazorPad where+    def = RazorPad 0.5++razorPad = razorPad' def++razorPad' (RazorPad speed) = Patch+    { patchInstr = at fromMono . mul 0.6 . onCps (uncurry $ impRazorPad speed)+    , patchFx    = fx1 0.35 largeHall2 }++overtonePad = Patch+    { patchInstr = 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)))+    , patchFx    = fx1 0.35 smallHall2 }++caveOvertonePad = overtonePad { patchFx = fx1 0.2 (magicCave2 . mul 0.8) }++-- implem++impPwEnsemble :: Sig -> SE Sig+impPwEnsemble x = mul 0.3 $ at (mlp (3500 + x * 2) 0.1) $ mul (leg 0.5 0 1 1) $ sum+    [ f 0.2 0.11 2 (x * cent (-6))+    , f 0.8 (-0.1) 1.8 (x * cent 6)+    , f 0.2 0.11 2 (x * 0.5) ]+    where f a b c = rndPw (a + b * tri c)++-- | Tibetan chant. It's a chorus of many sinusoids.+--+-- > tibetan n off cps+--+-- * n - the number of sinusoids (the best is 9)+--+-- * off - frequency step of the harmonics ~ (0.01, 0.03)+-- +-- * cps - the frequency of the note+tibetan :: Int -> Sig -> D -> Sig+tibetan n off cps = chorusPitch n (2 * off * fromIntegral n) (oscBy wave) (sig cps)+    where wave = ifB (cps `lessThan` 230) (waveBy 5) (ifB (cps `lessThan` 350) (waveBy 3) (waveBy 1))+          waveBy x = sines $ [0.3, 0, 0, 0] ++ replicate x 0.1++impRazorPad speed amp cps = f cps + 0.75 * f (cps * 0.5)+    where f cps = mul (leg 0.5 0 1 1) $ genRazor (filt 1 mlp) speed amp cps++genRazor filter speed amp cps = mul amp $ do+    a1 <- ampSpline 0.01+    a2 <- ampSpline 0.02    ++    return $ filter (1000 + 2 * cps + 500 * amp) 0.1 $ mean [+          fosc 1 3 (a1 * uosc (speed)) cps+        , fosc 3 1 (a2 * uosc (speed + 0.2)) cps+        , fosc 1 7 (a1 * uosc (speed - 0.15)) cps ]+    where ampSpline c = rspline ( amp) (3.5 + amp) ((speed / 4) * (c - 0.1)) ((speed / 4) * (c  + 0.1))+++-- | +-- > nightPad fadeInTime cps+impNightPad :: D -> Sig -> Sig+impNightPad dt = (fadeIn dt * ) . stringPad 1++-- | +--+-- > stringPad amplitude cps+stringPad :: Sig -> Sig -> Sig+stringPad amp cps = blp (900 + amp * 300) $ chorusPitch 3 0.1 f cps+    where f x = poscil 1 x giwave++giwave :: Tab+giwave = sines [1, 0.5, 0.33, 0.25, 0.0, 0.1, 0.1, 0.1]++fx1 :: Sig -> (a -> a) -> [FxSpec a]+fx1 dw f = [FxSpec dw (return . f)]++-- | The magic cave reverb (stereo).+magicCave2 :: Sig2 -> Sig2+magicCave2 = rever2 0.99++-- | Stereo reverb for small hall.+smallHall2 :: Sig2 -> Sig2+smallHall2 = rever2 0.8++-- | Stereo reverb for large hall.+largeHall2 :: Sig2 -> Sig2+largeHall2 = rever2 0.9++-- | Mono reverb (based on reverbsc)+--+-- > rever2 feedback (asigLeft, asigRight)+rever2 :: Feedback -> Sig2 -> Sig2+rever2 fbk (a1, a2) = (a1 + wa1, a2 + wa2)+    where (wa1, wa2) = reverbsc a1 a2 fbk 12000++type Feedback = Sig
+ src/Csound/Air/Patch.hs view
@@ -0,0 +1,175 @@+-- | Patches.+module Csound.Air.Patch(+	CsdNote, Instr, Fx, Fx1, Fx2, FxSpec(..), DryWetRatio,+	Patch1, Patch2, Patch(..),	+	getPatchFx, dryPatch, atMix, atMixes,++	-- * Midi+	atMidi,++	-- * Events+	atSched,+	atSchedUntil,++	-- * Sco+	atSco,++	-- * Single note+	atNote,++	-- * Fx+	addInstrFx, addPreFx, addPostFx,++	-- * Pads+	harmonPatch, deepPad,++	-- * Misc+	patchWhen, mixInstr+) where++import Control.Monad+import Control.Applicative++import Csound.Typed+import Csound.SigSpace+import Csound.Control.Midi+import Csound.Control.Instr++-- | A simple csound note (good for playing with midi-keyboard).+-- It's a pair of amplitude (0 to 1) and freuqncy (Hz).+type CsdNote = (D, D)++-- | An instrument transforms a note to a signal.+type Instr a = CsdNote -> SE a++-- | An effect processes the input signal.+type Fx a = a  -> SE a+type DryWetRatio = Sig++-- | Mono effect.+type Fx1 = Fx Sig++-- | Stereo effect.+type Fx2 = Fx Sig2++-- | Mono patches.+type Patch1 = Patch Sig++-- | Stereo patches.+type Patch2 = Patch Sig2++data FxSpec a = FxSpec+	{ fxMix :: DryWetRatio+	, fxFun :: Fx a	+	}++-- | A patch. It's an instrument, an effect and default dry/wet ratio.+data Patch a = Patch+	{ patchInstr :: Instr a+	, patchFx	 :: [FxSpec a]+	}++dryPatch :: Patch a -> Patch a+dryPatch p = p { patchFx = [] }++-- | Sets the mix of the last effect.+atMix :: Sig -> Patch a -> Patch a+atMix k p = p { patchFx = mapHead (\x -> x { fxMix = k }) (patchFx p) }+	where +		mapHead f xs = case xs of+			[]   -> []+			a:as -> f a : as++-- | Sets the mix of the effects from last to first.+atMixes :: [Sig] -> Patch a -> Patch a+atMixes ks p = p { patchFx = zipFirst (\k x -> x { fxMix = k }) ks (patchFx p) }+	where+		zipFirst f xs ys = case (xs, ys) of+			(_,    [])   -> []+			([],   bs)   -> bs+			(a:as, b:bs) -> f a b : zipFirst f as bs+++wet :: (SigSpace a, Sigs a) => FxSpec a -> Fx a+wet (FxSpec k fx) asig = fmap ((mul (1 - k) asig + ) . mul k) $ fx asig++-- | Transforms all the effects for the given patch into a single function. +getPatchFx :: (SigSpace a, Sigs a) => Patch a -> Fx a+getPatchFx p = foldr (<=<) return $ fmap wet $ patchFx p++--------------------------------------------------------------++instance SigSpace a => SigSpace (Patch a) where+	mapSig f p = p { patchInstr = fmap (mapSig f) . patchInstr p }++--------------------------------------------------------------+-- note++-- | Plays a patch at the given note.+atNote :: (SigSpace a, Sigs a) => Patch a -> CsdNote -> SE a+atNote p note = getPatchFx p =<< patchInstr p note++--------------------------------------------------------------+-- midi++-- | Plays a patch with midi. Supplies a custom value for mixing effects (dry/wet).+-- The 0 is a dry signal, the 1 is a wet signal.+atMidi :: (SigSpace a, Sigs a) => Patch a -> SE a+atMidi a = getPatchFx a =<< midi (patchInstr a . ampCps)	++--------------------------------------------------------------+-- sched++-- | Plays a patch with event stream. Supplies a custom value for mixing effects (dry/wet).+-- The 0 is a dry signal, the 1 is a wet signal.+atSched :: (SigSpace a, Sigs a) => Patch a -> Evt (Sco CsdNote) -> SE a+atSched p evt = getPatchFx p $ sched (patchInstr p) evt++atSchedUntil :: (SigSpace a, Sigs a) => Patch a -> Evt CsdNote -> Evt b -> SE a+atSchedUntil p evt stop = getPatchFx p $ schedUntil (patchInstr p) evt stop++--------------------------------------------------------------+-- sco+ + -- | Plays a patch with scores. Supplies a custom value for mixing effects (dry/wet).+-- The 0 is a dry signal, the 1 is a wet signal.+atSco :: (SigSpace a, Sigs a) => Patch a -> Sco CsdNote -> Sco (Mix a)+atSco p sc = eff (getPatchFx p) $ sco (patchInstr p) sc	++--------------------------------------------------------------++-- | Adds an effect to the patch's instrument.+addInstrFx :: Fx a -> Patch a -> Patch a+addInstrFx f p = p { patchInstr = f <=< patchInstr p }++-- | Appends an effect before patch's effect.+addPreFx :: DryWetRatio -> Fx a -> Patch a -> Patch a+addPreFx dw f p = p { patchFx = patchFx p ++ [FxSpec dw f] }++-- | Appends an effect after patch's effect.+addPostFx :: DryWetRatio -> Fx a -> Patch a -> Patch a+addPostFx dw f p = p { patchFx = FxSpec dw f : patchFx p }++----------------------------------------------------------------++-- | Plays the patch when confition is true otherwise it produces silence.+patchWhen :: Sigs a => BoolSig -> Patch a -> Patch a+patchWhen cond p = p +	{ patchInstr = playWhen cond (patchInstr p)+	, patchFx    = fmap (mapFun $ playWhen cond) (patchFx p) }+	where mapFun f x = x { fxFun = f $ fxFun x }+++mixInstr :: (SigSpace a, Num a) => Sig -> Patch a -> Patch a -> Patch a+mixInstr k f p = p { patchInstr = \x -> liftA2 (+) (patchInstr p x) (fmap (mul k) (patchInstr f x)) }++------------------------------------------------+-- pads++harmonPatch :: (SigSpace a, Sigs a) => [Sig] -> [D] -> Patch a -> Patch a+harmonPatch amps freqs p = p { +		patchInstr = \(amp, cps) -> fmap sum $ zipWithM (\a f -> fmap (mul a) $ patchInstr p (amp, cps * f)) amps freqs	+	}++deepPad :: (SigSpace a, Sigs a) => Patch a -> Patch a+deepPad = harmonPatch (fmap (* 0.75) [1, 0.5]) [1, 0.5]
src/Csound/Air/Sampler.hs view
@@ -6,9 +6,13 @@ 	-- with event sampler functions. 	evtTrig, evtTap, evtGroup, evtCycle, +	syncEvtTrig, syncEvtTap, syncEvtGroup, syncEvtCycle,+ 	-- * Keyboard sampler 	charTrig, charTap, charPush, charToggle, charGroup, charCycle, +	syncCharTrig, syncCharTap, syncCharPush,syncCharToggle, syncCharGroup, syncCharCycle,+     -- * Midi sampler     midiTrig, midiTap, midiPush, midiToggle, midiGroup,  @@ -16,7 +20,14 @@     midiTrigBy, midiTapBy, midiPushBy, midiToggleBy, midiGroupBy,      -- ** Midi instruments-    MidiTrigFun, midiAmpInstr, midiLpInstr, midiAudioLpInstr, midiConstInstr+    MidiTrigFun, midiAmpInstr, midiLpInstr, midiAudioLpInstr, midiConstInstr,++    -- * Misc++    -- | Keyboard char columns+    keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, +    keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0+ ) where  import Data.Monoid@@ -35,14 +46,28 @@ -- Event sampler  -- | Triggers the signal with the first stream and turns it off with the second stream.-evtTrig :: (Sigs a) => Tick -> Tick -> a -> a-evtTrig x st a = runSeg $ loop $ lim st $ del x $ loop (lim x $ toSeg a)+evtTrig :: (Sigs a) => Maybe a -> Tick -> Tick -> a -> a+evtTrig minitVal x st a = case minitVal of+	Nothing -> ons+	Just v0 -> ons + offs v0 + first v0+	where +		ons     = evtTrigNoInit x st a+		offs  v = evtTrigNoInit st x v+		first v = evtTrigger loadbang x v +		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	+ -- | Toggles the signal with event stream.-evtToggle :: (Sigs a) => Tick -> a -> a-evtToggle evt = evtTrig (fmap (const unit) ons) (fmap (const unit) offs)+evtToggle :: (Sigs a) => Maybe a -> Tick -> a -> a+evtToggle initVal evt = evtTrig initVal (fmap (const unit) ons) (fmap (const unit) offs) 	where (offs, ons) = splitToggle $ toTog evt +syncEvtToggle :: (Sigs a) => Sig -> Maybe a -> Tick -> a -> a+syncEvtToggle bpm initVal evt = evtToggle initVal (syncBpm bpm evt)+ -- | Consider note limiting? or performance degrades -- every note is held to infinity and it continues to produce zeroes. -- No it's not every sequence note triggers it@@ -50,74 +75,172 @@ evtTap :: (Sigs a) => D -> 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 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) => [(Tick, a)] -> Tick -> a-evtGroup as stop = sum $ fmap (\(a, b, c) -> evtTrig a (mappend b stop) c) +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)  	$ zipWith (\n (a, sam) -> (a, mconcat $ fmap snd $ filter ((/= n) . fst) allEvts, sam)) [(0 :: Int)..] as 	where  		allEvts :: [(Int, Tick)] 		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)+ -- | Triggers one signal after another with an event stream.-evtCycle :: (Sigs a) => Tick -> Tick -> [a] -> a-evtCycle start stop sigs = runSeg $ loop $ lim stop $ del start $ loop $ mel $ fmap (lim start . toSeg) sigs+evtCycle :: (Sigs a) => Maybe a -> Tick -> Tick -> [a] -> a+evtCycle minitVal start stop sigs = case minitVal of+	Nothing -> ons+	Just _  -> ons + offs +	where +		ons  = evtCycleNoInit start stop sigs+		offs = evtGroup minitVal [(start, 0)] stop +		evtCycleNoInit start stop sigs = runSeg $ loop $ lim stop $ del start $ loop $ mel $ fmap (lim start . toSeg) sigs++-- | Triggers one signal after another with an event stream.+syncEvtCycle :: (Sigs a) => Sig -> Maybe a -> Tick -> Tick -> [a] -> a+syncEvtCycle bpm minitVal start stop sigs = evtCycle minitVal (syncBpm bpm start) (syncBpm bpm stop) sigs+ ----------------------------------------------------------- -- Char sampler  -- | Triggers a signal when one of the chars from the first string is pressed.--- Stos signal from playing when one of the chars from the second string is pressed.-charTrig :: (Sigs a) => String -> String -> a -> a-charTrig starts stops asig = runSeg $ loop $ lim (strOn stops) $ toSeg $ retrig (const $ return asig) (strOn starts)+-- Stops signal from playing when one of the chars from the second string is pressed.+charTrig :: (Sigs a) => Maybe a -> String -> String -> a -> a+charTrig minitVal starts stops asig = case minitVal of+	Nothing      -> ons+	Just initVal -> ons + offs initVal + first initVal+	where+		ons   = charTrigNoInit starts stops  asig +		offs  initVal = charTrigNoInit stops  starts initVal+		first initVal = evtTrigger loadbang (strOn starts) initVal +		charTrigNoInit starts stops asig = runSeg $ loop $ lim (strOn stops) $ toSeg $ retrig (const $ return asig) (strOn starts)++-- | 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). +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 +		offs  initVal = charTrigNoInit stops  starts initVal+		first initVal = syncEvtTrigger bpm loadbang (strOn starts) initVal++		charTrigNoInit starts stops asig = runSeg $ loop $ lim (syncBpm bpm $ strOn stops) $ toSeg $ retrig (const $ return asig) (syncBpm bpm $ strOn starts)++-- syncCharTrig :: (Sigs a) => Sig -> String -> String -> a -> a+-- syncCharTrig bpm starts stops asig = runSeg $ loop $ lim (syncBpm bpm $ strOn stops) $ toSeg $ retrig (const $ return asig) (syncBpm bpm $ strOn starts)+ -- | Plays a signal while a key is pressed.-charPush :: Sigs a => Char -> a -> a-charPush ch = evtTrigger (charOn ch) (charOff ch)+charPush :: Sigs a => Maybe a -> Char -> a -> a+charPush = genCharPush evtTrigger +-- | Plays a signal while a key is pressed. Synchronized by BPM (first argument).+syncCharPush :: Sigs a => Sig -> Maybe a -> Char -> a -> a+syncCharPush bpm = genCharPush (syncEvtTrigger bpm)++genCharPush :: Sigs a => (Tick -> Tick -> a -> a) -> Maybe a -> Char -> a -> a+genCharPush trig minitVal ch asig = case minitVal of+	Nothing -> ons+	Just v0 -> ons + offs v0 + first v0+	where +		ons     = trig (charOn ch)  (charOff ch) asig+		offs  v = trig (charOff ch) (charOn  ch) v+		first v = trig loadbang (charOn ch) v+ -- | Toggles the signal when key is pressed.-charToggle :: (Sigs a) => Char -> a -> a-charToggle key asig = retrig (togInstr asig) +charToggle :: (Sigs a) => Maybe a -> Char -> a -> a+charToggle = genCharToggle id++-- | Toggles the signal when key is pressed.+-- Synchronizes by BPM (first argument).+syncCharToggle :: (Sigs a) => Sig -> Maybe a -> Char -> a -> a+syncCharToggle bpm = genCharToggle (syncBpm bpm)++-- | 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)) -	$ charOn key+	$ needSync $ charOn key 	where -		togInstr asig isPlay = do-			ref <- newSERef 0+		togInstr mv0 asig isPlay = do+			ref <- newRef 0			+			case mv0 of+				Nothing -> return ()+				Just v0 -> writeRef ref v0 			when1 (sig isPlay ==* 1) $ do-				writeSERef ref asig-			readSERef ref+				writeRef ref asig+			readRef ref --- | Consider note limiting? or performance degrades+-- Consider note limiting? or performance degrades -- 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 stop starts = evtTap stop (strOn starts) +syncCharTap :: Sigs a => Sig -> D -> String -> a -> a+syncCharTap bpm stop starts = syncEvtTap bpm stop (strOn starts)+ -- | Plays a list of signals when corresponding key is pressed. -- Turns off all other signals in the group. The last string is -- for stopping the group from playing.-charGroup :: (Sigs a) => [(Char, a)] -> String -> a-charGroup as stop = sum $ fmap f as-	where -		allKeys = fmap fst as ++ stop-		f (key, asig) = evtTrigger ons offs asig-			where-				ons  = charOn key-				offs = strOn allKeys			+charGroup :: (Sigs a) => Maybe a -> [(Char, a)] -> String -> a+charGroup = genCharGroup evtTrigger +-- | Plays a list of signals when corresponding key is pressed.+-- Turns off all other signals in the group. The last string is+-- for stopping the group from playing. Events are syncronized by BPM (first argument).+syncCharGroup :: (Sigs a) => Sig -> Maybe a -> [(Char, a)] -> String -> a+syncCharGroup bpm = genCharGroup (syncEvtTrigger bpm)++genCharGroup :: (Sigs a) => (Tick -> Tick -> a -> a) -> Maybe a -> [(Char, a)] -> String -> a+genCharGroup trig minitVal as stop = case minitVal of+	Nothing      -> charGroupNoInit as stop+	Just initVal -> ons + offs initVal + first initVal+	where+		ons           = charGroupNoInit as stop+		offs  initVal = charGroupNoInit (fmap (\ch -> (ch, initVal)) stop) onKeys+		first initVal = trig loadbang (mconcat $ fmap charOn onKeys) initVal++		onKeys = fmap fst as	+	+		charGroupNoInit as stop = sum $ fmap f as+			where +				allKeys = fmap fst as ++ stop+				f (key, asig) = trig ons offs asig+					where+						ons  = charOn key+						offs = strOn allKeys+ -- | Plays signals one after another when key is pressed. -- Stops the group from playing when the char from the last  -- argument is pressed.-charCycle :: Sigs a => Char -> String -> [a] -> a-charCycle start stop = evtCycle (charOn start) (strOn stop) +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 +-- 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+ ---------------------------------------------------------------------  evtTrigger :: (Sigs a) => Tick -> Tick -> a -> a evtTrigger ons offs asig = schedUntil (const $ return asig) ons offs +syncEvtTrigger :: (Sigs a) => Sig -> Tick -> Tick -> a -> a+syncEvtTrigger bpm ons offs asig = schedUntil (const $ return asig) (syncBpm bpm ons) (syncBpm bpm offs)+ ---------------------------------------------------------- -- Midi sampler @@ -199,10 +322,10 @@ 	(fmap (accumE (1 :: D) (\a s -> ((a, s), mod' (s + 1) 2))) $ midiKeyOn midiChn $ int key) 	where  		togMidiInstr asig (amp, isPlay) = do-			ref <- newSERef 0+			ref <- newRef 0 			when1 (sig isPlay ==* 1) $ do-				writeSERef ref =<< midiInstr asig amp-			readSERef ref+				writeRef ref =<< midiInstr asig amp+			readRef ref  -- | The generic midiGroup. 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).@@ -218,3 +341,19 @@  midiEvtTriggerBy :: (SigSpace a, Sigs a) => (a -> D -> SE a) -> Evt D -> Tick -> a -> a midiEvtTriggerBy midiInstr ons offs asig = schedUntil (midiAmpInstr asig) ons offs++-----------------------------------------------------------+-- misc++keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0 :: [Char]++keyColumn1 = ['1', 'q', 'a', 'z']+keyColumn2 = ['2', 'w', 's', 'x']+keyColumn3 = ['3', 'e', 'd', 'c']+keyColumn4 = ['4', 'r', 'f', 'v']+keyColumn5 = ['5', 't', 'g', 'b']+keyColumn6 = ['6', 'y', 'h', 'n']+keyColumn7 = ['7', 'u', 'j', 'm']+keyColumn8 = ['8', 'i', 'k', ',']+keyColumn9 = ['9', 'o', 'l', '.']+keyColumn0 = ['0', 'p', ';', '/']
src/Csound/Air/Seg.hs view
@@ -236,22 +236,22 @@  simT' :: [Tick] -> Tick simT' as = Evt $ \bam -> do-	isAwaitingRef <- newSERef (1 :: D)-	countDownRef  <- newSERef (int (length as) :: D)+	isAwaitingRef <- newRef (1 :: D)+	countDownRef  <- newRef (int (length as) :: D)  	mapM_ (mkEvt countDownRef) as -	countDown <- readSERef countDownRef-	isAwaiting <- readSERef isAwaitingRef+	countDown <- readRef countDownRef+	isAwaiting <- readRef isAwaitingRef 	when1 (sig isAwaiting ==* 1 &&* sig countDown ==* 0) $ do 		bam unit-		writeSERef isAwaitingRef 0+		writeRef isAwaitingRef 0 	where  		mkEvt ref e = do-			notFiredRef <- newSERef (1 :: D)-			notFired <- readSERef notFiredRef+			notFiredRef <- newRef (1 :: D)+			notFired <- readRef notFiredRef 			runEvt e $ \_ -> do 				when1 (sig notFired ==* 1) $ do-					writeSERef notFiredRef 0-					modifySERef ref (\x -> x - 1)+					writeRef notFiredRef 0+					modifyRef ref (\x -> x - 1)
src/Csound/Air/Wav.hs view
@@ -405,7 +405,7 @@      ramChn :: Bool -> Int -> Fidelity -> Phsr -> Sig -> Sig ramChn isMono n winSize (Phsr file start end speed) pitch = -    ifB (abs speed <* 0.001) 0 $ +    ifB (abs speed `lessThan` 0.001) 0 $          ramTab winSize (mkTab isMono n file ) (lphase (filelen $ text file) start end (speed * srFactor)) (pitch * srFactor)     where srFactor = sig $ (filesr $ text file) / getSampleRate
src/Csound/Control/Evt.hs view
@@ -113,7 +113,7 @@ triggerE a1 a2 a3 = sigToEvt $ trigger a1 a2 a3  -- | the sync function but time is measured in beats per minute.-syncBpm :: (Default a, Tuple a) => D -> Evt a -> Evt a+syncBpm :: (Default a, Tuple a) => Sig -> Evt a -> Evt a syncBpm dt = sync (dt / 60)  -- | Splits event stream on two streams with predicate.@@ -150,7 +150,7 @@     | null vals = mempty     | otherwise = fmap (atArg vals) $ filterE within evt     where-        within x = (x >=* 0) &&* (x <* len)+        within x = (x >=* 0) &&* (x `lessThan` len)         len = int $ length vals  -- | @@ -241,7 +241,7 @@  takeByWeight :: (Tuple a, Arg a) => [D] -> [a] -> D -> a takeByWeight accumWeights vals at = -    guardedArg (zipWith (\w val -> (at <* w, val)) accumWeights vals) (last vals)+    guardedArg (zipWith (\w val -> (at `lessThan` w, val)) accumWeights vals) (last vals)  accumWeightList :: Num a => [a] -> [a] accumWeightList = go 0@@ -287,7 +287,7 @@ masked :: (Tuple a, Arg a) => [D] -> Evt a -> Evt a masked ms = filterAccumE 0 $ \a s ->      let n  = int $ length ms-        s1 = ifB (s + 1 <* n) (s + 1) 0+        s1 = ifB (s + 1 `lessThan` n) (s + 1) 0     in  (atArg ms s ==* 1, a, s1)  patternToMask :: [Int] -> [Bool]@@ -321,7 +321,7 @@  -- | Takes the ns events from the event stream and ignores the rest of the stream. takeE :: Int -> Evt a -> Evt a-takeE n = filterRow ( <* int n)+takeE n = filterRow ( `lessThan` int n)  -- | Drops the ns events from the event stream and leaves the rest of the stream. dropE :: Int -> Evt a -> Evt a
src/Csound/Control/Gui.hs view
@@ -79,9 +79,15 @@     -- ** Lifters with visual scaling     hlifts', vlifts', -    hlift2', vlift2', hlift3', vlift3', hlift4', vlift4', hlift5', vlift5'+    hlift2', vlift2', hlift3', vlift3', hlift4', vlift4', hlift5', vlift5',++    -- * Monadic binds+    hbind, vbind, happly, vapply, hmapM, vmapM,+    hbind', vbind', happly', vapply', hmapM', vmapM' ) where +import Control.Monad+ import Csound.Typed  import Csound.Typed.Gui@@ -266,3 +272,62 @@ vlift5' :: Double -> Double -> Double -> Double -> Double -> (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b vlift5' a b c d e = lift5' a b c d e (\a b c d e -> ver [a, b, c, d, e]) +-- | Monadic bind with horizontal concatenation of visuals.+hbind :: Source a -> (a -> Source b) -> Source b+hbind = genBind (\a b -> hor [a, b])++-- | Monadic bind with vertical concatenation of visuals.+vbind :: Source a -> (a -> Source b) -> Source b+vbind = genBind (\a b -> ver [a, b])++-- | Monadic apply with horizontal concatenation of visuals.+happly :: (a -> Source b) -> Source a -> Source b+happly = flip $ genBind (\a b -> hor [b, a])++-- | Monadic apply with vertical concatenation of visuals.+vapply :: (a -> Source b) -> Source a -> Source b+vapply = flip $ genBind (\a b -> ver [b, a])++-- | Monadic bind with horizontal concatenation of visuals.+-- It expects scaling factors for visuals as first two arguments.+hbind' :: Double -> Double -> Source a -> (a -> Source b) -> Source b+hbind' ka kb = genBind (\a b -> hor [sca ka a, sca kb b])++-- | Monadic bind with vertical concatenation of visuals.+-- It expects scaling factors for visuals as first two arguments.+vbind' :: Double -> Double -> Source a -> (a -> Source b) -> Source b+vbind' ka kb = genBind (\a b -> ver [sca ka a, sca kb b])++-- | Monadic apply with horizontal concatenation of visuals.+-- It expects scaling factors for visuals as first two arguments.+happly' :: Double -> Double -> (a -> Source b) -> Source a -> Source b+happly' ka kb = flip $ genBind (\a b -> hor [sca kb b, sca ka a])++-- | Monadic apply with vertical concatenation of visuals.+-- It expects scaling factors for visuals as first two arguments.+vapply' :: Double -> Double -> (a -> Source b) -> Source a -> Source b+vapply' ka kb = flip $ genBind (\a b -> ver [sca kb b, sca ka a])+++genBind :: (Gui -> Gui -> Gui) -> Source a -> (a -> Source b) -> Source b+genBind gui ma mf = source $ do+    (ga, a) <- ma+    (gb, b) <- mf a+    return (gui ga gb, b)++hmapM :: (a -> Source b) -> [a] -> Source [b]+hmapM = genMapM hor++vmapM :: (a -> Source b) -> [a] -> Source [b]+vmapM = genMapM ver++hmapM' :: [Double] -> (a -> Source b) -> [a] -> Source [b]+hmapM' ks = genMapM (\xs -> hor $ zipWith sca ks xs)++vmapM' :: [Double] -> (a -> Source b) -> [a] -> Source [b]+vmapM' ks = genMapM (\xs -> ver $ zipWith sca ks xs)++genMapM :: ([Gui] -> Gui) -> (a -> Source b) -> [a] -> Source [b]+genMapM gui f xs = source $ do+    (gs, vs) <- fmap unzip $ mapM f xs+    return (gui gs, vs)
src/Csound/Control/Gui/Widget.hs view
@@ -186,10 +186,10 @@  genNumbers :: ([Gui] -> Gui) -> [Double] -> Source Sig genNumbers gx as@(d:ds) = source $ do-    ref <- newGlobalSERef (sig $ double d)+    ref <- newGlobalRef (sig $ double d)     (gs, evts) <- fmap unzip $ mapM (button . show) as-    zipWithM_ (\x e -> runEvt e $ \_ -> writeSERef ref (sig $ double x)) as evts -    res <- readSERef ref+    zipWithM_ (\x e -> runEvt e $ \_ -> writeRef ref (sig $ double x)) as evts +    res <- readRef ref     return (gx gs, res)  @@ -278,17 +278,17 @@ radioGroupSig  :: ([Gui] -> Gui) -> [String] -> Int -> Source Sig radioGroupSig gcat names initVal = source $ do     (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> flip setToggleSig (i == initVal) tag) $ zip [0 ..] names-    curRef <- newGlobalSERef (sig $ int initVal)-    current <- readSERef curRef    +    curRef <- newGlobalRef (sig $ int initVal)+    current <- readRef curRef         zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids     zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do                       when1 (sig x ==* 1) $ do-            writeSERef curRef i+            writeRef curRef i         when1 (sig x ==* 0 &&* current ==* i) $ do-           writeSERef curRef i    +           writeRef curRef i             ) reads ids    -    res <- readSERef curRef+    res <- readRef curRef     return (gcat guis, res)     where                 ids = fmap (sig . int) [0 .. length names - 1]@@ -453,20 +453,20 @@ radioGroupSig'  :: ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig radioGroupSig' gcat ctrl names initVal = source $ do     (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> flip setToggleSig (i == initVal) tag) $ zip [0 ..] names-    curRef <- newGlobalSERef (sig $ int initVal)   +    curRef <- newGlobalRef (sig $ int initVal)    -    when1 (changed [ctrl] ==* 1) $ writeSERef curRef ctrl+    when1 (changed [ctrl] ==* 1) $ writeRef curRef ctrl -    current <- readSERef curRef    +    current <- readRef curRef         zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids     zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do                       when1 (sig x ==* 1) $ do-            writeSERef curRef i+            writeRef curRef i         when1 (sig x ==* 0 &&* current ==* i) $ do-           writeSERef curRef i    +           writeRef curRef i             ) reads ids    -    res <- readSERef curRef+    res <- readRef curRef     return (gcat guis, res)     where                 ids = fmap (sig . int) [0 .. length names - 1]@@ -475,10 +475,10 @@ ctrlSig :: D -> Sig -> SinkSource Sig -> Source Sig ctrlSig initVal ctrl v = source $ do     (gui, output, input) <- v-    ref <- newGlobalSERef (sig initVal)-    when1 (changed [ctrl] ==* 1) $ writeSERef ref ctrl  -    when1 (changed [input] ==* 1) $ writeSERef ref input    -    res <- readSERef ref+    ref <- newGlobalRef (sig initVal)+    when1 (changed [ctrl] ==* 1) $ writeRef ref ctrl  +    when1 (changed [input] ==* 1) $ writeRef ref input    +    res <- readRef ref     output res     return (gui, res)
src/Csound/Control/Instr.hs view
@@ -149,10 +149,10 @@ -- it produces silence. playWhen :: forall a b. Sigs a => BoolSig -> (b -> SE a) -> (b -> SE a) playWhen onSig instr msg = do-    ref <- newSERef (0 :: a)-    writeSERef ref 0-    when1 onSig $ writeSERef ref =<< instr msg-    readSERef ref+    ref <- newRef (0 :: a)+    writeRef ref 0+    when1 onSig $ writeRef ref =<< instr msg+    readRef ref  ------------------------------------------------------------------------- -------------------------------------------------------------------------
src/Csound/Control/Midi.hs view
@@ -1,3 +1,4 @@+{-# Language FlexibleContexts #-} -- | Midi. module Csound.Control.Midi(     MidiChn(..), MidiFun, toMidiFun, toMidiFun_, @@ -11,7 +12,7 @@     cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl,            -- * Overload-    MidiInstr(..)+    tryMidi, MidiInstr(..) ) where  import Data.Boolean@@ -75,27 +76,27 @@  genAmpCpsSig :: ((Msg -> SE Sig) -> SE Sig) -> SE (Sig, Sig, Sig) genAmpCpsSig midiFun = do-	ref <- newGlobalSERef ((0, 0) :: (Sig, Sig))+	ref <- newGlobalRef ((0, 0) :: (Sig, Sig)) 	status <- midiFun (instr ref) 	let resStatus = ifB (downsamp status ==* 0) 0 1-	(amp, cps) <- readSERef ref+	(amp, cps) <- readRef ref 	return (downsamp amp, downsamp cps, resStatus) 	where -		instr :: SERef (Sig, Sig) -> Msg -> SE Sig+		instr :: Ref (Sig, Sig) -> Msg -> SE Sig 		instr hNote msg = do-			writeSERef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg)+			writeRef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg) 			return 1		  genHoldAmpCpsSig :: ((Msg -> SE ()) -> SE ()) -> SE (Sig, Sig) genHoldAmpCpsSig midiFun = do-	ref <- newGlobalSERef ((0, 0) :: (Sig, Sig))+	ref <- newGlobalRef ((0, 0) :: (Sig, Sig)) 	midiFun (instr ref)	-	(amp, cps) <- readSERef ref+	(amp, cps) <- readRef ref 	return (downsamp amp, downsamp cps) 	where -		instr :: SERef (Sig, Sig) -> Msg -> SE ()+		instr :: Ref (Sig, Sig) -> Msg -> SE () 		instr hNote msg = do-			writeSERef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg)			+			writeRef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg)			   --------------------------------------------------------------@@ -111,15 +112,15 @@  midiKeyOnBy :: MidiFun Sig -> D -> SE (Evt D) midiKeyOnBy midiFun key = do	-	chRef  <- newGlobalSERef (0 :: Sig)-	evtRef <- newGlobalSERef (0 :: Sig)-	writeSERef chRef =<< midiFun instr+	chRef  <- newGlobalRef (0 :: Sig)+	evtRef <- newGlobalRef (0 :: Sig)+	writeRef chRef =<< midiFun instr  	alwaysOn $ do-		a <- readSERef chRef-		writeSERef evtRef $ diff a+		a <- readRef chRef+		writeRef evtRef $ diff a -	evtSig <- readSERef evtRef+	evtSig <- readRef evtRef 	return $ filterE ( >* 0) $ snaps evtSig 	where 		instr msg = do@@ -129,16 +130,16 @@  midiKeyOffBy :: MidiFun Sig -> D -> SE Tick midiKeyOffBy midiFun key = do	-	chRef  <- newGlobalSERef (0 :: Sig)-	evtRef <- newGlobalSERef (0 :: Sig)-	writeSERef chRef =<< midiFun instr+	chRef  <- newGlobalRef (0 :: Sig)+	evtRef <- newGlobalRef (0 :: Sig)+	writeRef chRef =<< midiFun instr  	alwaysOn $ do-		a <- readSERef chRef-		writeSERef evtRef $ diff a+		a <- readRef chRef+		writeRef evtRef $ diff a -	evtSig <- readSERef evtRef-	return $ fmap (const unit) $ filterE ( <* 0) $ snaps evtSig+	evtSig <- readRef evtRef+	return $ fmap (const unit) $ filterE ( `lessThan` 0) $ snaps evtSig 	where 		instr msg = do 			print' [notnum msg] @@ -164,3 +165,11 @@ umidiCtrl :: D -> D -> D -> SE Sig umidiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival 0 1 +--------------------------------------------------------------++-- | Invokes ooverloaded instruments with midi.+-- Example:+--+-- > dac $ tryMidi (mul (fades 0.01 0.1) . tri)+tryMidi :: (MidiInstr a, Sigs (MidiInstrOut a)) => a -> SE (MidiInstrOut a)+tryMidi x = midi $ onMsg x
src/Csound/Control/Overload/MidiInstr.hs view
@@ -7,7 +7,7 @@ import Csound.Typed.Opcode  ampCps :: Msg -> (D, D)-ampCps msg = (ampmidi msg 1, (cpsmidi msg))+ampCps msg = (ampmidi msg 1, cpsmidi msg)  -------------------------------------------------------------------------------
src/Csound/Control/SE.hs view
@@ -1,5 +1,5 @@ module Csound.Control.SE(-    SE, SERef, writeSERef, readSERef, modifySERef, mixSERef, newSERef, sensorsSE, newGlobalSERef, globalSensorsSE+    SE, Ref, writeRef, readRef, modifyRef, mixRef, newRef, sensorsSE, newGlobalRef, globalSensorsSE ) where  import Csound.Typed.Control
src/Csound/Tab.hs view
@@ -115,10 +115,10 @@ newGlobalTab :: D -> SE Tab newGlobalTab size = do       identifier <- getNextGlobalGenId-    ref <- newGlobalSERef (0 :: D)        +    ref <- newGlobalRef (0 :: D)             tabId <- ftgenonce 0 (int identifier) size 7 0 [size, 0]-    writeSERef ref (fromGE $ toGE tabId)-    fmap (fromGE . toGE) $ readSERef ref+    writeRef ref (fromGE $ toGE tabId)+    fmap (fromGE . toGE) $ readRef ref  -- | Calculates the number of samples needed to store the given amount of seconds. -- It multiplies the value by the current sample rate.
src/Csound/Types.hs view
@@ -43,6 +43,7 @@         -- ** Logic functions     boolSig, when1, whens, whileDo, untilDo,+    equalsTo, notEqualsTo, lessThan, greaterThan, lessThanEquals, greaterThanEquals,      -- ** Aliases      -- | Handy for functions that return tuples to specify the utput type