csound-expression 4.2.1 → 4.3

raw patch · 14 files changed

+707/−55 lines, 14 filesdep ~csound-expression-typedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: csound-expression-typed

API changes (from Hackage documentation)

Files

• csound-expression.cabal +2/−2
• src/Csound/Air/Envelope.hs +261/−36
• src/Csound/Air/Filter.hs +11/−1
• src/Csound/Air/Misc.hs +40/−1
• src/Csound/Air/Wav.hs +7/−1
• src/Csound/Air/Wave.hs +5/−4
• src/Csound/Base.hs +1/−1
• src/Csound/Control/Gui.hs +127/−1
• src/Csound/Control/Gui/Widget.hs +173/−1
• src/Csound/Control/Midi.hs +2/−2
• src/Csound/Control/SE.hs +2/−1
• src/Csound/Control/Sf.hs +1/−1
• src/Csound/IO.hs +43/−0
• src/Csound/SigSpace.hs +32/−3

@@ -1,5 +1,5 @@ Name:          csound-expression-Version:       4.2.1+Version:       4.3 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -68,7 +68,7 @@   Ghc-Options:    -Wall   Build-Depends:         base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0,-        csound-expression-typed >= 0.0.6.0, csound-expression-opcodes >= 0.0.1+        csound-expression-typed >= 0.0.6.1, csound-expression-opcodes >= 0.0.1   Hs-Source-Dirs:      src/   Exposed-Modules:         Csound.Base

@@ -4,17 +4,27 @@     -- * Relative duration     onIdur, lindur, expdur, linendur,     onDur, lindurBy, expdurBy, linendurBy,    -    -- * Looping envelopes-    oscLins, oscElins, oscExps, oscEexps, oscLine, +    -- * Looping envelopes   +    lpshold, loopseg, loopxseg, lpsholdBy, loopsegBy, loopxsegBy,+    holdSeq, linSeq, expSeq,+    linloop, exploop, sah, stepSeq, +    constSeq, triSeq, sqrSeq, sawSeq, isawSeq, xsawSeq, ixsawSeq, isqrSeq, xtriSeq,+    adsrSeq, xadsrSeq, adsrSeq_, xadsrSeq_,  +     -- * Faders-    fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades,+    fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades+ ) where  import Data.List(intersperse)  import Csound.Typed-import Csound.Typed.Opcode-import Csound.Air.Misc+import Csound.Typed.Opcode hiding (lpshold, loopseg, loopxseg)+import qualified Csound.Typed.Opcode as C(lpshold, loopseg, loopxseg)+import Csound.Air.Wave+import Csound.Tab(lins, exps, gp)+import Csound.Air.Wave(oscBy)+import Csound.Air.Filter(slide)  -- | Linear adsr envelope generator with release --@@ -112,52 +122,267 @@ expFades :: D -> D -> Sig expFades att dec = expFadeIn att * expFadeOut dec +-- The step sequencer. It takes the weights of constant steps and the frequency of repetition.+-- It outputs the piecewise constant function with given values. Values are equally spaced+-- and repeated with given rate.+stepSeq :: [Sig] -> Sig -> Sig+stepSeq as = lpshold (intersperseEnd 1 [1] as) --- | Loops over line segments with the given rate.++-- | Sample and hold cyclic signal. It takes the list of ----- > oscLins [a, durA, b, durB, c, durC ..] cps+-- > [a, dta, b, dtb, c, dtc, ...] ----- where +-- the a, b, c, ... are values of the constant segments ----- * @a@, @b@, @c@ ... -- values+-- the dta, dtb, dtc, are durations in seconds of constant segments. ----- * durA, durB, durC -- durations of the segments relative to the current frequency.-oscLins :: [D] -> Sig -> Sig-oscLins points cps = loopseg cps 0 0 (fmap sig points) +-- The period of the repetition equals to the sum of all durations.+sah :: [Sig] -> Sig+sah as = stepSeq as (1 / period)+    where +        period = sumDts as --- | Loops over equally spaced line segments with the given rate.+        sumDts xs = case xs of+            a : dt : rest -> dt + sumDts rest+            _ -> 0++-- | It's just like @linseg@ but it loops over the envelope.+linloop :: [Sig] -> Sig+linloop = genLoop loopseg . (++ [0])++-- | It's just like @expseg@ but it loops over the envelope.+exploop :: [Sig] -> Sig+exploop = genLoop loopxseg . (++ [0])++genLoop :: ([Sig] -> Sig -> Sig) -> [Sig] -> Sig+genLoop f as = f (tfmList as) (1 / len)+    where+        tfmList xs = case xs of+            [] -> []+            [a] -> [a]+            a:b:rest -> a : (b/len) : tfmList rest++        len = go as+            where+                go xs = case xs of+                    []  -> 0+                    [a] -> 0+                    a:b:rest -> b + go rest++-- | Sample and hold sequence. It outputs the looping sequence of constan elements.+constSeq :: [Sig] -> Sig -> Sig+constSeq = genSeq stepSeq id ++-- | Step sequencer with unipolar triangle.+triSeq :: [Sig] -> Sig -> Sig+triSeq as cps = genSeq loopseg triList as (2 * cps)++-- | Step sequencer with unipolar square.+sqrSeq :: [Sig] -> Sig -> Sig+sqrSeq = genSeq stepSeq (intersperseEnd 0 [0])++-- | Step sequencer with unipolar sawtooth.+sawSeq :: [Sig] -> Sig -> Sig+sawSeq = genSeq loopseg sawList++-- | Step sequencer with unipolar inveted square.+isqrSeq :: [Sig] -> Sig -> Sig+isqrSeq = genSeq stepSeq ((0 : ) . intersperseEnd 0 [])++-- | Step sequencer with unipolar inveted sawtooth.+isawSeq :: [Sig] -> Sig -> Sig+isawSeq = genSeq loopseg isawList++-- | Step sequencer with unipolar exponential sawtooth.+xsawSeq :: [Sig] -> Sig -> Sig+xsawSeq = genSeq loopxseg sawList++-- | Step sequencer with unipolar inverted exponential sawtooth.+ixsawSeq :: [Sig] -> Sig -> Sig+ixsawSeq = genSeq loopxseg isawList++-- | Step sequencer with unipolar exponential triangle.+xtriSeq :: [Sig] -> Sig -> Sig+xtriSeq as cps = genSeq loopxseg triList as (2 * cps)++sawList xs = case xs of+    []  -> []           +    a:rest -> a : 1 : 0 : 0 : sawList rest+        +isawList xs = case xs of+    []  -> []           +    a:rest -> 0 : 1 : a : 0 : isawList rest++triList xs = case xs of+    [] -> [0, 0]+    a:rest -> 0 : 1 : a : 1 : triList rest ++------------------------------------------------------------------++genSeq :: ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig+genSeq mkSeq go as cps = mkSeq (go as) (cps / len)+    where len = sig $ int $ length as++intersperseEnd :: a -> [a] -> [a] -> [a]+intersperseEnd val end xs = case xs of+    [] -> end+    [a] -> a : end+    a:as -> a : val : intersperseEnd val end as ++------------------------------------------------------------------++smooth :: Sig -> Sig+smooth = slide 0.001++-- | Looping sample and hold envelope. The first argument is the list of pairs: ----- > oscElins [a, b, c] === oscLins [a, 1, b, 1, c]-oscElins :: [D] -> Sig -> Sig-oscElins points = oscLins (intersperse 1 points)+-- > [a, durA, b, durB, c, durc, ...]+--+-- It's a list of values and durations. The durations are relative+-- to the period of repetition. The period is specified with the second argument.+-- The second argument is the frequency of repetition measured in Hz.+-- +-- > lpshold valDurs frequency+lpshold :: [Sig] -> Sig -> Sig+lpshold as cps = smooth $ C.lpshold cps 0 0 as --- | +-- | Looping linear segments envelope. The first argument is the list of pairs: ----- > oscLine a b cps+-- > [a, durA, b, durB, c, durc, ...] ----- Goes from @a@ to @b@ and back by line segments. One period is equal to @2\/cps@ so that one period is passed by @1\/cps@ seconds.-oscLine :: D -> D -> Sig -> Sig-oscLine a b cps = oscElins [a, b, a] (cps / 2)+-- It's a list of values and durations. The durations are relative+-- to the period of repetition. The period is specified with the second argument.+-- The second argument is the frequency of repetition measured in Hz.+-- +-- > loopseg valDurs frequency+loopseg :: [Sig] -> Sig -> Sig+loopseg as cps = smooth $ C.loopseg cps 0 0 as --- | Loops over exponential segments with the given rate.+-- | Looping exponential segments envelope. The first argument is the list of pairs: ----- > oscLins [a, durA, typeA, b, durB, typeB, c, durC, typeC ..] cps+-- > [a, durA, b, durB, c, durc, ...] ----- where +-- It's a list of values and durations. The durations are relative+-- to the period of repetition. The period is specified with the second argument.+-- The second argument is the frequency of repetition measured in Hz.+-- +-- > loopxseg valDurs frequency+loopxseg :: [Sig] -> Sig -> Sig+loopxseg as cps = smooth $ C.loopxseg cps 0 0 as++-- | It's like lpshold but we can specify the phase of repetition (phase belongs to [0, 1]).+lpsholdBy :: D -> [Sig] -> Sig -> Sig+lpsholdBy phase as cps = smooth $ C.lpshold cps 0 phase  as++-- | It's like loopseg but we can specify the phase of repetition (phase belongs to [0, 1]).+loopsegBy :: D -> [Sig] -> Sig -> Sig+loopsegBy phase as cps = smooth $ C.loopseg cps 0 phase  as++-- | It's like loopxseg but we can specify the phase of repetition (phase belongs to [0, 1]).+loopxsegBy :: D -> [Sig] -> Sig -> Sig+loopxsegBy phase as cps = smooth $ C.loopxseg cps 0 phase  as++-- | The looping ADSR envelope. ----- * @a@, @b@, @c@ ... -- values+-- > xadsrSeq attack decay sustain release weights frequency ----- * durA, durB, durC -- durations of the segments relative to the current frequency.+-- The sum of attack, decay, sustain and release time durations +-- should be equal to one.+adsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig+adsrSeq a d s r = linSeq (adsrList a d s r)++-- | The looping exponential ADSR envelope. there is a fifth segment+-- at the end of the envelope during which the envelope equals to zero. ----- * typeA, typeB, typeC, ... -- shape of the envelope. If the value is 0 then the shap eis linear; otherwise it is an concave exponential (positive type) or a convex exponential (negative type).-oscExps :: [D] -> Sig -> Sig-oscExps points cps = looptseg cps 0 (fmap sig points)+-- > xadsrSeq attack decay sustain release weights frequency+--+-- The sum of attack, decay, sustain and release time durations +-- should be equal to one.+xadsrSeq :: Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig+xadsrSeq a d s r = expSeq (adsrList a d s r) --- | Loops over equally spaced exponential segments with the given rate.+-- | The looping ADSR envelope with the rest at the end. ----- > oscLins [a, typeA, b, typeB, c, typeC ..] === oscLins [a, 1, typeA, b, 1, typeB, c, 1, typeC ..]-oscEexps :: [D] -> Sig -> Sig-oscEexps points = oscExps (insertOnes points)-    where insertOnes xs = case xs of-            a:b:as  -> a:1:b:insertOnes as-            _       -> xs+-- > adsrSeq attack decay sustain release rest weights frequency+--+-- The sum of attack, decay, sustain, release and rest time durations +-- should be equal to one.+adsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig+adsrSeq_ a d s r rest = linSeq (adsrList_ a d s r rest)++-- | The looping exponential ADSR envelope. there is a fifth segment+-- at the end of the envelope during which the envelope equals to zero.+--+-- > xadsrSeq_ attack decay sustain release rest weights frequency+--+-- The sum of attack, decay, sustain, release and rest time durations +-- should be equal to one.+xadsrSeq_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig] -> Sig -> Sig+xadsrSeq_ a d s r rest = expSeq (adsrList_ a d s r rest)++adsrList :: Sig -> Sig -> Sig -> Sig -> [Sig]+adsrList a d s r = [0, a, 1, d, s, 1 - (a + d + r), s, r, 0]++adsrList_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Sig]+adsrList_ a d s r rest = [0, a, 1, d, s, 1 - (a + d + r + rest), s, r, 0, rest, 0]++-- | The looping sequence of constant segments.+--+-- > linSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps+--+-- The first argument is the list that specifies the shape of the looping wave.+-- It's the alternating values and durations of transition from one value to another.+-- The durations are relative to the period. So that lists+--+-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]+--+-- produce the same results. The second list is the list of scales for subsequent periods.+-- Every value in the period is scaled with values from the second list.+-- The last argument is the rate of repetition (Hz).+holdSeq :: [Sig] -> [Sig] -> Sig -> Sig+holdSeq = genSegSeq lpshold++-- | The looping sequence of linear segments.+--+-- > linSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps+--+-- The first argument is the list that specifies the shape of the looping wave.+-- It's the alternating values and durations of transition from one value to another.+-- The durations are relative to the period. So that lists+--+-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]+--+-- produce the same results. The second list is the list of scales for subsequent periods.+-- Every value in the period is scaled with values from the second list.+-- The last argument is the rate of repetition (Hz).+linSeq :: [Sig] -> [Sig] -> Sig -> Sig+linSeq = genSegSeq loopseg++-- | The looping sequence of exponential segments.+--+-- > expSeg [a, durA, b, durB, c, durC, ...] [scale1, scale2, scale3] cps+--+-- The first argument is the list that specifies the shape of the looping wave.+-- It's the alternating values and durations of transition from one value to another.+-- The durations are relative to the period. So that lists+--+-- > [0, 0.5, 1, 0.5, 0]  and [0, 50, 1, 50, 0]+--+-- produce the same results. The second list is the list of scales for subsequent periods.+-- Every value in the period is scaled with values from the second list.+-- The last argument is the rate of repetition (Hz).+expSeq :: [Sig] -> [Sig] -> Sig -> Sig+expSeq = genSegSeq loopxseg++genSegSeq :: ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> Sig -> Sig+genSegSeq mkSeg shape weights cps = mkSeg (groupSegs $ fmap (scaleVals shape) weights) (cps / len)+    where +        len = sig $ int $ length weights+        scaleVals xs k = case xs of+            [] -> []+            [a] -> [a * k]+            a:da:rest -> (a * k) : da : scaleVals rest k    ++        groupSegs :: [[Sig]] -> [Sig]+        groupSegs as = concat $ intersperse [0] as

@@ -9,7 +9,10 @@     blp, bhp, bbp, bbr,      -- * Specific filters-    mlp+    mlp,++    -- * Making the smooth lines+    slide ) where  import Csound.Typed@@ -77,3 +80,10 @@ -- > mlp centerFrequency qResonance signal mlp :: Sig -> Sig -> Sig -> Sig mlp cf q asig = moogladder asig cf q+++-- | Produces smooth transitions between values in the signals.+-- The first value defines a duration in seconds for a transition from one+-- value to another in piecewise constant signals.+slide :: Sig -> Sig -> Sig+slide = flip portk

@@ -6,15 +6,25 @@     odds, evens,     -- * Random functions     rndPan, rndPan2, rndVol, gaussVol, +    -- * Choose signals+    selector,     -- * Saving to file-    writeHifi+    writeHifi,++    -- * Arpeggios+    arpeggi, arpBy,++    -- * GUI+    lpJoy ) where  import Data.Boolean  import Csound.Typed import Csound.Typed.Opcode+import Csound.Control.Gui import Csound.Air.Wave+import Csound.Air.Envelope import Csound.Air.Filter import Csound.SigSpace import Csound.IO(writeSndBy)@@ -164,3 +174,32 @@ writeHifi :: D -> String -> SE Sig2 -> IO () writeHifi n fileName a = writeSndBy (setRates 48000 10) fileName $ fmap (setDur $ n) a ++-- | It picks a signal from the list by integer index.+-- The original value is taken from the head of the list (the first element).+selector :: (Num a, SigSpace a) => [a] -> Sig -> a+selector as k = sum $ zipWith choice [0..] as+    where choice n a = mul (port (ifB (sig (int n) ==* k) 1 0) 0.02) a++-- | Creates running arpeggios. +--+-- > arpeggiBy ampWeights pitches instrument cps+--+-- It plays an instrument with fast sequence of notes. We can specify+-- the pitches and amplitude weights of the notes as well as frequency of repetition.+arpeggi :: SigSpace a => [Sig] -> [Sig] -> (Sig -> a) -> Sig -> a+arpeggi = arpBy triSeq sqrSeq ++-- | Creates running arpeggios. +--+-- > arpeggiBy ampWave pitchwave ampWeights pitches instrument cps+--+-- It plays an instrument with fast sequence of notes. We can specify amplitude envelope wave, pitch envelope wave,+-- the pitches and amplitude weights of the notes as well as frequency of repetition.+arpBy :: SigSpace a => ([Sig] -> Sig -> Sig) -> ([Sig] -> Sig -> Sig) -> [Sig] -> [Sig] -> (Sig -> a) -> Sig -> a+arpBy ampWave cpsWave amps cpss wave dt = mul (ampWave amps dt) $ wave $ cpsWave cpss dt++-- | Low-pass filter pictured as joystick.+-- Ox is for center frequency and Oy is for resonance.+lpJoy :: Source (Sig -> Sig)+lpJoy = lift1 (\(cps, res) -> mlp cps res) $ joy (expSpan 100 17000) (linSpan 0.05 0.95) (1400, 0.5)

@@ -24,7 +24,7 @@     lengthSnd, segments,      -- * Signal manipulation-    takeSnd, delaySnd, segmentSnd, repeatSnd, toMono+    takeSnd, delaySnd, afterSnd, segmentSnd, repeatSnd, toMono ) where  import Data.List(isSuffixOf)@@ -59,6 +59,12 @@ -- | Repeats the signal with the given period. repeatSnd :: Sigs a => D -> a -> a repeatSnd dt asig = sched (const $ return asig) $ segments dt++-- | Plays the first signal for some time (in seconds) and then switches to the next one.+--+-- > afterSnd dur sig1 sig2+afterSnd :: (Num b, Sigs b) => D -> b -> b -> b+afterSnd dt a b = takeSnd dt a + delaySnd dt b  -------------------------------------------------------------------------- -- sound files playback

@@ -17,6 +17,7 @@ import Csound.Typed import Csound.Typed.Opcode hiding (lfo) import Csound.Tab(sine, sines4)+import Csound.SigSpace  -- | A pure tone (sine wave). osc :: Sig -> Sig@@ -73,14 +74,14 @@ -- | Rescaling of the bipolar signal (-1, 1) -> (a, b) --  -- > on a b biSig-on :: Sig -> Sig -> Sig -> Sig-on a b x = uon a b $ unipolar x +on :: SigSpace a => Sig -> Sig -> a -> a+on a b x = uon a b $ mapSig unipolar x   -- | Rescaling of the unipolar signal (0, 1) -> (a, b) --  -- > on a b uniSig-uon :: Sig -> Sig -> Sig -> Sig-uon a b x = a + (b - a) * x+uon :: SigSpace a => Sig -> Sig -> a -> a+uon a b = mapSig (\x -> a + (b - a) * x)   -------------------------------------------------------------------------- -- noise

@@ -35,5 +35,5 @@ import Data.Default import Data.Monoid     -import Csound.Typed.Opcode hiding (button, display, space, lfo, initc7, ctrl7, oscInit, oscListen, oscSend)+import Csound.Typed.Opcode hiding (button, display, space, lfo, initc7, ctrl7, oscInit, oscListen, oscSend, lpshold, loopseg, loopxseg) 

@@ -62,7 +62,15 @@     -- * Re-exports     module Csound.Control.Gui.Layout,     module Csound.Control.Gui.Props,-    module Csound.Control.Gui.Widget+    module Csound.Control.Gui.Widget,++    -- * Lifters+    -- | An easy way to combine visuals for sound sources.++    lift1, hlift2, vlift2, hlift3, vlift3, hlift4, vlift4, hlift5, vlift5,++    -- ** Lifters with visual scaling+    hlift2', vlift2', hlift3', vlift3', hlift4', vlift4', hlift5', vlift5' ) where  import Csound.Typed@@ -86,3 +94,121 @@  instance SigSpace a => SigSpace (Source a) where     mapSig f = mapSource (mapSig f)+++----------------------------------------------------------------------------------+-- easy grouppings for GUIs++-- | The shortcut for @mapSource@.+lift1 :: (a -> b) -> Source a -> Source b+lift1 = mapSource++lift2 :: (Gui -> Gui -> Gui) -> (a -> b -> c) -> Source a -> Source b -> Source c+lift2 gf f ma mb = source $ do+    (ga, a) <- ma+    (gb, b) <- mb+    return $ (gf ga gb, f a b)++lift2' a b gf = lift2 (tfm2 a b gf)+    where tfm2 sa sb gf = \a b -> gf (sca sa a) (sca sb b)++-- | Combines two sound sources. Visuals are aligned horizontally+-- and the sound sources a grouped with the given function. +hlift2 :: (a -> b -> c) -> Source a -> Source b -> Source c+hlift2 = lift2 (\a b -> hor [a, b])++-- | Combines two sound sources. Visuals are aligned vertically+-- and the sound sources a grouped with the given function. +vlift2 :: (a -> b -> c) -> Source a -> Source b -> Source c+vlift2 = lift2 (\a b -> ver [a, b])++-- | It's just like the @hlift2@ but two more parameters change visual scaling of the widgets.+hlift2' :: Double -> Double -> (a -> b -> c) -> Source a -> Source b -> Source c+hlift2' sa sb = lift2' sa sb (\a b -> hor [a, b])++-- | It's just like the @vlift2@ but two more parameters change visual scaling of the widgets.+vlift2' :: Double -> Double -> (a -> b -> c) -> Source a -> Source b -> Source c+vlift2' sa sb = lift2' sa sb (\a b -> ver [a, b])++lift3 :: (Gui -> Gui -> Gui -> Gui) -> (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d+lift3 gf f ma mb mc = source $ do+    (ga, a) <- ma+    (gb, b) <- mb+    (gc, c) <- mc+    return $ (gf ga gb gc, f a b c)++lift3' sa sb sc gf = lift3 (tfm3 sa sb sc gf)+    where tfm3 sa sb sc gf = \a b c -> gf (sca sa a) (sca sb b) (sca sc c)++-- | The same as @hlift2@ but for three sound sources.+hlift3 :: (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d+hlift3 = lift3 (\a b c -> hor [a, b, c])++-- | The same as @vlift2@ but for three sound sources.+vlift3 :: (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d+vlift3 = lift3 (\a b c -> ver [a, b, c])++-- | The same as @hlift2'@ but for three sound sources.+hlift3' :: Double -> Double -> Double -> (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d+hlift3' a b c = lift3' a b c (\a b c -> hor [a, b, c])++-- | The same as @vlift2'@ but for three sound sources.+vlift3' :: Double -> Double -> Double -> (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d+vlift3' a b c = lift3' a b c (\a b c -> ver [a, b, c])++lift4 :: (Gui -> Gui -> Gui -> Gui -> Gui) -> (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e+lift4 gf f ma mb mc md = source $ do+    (ga, a) <- ma+    (gb, b) <- mb+    (gc, c) <- mc+    (gd, d) <- md+    return $ (gf ga gb gc gd, f a b c d)++lift4' sa sb sc sd gf = lift4 (tfm3 sa sb sc sd gf)+    where tfm3 sa sb sc sd gf = \a b c d -> gf (sca sa a) (sca sb b) (sca sc c) (sca sd d)++-- | The same as @hlift2@ but for four sound sources.+hlift4 :: (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e+hlift4 = lift4 (\a b c d -> hor [a, b, c, d])++-- | The same as @vlift2@ but for four sound sources.+vlift4 :: (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e+vlift4 = lift4 (\a b c d -> ver [a, b, c, d])++-- | The same as @hlift2'@ but for four sound sources.+hlift4' :: Double -> Double -> Double -> Double -> (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e+hlift4' a b c d = lift4' a b c d (\a b c d -> hor [a, b, c, d])++-- | The same as @vlift2'@ but for four sound sources.+vlift4' :: Double -> Double -> Double -> Double -> (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e+vlift4' a b c d = lift4' a b c d (\a b c d -> ver [a, b, c, d])+++lift5 :: (Gui -> Gui -> Gui -> Gui -> Gui -> Gui) -> (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b+lift5 gf f ma1 ma2 ma3 ma4 ma5 = source $ do+    (ga1, a1) <- ma1+    (ga2, a2) <- ma2+    (ga3, a3) <- ma3+    (ga4, a4) <- ma4+    (ga5, a5) <- ma5+    return $ (gf ga1 ga2 ga3 ga4 ga5, f a1 a2 a3 a4 a5)++lift5' sa sb sc sd se gf = lift5 (tfm3 sa sb sc sd se gf)+    where tfm3 sa sb sc sd se gf = \a b c d e -> gf (sca sa a) (sca sb b) (sca sc c) (sca sd d) (sca se e)++-- | The same as @hlift2@ but for five sound sources.+hlift5 :: (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b+hlift5 = lift5 (\a b c d e -> hor [a, b, c, d, e])++-- | The same as @vlift2@ but for five sound sources.+vlift5 :: (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b+vlift5 = lift5 (\a b c d e -> ver [a, b, c, d, e])++-- | The same as @hlift2'@ but for five sound sources.+hlift5' :: Double -> Double -> Double -> Double -> Double -> (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b+hlift5' a b c d e = lift5' a b c d e (\a b c d e -> hor [a, b, c, d, e])++-- | The same as @vlift2'@ but for five sound sources.+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])+

@@ -25,14 +25,28 @@     -- * Transformers     setTitle,     -- * Keyboard-    KeyEvt(..), Key(..), keyIn, charOn, charOff+    KeyEvt(..), Key(..), keyIn, charOn, charOff,++    -- * Easy to use widgets+    uknob, xknob, uslider, xslider, ujoy, +    hradio, vradio, hradioSig, vradioSig,++    -- * Number selectors+    -- | Widgets for sample and hold functions+    hnumbers, vnumbers,++    -- * The 2D matrix of widgets+    knobPad, togglePad, buttonPad, genPad ) where +import Control.Monad+ import Data.List(transpose) import Data.Boolean  import Csound.Typed.Gui import Csound.Typed.Types+import Csound.Control.SE import Csound.Control.Evt(listAt)  --------------------------------------------------------------------@@ -98,3 +112,161 @@ charOff :: Char -> Evt Unit charOff = keyIn . Release . CharKey ++-- | Unipolar linear slider. The value belongs to the interval [0, 1].+-- The argument is for initial value.+uslider :: Double -> Source Sig+uslider = slider "" (linSpan 0 1)++-- | Unipolar linear knob. The value belongs to the interval [0, 1].+-- The argument is for initial value.+uknob :: Double -> Source Sig+uknob = knob "" (linSpan 0 1)++-- | Exponential slider (usefull for exploring frequencies or decibels). +--+-- > xknob min max initVal+--+-- The value belongs to the interval [min, max].+-- The last argument is for initial value.+xslider :: Double -> Double -> Double -> Source Sig+xslider a b initVal = slider "" (expSpan a b) initVal++-- | Exponential knob (usefull for exploring frequencies or decibels). +--+-- > xknob min max initVal+--+-- The value belongs to the interval [min, max].+-- The last argument is for initial value.+xknob :: Double -> Double -> Double -> Source Sig+xknob a b initVal = knob "" (expSpan a b) initVal++-- | Unit linear joystick.+ujoy :: (Double, Double) -> Source (Sig, Sig)+ujoy = joy (linSpan 0 1) (linSpan 0 1)++---------------------------------------------------------------+-- sample and hold++-- | The sample and hold widget. You can pick a value from the list of doubles.+-- The original value is a head of the list (the first element).+-- The visual grouping is horizontal (notice the prefix @h@).+-- It's common to use it with function @selector@.+hnumbers :: [Double] -> Source Sig+hnumbers = genNumbers hor++-- | The sample and hold widget. You can pick a value from the list of doubles.+-- The original value is a head of the list (the first element).+-- The visual grouping is vertical (notice the prefix @v@).+-- It's common to use it with function @selector@.+vnumbers :: [Double] -> Source Sig+vnumbers = genNumbers ver++genNumbers :: ([Gui] -> Gui) -> [Double] -> Source Sig+genNumbers gx as@(d:ds) = source $ do+    ref <- newGlobalSERef (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+    return (gx gs, res)+++-------------------------------------------------------------------+-- 2D matrix of widgets++-- | The matrix of unipolar knobs.+--+-- > knobPad columnNum rowNum names initVals +--+-- It takes in the dimensions of matrix, the names (we can leave it empty +-- if names are not important) and list of init values.+-- It returns a function that takes in indices and produces the signal in+-- the corresponding cell.+knobPad :: Int -> Int -> [String] -> [Double] -> Source (Int -> Int -> Sig)+knobPad = genPad mkKnob 0.5+    where mkKnob name = knob name uspan ++-- | The matrix of toggle buttons.+--+-- > togglePad columnNum rowNum names initVals +--+-- It takes in the dimensions of matrix, the names (we can leave it empty +-- if names are not important) and list of init values (on/off booleans).+-- It returns a function that takes in indices and produces the event stream in+-- the corresponding cell.+togglePad :: Int -> Int -> [String] -> [Bool] -> Source (Int -> Int -> Evt D)+togglePad = genPad toggle False++-- | The matrix of buttons.+--+-- > buttonPad columnNum rowNum names+--+-- It takes in the dimensions of matrix, the names (we can leave it empty +-- if names are not important).+-- It returns a function that takes in indices and produces the event stream in+-- the corresponding cell.+buttonPad :: Int -> Int -> [String] -> Source (Int -> Int -> Evt Unit)+buttonPad width height names = genPad mkButton False width height names []+    where mkButton name _ = button name++-- | A generic constructor for matrixes of sound source widgets.+-- It takes the constructor of the widget, a default initial value,+-- the dimensions of the matrix, the list of names and the list of initial values.+-- It produces the function that maps indices to corresponding values.+genPad :: (String -> a -> Source b) -> a -> Int -> Int -> [String] -> [a] -> Source (Int -> Int -> b)+genPad mk initVal width height names as = source $ do+    (gui, vals) <- fmap reGroupCol $ mapM mkRow inits+    let f x y = (vals !! y) !! x+    return $ (gui, f)+    where +        mkRow xs = fmap reGroupRow $ mapM (uncurry mk) xs+        +        inits = split height width $ zip (names ++ repeat "") (as ++ repeat initVal)++        split m n xs = case m of+            0 -> []+            a -> (take n xs) : split (a - 1) n (drop n xs)++        reGroupCol = reGroup ver+        reGroupRow = reGroup hor++        reGroup f as = (f xs, ys)+            where (xs, ys) = unzip as+++-- | Horizontal radio group.+hradio :: [String] -> Int -> Source (Evt D)+hradio = radioGroup hor++-- | Vertical radio group.+vradio :: [String] -> Int -> Source (Evt D)+vradio = radioGroup ver++-- | Horizontal radio group.+hradioSig :: [String] -> Int -> Source Sig+hradioSig = radioGroupSig hor++-- | Vertical radio group.+vradioSig :: [String] -> Int -> Source Sig+vradioSig = radioGroupSig ver++radioGroup :: ([Gui] -> Gui) -> [String] -> Int -> Source (Evt D)+radioGroup gcat names initVal = mapSource snaps $ radioGroupSig gcat names initVal++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    +    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+        when1 (sig x ==* 0 &&* current ==* i) $ do+           writeSERef curRef i    +        ) reads ids   ++    res <- readSERef curRef+    return (gcat guis, res)+    where        +        ids = fmap (sig . int) [0 .. length names - 1]

@@ -99,10 +99,10 @@ 	return (port amp portTime,  port cps portTime)  -genAmpCpsSig :: ((Msg -> SE Sig) -> Sig) -> SE (Sig, Sig, Sig)+genAmpCpsSig :: ((Msg -> SE Sig) -> SE Sig) -> SE (Sig, Sig, Sig) genAmpCpsSig midiFun = do 	ref <- newGlobalSERef ((0, 0) :: (Sig, Sig))-	let status = midiFun (instr ref)+	status <- midiFun (instr ref) 	let resStatus = ifB (downsamp status ==* 0) 0 1 	(amp, cps) <- readSERef ref 	return (downsamp amp, downsamp cps, resStatus)

@@ -1,6 +1,7 @@ module Csound.Control.SE(-    SE, SERef, writeSERef, readSERef, newSERef, sensorsSE, newGlobalSERef, globalSensorsSE+    SE, SERef, writeSERef, readSERef, modifySERef, mixSERef, newSERef, sensorsSE, newGlobalSERef, globalSensorsSE ) where  import Csound.Typed.Control+import Csound.Typed.Types.Tuple 

@@ -27,7 +27,7 @@ -- Midi listens on all channels. It's useful to quickly -- test a sound font. The second argument is a sustain in seconds. -- How long it takes for the sound to decay.-sf2 :: Sf -> D -> (Sig, Sig)+sf2 :: Sf -> D -> SE (Sig, Sig) sf2 sf sust = midi $ sfMsg3 sf sust  -----------------------------------

@@ -44,6 +44,8 @@ import Data.Monoid import Data.Default import Csound.Typed+import Csound.Types(Sig2, Sig4)+import Csound.Control.Gui  import Csound.Options(setSilent) @@ -118,6 +120,47 @@  instance (Sigs a, Sigs b) => RenderCsd (a -> SE b) where     renderCsdBy opt f = renderEffBy opt f++instance RenderCsd (Source Sig) where+    renderCsdBy opt a = renderCsdBy opt res+        where res = do+                (gui, asig) <- a+                panel gui+                return asig++instance RenderCsd (Source Sig2) where+    renderCsdBy opt a = renderCsdBy opt res+        where res = do+                (gui, asig) <- a+                panel gui+                return asig++instance RenderCsd (Source Sig4) where+    renderCsdBy opt a = renderCsdBy opt res+        where res = do+                (gui, asig) <- a+                panel gui+                return asig++instance RenderCsd (Source (SE Sig)) where+    renderCsdBy opt a = renderCsdBy opt res+        where res = do+                (gui, asig) <- a+                panel gui+                asig++instance RenderCsd (Source (SE Sig2)) where+    renderCsdBy opt a = renderCsdBy opt res+        where res = do+                (gui, asig) <- a+                panel gui+                asig+instance RenderCsd (Source (SE Sig4)) where+    renderCsdBy opt a = renderCsdBy opt res+        where res = do+                (gui, asig) <- a+                panel gui+                asig  -- | Renders Csound file. renderCsd :: RenderCsd a => a -> IO String

@@ -1,15 +1,15 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# Language FlexibleInstances #-} module Csound.SigSpace(-    SigSpace(..), BindSig(..), mul,-    cfd, cfds, cfdSpec, cfdsSpec, +    SigSpace(..), BindSig(..), mul, at,+    cfd, cfd4, cfds, cfdSpec, cfdSpec4, cfdsSpec,      wsum         ) where  import Control.Applicative  import Csound.Typed-import Csound.Typed.Opcode(pvscross)+import Csound.Typed.Opcode(pvscross, pvscale, pvsmix)  -- | A class for easy way to process the outputs of the instruments. class SigSpace a where@@ -23,6 +23,10 @@ mul :: SigSpace a => Sig -> a -> a mul k = mapSig (k * ) +-- | A shortcut for @mapSig@.+at :: SigSpace a => (Sig -> Sig) -> a -> a+at = mapSig+ -- | Crossfade. -- -- > cfd coeff sig1 sig2@@ -36,6 +40,22 @@     []   -> zero     a:as -> foldl (\x f -> f x) a $ zipWith mix' cs as      where mix' c a b = mixFun c b a++-- | Bilinear interpolation for four signals.+-- The signals are placed in the corners of the unit square.+-- The first two signals are the xy coordinates in the square. +--+-- > cfd4 x y a b c d+--+-- * (0, 0) is for a+--+-- * (1, 0) is for b+--+-- * (1, 1) is for c+--+-- * (0, 1) is for d+cfd4 :: (Num a, SigSpace a) => Sig -> Sig -> a -> a -> a -> a -> a +cfd4 x y a b c d = sum $ zipWith mul [(1 - x) * (1 - y), x * (1 - y) , x * y, (1 - x) * y] [a, b, c, d]    -- | Generic crossfade for n coefficients and n+1 signals. --@@ -46,6 +66,15 @@ -- | Spectral crossfade. cfdSpec :: Sig -> Spec -> Spec -> Spec cfdSpec coeff a b = pvscross a b (1 - coeff) coeff++-- | Spectral bilinear crossfade (see @cfd4@).+cfdSpec4 :: Sig -> Sig -> Spec -> Spec -> Spec -> Spec -> Spec+cfdSpec4 x y a b c d = foldl1 pvsmix+    [ pvscale a ((1 - x) * (1 - y))+    , pvscale b (x * (1 - y))+    , pvscale c (x * y)+    , pvscale d ((1 - x) * y)+    ]  -- | Generic spectral crossfade. cfdsSpec :: [Sig] -> [Spec] -> Spec