csound-expression 4.7.1 → 4.8

raw patch · 12 files changed

+1059/−62 lines, 12 filesdep ~csound-expression-typeddep ~temporal-mediaPVP ok

version bump matches the API change (PVP)

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

API changes (from Hackage documentation)

Files

• csound-expression.cabal +3/−2
• src/Csound/Air.hs +5/−1
• src/Csound/Air/Envelope.hs +432/−3
• src/Csound/Air/Live.hs +53/−7
• src/Csound/Air/Looper.hs +244/−0
• src/Csound/Air/Seg.hs +5/−1
• src/Csound/Air/Wave.hs +1/−16
• src/Csound/Control/Evt.hs +7/−1
• src/Csound/Control/Gui.hs +62/−2
• src/Csound/Control/Gui/Widget.hs +212/−8
• src/Csound/Control/Instr.hs +12/−2
• src/Csound/SigSpace.hs +23/−19

@@ -1,5 +1,5 @@ Name:          csound-expression-Version:       4.7.1+Version:       4.8 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, transformers >= 0.3,-        csound-expression-typed >= 0.0.7.5, csound-expression-dynamic >= 0.1.4.3, temporal-media >= 0.5.0,+        csound-expression-typed >= 0.0.7.6, csound-expression-dynamic >= 0.1.4.3, temporal-media >= 0.6.0,         csound-expression-opcodes >= 0.0.2   Hs-Source-Dirs:      src/   Exposed-Modules:@@ -85,6 +85,7 @@         Csound.Air.Live         Csound.Air.Seg         Csound.Air.Sampler+        Csound.Air.Looper         Csound.Air.Misc         Csound.Air.Hvs         

@@ -22,8 +22,11 @@     module Csound.Air.Fx,        -- | Widgets to make live performances.-    module Csound.Air.Live,  +    module Csound.Air.Live,  +    -- | A multitap looper.+    module Csound.Air.Looper,   +     -- | Scheduling signals with event streams     module Csound.Air.Seg, @@ -42,6 +45,7 @@ import Csound.Air.Spec import Csound.Air.Fx import Csound.Air.Live+import Csound.Air.Looper import Csound.Air.Seg import Csound.Air.Sampler import Csound.Air.Misc

@@ -1,10 +1,21 @@+{-#  Language TypeFamilies, FlexibleInstances #-} -- | Envelopes module Csound.Air.Envelope (     leg, xeg,     -- * Relative duration     onIdur, lindur, expdur, linendur,-    onDur, lindurBy, expdurBy, linendurBy,    +    onDur, lindurBy, expdurBy, linendurBy,  ++    -- * Faders+    fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades,++    -- * Humanize    +    HumanizeValue(..), HumanizeTime(..), HumanizeValueTime(..),+    hval, htime, hvalTime,+     -- * Looping envelopes   ++    -- ** Simple     lpshold, loopseg, loopxseg, lpsholdBy, loopsegBy, loopxsegBy,     holdSeq, linSeq, expSeq,     linloop, exploop, sah, stepSeq, @@ -12,13 +23,25 @@     pwSeq, ipwSeq, rampSeq, irampSeq, xrampSeq, ixrampSeq,     adsrSeq, xadsrSeq, adsrSeq_, xadsrSeq_,   -    -- * Faders-    fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades+    -- ** Complex+    Seq, toSeq, onBeat, onBeats, +    seqConst, seqLin, seqExp,++    seqPw, iseqPw, seqSqr, iseqSqr,+    seqSaw, iseqSaw, xseqSaw, ixseqSaw, seqRamp, iseqRamp, seqTri, seqTriRamp,+    seqAdsr, xseqAdsr, seqAdsr_, xseqAdsr_,++    seqPat, seqAsc, seqDesc, seqHalf+ ) where +import Control.Monad+import Control.Applicative import Data.List(intersperse) +import Temporal.Media+ import Csound.Typed import Csound.Typed.Opcode hiding (lpshold, loopseg, loopxseg) import qualified Csound.Typed.Opcode as C(lpshold, loopseg, loopxseg)@@ -448,3 +471,409 @@          groupSegs :: [[Sig]] -> [Sig]         groupSegs as = concat $ intersperse [0] as+++-- | The seq is a type for step sequencers. +-- The step sequencer is a monophonic control signal.+-- Most often step sequencer is a looping segment of+-- some values. It's used to create bas lines or conrtrol the frequency of+-- the filter in dub or trance music. There are simple functions+-- for creation of step sequencers defined in the module "Csound.Air.Envelope".+--+-- Basically the step sequence is a list of pairs:+--+-- >  [(valA, durA), (valB, durB), (valC, durC)]+--+-- each pair defines a segment of height valN that lasts for durN.+-- The sequence is repeated with the given frequency. Each segment+-- has certain shape. It can be a constant or line segment or +-- fragment of square wave or fragment of an adsr envelope. +-- There are many predefined functions.+--+-- With Seq we can construct control signals in very flexible way.+-- We can use the score composition functions for creation of sequences.+-- We can use @mel@ for sequencing of individual steps, we can use @str@+-- for stretching the sequence in time domain, we can delay with @del@.+--+-- Here is an example:+--+-- > dac $ tri $ seqConst [str 0.25 $ mel [440, 220, 330, 220], 110] 1+--+-- We can see how the function @str@ was used to make a certain segment faster.+-- There are numerical instaces for Seq. Bt it defines only functions @fronInteger@ and+-- @fromRational@.+newtype Seq = Seq { unSeq :: [Seq1] }++data Seq1 = Rest {+        seq1Dur :: Sig } +    | Seq1 {+          seq1Dur :: Sig+        , seq1Val :: Sig+    }++type instance DurOf Seq = Sig++instance Duration Seq where+    dur (Seq as) = sum $ fmap seq1Dur as++instance Rest Seq where+    rest t = Seq [Rest t]++instance Delay Seq where+    del t a = mel [rest t, a]++instance Melody Seq where+    mel as = Seq $ as >>= unSeq    ++instance Stretch Seq where+    str t (Seq as) = Seq $ fmap (updateDur t) as+        where updateDur k a = a { seq1Dur = k * seq1Dur a }++-- | Creates a +toSeq :: Sig -> Seq+toSeq a = Seq [Seq1 1 a]++-- | Squashes a sequence to a single beat.+onBeat :: Seq -> Seq+onBeat a = str (1 / dur a) a++-- | Squashes a sequence to a single beat and then stretches to the given value.+onBeats :: Sig -> Seq -> Seq+onBeats k = str k . onBeat++instance Num Seq where+    fromInteger n = toSeq $ fromInteger n+    (+) = undefined+    (*) = undefined+    negate = undefined+    abs = undefined+    signum = undefined++instance Fractional Seq where+    fromRational = toSeq . fromRational+    (/) = undefined++-------------------------------------------------++seqGen0 :: ([Sig] -> Sig -> Sig) -> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig+seqGen0 loopFun segFun as = loopFun (renderSeq0 segFun $ mel as)++seqGen1 :: ([Sig] -> Sig -> Sig) -> (Sig -> Sig -> [Sig]) -> [Seq] -> Sig -> Sig+seqGen1 loopFun segFun as = loopFun (renderSeq1 segFun $ mel as)++simpleSeq0 loopFun = seqGen0 loopFun $ \dt val -> [val, dt]+simpleSeq1 loopFun = seqGen0 loopFun $ \dt val -> [val, dt]++seq0 = seqGen0 lpshold+seq1 = seqGen1 loopseg+seqx = seqGen1 loopxseg++-- | A sequence of constant segments.+seqConst :: [Seq] -> Sig -> Sig+seqConst = simpleSeq0 lpshold++-- | A linear sequence.+seqLin :: [Seq] -> Sig -> Sig+seqLin = simpleSeq1 loopseg++-- | An exponential sequence.+seqExp :: [Seq] -> Sig -> Sig+seqExp = simpleSeq1 loopxseg++-------------------------------------------------+-- square++-- | The sequence of pulse width waves.+-- The first argument is a duty cycle (ranges from 0 to 1).+seqPw :: Sig -> [Seq] -> Sig -> Sig+seqPw k = seq0 $ \dt val -> [val, dt * k, 0, dt * (1 - k)]++-- | The sequence of inversed pulse width waves.+iseqPw :: Sig -> [Seq] -> Sig -> Sig+iseqPw k = seq0 $ \dt val -> [0, dt * k, val, dt * (1 - k)]++-- | The sequence of square waves.+seqSqr :: [Seq] -> Sig -> Sig+seqSqr = seqPw 0.5++-- | The sequence of inversed square waves.+iseqSqr :: [Seq] -> Sig -> Sig+iseqSqr = iseqPw 0.5++-- saw++saw1  dt val = [val, dt, 0, 0]+isaw1 dt val = [0, dt, val, 0]++-- | The sequence of sawtooth waves.+seqSaw :: [Seq] -> Sig -> Sig+seqSaw = seq1 saw1++-- | The sequence of inversed sawtooth waves.+iseqSaw :: [Seq] -> Sig -> Sig+iseqSaw = seq1 isaw1++-- | The sequence of exponential sawtooth waves.+xseqSaw :: [Seq] -> Sig -> Sig+xseqSaw = seqx saw1++-- | The sequence of inversed exponential sawtooth waves.+ixseqSaw :: [Seq] -> Sig -> Sig+ixseqSaw = seqx isaw1++-- | The sequence of ramp  functions. The first argument is a duty cycle.+seqRamp :: Sig -> [Seq] -> Sig -> Sig+seqRamp k = seq1 $ \dt val -> [val, k * dt, 0, (1 - k) * dt, 0, 0]++-- | The sequence of inversed ramp  functions. The first argument is a duty cycle.+iseqRamp :: Sig -> [Seq] -> Sig -> Sig+iseqRamp k = seq1 $ \dt val -> [0, k * dt, val, (1 - k) * dt, 0, 0]++-- tri++-- | The sequence of triangular waves.+seqTri :: [Seq] -> Sig -> Sig+seqTri = seqTriRamp 0.5++-- | The sequence of ramped triangular waves.+seqTriRamp :: Sig -> [Seq] -> Sig -> Sig+seqTriRamp k = seq1 $ \dt val -> [0, dt * k, val, dt * (1 - k)]++-- adsr++adsr1 a d s r dt val = [0, a * dt, val, d * dt, s * val, (1 - a - r), s * val, r * dt ]+adsr1_ a d s r rest dt val = [0, a * dt, val, d * dt, s * val, (1 - a - r - rest), s * val, r * dt, 0, rest ]++-- | The sequence of ADSR-envelopes.+--+-- > seqAdsr att dec sus rel+--+-- It has to be:+--+-- > att + dec + sus_time + rel == 1+seqAdsr :: Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig+seqAdsr a d s r = seq1 (adsr1 a d s r)++-- | The sequence of exponential ADSR-envelopes.+xseqAdsr :: Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig+xseqAdsr a d s r = seqx (adsr1 a d s r)++-- | The sequence of ADSR-envelopes with rest at the end.+--+-- > seqAdsr att dec sus rel rest+--+-- It has to be:+--+-- > att + dec + sus_time + rel + rest == 1++seqAdsr_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig+seqAdsr_ a d s r rest = seq1 (adsr1_ a d s r rest)++-- | The sequence of exponential ADSR-envelopes with rest at the end.+xseqAdsr_ :: Sig -> Sig -> Sig -> Sig -> Sig -> [Seq] -> Sig -> Sig+xseqAdsr_ a d s r rest = seqx (adsr1_ a d s r rest)++-------------------------------------------------++renderSeq0 :: (Sig -> Sig -> [Sig]) -> Seq -> [Sig]+renderSeq0 f (Seq as) = as >>= phi+    where +        phi x = case x of+            Seq1 dt val -> f dt val+            Rest dt     -> [0, dt]++renderSeq1 :: (Sig -> Sig -> [Sig]) -> Seq -> [Sig]+renderSeq1 f (Seq as) = as >>= phi+    where +        phi x = case x of+            Seq1 dt val -> f dt val+            Rest dt     -> [0, dt, 0, 0]++-------------------------------------------------++genSeqPat :: (Int -> [Double]) -> [Int] -> Seq+genSeqPat g ns = mel (ns >>= f)+    where f n +            | n <= 0 = []+            | n == 1 = [1]+            | otherwise = fmap (toSeq . sig . double) $ g n++-- | Function for creation of accented beats. +-- The steady beat pattern of accents is repeated.+-- The first argument describes the list of integers.+-- Each integer is a main beat and the length of the beat.+-- We can create a typical latino beat:+--+-- > dac $ mul (seqSaw [seqPat [3, 3, 2]] 1) white+seqPat :: [Int] -> Seq+seqPat ns = mel (ns >>= f)+    where f n +            | n <= 0 = []+            | n == 1 = [1]+            | otherwise = [1, rest $ sig $ int $ n - 1]++rowDesc n = [1, 1 - recipN .. recipN ]+    where recipN = 1/ fromIntegral n++-- | It's like @seqPat@ but inplace of rests it fills the gaps with+-- segments descending in value.+--+-- > dac $ mul (seqSaw [seqDesc [3, 3, 2]] 1) white+seqDesc :: [Int] -> Seq+seqDesc = genSeqPat rowDesc+    +-- | It's like @seqPat@ but inplace of rests it fills the gaps with+-- segments ascending in value.+--+-- > dac $ mul (seqSaw [seqAsc [3, 3, 2]] 1) white+seqAsc :: [Int] -> Seq+seqAsc = genSeqPat (\n -> let xs = rowDesc n in head xs : reverse (tail xs))++-- | It's like @seqPat@ but inplace of rests it fills the gaps with 0.5s.+--+-- > dac $ mul (seqSaw [seqHalf [3, 3, 2]] 1) white+seqHalf :: [Int] -> Seq+seqHalf = genSeqPat $ (\n -> 1 : take (n - 1) (repeat 0.5))++-------------------------------------------------+-- humanizers++-- | Alias for @humanVal@.+hval :: HumanizeValue a => Sig -> a -> HumanizeValueOut a+hval = humanVal++-- | Alias for @humanTime@.+htime :: HumanizeTime a => Sig -> a -> HumanizeTimeOut a+htime = humanTime++-- | Alias for @humanValTime@.+hvalTime :: HumanizeValueTime a => Sig -> Sig -> a -> HumanizeValueTimeOut a+hvalTime = humanValTime++-- value++-- | A function transformer (decorator). We can transform an envelope producer+-- so that all values are sumed with some random value. The amplitude of the+-- random value is given with the first argument.+--+-- It can transform linseg, expseg, sequence producers and simplified sequence producers. +--+-- An example:+--+-- > dac $ mul (humanVal 0.1 sqrSeq [1, 0.5, 0.2, 0.1] 1) $ white+--+-- As you can see it transforms the whole function. So we don't need for extra parenthesis.+class HumanizeValue a where+    type HumanizeValueOut a :: *+    humanVal :: Sig -> a -> HumanizeValueOut a++rndVal :: Sig -> Sig -> Sig -> SE Sig+rndVal cps dr val = fmap (+ val) $ randh dr cps++rndValD :: Sig -> D -> SE D+rndValD dr val = fmap (+ val) $ random (- (ir dr)) (ir dr)++instance HumanizeValue ([Seq] -> Sig -> Sig) where+    type HumanizeValueOut ([Seq] -> Sig -> Sig) = [Seq] -> Sig -> SE Sig+    humanVal dr f = \sq cps -> fmap (\x -> f x cps) (mapM (humanSeq cps) sq)+        where+            humanSeq cps (Seq as) = fmap Seq $ forM as $ \x -> case x of+                Rest _      -> return x+                Seq1 dt val -> fmap (Seq1 dt) $ rndVal cps dr val++instance HumanizeValue ([Sig] -> Sig -> Sig) where+    type HumanizeValueOut ([Sig] -> Sig -> Sig) = [Sig] -> Sig -> SE Sig+    humanVal dr f = \sq cps -> fmap (\x -> f x cps) (mapM (humanSig cps) sq)+        where humanSig cps val = rndVal cps dr val++instance HumanizeValue ([D] -> Sig) where+    type HumanizeValueOut ([D] -> Sig) = [D] -> SE Sig+    humanVal dr f = \xs -> fmap f $ mapM human1 $ zip [0 ..] xs+        where human1 (n, a)+                    | mod n 2 == 1 = rndValD dr a+                    | otherwise    = return a++instance HumanizeValue ([D] -> D -> Sig) where+    type HumanizeValueOut ([D] -> D -> Sig) = [D] -> D -> SE Sig+    humanVal dr f = \xs release -> fmap (flip f release) $ mapM human1 $ zip [0 ..] xs+        where human1 (n, a)+                    | mod n 2 == 1 = rndValD dr a+                    | otherwise    = return a++-- time++-- | A function transformer (decorator). We can transform an envelope producer+-- so that all durations are sumed with some random value. The amplitude of the+-- random value is given with the first argument.+--+-- It can transform linseg, expseg, sequence producers and simplified sequence producers. +--+-- An example:+--+-- > dac $ mul (humanTime 0.1 sqrSeq [1, 0.5, 0.2, 0.1] 1) $ white+--+-- As you can see it transforms the whole function. So we don't need for extra parenthesis.+class HumanizeTime a where+    type HumanizeTimeOut a :: *+    humanTime :: Sig -> a -> HumanizeTimeOut a++instance HumanizeTime ([Seq] -> Sig -> Sig) where+    type HumanizeTimeOut ([Seq] -> Sig -> Sig) = [Seq] -> Sig -> SE Sig+    humanTime dr f = \sq cps -> fmap (\x -> f x cps) (mapM (humanSeq cps) sq)+        where+            humanSeq cps (Seq as) = fmap Seq $ forM as $ \x -> case x of+                Rest dt     -> fmap Rest $ rndVal cps dr dt+                Seq1 dt val -> fmap (flip Seq1 val) $ rndVal cps dr dt++instance HumanizeTime ([D] -> Sig) where+    type HumanizeTimeOut ([D] -> Sig) = [D] -> SE Sig+    humanTime dr f = \xs -> fmap f $ mapM human1 $ zip [0 ..] xs+        where human1 (n, a)+                    | mod n 2 == 0 = rndValD dr a+                    | otherwise    = return a++instance HumanizeTime ([D] -> D -> Sig) where+    type HumanizeTimeOut ([D] -> D -> Sig) = [D] -> D -> SE Sig+    humanTime dr f = \xs release -> liftA2 f (mapM human1 $ zip [0 ..] xs) (rndValD dr release)+        where human1 (n, a)+                    | mod n 2 == 0 = rndValD dr a+                    | otherwise    = return a++-- value & time++-- | A function transformer (decorator). We can transform an envelope producer+-- so that all values and durations are sumed with some random value. The amplitude of the+-- random value is given with the first two arguments.+--+-- It can transform linseg, expseg, sequence producers and simplified sequence producers. +--+-- An example:+--+-- > dac $ mul (humanValTime 0.1 0.1 sqrSeq [1, 0.5, 0.2, 0.1] 1) $ white+--+-- As you can see it transforms the whole function. So we don't need for extra parenthesis.+class HumanizeValueTime a where+    type HumanizeValueTimeOut a :: *+    humanValTime :: Sig -> Sig -> a -> HumanizeValueTimeOut a++instance HumanizeValueTime ([Seq] -> Sig -> Sig) where+    type HumanizeValueTimeOut ([Seq] -> Sig -> Sig) = [Seq] -> Sig -> SE Sig+    humanValTime drVal drTime f = \sq cps -> fmap (\x -> f x cps) (mapM (humanSeq cps) sq)+        where+            humanSeq cps (Seq as) = fmap Seq $ forM as $ \x -> case x of+                Rest dt     -> fmap Rest $ rndVal cps drTime dt+                Seq1 dt val -> liftA2 Seq1 (rndVal cps drTime dt) (rndVal cps drVal val)++instance HumanizeValueTime ([D] -> Sig) where+    type HumanizeValueTimeOut ([D] -> Sig) = [D] -> SE Sig+    humanValTime drVal drTime f = \xs -> fmap f $ mapM human1 $ zip [0 ..] xs+        where human1 (n, a)+                    | mod n 2 == 1 = rndValD drVal  a+                    | otherwise    = rndValD drTime a++instance HumanizeValueTime ([D] -> D -> Sig) where+    type HumanizeValueTimeOut ([D] -> D -> Sig) = [D] -> D -> SE Sig+    humanValTime drVal drTime f = \xs release -> liftA2 f (mapM human1 $ zip [0 ..] xs) (rndValD drTime release)+        where human1 (n, a)+                    | mod n 2 == 1 = rndValD drVal  a+                    | otherwise    = rndValD drTime a

@@ -5,13 +5,17 @@     mixer, hmixer, mixMono,      -- * Effects-    FxFun, FxUI(..), fxBox,+    FxFun, FxUI(..), fxBox, uiBox,     fxColor, fxVer, fxHor, fxSca, fxApp, +    -- * Instrument choosers+    hinstrChooser, vinstrChooser,+    hmidiChooser, vmidiChooser,+     -- ** Fx units     uiDistort, uiChorus, uiFlanger, uiPhaser, uiDelay, uiEcho,     uiFilter, uiReverb, uiGain, uiWhite, uiPink, uiFx, uiRoom,-    uiHall, uiCave, uiSig, uiMix,+    uiHall, uiCave, uiSig, uiMix, uiMidi,       -- * Static widgets     AdsrBound(..), AdsrInit(..),@@ -28,7 +32,9 @@  import Csound.Typed import Csound.Typed.Gui-import Csound.Control.Gui(funnyRadio, mapSource)+import Csound.Control.Evt+import Csound.Control.Instr+import Csound.Control.Gui import Csound.Typed.Opcode hiding (space) import Csound.SigSpace import Csound.Air.Wave@@ -152,8 +158,19 @@             | otherwise = f gs             where f xs = uiGroupGui gOff (ver xs) +-- | Creates an FX-box from the given visual representation.+-- It insertes a big On/Off button atop of the GUI.+uiBox :: String -> Source FxFun -> Bool -> Source FxFun +uiBox name fx onOff = mapGuiSource (setBorder UpBoxBorder) $ vlift2' uiOnOffSize uiBoxSize go off fx+    where+        off =  mapGuiSource (setFontSize 25) $ toggleSig name onOff +        go off fx arg = mul off $ fx arg++uiOnOffSize = 1.7+uiBoxSize   = 8+ uiGroupGui :: Gui -> Gui -> Gui -uiGroupGui a b =ver [sca 1.7 a, sca 8 b]+uiGroupGui a b =ver [sca uiOnOffSize a, sca uiBoxSize b]  sourceColor2 :: Color -> Source a -> Source a sourceColor2 col a = source $ do@@ -283,9 +300,10 @@ uiCave :: Bool -> Source FxFun uiCave isOn = sourceColor2 C.darkviolet $ uiFx "Cave" magicCave2 isOn --- | The widget for selecting a midi instrument. -uiMidi :: Bool -> [(String, Msg -> SE Sig2)] -> Source FxFun-uiMidi isOn as = sourceColor2 C.forestgreen $ undefined+-- | Midi chooser implemented as FX-box.+uiMidi :: [(String, Msg -> SE Sig2)] -> Int -> Source FxFun +uiMidi xs initVal = sourceColor2 C.forestgreen $ uiBox "Midi" fx True+    where fx = lift1 (\aout arg -> return $ aout + arg) $ vmidiChooser xs initVal  -- | the widget for mixing in a signal to the signal. uiSig :: String -> Bool -> Source Sig2 -> Source FxFun@@ -353,3 +371,31 @@ masterVolumeKnob :: Source Sig masterVolumeKnob = knob "master" uspan 0.5 ++----------------------------------------------------+-- instrument choosers++genMidiChooser chooser xs initVal = joinSource $ lift1 midi $ chooser xs initVal++-- | Chooses a midi instrument among several alternatives. It uses the @hradio@ for GUI groupping.+hmidiChooser :: Sigs a => [(String, Msg -> SE a)] -> Int -> Source a+hmidiChooser = genMidiChooser hinstrChooser++-- | Chooses a midi instrument among several alternatives. It uses the @vradio@ for GUI groupping.+vmidiChooser :: Sigs a => [(String, Msg -> SE a)] -> Int -> Source a+vmidiChooser = genMidiChooser vinstrChooser++-- | Chooses an instrument among several alternatives. It uses the @hradio@ for GUI groupping.+hinstrChooser :: (Sigs b) => [(String, a -> SE b)] -> Int -> Source (a -> SE b)+hinstrChooser = genInstrChooser hradioSig++-- | Chooses an instrument among several alternatives. It uses the @vradio@ for GUI groupping.+vinstrChooser :: (Sigs b) => [(String, a -> SE b)] -> Int -> Source (a -> SE b)+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+    where +        (names, instrs) = unzip xs+        go instrId arg = fmap sum $ mapM ( $ arg) $ zipWith (\n instr -> playWhen (sig (int n) ==* instrId) instr) [0 ..] instrs+            

@@ -0,0 +1,244 @@+-- | A multitap looper.+module Csound.Air.Looper (+	LoopSpec(..), LoopControl(..),+	sigLoop, midiLoop, sfLoop+) where++import Control.Monad+import Data.List++import Data.Default+import Data.Boolean+import Csound.Typed +import Csound.Typed.Gui hiding (button)+import Csound.Control.Evt+import Csound.Control.Instr+import Csound.Control.Gui +import Csound.Control.Sf++import Csound.Typed.Opcode hiding (space, button)+import Csound.SigSpace+import Csound.Air.Live	+import Csound.Air.Wave+import Csound.Air.Fx+import Csound.Air.Filter+import Csound.Air.Misc+++-- | The type for fine tuning of the looper. Let's review the values:+-- +-- * @loopMixVal@ - list of initial values for mix levels (default is 0.5 for all taps)+--+-- * @loopPrefx@ - list of pre-loop effects (the default is do-nothing effect)+--+-- * @loopPostfx@ - list of post-loop effects (the default is do-nothing effect)+--+-- * @loopPrefxVal - list of dry/wet values for pre-looop effects (the default is 0.5 for all taps)+--+-- * @loopPostfxVal - list of dry/wet values for post-looop effects (the default is 0.5 for all taps)+--+-- * @loopInitInstr@  - the initial sounding tap (sound source) (what tap we are going to record when the looper starts up).+--+-- * @loopFades@ - the list of instrument groups to fade/out. Eachl list item is a list of integers+-- where an integer points to a tap number. By default a single fader is given to each tap.+-- with lists of integers we can group the sound sources by their functions in the song.+-- We may group all harmonic instruments in a single group and all drums into another group.+--+-- * @loopReeatFades@ -- a repeat fade weight is a value that represents +--    an amount of repetition. A looping tap is implemented as a delay tap with+--   big feedback. The repeat fades equals to the feedback amount. It have to be not bigger+-- 	 than 1. If the value equals to 1 than the loop is repeated forever. If it's lower+--   than 1 the loop is gradually going to fade. +--+-- * @loopControl@ -- specifies an external controllers for the looper.+--   See the docs for the type @LoopSpec@.+data LoopSpec = LoopSpec +	{ loopMixVal  :: [Sig]+	, loopPrefx  :: [FxFun]+	, loopPostfx :: [FxFun]+	, loopPrefxVal :: [Sig]+	, loopPostfxVal :: [Sig]	+	, loopInitInstr :: Int+	, loopFades :: [[Int]]	+	, loopRepeatFades :: [Sig]+	, loopControl :: LoopControl+	}++instance Default LoopSpec where+	def = LoopSpec {+		  loopPrefx  		= []+		, loopPostfx 		= []+		, loopPrefxVal 		= []+		, loopPostfxVal 	= []+		, loopMixVal      	= []+		, loopInitInstr 	= 0+		, loopFades 		= []+		, loopRepeatFades   = []+		, loopControl       = def+		}		++-- | External controllers. We can control the looper with+-- UI-widgets but sometimes it's convenient to control the+-- loper with some external midi-device. This structure mocks+-- all controls (except knobs for effects and mix).+--+-- * @loopTap@ - selects the current tap. It's a stream of integers (from 0 to a given integer).+--+-- * @loopFade@ - can fade in or fade out a group of taps. It's a list of toggle-like event streams.+--   they produce 1s for on and 0s for off.+--+-- * @loopDel@ - is for deleting the content of a given tap. It's just a click of the button.+--   So the value should be an event stream of units (which is @Tick = Evt Unit@).+--+-- * @loopThrough@ - is an event stream of toggles.+--+-- All values are wrapped in the @Maybe@ type. If the value is @Nothing@ in the given cell+-- the looper is controled only with virtual widgets.+--+-- There is an instance of @Default@ for @LoopControl@ with all values set to @Nothing@.+-- It's useful when we want to control only  a part of parameters externally.+-- We can use the value @def@ to set the  rest parameters:+--+-- > def { loopTap = Just someEvt }+data LoopControl = LoopControl +	{ loopTap  :: Maybe (Evt D)+	, loopFade :: Maybe ([Evt D])+	, loopDel  :: Maybe Tick+	, loopThrough :: Maybe (Evt D)+	}++instance Default LoopControl where+	def = LoopControl {+		  loopTap  = Nothing+		, loopFade = Nothing+		, loopDel  = Nothing+		, loopThrough = Nothing }++type TapControl     = [String] -> Int -> Source Sig+type FadeControl    = [String -> Source (Evt D)]+type DelControl     = Source Tick+type ThroughControl = Source Sig++-- | The @midiLoop@ that is adapted for usage with soundfonts.+-- It takes in a list of pairs of sound fonts as sound sources.+-- The second value in the pair is the release time for the given sound font.+sfLoop :: LoopSpec -> D -> [D] -> [(Sf, D)] -> Source Sig2+sfLoop spec dtBpm times fonts = midiLoop spec dtBpm times $ fmap (uncurry sfMsg) fonts++-- | The @sigLoop@ that is adapted for usage with midi instruments.+-- It takes a list of midi instruments in place of signal inputs. The rest is the same+midiLoop :: LoopSpec -> D -> [D] -> [Msg -> SE Sig2] -> Source Sig2+midiLoop = genLoop $ \cond midiInstr -> midi $ playWhen cond midiInstr ++-- | Simple multitap Looper. We can create as many taps as we like+-- also we can create fade outs/ins insert effects and control mix. +--+-- > sigLoop spec bpm times imputs +--+-- Arguments:+--+-- * looper @spec@ (see the docs for the type)+--+-- * main @bpm@ rate. All taps are aligned with the main rate+--+-- * list of multipliers for each tap. Each tap is going to have a fixed+--    length that is a multiplier of the main rate. It doesn't have to be+--    an integer. So we can create weird drum patterns with odd loop durations.+--+-- * list of signal sources. By convention all sources are stereo signals.+--    We can use the function @fromMono@ to convert the mono signal to stereo.+sigLoop :: LoopSpec -> D -> [D] -> [Sig2] -> Source Sig2+sigLoop = genLoop $ \cond asig -> return $ mul (ifB cond 1 0) asig++getControls :: LoopControl -> (TapControl, FadeControl, DelControl, ThroughControl)+getControls a =	+	( maybe hradioSig (hradioSig' . evtToSig (-1)) (loopTap a)+	, fmap (\f x -> f x True) $ maybe (repeat toggle) (\xs -> fmap toggle' xs ++ repeat toggle) (loopFade a)+	, ( $ "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 playInstr spec dtBpm times' instrs = do+	(preFxKnobGui, preFxKnobWrite, preFxKnobRead) <- setKnob "pre" (linSpan 0 1) 0.5+	(postFxKnobGui, postFxKnobWrite, postFxKnobRead) <- setKnob "post" (linSpan 0 1) 0.5+	(mixKnobGui, mixKnobWrite, mixKnobRead) <- setKnob "mix" (linSpan 0 1) 0.5++	let knobGuis = ver [mixKnobGui, preFxKnobGui, postFxKnobGui]++	mapGuiSource (\gs -> hor [knobGuis, sca 12 gs]) $ joinSource $ vlift3 (\(thr, delEvt) x sils -> do+		-- knobs	+		mixCoeffs <- tabSigs mixKnobWrite mixKnobRead x initMixVals+		preCoeffs <- tabSigs preFxKnobWrite preFxKnobRead x initPreVals+		postCoeffs <- tabSigs postFxKnobWrite postFxKnobRead x initPostVals++		refs <- mapM (const $ newSERef (1 :: Sig)) ids+		delRefs <- mapM (const $ newSERef (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+		(tapControl, fadeControl, delControl, throughControl) = getControls (loopControl spec)++		dt = 60 / dtBpm ++		times = take len $ times' ++ repeat 1++		postFx = take len $ loopPostfx spec ++ repeat return+		preFx = take len $ loopPrefx spec ++ repeat return+		repeatFades = loopRepeatFades spec ++ repeat 1++		len = length ids+		initMixVals = take len $ loopMixVal spec ++ repeat 0.5+		initPreVals = take len $ loopPrefxVal spec ++ repeat 0.5+		initPostVals = take len $ loopPostfxVal spec ++ repeat 0.5++		silencer +			| null (loopFades spec) = fmap return ids+			| otherwise               = loopFades spec++		initInstr = loopInitInstr spec++		ids = [0 .. length instrs - 1]+		through = throughControl+		delete = delControl++		throughDel = hlift2' 6 1 (\a b -> (a, b)) through delete+		sw = tapControl (fmap show ids) initInstr		 +		sil = hlifts id $ zipWith (\f n -> f (show n)) fadeControl [0 .. length silencer - 1]++		maxDel = 3++		f delEvt thr x (t, n, repeatFadeWeight) (mixCoeff, preFx, preCoeff, postFx, postCoeff) (delRef, silRef, instr) = do+			silVal <- readSERef silRef	+			runEvt delEvt $ \_ -> do+				a <- readSERef delRef+				when1 isCurrent $ writeSERef delRef (ifB (a + 1 <* maxDel) (a + 1) 0)+			delVal <- readSERef delRef+			echoSig <- playSf 0++			let d0 = delVal ==* 0+			    d1 = delVal ==* 1+			    d2 = delVal ==* 2++			let playEcho dId = mul (smooth 0.05 $ ifB dId 1 0) $ mul (smooth 0.1 silVal) $ at (echo (dt * t) (ifB dId repeatFadeWeight 0)) $ ifB dId echoSig 0++			mul mixCoeff $ mixAt postCoeff postFx $ sum [ sum $ fmap playEcho [d0, d1, d2]+				, playSf 1]+			where +				playSf thrVal = mixAt preCoeff preFx $ playInstr (isCurrent &&* thr ==* thrVal) instr+				isCurrent = x ==* (sig $ int n)++		setSilencer refs silIds evt = runEvt evt $ \v -> +			mapM_ (\ref -> writeSERef 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	++	vs <- mapM readSERef 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++	return vs

@@ -48,9 +48,13 @@  type instance DurOf (Seg a) = Tick -instance Sigs a => Compose (Seg a) where+instance Sigs a => Melody (Seg a) where 	mel = sflow++instance Sigs a => Harmony (Seg a) where	 	har = spar++instance Sigs a => Compose (Seg a) where  instance Sigs a => Delay (Seg a) where 	del = sdel

@@ -5,7 +5,7 @@     osc, oscBy, saw, isaw, pulse, sqr, pw, tri, ramp, blosc,      -- * Unipolar-    unipolar, bipolar, on, uon, uosc, uoscBy, usaw, uisaw, upulse, usqr, upw, utri, uramp, ublosc,+    unipolar, bipolar, uosc, uoscBy, usaw, uisaw, upulse, usqr, upw, utri, uramp, ublosc,      -- * Noise     rndh, urndh, rndi, urndi, white, pink,@@ -97,21 +97,6 @@ -- | Unipolar triangle wave with ram factor. uramp :: Sig -> Sig -> Sig uramp duty cps = unipolar $ ramp duty cps----- rescaling---- | Rescaling of the bipolar signal (-1, 1) -> (a, b)--- --- > on a b biSig-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 :: SigSpace a => Sig -> Sig -> a -> a-uon a b = mapSig (\x -> a + (b - a) * x)   -------------------------------------------------------------------------- -- noise

@@ -6,7 +6,7 @@     boolToEvt, evtToBool, sigToEvt, evtToSig, stepper,     filterE, filterSE, accumSE, accumE, filterAccumE, filterAccumSE, -    Snap, snapshot, snaps, sync, syncBpm, +    Snap, snapshot, snaps, snaps2, sync, syncBpm,           -- * Opcodes     metroE, impulseE, changedE, triggerE, loadbang, impulse,@@ -92,6 +92,12 @@ -- | Splits a toggle event stream on on-events and off-events. splitToggle :: Evt D -> (Evt D, Evt D) splitToggle = swap . partitionE (==* 0)++-- | Constructs an event stream that contains pairs from the+-- given pair of signals. Events happens when any signal changes.+snaps2 :: Sig2 -> Evt (D, D)+snaps2 (x, y) = snapshot const (x, y) trigger+    where trigger = sigToEvt $ changed [x, y]  ---------------------------------------------------------------------- -- higher level evt-funs

@@ -1,4 +1,9 @@-{-# Language TypeSynonymInstances, FlexibleInstances #-}+{-# Language +    TypeSynonymInstances, +    FlexibleInstances, +    MultiParamTypeClasses, +    FlexibleContexts, +    TypeFamilies #-} -- | GUI (Graphical User Interface) elements are handy to change  -- the parameters of the sound in real time. It includes sliders,  -- knobs, rollers, buttons and other widgets. @@ -51,9 +56,10 @@     Gui,      Widget, Input, Output, Inner,     Sink, Source, Display, SinkSource,-    widget, sink, source, display, sinkSource,+    widget, sink, source, display, sinkSource, sinkSlice, sourceSlice,     mapSource, mapGuiSource,      mhor, mver, msca,+    joinSource,      -- * Panels     panel, win, panels, panelBy,@@ -66,10 +72,13 @@      -- * Lifters     -- | An easy way to combine visuals for sound sources.+    hlifts, vlifts,      lift1, hlift2, vlift2, hlift3, vlift3, hlift4, vlift4, hlift5, vlift5,      -- ** Lifters with visual scaling+    hlifts', vlifts',+     hlift2', vlift2', hlift3', vlift3', hlift4', vlift4', hlift5', vlift5' ) where @@ -80,7 +89,23 @@ import Csound.Control.Gui.Layout import Csound.Control.Gui.Props import Csound.Control.Gui.Widget+import Csound.SigSpace +instance SigSpace a => SigSpace (Source a) where+    mapSig f = mapSource (mapSig f)++instance (At Sig (SE Sig) a) => At Sig (SE Sig) (Source a) where+    type AtOut Sig (SE Sig) (Source a) = Source (AtOut Sig (SE Sig) a)+    at f a = mapSource (at f) a++instance (At Sig2 Sig2 a) => At Sig2 Sig2 (Source a) where+    type AtOut Sig2 Sig2 (Source a) = Source (AtOut Sig2 Sig2 a)+    at f a = mapSource (at f) a++instance (At Sig2 (SE Sig2) a) => At Sig2 (SE Sig2) (Source a) where+    type AtOut Sig2 (SE Sig2) (Source a) = Source (AtOut Sig2 (SE Sig2) a)+    at f a = mapSource (at f) a+ -- | Creates a window with the given name, size and content -- -- > win name (width, height) gui@@ -90,8 +115,43 @@ keyWin :: String -> (Int, Int) -> Gui -> SE () keyWin name (x, y) = keyPanelBy name (Just $ Rect 0 0 x y) +-- | Hides the SE inside Source.+joinSource :: Source (SE a) -> Source a+joinSource a = do+    (g, mv) <- a+    v <- mv+    return (g, v)+ ---------------------------------------------------------------------------------- -- easy grouppings for GUIs++-- | Groups a list of Source-widgets. The visuals are horizontally aligned.+hlifts :: ([a] -> b) -> [Source a] -> Source b+hlifts = genLifts hor++-- | Groups a list of Source-widgets. The visuals are vertically aligned.+vlifts :: ([a] -> b) -> [Source a] -> Source b+vlifts = genLifts ver++-- | Groups a list of Source-widgets. The visuals are horizontally aligned. +-- It uses the list of proportions.+hlifts' :: [Double] -> ([a] -> b) -> [Source a] -> Source b+hlifts' props = genLifts (applyProportionsToList props hor)++-- | Groups a list of Source-widgets. The visuals are vertically aligned.+-- It uses the list of proportions.+vlifts' :: [Double] -> ([a] -> b) -> [Source a] -> Source b+vlifts' props = genLifts (applyProportionsToList props ver)++applyProportionsToList :: [Double] -> ([Gui] -> Gui) -> [Gui] -> Gui+applyProportionsToList props f as = f $ zipWith sca (props ++ repeat 1) as++genLifts :: ([Gui] -> Gui) -> ([a] -> b) -> [Source a] -> Source b+genLifts gf f as = fmap phi $ sequence as+    where +        phi xs = (gf gs, f vs)+            where (gs, vs) = unzip xs+  -- | The shortcut for @mapSource@. lift1 :: (a -> b) -> Source a -> Source b

@@ -21,6 +21,7 @@     butBank1, butBankSig1,      radioButton, matrixButton, funnyRadio, funnyMatrix,     setNumeric, meter,+    setKnob, setSlider,     setToggle, setToggleSig,     -- * Transformers     setTitle,@@ -35,8 +36,19 @@     -- | Widgets for sample and hold functions     hnumbers, vnumbers, +    -- * Range widgets+    Range,+    rangeKnob, rangeSlider, rangeKnobSig, rangeSliderSig,+    rangeJoy, rangeJoy2, rangeJoySig,+     -- * The 2D matrix of widgets-    knobPad, togglePad, buttonPad, genPad+    knobPad, togglePad, buttonPad, genPad,++    -- * External control++    -- | The widgets can be controlled with external signals/event streams+    button', toggle', toggleSig', knob', slider', uknob', uslider',+    hradio', vradio', hradioSig', vradioSig' ) where  import Control.Monad@@ -48,7 +60,9 @@ import Csound.Typed.Gui import Csound.Typed.Types import Csound.Control.SE-import Csound.Control.Evt(listAt, Tick)+import Csound.SigSpace(uon)+import Csound.Control.Evt(listAt, Tick, snaps2, dropE, devt, loadbang, evtToSig)+import Csound.Typed.Opcode(changed)  -------------------------------------------------------------------- -- aux widgets@@ -133,21 +147,21 @@  -- | Exponential slider (usefull for exploring frequencies or decibels).  ----- > xknob min max initVal+-- > 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+xslider :: Range 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+-- > 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+xknob :: Range Double -> Double -> Source Sig+xknob (a, b) initVal = knob "" (expSpan a b) initVal  -- | Unit linear joystick. ujoy :: (Double, Double) -> Source (Sig, Sig)@@ -278,3 +292,193 @@     return (gcat guis, res)     where                 ids = fmap (sig . int) [0 .. length names - 1]++++-- | Pair of minimum and maximum values.+type Range a = (a, a)++-- | Creates a knob that outputs only integers in the given range.+-- It produces a signal of integer values.+--+-- > rangeKnobSig (min, max) initVal +rangeKnobSig :: Range Int -> Int -> Source Sig+rangeKnobSig = rangeSig1 uknob++-- | Creates a slider that outputs only integers in the given range.+-- It produces a signal of integer values.+--+-- > rangeSliderSig (min, max) initVal +rangeSliderSig :: Range Int -> Int -> Source Sig+rangeSliderSig = rangeSig1 uslider++-- | Creates a knob that outputs only integers in the given range.+-- It produces an event stream of integer values. It can be used with+-- list access functions @listAt@, @atTuple@, @atArg@.+--+-- > rangeKnob needInit (min, max) initVal+--+-- The first argument is a boolean. If it's true than the initial value+-- is put in the output stream. If it\s False the initial value is skipped.+rangeKnob :: Bool -> Range Int -> Int -> Source (Evt D)+rangeKnob = rangeEvt1 uknob++-- | Creates a slider that outputs only integers in the given range.+-- It produces an event stream of integer values. It can be used with+-- list access functions @listAt@, @atTuple@, @atArg@.+--+-- > rangeSlider needInit (min, max) initVal+--+-- The first argument is a boolean. If it's true than the initial value+-- is put in the output stream. If it\s False the initial value is skipped.+rangeSlider :: Bool -> Range Int -> Int -> Source (Evt D)+rangeSlider = rangeEvt1 uslider++rangeSig1 :: (Double -> Source Sig) -> Range Int -> Int -> Source Sig+rangeSig1 widget range initVal = mapSource (fromRelative range) $ widget $ toRelativeInitVal range initVal++rangeEvt1 :: (Double -> Source Sig) -> Bool -> Range Int -> Int -> Source (Evt D)+rangeEvt1 widget isInit range initVal = mapSource (addInit . snaps) $ rangeSig1 widget range initVal+    where+        addInit+            | isInit    = ((devt (int initVal) loadbang) <> )+            | otherwise = id++-- | 2d range range slider. Outputs a pair of event streams. +-- Each stream  contains changes in the given direction (Ox or Oy).+--+-- > rangeJoy needsInit rangeX rangeY (initX, initY)+--+-- The first argument is a boolean. If it's true than the initial value+-- is put in the output stream. If it\s False the initial value is skipped.+rangeJoy :: Bool -> Range Int -> Range Int -> (Int, Int) -> Source (Evt D, Evt D)+rangeJoy isInit rangeX rangeY initVals = mapSource (addInit . f) $ rangeJoySig rangeX rangeY initVals+    where +        f (x, y) = (snaps x, snaps y)           +        addInit+            | isInit    = id+            | otherwise = \(a, b) -> (dropE 1 a, dropE 1 b)++-- | 2d range range slider. It produces a single event stream. +-- The event fires when any signal changes.+--+-- > rangeJoy2 needsInit rangeX rangeY (initX, initY)+--+-- The first argument is a boolean. If it's true than the initial value+-- is put in the output stream. If it\s False the initial value is skipped.+rangeJoy2 :: Bool -> Range Int -> Range Int -> (Int, Int) -> Source (Evt (D, D))+rangeJoy2 isInit rangeX rangeY initVals = mapSource (addInit . snaps2) $ rangeJoySig rangeX rangeY initVals+    where+        addInit+            | isInit    = id+            | otherwise = dropE 1++-- | 2d range range slider. It produces the pair of integer signals+rangeJoySig :: Range Int -> Range Int -> (Int, Int) -> Source (Sig, Sig)+rangeJoySig rangeX rangeY (initValX, initValY) = mapSource f $ +    ujoy (toRelativeInitVal rangeX initValX, toRelativeInitVal rangeY initValY)+    where f (x, y) = (fromRelative rangeX x, fromRelative rangeY y)++toRelativeInitVal :: Range Int -> Int -> Double+toRelativeInitVal (kmin, kmax) initVal = (fromIntegral $ initVal - kmin) / (fromIntegral $ (kmax - 1) - kmin) ++fromRelative :: Range Int -> Sig -> Sig+fromRelative (kmin, kmax) = floor' . uon (f kmin) (f kmax - 0.01)+    where f = sig . int+++------------------------------------------------------------+-- external control of widgets++-- | It's like simple @button@, but it can be controlled with external control.+-- The first argument is for external control.+button' :: Tick -> String -> Source Tick+button' ctrl name = mapSource (mappend ctrl) $ button name++-- | It's like simple @toggle@, but it can be controlled with external control.+-- The first argument is for external control.+toggle' :: Evt D -> String -> Bool -> Source (Evt D)+toggle' ctrl name initVal = source $ do+    (gui, output, input) <- setToggle name initVal+    output ctrl+    return $ (gui, mappend ctrl input)++toggleSig' :: Sig -> String -> Bool -> Source Sig+toggleSig' ctrl name initVal = +    ctrlSig (if initVal then 1 else 0) ctrl $ setToggleSig name initVal++-- | It's like simple @uknob@, but it can be controlled with external control.+-- The first argument is for external control.+uknob' :: Sig -> Double -> Source Sig   +uknob' ctrl initVal = ctrlSig (double initVal) ctrl $ setKnob "" uspan initVal ++-- | It's like simple @uslider@, but it can be controlled with external control.+-- The first argument is for external control.+uslider' :: Sig -> Double -> Source Sig +uslider' ctrl initVal = ctrlSig (double initVal) ctrl $ setSlider "" uspan initVal ++-- | It's like simple @knob@, but it can be controlled with external control.+-- The first argument is for external control.+knob' :: Sig -> String -> ValSpan -> Double -> Source Sig+knob' ctrl name span initVal = ctrlSig (double initVal) ctrl $ setKnob name span initVal++-- | It's like simple @slider@, but it can be controlled with external control.+-- The first argument is for external control.+slider' :: Sig -> String -> ValSpan -> Double -> Source Sig+slider' ctrl name span initVal = ctrlSig (double initVal) ctrl $ setSlider name span initVal++-- | It's like simple @hradioSig@, but it can be controlled with external control.+-- The first argument is for external control.+hradioSig' :: Sig -> [String] -> Int -> Source Sig+hradioSig' = radioGroupSig' hor ++-- | It's like simple @vradioSig@, but it can be controlled with external control.+-- The first argument is for external control.+vradioSig' :: Sig -> [String] -> Int -> Source Sig+vradioSig' = radioGroupSig' ver++-- | It's like simple @hradio@, but it can be controlled with external control.+-- The first argument is for external control.+hradio' :: Evt D -> [String] -> Int -> Source (Evt D) +hradio' = radioGroup' hor ++-- | It's like simple @vradio@, but it can be controlled with external control.+-- The first argument is for external control.+vradio' :: Evt D -> [String] -> Int -> Source (Evt D)+vradio' = radioGroup' ver++radioGroup'  :: ([Gui] -> Gui) -> Evt D -> [String] -> Int -> Source (Evt D)+radioGroup' gcat ctrl names initVal =  mapSource snaps $ radioGroupSig' gcat (evtToSig (int initVal) ctrl) names initVal++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)   ++    when1 (changed [ctrl] ==* 1) $ writeSERef curRef ctrl++    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]+++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+    output res+    return (gui, res)+    

@@ -1,4 +1,4 @@-{-# Language TypeFamilies, FlexibleContexts, FlexibleInstances #-}+{-# Language TypeFamilies, FlexibleContexts, FlexibleInstances, ScopedTypeVariables #-} -- | We can convert notes to sound signals with instruments.  -- An instrument is a function: --@@ -87,7 +87,7 @@     withDur,      -- ** Misc-    alwaysOn,+    alwaysOn, playWhen,      -- * Overload     -- | Converters to make it easier a construction of the instruments.@@ -143,6 +143,16 @@             res <- instr x             runEvt offEvt $ const $ turnoff             return res++-- | Transforms an instrument from always on to conditional one. +-- The routput instrument plays only when condition is true otherwise+-- it produces silence.+playWhen :: forall a b. Sigs a => BoolSig -> (b -> SE a) -> (b -> SE a)+playWhen onSig instr msg = do+    ref <- newSERef (0 :: a)+    writeSERef ref 0+    when1 onSig $ writeSERef ref =<< instr msg+    readSERef ref  ------------------------------------------------------------------------- -------------------------------------------------------------------------

@@ -5,7 +5,7 @@         FlexibleInstances,          FlexibleContexts #-} module Csound.SigSpace(-    SigSpace(..), BindSig(..), mul, At(..), bat,+    SigSpace(..), BindSig(..), mul, on, uon, At(..), mixAt, bat,     cfd, cfd4, cfds, cfdSpec, cfdSpec4, cfdsSpec,      wsum         ) where@@ -15,7 +15,6 @@  import Csound.Typed import Csound.Types-import Csound.Control.Gui(Source, mapSource) import Csound.Typed.Opcode(pvscross, pvscale, pvsmix, balance)  -- | A class for easy way to process the outputs of the instruments.@@ -30,6 +29,21 @@ mul :: SigSpace a => Sig -> a -> a mul k = mapSig (k * ) +-- rescaling++-- | Rescaling of the bipolar signal (-1, 1) -> (a, b)+-- +-- > on a b biSig+on :: SigSpace a => Sig -> Sig -> a -> a+on a b x = uon a b $ mapSig unipolar x +    where unipolar a = 0.5 + 0.5 * a++-- | Rescaling of the unipolar signal (0, 1) -> (a, b)+-- +-- > on a b uniSig+uon :: SigSpace a => Sig -> Sig -> a -> a+uon a b = mapSig (\x -> a + (b - a) * x) + -- | Crossfade. -- -- > cfd coeff sig1 sig2@@ -111,10 +125,6 @@ instance SigSpace (SE (Sig, Sig, Sig, Sig)) where mapSig  f = fmap (mapSig f) instance BindSig  (SE (Sig, Sig, Sig, Sig)) where bindSig f = fmap (bindSig f) -instance SigSpace a => SigSpace (Source a) where-    mapSig f = mapSource (mapSig f)-- ----------------------------------------------------- -- numeric instances @@ -298,9 +308,16 @@     type AtOut a b c :: *     at :: (a -> b) -> c -> AtOut a b c +-- | It applies an effect and balances the processed signal by original one. bat :: At Sig a b => (Sig -> a) -> b -> AtOut Sig a b bat f = at (\x -> mapSig ( `balance` x) $ f x) +-- | It applies an effect and mixes the processed signal with original one.+-- The first argument is for proportion of dry/wet (original/processed).+-- It's like @at@ but it allows to balance processed signal with original one.+mixAt :: (At a b c, c ~ AtOut a b c, SigSpace c, Num c) => Sig -> (a -> b) -> c -> c+mixAt k f a = cfd k a (at f a)+ instance SigSpace a => At Sig Sig a where     type AtOut Sig Sig a = a     at f a = mapSig f a@@ -361,10 +378,6 @@  ---------------------------------------------------------    -instance (At Sig (SE Sig) a) => At Sig (SE Sig) (Source a) where-    type AtOut Sig (SE Sig) (Source a) = Source (AtOut Sig (SE Sig) a)-    at f a = mapSource (at f) a- ---------------------------------------------------------    -- Sig2 -> Sig2 @@ -406,12 +419,3 @@     at f a = f =<< a  ---------------------------------------------------------   --instance (At Sig2 Sig2 a) => At Sig2 Sig2 (Source a) where-    type AtOut Sig2 Sig2 (Source a) = Source (AtOut Sig2 Sig2 a)-    at f a = mapSource (at f) a--instance (At Sig2 (SE Sig2) a) => At Sig2 (SE Sig2) (Source a) where-    type AtOut Sig2 (SE Sig2) (Source a) = Source (AtOut Sig2 (SE Sig2) a)-    at f a = mapSource (at f) a-