diff --git a/csound-expression.cabal b/csound-expression.cabal --- a/csound-expression.cabal +++ b/csound-expression.cabal @@ -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: @@ -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 diff --git a/examples/Color.hs b/examples/Color.hs --- a/examples/Color.hs +++ b/examples/Color.hs @@ -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] diff --git a/examples/DubBass.hs b/examples/DubBass.hs --- a/examples/DubBass.hs +++ b/examples/DubBass.hs @@ -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) diff --git a/examples/Events.hs b/examples/Events.hs --- a/examples/Events.hs +++ b/examples/Events.hs @@ -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 diff --git a/examples/Gm.hs b/examples/Gm.hs --- a/examples/Gm.hs +++ b/examples/Gm.hs @@ -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 diff --git a/examples/Gui/Button.hs b/examples/Gui/Button.hs --- a/examples/Gui/Button.hs +++ b/examples/Gui/Button.hs @@ -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!" diff --git a/examples/Gui/Envelope.hs b/examples/Gui/Envelope.hs deleted file mode 100644 --- a/examples/Gui/Envelope.hs +++ /dev/null @@ -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 - diff --git a/examples/Gui/EnvelopeAndHarmonics.hs b/examples/Gui/EnvelopeAndHarmonics.hs --- a/examples/Gui/EnvelopeAndHarmonics.hs +++ b/examples/Gui/EnvelopeAndHarmonics.hs @@ -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 diff --git a/examples/Gui/Filter.hs b/examples/Gui/Filter.hs deleted file mode 100644 --- a/examples/Gui/Filter.hs +++ /dev/null @@ -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 - diff --git a/examples/Gui/Harmonics.hs b/examples/Gui/Harmonics.hs --- a/examples/Gui/Harmonics.hs +++ b/examples/Gui/Harmonics.hs @@ -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 diff --git a/examples/Gui/Key.hs b/examples/Gui/Key.hs --- a/examples/Gui/Key.hs +++ b/examples/Gui/Key.hs @@ -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 diff --git a/examples/Gui/Osc.hs b/examples/Gui/Osc.hs deleted file mode 100644 --- a/examples/Gui/Osc.hs +++ /dev/null @@ -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) - diff --git a/examples/Gui/Waves.hs b/examples/Gui/Waves.hs --- a/examples/Gui/Waves.hs +++ b/examples/Gui/Waves.hs @@ -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 diff --git a/examples/Heartbeat.hs b/examples/Heartbeat.hs --- a/examples/Heartbeat.hs +++ b/examples/Heartbeat.hs @@ -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]) diff --git a/examples/Midi.hs b/examples/Midi.hs --- a/examples/Midi.hs +++ b/examples/Midi.hs @@ -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 diff --git a/examples/README.txt b/examples/README.txt --- a/examples/README.txt +++ b/examples/README.txt @@ -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 diff --git a/examples/Test.hs b/examples/Test.hs --- a/examples/Test.hs +++ b/examples/Test.hs @@ -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 diff --git a/examples/Tibetan.hs b/examples/Tibetan.hs --- a/examples/Tibetan.hs +++ b/examples/Tibetan.hs @@ -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 ]] diff --git a/examples/Wind.hs b/examples/Wind.hs --- a/examples/Wind.hs +++ b/examples/Wind.hs @@ -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 diff --git a/src/Csound/Air.hs b/src/Csound/Air.hs --- a/src/Csound/Air.hs +++ b/src/Csound/Air.hs @@ -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 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 @@ -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 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 @@ -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 + + 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 @@ -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 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,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 diff --git a/src/Csound/Air/Patch.hs b/src/Csound/Air/Patch.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Air/Patch.hs @@ -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] 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 @@ -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', ';', '/'] 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 @@ -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) 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 @@ -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 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 @@ -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 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 @@ -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) 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 @@ -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) 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 @@ -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 ------------------------------------------------------------------------- ------------------------------------------------------------------------- diff --git a/src/Csound/Control/Midi.hs b/src/Csound/Control/Midi.hs --- a/src/Csound/Control/Midi.hs +++ b/src/Csound/Control/Midi.hs @@ -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 diff --git a/src/Csound/Control/Overload/MidiInstr.hs b/src/Csound/Control/Overload/MidiInstr.hs --- a/src/Csound/Control/Overload/MidiInstr.hs +++ b/src/Csound/Control/Overload/MidiInstr.hs @@ -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) ------------------------------------------------------------------------------- diff --git a/src/Csound/Control/SE.hs b/src/Csound/Control/SE.hs --- a/src/Csound/Control/SE.hs +++ b/src/Csound/Control/SE.hs @@ -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 diff --git a/src/Csound/Tab.hs b/src/Csound/Tab.hs --- a/src/Csound/Tab.hs +++ b/src/Csound/Tab.hs @@ -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. diff --git a/src/Csound/Types.hs b/src/Csound/Types.hs --- a/src/Csound/Types.hs +++ b/src/Csound/Types.hs @@ -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