csound-expression 4.3 → 4.4

raw patch · 19 files changed

+1030/−140 lines, 19 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 +5/−3
• src/Csound/Air.hs +8/−0
• src/Csound/Air/Envelope.hs +71/−9
• src/Csound/Air/Filter.hs +124/−5
• src/Csound/Air/Misc.hs +15/−1
• src/Csound/Air/Sampler.hs +219/−0
• src/Csound/Air/Seg.hs +234/−0
• src/Csound/Air/Wav.hs +14/−2
• src/Csound/Air/Wave.hs +32/−2
• src/Csound/Base.hs +2/−0
• src/Csound/Control/Evt.hs +44/−3
• src/Csound/Control/Gui.hs +0/−6
• src/Csound/Control/Gui/Widget.hs +10/−2
• src/Csound/Control/Instr.hs +16/−6
• src/Csound/Control/Midi.hs +81/−60
• src/Csound/IO.hs +7/−5
• src/Csound/Options.hs +8/−1
• src/Csound/SigSpace.hs +138/−34
• src/Csound/Types.hs +2/−1

@@ -1,5 +1,5 @@ Name:          csound-expression-Version:       4.3+Version:       4.4 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.1, csound-expression-opcodes >= 0.0.1+        csound-expression-typed >= 0.0.7.0, csound-expression-opcodes >= 0.0.1   Hs-Source-Dirs:      src/   Exposed-Modules:         Csound.Base@@ -81,8 +81,10 @@         Csound.Air.Spec         Csound.Air.Fx         Csound.Air.Live+        Csound.Air.Seg+        Csound.Air.Sampler         Csound.Air.Misc-+                 Csound.Types         Csound.Tab         Csound.SigSpace

@@ -21,6 +21,12 @@     -- | Widgets to make live performances.     module Csound.Air.Live,   +    -- | Scheduling signals with event streams+    module Csound.Air.Seg,++    -- | Triggering sound samples with events, keyboard and midi.+    module Csound.Air.Sampler,+     -- | Other usefull stuff.     module Csound.Air.Misc ) where@@ -32,4 +38,6 @@ import Csound.Air.Spec import Csound.Air.Fx import Csound.Air.Live+import Csound.Air.Seg+import Csound.Air.Sampler import Csound.Air.Misc

@@ -9,6 +9,7 @@     holdSeq, linSeq, expSeq,     linloop, exploop, sah, stepSeq,      constSeq, triSeq, sqrSeq, sawSeq, isawSeq, xsawSeq, ixsawSeq, isqrSeq, xtriSeq,+    pwSeq, ipwSeq, rampSeq, irampSeq, xrampSeq, ixrampSeq,     adsrSeq, xadsrSeq, adsrSeq_, xadsrSeq_,        -- * Faders@@ -176,7 +177,7 @@  -- | Step sequencer with unipolar triangle. triSeq :: [Sig] -> Sig -> Sig-triSeq as cps = genSeq loopseg triList as (2 * cps)+triSeq as cps = genSeq loopseg triList as cps  -- | Step sequencer with unipolar square. sqrSeq :: [Sig] -> Sig -> Sig@@ -204,20 +205,78 @@  -- | Step sequencer with unipolar exponential triangle. xtriSeq :: [Sig] -> Sig -> Sig-xtriSeq as cps = genSeq loopxseg triList as (2 * cps)+xtriSeq as cps = genSeq loopxseg triList as (cps) +-- | A sequence of unipolar waves with pulse width moulation (see upw).+-- The first argument is a duty cycle in range 0 to 1.+pwSeq :: Sig -> [Sig] -> Sig -> Sig+pwSeq duty = genSeq lpshold (pwList duty)++-- | A sequence of unipolar inverted waves with pulse width moulation (see upw).+-- The first argument is a duty cycle in range 0 to 1.+ipwSeq :: Sig -> [Sig] -> Sig -> Sig+ipwSeq duty = genSeq lpshold (ipwList duty)++-- | A sequence of unipolar triangle waves with ramp factor (see uramp).+-- The first argument is a ramp factor cycle in range 0 to 1.+rampSeq :: Sig -> [Sig] -> Sig -> Sig+rampSeq duty xs = genSeq loopseg (rampList (head xs) duty) xs++-- | A sequence of unipolar exponential triangle waves with ramp factor (see uramp).+-- The first argument is a ramp factor cycle in range 0 to 1.+xrampSeq :: Sig -> [Sig] -> Sig -> Sig+xrampSeq duty xs = genSeq loopxseg (rampList (head xs) duty) xs++-- | A sequence of unipolar inverted triangle waves with ramp factor (see uramp).+-- The first argument is a ramp factor cycle in range 0 to 1.+irampSeq :: Sig -> [Sig] -> Sig -> Sig+irampSeq duty xs = genSeq loopseg (irampList (head xs) duty) xs++-- | A sequence of unipolar inverted exponential triangle waves with ramp factor (see uramp).+-- The first argument is a ramp factor cycle in range 0 to 1.+ixrampSeq :: Sig -> [Sig] -> Sig -> Sig+ixrampSeq duty xs = genSeq loopxseg (irampList (head xs) duty) xs++ sawList xs = case xs of-    []  -> []           +    []  -> []       +    [a] -> a : 1 : 0 : []     a:rest -> a : 1 : 0 : 0 : sawList rest          isawList xs = case xs of-    []  -> []           +    []  -> []  +    [a] -> 0 : 1 : a : []     a:rest -> 0 : 1 : a : 0 : isawList rest  triList xs = case xs of     [] -> [0, 0]     a:rest -> 0 : 1 : a : 1 : triList rest  +pwList k xs = case xs of+    []   -> []+    a:as -> a : k : 0 : (1 - k) : pwList k as++ipwList k xs = case xs of+    []   -> []+    a:as -> 0 : k : a : (1 - k) : ipwList k as++rampList a1 duty xs = case xs of+    [] -> []+    [a] -> 0.5 * a : d1 : a : d1 : 0.5 * a : d2 : 0 : d2 : 0.5 * a1 : []+    a:as -> 0.5 * a : d1 : a : d1 : 0.5 * a : d2 : 0 : d2 : rampList a1 duty as  +    where +        d1 = duty / 2+        d2 = (1 - duty) / 2++irampList a1 duty xs = case xs of+    [] -> []+    [a] -> 0.5 * a : d1 : 0 : d1 : 0.5 * a : d2 : a : d2 : 0.5 * a1 : []+    a:as -> 0.5 * a : d1 : 0 : d1 : 0.5 * a : d2 : a : d2 : rampList a1 duty as  +    where +        d1 = duty / 2+        d2 = (1 - duty) / 2++ ------------------------------------------------------------------  genSeq :: ([Sig] -> Sig -> Sig) -> ([Sig] -> [Sig]) -> [Sig] -> Sig -> Sig@@ -233,8 +292,11 @@ ------------------------------------------------------------------  smooth :: Sig -> Sig-smooth = slide 0.001+smooth = flip portk 0.001 +fixEnd :: [Sig] -> [Sig]+fixEnd = ( ++ [0])+ -- | Looping sample and hold envelope. The first argument is the list of pairs: -- -- > [a, durA, b, durB, c, durc, ...]@@ -257,7 +319,7 @@ --  -- > loopseg valDurs frequency loopseg :: [Sig] -> Sig -> Sig-loopseg as cps = smooth $ C.loopseg cps 0 0 as+loopseg as cps = smooth $ C.loopseg cps 0 0 (fixEnd as)  -- | Looping exponential segments envelope. The first argument is the list of pairs: --@@ -269,7 +331,7 @@ --  -- > loopxseg valDurs frequency loopxseg :: [Sig] -> Sig -> Sig-loopxseg as cps = smooth $ C.loopxseg cps 0 0 as+loopxseg as cps = smooth $ C.loopxseg cps 0 0 (fixEnd as)  -- | It's like lpshold but we can specify the phase of repetition (phase belongs to [0, 1]). lpsholdBy :: D -> [Sig] -> Sig -> Sig@@ -277,11 +339,11 @@  -- | 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+loopsegBy phase as cps = smooth $ C.loopseg cps 0 phase (fixEnd 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+loopxsegBy phase as cps = smooth $ C.loopxseg cps 0 phase (fixEnd as)  -- | The looping ADSR envelope. --

@@ -1,21 +1,36 @@ -- | Filters module Csound.Air.Filter(     -- | Arguemnts are inversed to get most out of curruing. First come parameters and the last one is the signal.-    ++    -- * First order filters+    lp1, hp1,+     -- * Simple filters     lp, hp, bp, br, alp,+    bp2, br2,          -- * Butterworth filters     blp, bhp, bbp, bbr, +    -- * Filter order+    ResonFilter, FlatFilter,+    filt, flatFilt,+     -- * Specific filters-    mlp, +    -- ** Moog filters+    mlp, mlp2, mlp3, lp18,++    -- ** Formant filters+    formant, singA, singO, singE, singU, singO2,+     -- * Making the smooth lines-    slide+    smooth, slide+ ) where  import Csound.Typed+import Csound.SigSpace(bat) import Csound.Typed.Opcode  -- | Low-pass filter.@@ -81,9 +96,113 @@ mlp :: Sig -> Sig -> Sig -> Sig mlp cf q asig = moogladder asig cf q +-- | Makes slides 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 lineto  -- | 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+smooth :: Sig -> Sig -> Sig+smooth = flip portk++-- | Resonant filter.+-- +-- > f centerFreq q asig+type ResonFilter = Sig -> Sig -> Sig -> Sig++-- | Filter without a resonance.+-- +-- > f centerFreq q asig+type FlatFilter  = Sig -> Sig -> Sig++-- | Applies a filter n-times. The n is given in the first rgument.+filt :: Int -> ResonFilter -> ResonFilter+filt n f cfq q asig = (foldl (.) id $ replicate n (f cfq q)) asig++-- | Applies a flat filter (without resonance) n-times. The n is given in the first rgument.+flatFilt :: Int -> FlatFilter -> FlatFilter+flatFilt n f cfq asig = (foldl (.) id $ replicate n (f cfq)) asig++-- spec filt++-- | Low pass filter 18 dB  with built in distortion module.+--+-- > lp18 distortion centerFreq resonance asig+--+-- * distortion's range is 0 to 1+--+-- * resonance's range is 0 to 1+lp18 :: Sig -> Sig -> Sig -> Sig -> Sig+lp18 dist cfq q asig = lpf18 asig cfq q dist++-- | Another implementation of moog low pass filter (it's moogvcf in Csound).+-- The arguments have are just like in the @mlp@ filter.+mlp2 :: Sig -> Sig -> Sig -> Sig+mlp2 cfq q asig = moogvcf asig cfq q++-- | Mooglowpass filter with 18 dB.+mlp3 :: Sig -> Sig -> Sig -> Sig+mlp3 = lp18 0++-- | First order low pass filter (tone in Csound, 6 dB)+--+-- > lp1 centerFreq asig+lp1 :: Sig -> Sig -> Sig+lp1 cfq asig = tone asig cfq++-- | First order high pass filter (atone in Csound, 6 dB)+--+-- > hp1 centerFreq asig+hp1 :: Sig -> Sig -> Sig+hp1 cfq asig = atone asig cfq++-- | Resonance band pass filter (yet another implementation, it's reson in Csound) +--+-- > bp2 centerFreq q asig+bp2 :: Sig -> Sig -> Sig -> Sig+bp2 cfq q asig = reson asig cfq q++-- | Resonance band reject filter (yet another implementation, it's areson in Csound) +--+-- > br2 centerFreq q asig+br2 :: Sig -> Sig -> Sig -> Sig+br2 cfq q asig = areson asig cfq q++-- | Formant filter.+--+-- > formant bandPassFilter formants asig+--+-- It expects a band pass filter, a list of formants and processed signal.+-- The signal is processed with each filter the result is a sum of all proceessed signals.+-- Formant filters are used to mimic the vocalization of the sound.+formant :: ResonFilter -> [(Sig, Sig)] -> Sig -> Sig+formant f qs asig = sum (fmap (( $ asig) . uncurry f) qs)++-- | Formant filter that sings an A.+singA :: Sig -> Sig+singA = bat (formant bp2 anA)++-- | Formant filter that sings an O.+singO :: Sig -> Sig+singO = bat (formant bp2 anO)++-- | Formant filter that sings an E.+singE :: Sig -> Sig+singE = bat (formant bp2 anE)++-- | Formant filter that sings an U.+singU :: Sig -> Sig+singU = bat (formant bp2 anIY)++-- | Formant filter that sings an O.+singO2 :: Sig -> Sig+singO2 = bat (formant bp2 anO2)++anO  = [(280, 20), (650, 25), (2200, 30), (3450, 40), (4500, 50)]+anA  = [(650, 50), (1100, 50), (2860, 50), (3300, 50), (4500, 50)] +anE  = [(500, 50), (1750, 50), (2450, 50), (3350, 50), (5000, 50)]+anIY = [(330, 50), (2000, 50), (2800, 50), (3650, 50), (5000, 50)]+anO2 = [(400, 50), (840, 50), (2800, 50), (3250, 50), (4500, 50)]

@@ -15,7 +15,10 @@     arpeggi, arpBy,      -- * GUI-    lpJoy+    lpJoy,++    -- * Function composition+    funSeq, funPar ) where  import Data.Boolean@@ -203,3 +206,14 @@ -- 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)+++-- | Chains all functions in the list.+funSeq :: [a -> a] -> a -> a+funSeq = foldl (.) id++-- | Applies all functions in the list to the given input+-- and summs them up.+funPar :: Num a => [a -> a] -> a -> a+funPar fs a = sum $ fmap ($ a) fs+

@@ -0,0 +1,219 @@+module Csound.Air.Sampler (++	-- * Event sampler++	-- | Note: The release phase of the instrument is skipped+	-- with event sampler functions.+	evtTrig, evtTap, evtGroup, evtCycle,++	-- * Keyboard sampler+	charTrig, charTap, charPush, charToggle, charGroup, charCycle,++    -- * Midi sampler+    midiTrig, midiTap, midiPush, midiToggle, midiGroup, ++    -- * Generic functions+    midiTrigBy, midiTapBy, midiPushBy, midiToggleBy, midiGroupBy,++    -- ** Midi instruments+    MidiTrigFun, midiAmpInstr, midiLpInstr, midiAudioLpInstr, midiConstInstr+) where++import Data.Monoid+import Data.Boolean++import Csound.Typed+import Csound.Control+import Csound.SigSpace++import Csound.Air.Filter(mlp)+import Csound.Air.Wav(takeSnd)+import Csound.Air.Seg++-----------------------------------------------------------+-- 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 $ sloop $ slim st $ sdel x $ sloop (slim x $ toSeg a)++-- | Toggles the signal with event stream.+evtToggle :: (Sigs a) => Tick -> a -> a+evtToggle evt = evtTrig (fmap (const unit) ons) (fmap (const unit) offs)+	where (offs, ons) = splitToggle $ toTog 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+-- but it's best to limit them anyway+evtTap :: (Sigs a) => D -> Tick -> a -> a+evtTap dt x a = runSeg $ sdel x $ sloop $ slim x $ toSeg $ takeSnd dt a++-- | 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) +	$ 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) ++-- | Triggers one signal after another with an event stream.+evtCycle :: (Sigs a) => Tick -> Tick -> [a] -> a+evtCycle start stop sigs = runSeg $ sloop $ slim stop $ sdel start $ sloop $ sflow $ fmap (slim start . toSeg) 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 $ sloop $ slim (strOn stops) $ toSeg $ retrig (const $ return asig) (strOn starts)++-- | Plays a signal while a key is pressed.+charPush :: Sigs a => Char -> a -> a+charPush ch = evtTrigger (charOn ch) (charOff ch)++-- | Toggles the signal when key is pressed.+charToggle :: (Sigs a) => Char -> a -> a+charToggle key asig = retrig (togInstr asig) +	$ accumE (1 :: D) (\_ s -> (s, mod' (s + 1) 2)) +	$ charOn key+	where +		togInstr asig isPlay = do+			ref <- newSERef 0+			when1 (sig isPlay ==* 1) $ do+				writeSERef ref asig+			readSERef ref++-- | 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)++-- | 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			++-- | 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) ++---------------------------------------------------------------------++evtTrigger :: (Sigs a) => Tick -> Tick -> a -> a+evtTrigger ons offs asig = schedUntil (const $ return asig) ons offs++----------------------------------------------------------+-- Midi sampler++type MidiTrigFun a = a -> D -> SE a++-- | Scales the signal with the amplitude.+midiAmpInstr :: (SigSpace a, Sigs a) => a -> D -> SE a+midiAmpInstr asig amp = return $ mul (sig amp) asig++-- | Applies a low pass filter to the signal.+-- The first two arguments are the frequency range for center frequency of the filter+-- and the second one is amount of resonance (ranges from 0 to 1).+midiLpInstr :: (SigSpace a, Sigs a) => (Sig, Sig) -> Sig -> a -> D -> SE a+midiLpInstr (minC, maxC) q asig amp = return $ mapSig (mlp (minC * ((maxC / minC) ** sig amp) ) q) asig++-- | the midiLpInstr with audio range for center frequency.+midiAudioLpInstr :: (SigSpace a, Sigs a) => Sig -> a -> D -> SE a+midiAudioLpInstr = midiLpInstr (50, 10000)++-- | Ignores the amplitude and justplays back the original signal.+midiConstInstr :: (SigSpace a, Sigs a) => a -> D -> SE a+midiConstInstr asig amp = return asig++-- | Plays a signal when the key is pressed. Retriggers the signal when the key is pressed again.+-- The key is an integer midi code. The C1 is 60 and the A1 is 69.+midiTrig :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a+midiTrig = midiTrigBy midiAmpInstr++-- | Plays a signal when the key is pressed. Retriggers the signal when the key is pressed again.+-- Turns off the signal after specified duration (n seconds).+-- The key is an integer midi code. The C1 is 60 and the A1 is 69.+midiTap :: (SigSpace a, Sigs a) => MidiChn -> D -> Int -> a -> SE a+midiTap = midiTapBy midiAmpInstr++-- | Plyas a signal while the key is pressed.+-- The key is an integer midi code. The C1 is 60 and the A1 is 69.+midiPush :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a+midiPush = midiPushBy midiAmpInstr++-- | Plays and stops a signal in the toggle mode. +-- The key is an integer midi code. The C1 is 60 and the A1 is 69.+midiToggle :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a+midiToggle = midiToggleBy midiAmpInstr++-- | Plays a set of signals on the list of keys. When certain +-- key is pressed the corresponding signal starts to play and all+-- the rest are stopped. +--+-- -- The key is an integer midi code. The C1 is 60 and the A1 is 69.+midiGroup :: (SigSpace a, Sigs a) => MidiChn -> [(Int, a)] -> SE a+midiGroup = midiGroupBy midiAmpInstr++-- | The generic midiTrig. We can specify the midi function.+-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).+-- It produces some output. The default is scaling the signal with the amplitude.+midiTrigBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a+midiTrigBy midiInstr midiChn key asig = fmap (\evt -> retrig (midiInstr asig) evt) (midiKeyOn midiChn $ int key)++-- | The generic midiTap. We can specify the midi function.+-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).+-- It produces some output. The default is scaling the signal with the amplitude.+midiTapBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> D -> Int -> a -> SE a+midiTapBy midiInstr midiChn dt key asig = midiTrigBy midiInstr midiChn key (takeSnd dt asig)++-- | The generic midiPush. We can specify the midi function.+-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).+-- It produces some output. The default is scaling the signal with the amplitude.+midiPushBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a+midiPushBy midiInstr midiChn key asig = do+	ons  <- midiKeyOn midiChn (int key)+	offs <- midiKeyOff midiChn (int key)+	return $ midiEvtTriggerBy midiInstr ons offs asig	++-- | The generic midiToggle. We can specify the midi function.+-- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1).+-- It produces some output. The default is scaling the signal with the amplitude.+midiToggleBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a+midiToggleBy midiInstr midiChn key asig = fmap (\evt -> retrig (togMidiInstr asig) evt) +	(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+			when1 (sig isPlay ==* 1) $ do+				writeSERef ref =<< midiInstr asig amp+			readSERef 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).+-- It produces some output. The default is scaling the signal with the amplitude.+midiGroupBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> [(Int, a)] -> SE a+midiGroupBy midiInstr midiChn as = fmap sum $ mapM f as+	where +		allKeys = fmap fst as+		f (key, asig) = do+			ons  <- midiKeyOn midiChn (int key)+			offs <- fmap (fmap (const unit) . mconcat) $ mapM (midiKeyOn midiChn . int) allKeys+			return $ midiEvtTriggerBy midiInstr ons offs asig++midiEvtTriggerBy :: (SigSpace a, Sigs a) => (a -> D -> SE a) -> Evt D -> Tick -> a -> a+midiEvtTriggerBy midiInstr ons offs asig = schedUntil (midiAmpInstr asig) ons offs

@@ -0,0 +1,234 @@+module Csound.Air.Seg (+	Seg, toSeg, runSeg,+	slim, sflow, spar, sloop, +	sdel, srest, +	constLim, constDel, constRest, limSnd+) where++import Data.Maybe+import Data.Monoid+import Data.Boolean++import Csound.Typed+import Csound.SigSpace+import Csound.Control++import Csound.Air.Wav hiding (Loop)++-- | A segment of the signal. +-- The signal segment is a limited span of signal in time.+-- The time can be measured in seconds or in events!+-- The time span which is measured in events is the first+-- occurence of the event in the event stream. +--+-- There are handy functions for scheduling the signal segments.+-- we can delay the segment or loop over it or limit it with tme interval+-- or play a sequence of segments. The main feature of the segments is the+-- ability to schedule the signals with event streams (like button clicks or midi-events). +data Seg a +	= Unlim a+	| Lim Tick (Seg a)+	| ConstLim D (Seg a)+	| Seq [Seg a]+	| Par [Seg a]+	| Loop (Seg a)++instance Functor Seg where+	fmap f x = case x of+		Unlim a -> Unlim $ f a+		Lim dt a -> Lim dt $ fmap f a+		ConstLim dt a -> ConstLim dt $ fmap f a+		Seq as  -> Seq $ fmap (fmap f) as+		Par as  -> Par $ fmap (fmap f) as+		Loop a  -> Loop $ fmap f a++instance SigSpace a => SigSpace (Seg a) where+	mapSig f x = fmap (mapSig f) x++seq1 :: Tick -> a -> Seg a+seq1 dt a = Lim dt (Unlim a)++-- | Converts signals to segments.+-- The segment is not limited in length.+toSeg :: a -> Seg a+toSeg a = Unlim a++-- | Limits the length of the segment with event stream.+slim :: Tick -> Seg a -> Seg a+slim da x = case x of+	Par as   -> Par (fmap (slim da) as)+	_        -> Lim da x++-- | Limits the length of the segment with constant length in seconds.+constLim :: D -> Seg a -> Seg a+constLim da x = case x of+	Par as   -> Par (fmap (constLim da) as)+	_        -> ConstLim da x++-- | Plays the sequence of segments one ofter another.+sflow :: [Seg a] -> Seg a+sflow as = Seq $ flatten =<< as+	where +		flatten x = case x of+			Seq as -> as+			_      -> [x]++-- | Plays a list of segments at the same time.+-- the total length equals to the biggest length of all segments.+spar :: [Seg a] -> Seg a+spar as = Par $ flatten =<< as+	where +		flatten x = case x of+			Par as -> as+			_      -> [x]++-- | Loops over a segment. The segment should be limited for loop to take effect.+sloop :: Seg a -> Seg a+sloop x = case x of+	Unlim a -> Unlim a+	Loop a  -> Loop a+	Par as  -> Par (fmap sloop as)+	_       -> Loop x+++-- | Limits a signal with an event stream and retriggers it after stop.+limSnd :: Sigs a => Tick -> a -> a+limSnd dt = runSeg . sloop . slim dt . toSeg++------------------------------------------------++-- | Converts segments to signals.+runSeg :: (Sigs a) => Seg a -> a+runSeg x = case x of+	Unlim a -> a++	Lim dt (Unlim a) -> elim dt a+	Lim dt (Seq as)  -> uncurry (evtLoopOnce (Just dt)) (getEvtAndSig $ rmTailAfterUnlim as)	+	Lim dt (Loop (Seq as)) -> uncurry (evtLoop (Just dt)) (getEvtAndSig $ rmTailAfterUnlim as)+	Lim dt (Loop a) -> elim dt (runSeg (Loop a))+	Lim dt a -> elim dt (runSeg a)+++	ConstLim dt (Unlim a) -> takeSnd dt a+	ConstLim dt (Seq as)  -> uncurry (evtLoopOnce (Just $ impulseE dt)) (getEvtAndSig $ rmTailAfterUnlim as)	+	ConstLim dt (Loop (Seq as)) -> uncurry (evtLoop (Just $ impulseE dt)) (getEvtAndSig $ rmTailAfterUnlim as)+	ConstLim dt (Loop a) -> takeSnd dt (runSeg (Loop a))+	ConstLim dt a -> takeSnd dt (runSeg a)++	Seq as -> uncurry (evtLoopOnce Nothing) (getEvtAndSig $ rmTailAfterUnlim as)++	Loop (ConstLim dt a) -> repeatSnd dt $ runSeg a+	Loop (Lim dt a)      -> evtLoop Nothing [return $ runSeg a] [dt]+	Loop (Seq as)            -> uncurry (evtLoop Nothing) (getEvtAndSig as)++	Par as -> maybeElim (getDur x) $ sum $ fmap (\a -> maybeElim (getDur a) $ runSeg a) as++getDur :: Seg a -> Maybe (Either D Tick)+getDur x = case x of+	Unlim _ -> Nothing+	Loop  _ -> Nothing +	Lim dt _ -> Just $ Right dt+	ConstLim dt _ -> Just $ Left dt+	Seq as -> fromListT sum aftT' as+	Par as -> fromListT (foldl1 maxB) simT' as+	where +		fromListT g f as +			| all isJust ds = Just $ phi g f $ fmap fromJust ds+			| otherwise     = Nothing +			where ds = fmap getDur as++		phi g f xs+			| all isJust as = Left  $ g $ fmap fromJust as+			| otherwise     = Right $ f $ fmap toEvt xs+			where as = fmap getConstT xs++		getConstT x = case x of+			Left d -> Just d+			_      -> Nothing++		toEvt = either impulseE id++getEvtAndSig :: (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick])+getEvtAndSig as = unzip $ fmap (\x -> (return (runSeg x), getTick $ getDur x)) as+	where getTick = maybe mempty (either impulseE id)+++rmTailAfterUnlim :: [Seg a] -> [Seg a]+rmTailAfterUnlim = takeByIncludeLast isUnlim +	where +		isUnlim x = case x of+			Unlim _ -> True+			Loop  _ -> True+			Par  as -> any isUnlim as+			_       -> False ++takeByIncludeLast :: (a -> Bool) -> [a] -> [a]+takeByIncludeLast f xs = case xs of+	[] -> []+	a:as -> if f a then [a] else a : takeByIncludeLast f as++-------------------------------------------------+-- aux++-- | A pause. Plays nothing until something happens on the event stream.+srest :: (Num a) => Tick -> Seg a+srest dt = seq1 dt 0++-- | Delays a segment until something happens on the event stream.+sdel :: (Sigs a, Num a) => Tick -> Seg a -> Seg a+sdel dt a = sflow [srest dt, a]++-- | A pause. Plays nothing for the given time interval in seconds.+constRest :: Num a => D -> Seg a+constRest dt = constLim dt $ toSeg 0++-- | Delays a segment by a given time interval in seconds.+constDel :: Num a => D -> Seg a -> Seg a+constDel dt a = sflow [constRest dt, a]++-----------------------------------------------------------++elim :: Sigs a => Tick -> a -> a+elim dt asig = schedUntil (const $ return $ asig) (impulseE 0) dt++maybeElim :: (Num a, Sigs a) => Maybe (Either D Tick) -> a -> a+maybeElim mdt a = case mdt of+	Nothing -> a+	Just x  -> case x of +		Left d  -> takeSnd d a+		Right t -> elim t a++-- | Takes the first event from the event stream and ignores the rest of the stream.+take1 :: Evt a -> Evt a+take1 = fmap fst . filterE ((==* 0) . snd) . accumE (0 :: D) (\a s -> ((a, s), s + 1) )++-----------------------------------------------------------+-- tick funs with less instrs++aftT' :: [Tick] -> Tick+aftT' evts = take1 $ sigToEvt $ evtLoop Nothing asigs evts+	where +		asigs :: [SE Sig]+		asigs = fmap (return . sig) $ (replicate (length evts - 1) 0) ++ [1]++simT' :: [Tick] -> Tick+simT' as = Evt $ \bam -> do+	isAwaitingRef <- newSERef (1 :: D)+	countDownRef  <- newSERef (int (length as) :: D)++	mapM_ (mkEvt countDownRef) as++	countDown <- readSERef countDownRef+	isAwaiting <- readSERef isAwaitingRef+	when1 (sig isAwaiting ==* 1 &&* sig countDown ==* 0) $ do+		bam unit+		writeSERef isAwaitingRef 0+	where +		mkEvt ref e = do+			notFiredRef <- newSERef (1 :: D)+			notFired <- readSERef notFiredRef+			runEvt e $ \_ -> do+				when1 (sig notFired ==* 1) $ do+					writeSERef notFiredRef 0+					modifySERef ref (\x -> x - 1)+

@@ -24,7 +24,7 @@     lengthSnd, segments,      -- * Signal manipulation-    takeSnd, delaySnd, afterSnd, segmentSnd, repeatSnd, toMono+    takeSnd, delaySnd, afterSnd, lineSnd, loopLineSnd, segmentSnd, repeatSnd, toMono ) where  import Data.List(isSuffixOf)@@ -49,7 +49,7 @@  -- | Delays signals by the given amount (in seconds). delaySnd :: Sigs a => D -> a -> a-delaySnd dt asig = trigs (const $ return asig) $ eventList [(dt, -1, unit)]+delaySnd dt asig = trigs (const $ return asig) $ eventList [(dt, infiniteDur, unit)]  -- | Delays a signal by the first argument and takes only second argument amount -- of signal (everything is measured in seconds).@@ -65,6 +65,18 @@ -- > afterSnd dur sig1 sig2 afterSnd :: (Num b, Sigs b) => D -> b -> b -> b afterSnd dt a b = takeSnd dt a + delaySnd dt b++-- | Creates a sequence of signals. Each segment lasts for +-- fixed amount of time given in the first argument.+lineSnd :: (Num a, Sigs a) => D -> [a] -> a+lineSnd dt xs = foldr1 go xs+    where+        go a b = afterSnd dt a b++-- | Creates a sequence of signals and loops over the sequence. +-- Each segment lasts for  fixed amount of time given in the first argument.+loopLineSnd :: (Num a, Sigs a) => D -> [a] -> a+loopLineSnd dt xs = repeatSnd (dt * (int $ length xs)) $ lineSnd dt xs  -------------------------------------------------------------------------- -- sound files playback

@@ -2,14 +2,17 @@ -- A waveform function takes in a time varied frequency (in Hz). module Csound.Air.Wave ( 	 -- * Bipolar-    osc, oscBy, saw, isaw, pulse, sqr, tri, blosc,+    osc, oscBy, saw, isaw, pulse, sqr, pw, tri, ramp, blosc,      -- * Unipolar-    unipolar, bipolar, on, uon, uosc, uoscBy, usaw, uisaw, upulse, usqr, utri, ublosc,+    unipolar, bipolar, on, uon, uosc, uoscBy, usaw, uisaw, upulse, usqr, upw, utri, uramp, ublosc,      -- * Noise     rndh, urndh, rndi, urndi, white, pink, +    -- * Frequency modulation+    fosc,+     -- * Low frequency oscillators     Lfo, lfo ) where@@ -68,6 +71,33 @@ -- | Unipolar band-limited oscillator. ublosc :: Tab -> Sig -> Sig ublosc tb = unipolar . blosc tb++-- | Frequency modulation+--+-- > fosc carrierFreq modulatorFreq modIndex cps+fosc :: Sig -> Sig -> Sig -> Sig -> Sig+fosc car mod ndx cps = foscili 1 cps car mod ndx sine++-- | Pulse width modulation (width range is 0 to 1)+--+-- > pw dutyCycle cps+pw :: Sig -> Sig -> Sig+pw duty cps = vco2 1 cps `withD` 2 `withSig` duty++-- | Triangle wave with ramp factor (factor's range is 0 to 1)+--+-- > ramp factor cps+ramp :: Sig -> Sig -> Sig+ramp duty cps = vco2 1 cps `withD` 4 `withSig` (uon 0.01 0.99 $ duty)++-- | Unipolar pulse width modulation wave.+upw :: Sig -> Sig -> Sig+upw duty cps = unipolar $ pw duty cps++-- | Unipolar triangle wave with ram factor.+uramp :: Sig -> Sig -> Sig+uramp duty cps = unipolar $ ramp duty cps+  -- rescaling 

@@ -18,6 +18,7 @@     module Data.Boolean,     module Data.Default,     module Data.Monoid,+    module Control.Applicative,      -- * Opcodes     module Csound.Typed.Opcode@@ -34,6 +35,7 @@ import Data.Boolean import Data.Default import Data.Monoid+import Control.Applicative hiding ((<*))      import Csound.Typed.Opcode hiding (button, display, space, lfo, initc7, ctrl7, oscInit, oscListen, oscSend, lpshold, loopseg, loopxseg) 

@@ -1,6 +1,6 @@ {-#Language BangPatterns, TupleSections, FlexibleContexts #-} module Csound.Control.Evt(-    Evt(..), Bam, +    Evt(..), Bam, Tick,       -- * Core functions     boolToEvt, evtToBool, sigToEvt, stepper,@@ -13,7 +13,9 @@      -- * Higher-level event functions     devt, eventList,-    cycleE, iterateE, repeatE, appendE, mappendE, partitionE, splitToggle,+    cycleE, iterateE, repeatE, appendE, mappendE, partitionE, +    takeE, dropE, takeWhileE, dropWhileE,+    splitToggle, toTog, toTog1,     Rnds,     oneOf, freqOf, freqAccum,      randDs, randList, randInts, randSkip, randSkipBy, @@ -30,6 +32,8 @@ import Csound.Typed.Opcode import Csound.Types(atArg) +type Tick = Evt Unit+ -- | Constant event stream. It produces the same value (the first argument) -- all the time. devt :: D -> Evt a -> Evt D@@ -47,7 +51,7 @@  -- | Fires a single true value in the given time ahead. impulse :: D -> Sig -impulse dt = mpulse 1 0 `withD` dt+impulse dt = downsamp (mpulse (sig $ getBlockSize) 0 `withD` dt) `withD` getBlockSize  -- | Fires a single event in the given time ahead. impulseE :: D -> Evt Unit@@ -244,4 +248,41 @@     where single n              | n <= 0    = []             | otherwise = True : replicate (n - 1) False+++-- converting to toggle signals++togGen :: D -> Tick -> Evt D+togGen n = accumE n (\_ s -> let v = (mod' (s + 1) 2) in (v, v))++-- | Converts clicks to alternating 0 and 1 (toggle event stream)+toTog :: Tick -> Evt D+toTog  = togGen 1++-- | Converts clicks to alternating 1 and 0 (toggle event stream with first value set to 1)+toTog1 :: Tick -> Evt D+toTog1 = togGen 0+++mkRow :: Evt a -> Evt (a, D)+mkRow = accumE (0 :: D) (\a s -> ((a, s), s + 1) )++filterRow :: (D -> BoolD) -> Evt a -> Evt a+filterRow p = fmap fst . filterE (p . snd) . mkRow++-- | 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)++-- | Drops the ns events from the event stream and leaves the rest of the stream.+dropE :: Int -> Evt a -> Evt a+dropE n = filterRow ( >=* int n)++-- | Takes events while the predicate is true.+takeWhileE :: (a -> BoolD) -> Evt a -> Evt a+takeWhileE p = fmap fst . filterE snd . accumE (1 :: D) (\a s -> let s1 = s ==* 1 &&* p a in ((a, s1), ifB s1 1 0)) ++-- | Drops events while the predicate is true.+dropWhileE :: (a -> BoolD) -> Evt a -> Evt a+dropWhileE p = fmap fst . filterE (notB . snd) . accumE (1 :: D) (\a s -> let s1 = s ==* 1 &&* p a in ((a, s1), ifB s1 1 0))  

@@ -81,8 +81,6 @@ import Csound.Control.Gui.Props import Csound.Control.Gui.Widget -import Csound.SigSpace(SigSpace(..))- -- | Creates a window with the given name, size and content -- -- > win name (width, height) gui@@ -91,10 +89,6 @@  keyWin :: String -> (Int, Int) -> Gui -> SE () keyWin name (x, y) = keyPanelBy name (Just $ Rect 0 0 x y)--instance SigSpace a => SigSpace (Source a) where-    mapSig f = mapSource (mapSig f)-  ---------------------------------------------------------------------------------- -- easy grouppings for GUIs

@@ -25,7 +25,7 @@     -- * Transformers     setTitle,     -- * Keyboard-    KeyEvt(..), Key(..), keyIn, charOn, charOff,+    KeyEvt(..), Key(..), keyIn, charOn, charOff, strOn, strOff,      -- * Easy to use widgets     uknob, xknob, uslider, xslider, ujoy, @@ -41,13 +41,14 @@  import Control.Monad +import Data.Monoid import Data.List(transpose) import Data.Boolean  import Csound.Typed.Gui import Csound.Typed.Types import Csound.Control.SE-import Csound.Control.Evt(listAt)+import Csound.Control.Evt(listAt, Tick)  -------------------------------------------------------------------- -- aux widgets@@ -112,6 +113,13 @@ charOff :: Char -> Evt Unit charOff = keyIn . Release . CharKey +-- | Creates an event in the output stream when one of the chars is pressed.+strOn :: String -> Tick+strOn a = mconcat $ fmap charOn a++-- | Creates an event in the output stream when one of the chars is depressed.+strOff :: String -> Tick+strOff a = mconcat $ fmap charOff a  -- | Unipolar linear slider. The value belongs to the interval [0, 1]. -- The argument is for initial value.

@@ -75,21 +75,25 @@     -- way down the Score-structure.      CsdSco(..), Mix, sco, mix, eff, CsdEventList(..), CsdEvent,      mixLoop, sco_, mix_, mixLoop_, mixBy, +    infiniteDur,          -- * Evt        -- ** Singlular-    trig, sched, schedHarp, schedUntil, schedToggle,+    trig, sched, retrig, schedHarp, schedUntil, schedToggle,     trig_, sched_, schedUntil_,      trigBy, schedBy, schedHarpBy,     withDur,      -- ** Plural-    trigs, scheds, schedHarps, schedUntils,+    trigs, scheds, retrigs, schedHarps, schedUntils,      trigs_, scheds_, schedUntils_,      trigsBy, schedsBy, schedHarpsBy,     withDurs, +    -- ** Misc+    alwaysOn,+     -- * Overload     -- | Converters to make it easier a construction of the instruments.     Outs(..), onArg, AmpInstr(..), CpsInstr(..)@@ -99,7 +103,7 @@ import Csound.Typed.Opcode hiding (initc7) import Csound.Control.Overload -import Csound.Control.Evt(metroE, repeatE, splitToggle)+import Csound.Control.Evt(metroE, repeatE, splitToggle, loadbang)  -- | Mixes the scores and plays them in the loop. mixLoop :: (CsdSco f, Sigs a) => f (Mix a) -> a@@ -123,7 +127,7 @@ -- | Invokes an instrument with first event stream and  -- holds the note until the second event stream is active. schedUntils :: (Arg a, Sigs b) => (a -> SE b) -> Evt [a] -> Evt c -> b-schedUntils instr onEvt offEvt = scheds instr' $ withDurs (-1) onEvt+schedUntils instr onEvt offEvt = scheds instr' $ withDurs infiniteDur onEvt     where          instr' x = do              res <- instr x@@ -140,7 +144,7 @@ -- | Invokes an instrument with first event stream and  -- holds the note until the second event stream is active. schedUntils_ :: (Arg a) => (a -> SE ()) -> Evt [a] -> Evt c -> SE ()-schedUntils_ instr onEvt offEvt = scheds_ instr' $ withDurs (-1) onEvt+schedUntils_ instr onEvt offEvt = scheds_ instr' $ withDurs infiniteDur onEvt     where          instr' x = do              res <- instr x@@ -179,8 +183,11 @@ sched :: (Arg a, Sigs b) => (a -> SE b) -> Evt (D, a) -> b sched f = fromPlural $ scheds f +retrig :: (Arg a, Sigs b) => (a -> SE b) -> Evt a -> b+retrig f = fromPlural $ retrigs f+ -- | An instrument is triggered with event stream and delay time is set to zero --- (event fires immediately) and duration is set to inifinite time. The note is +-- (event fires immediately) and duration is set to infinite time. The note is  -- held while the instrument is producing something. If the instrument is silent -- for some seconds (specified in the first argument) then it's turned off. schedHarp :: (Arg a, Sigs b) => D -> (a -> SE b) -> Evt a -> b@@ -216,3 +223,6 @@ schedHarpBy :: (Arg a, Sigs b, Arg c) => D -> (a -> SE b) -> (c -> Evt a) -> c -> b schedHarpBy dt f = fromPluralBy $ schedHarpsBy dt f +-- | Executes some procedure for the whole lifespan of the program,+alwaysOn :: SE () -> SE ()+alwaysOn proc = sched_ (const $ proc) $ withDur (infiniteDur) $ loadbang

@@ -1,11 +1,15 @@ -- | Midi. module Csound.Control.Midi(+    MidiChn(..), MidiFun, toMidiFun, toMidiFun_,      Msg, Channel, midi, midin, pgmidi, ampCps,     midi_, midin_, pgmidi_,     -- * Mono-midi synth-    monoMsg, holdMsg, monoMsgn, holdMsgn, pgmonoMsg, pgholdMsg,+    monoMsg, holdMsg, +    -- * Midi event streams+    midiKeyOn, midiKeyOff,     -- * Reading midi note parameters-    cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl,        +    cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl,      +     -- * Overload     MidiInstr(..) ) where@@ -15,7 +19,27 @@ import Csound.Typed import Csound.Typed.Opcode hiding (initc7) import Csound.Control.Overload+import Csound.Control.Instr(alwaysOn)+import Csound.Control.Evt(Tick) +-- | Specifies the midi channel or programm.+data MidiChn = ChnAll | Chn Int | Pgm (Maybe Int) Int+	deriving (Show, Eq)++type MidiFun a = (Msg -> SE a) -> SE a++toMidiFun :: Sigs a => MidiChn -> MidiFun a+toMidiFun x = case x of+	ChnAll  -> midi+	Chn n   -> midin n+	Pgm a b -> pgmidi a b++toMidiFun_ :: MidiChn -> MidiFun ()+toMidiFun_ x = case x of+	ChnAll  -> midi_+	Chn n   -> midin_ n+	Pgm a b -> pgmidi_ a b+ ampCps :: Msg -> (D, D) ampCps msg = (ampmidi msg 1, cpsmidi msg) @@ -30,10 +54,10 @@ -- and release time. A portamento time is time it takes for transition -- from one note to another. ----- > monoMsg portamentoTime releaseTime-monoMsg :: D -> D -> SE (Sig, Sig)-monoMsg portTime relTime = do-	(amp, cps, status) <- genAmpCpsSig midi+-- > monoMsg channel portamentoTime releaseTime+monoMsg :: MidiChn -> D -> D -> SE (Sig, Sig)+monoMsg chn portTime relTime = do+	(amp, cps, status) <- genAmpCpsSig (toMidiFun chn) 	return (port amp portTime * port status relTime,  port cps portTime)  -- | Produces midi amplitude and frequency as a signal and holds the @@ -43,59 +67,9 @@ -- from one note to another. -- -- > holdMsg portamentoTime-holdMsg :: D -> SE (Sig, Sig)-holdMsg portTime = do-	(amp, cps) <- genHoldAmpCpsSig midi_-	return (port amp portTime,  port cps portTime)----- | Produces midi amplitude and frequency as a signal.--- The signal fades out when nothing is pressed. We can specify a channel.--- It can be used in mono-synths. Arguments are portamento time--- and release time. A portamento time is time it takes for transition--- from one note to another.------ > monoMsgn chnNumber portamentoTime releaseTime-monoMsgn :: Channel -> D -> D -> SE (Sig, Sig)-monoMsgn n portTime relTime = do-	(amp, cps, status) <- genAmpCpsSig (midin n)-	return (port amp portTime * port status relTime,  port cps portTime)---- | Produces midi amplitude and frequency as a signal and holds the --- last value till the next one is present. We can specify a channel.--- It can be used in mono-synths. Arguments are portamento time--- and release time. A portamento time is time it takes for transition--- from one note to another.------ > holdMsgn chnNumber portamentoTime-holdMsgn :: Channel -> D -> SE (Sig, Sig)-holdMsgn n portTime = do-	(amp, cps) <- genHoldAmpCpsSig (midin_ n)-	return (port amp portTime,  port cps portTime)----- | Produces midi amplitude and frequency as a signal.--- The signal fades out when nothing is pressed. We can specify a programm number and channel.--- It can be used in mono-synths. Arguments are portamento time--- and release time. A portamento time is time it takes for transition--- from one note to another.------ > pgmonoMsg chnNumber portamentoTime releaseTime-pgmonoMsg :: Maybe Int -> Channel -> D -> D -> SE (Sig, Sig)-pgmonoMsg pg n portTime relTime = do-	(amp, cps, status) <- genAmpCpsSig (pgmidi pg n)-	return (port amp portTime * port status relTime,  port cps portTime)---- | Produces midi amplitude and frequency as a signal and holds the --- last value till the next one is present. We can specify a programm number and channel.--- It can be used in mono-synths. Arguments are portamento time--- and release time. A portamento time is time it takes for transition--- from one note to another.------ > pgholdMsg portamentoTime-pgholdMsg :: Maybe Int -> Channel -> D -> SE (Sig, Sig)-pgholdMsg pg n portTime = do-	(amp, cps) <- genHoldAmpCpsSig (pgmidi_ pg n)+holdMsg :: MidiChn -> D -> SE (Sig, Sig)+holdMsg channel portTime = do+	(amp, cps) <- genHoldAmpCpsSig (toMidiFun_ channel) 	return (port amp portTime,  port cps portTime)  @@ -123,8 +97,55 @@ 		instr hNote msg = do 			writeSERef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg)			 + -------------------------------------------------------------- +-- | Listens to midi on event on the given key as event stream.+-- The event stream carries the level of volume (ranges from 0 to 1).+midiKeyOn :: MidiChn -> D -> SE (Evt D)+midiKeyOn = midiKeyOnBy . toMidiFun++-- | Listens to midi on event off the given key as event stream.+midiKeyOff :: MidiChn -> D -> SE Tick+midiKeyOff = midiKeyOffBy . toMidiFun++midiKeyOnBy :: MidiFun Sig -> D -> SE (Evt D)+midiKeyOnBy midiFun key = do	+	chRef  <- newGlobalSERef (0 :: Sig)+	evtRef <- newGlobalSERef (0 :: Sig)+	writeSERef chRef =<< midiFun instr++	alwaysOn $ do+		a <- readSERef chRef+		writeSERef evtRef $ diff a++	evtSig <- readSERef evtRef+	return $ filterE ( >* 0) $ snaps evtSig+	where+		instr msg = do+			print' [notnum msg] +			return $ ifB (boolSig $ notnum msg ==* key) (sig $ ampmidi msg 1) 0+++midiKeyOffBy :: MidiFun Sig -> D -> SE Tick+midiKeyOffBy midiFun key = do	+	chRef  <- newGlobalSERef (0 :: Sig)+	evtRef <- newGlobalSERef (0 :: Sig)+	writeSERef chRef =<< midiFun instr++	alwaysOn $ do+		a <- readSERef chRef+		writeSERef evtRef $ diff a++	evtSig <- readSERef evtRef+	return $ fmap (const unit) $ filterE ( <* 0) $ snaps evtSig+	where+		instr msg = do+			print' [notnum msg] +			return $ ifB (boolSig $ notnum msg ==* key) (sig $ ampmidi msg 1) 0++--------------------------------------------------------------+ -- | Initialization of the midi control-messages. initc7 :: D -> D -> D -> SE () initc7 = initMidiCtrl @@ -141,5 +162,5 @@      -- | Unipolar midiCtrl. Initializes midi control and get the value in the range 0 to 1. umidiCtrl :: D -> D -> D -> SE Sig-umidiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival (-1) 1+umidiCtrl chno ctrlno ival = midiCtrl7 chno ctrlno ival 0 1 

@@ -47,7 +47,7 @@ import Csound.Types(Sig2, Sig4) import Csound.Control.Gui -import Csound.Options(setSilent)+import Csound.Options(setSilent, setMa)  render :: Sigs a => Options -> SE a -> IO String render = renderOutBy @@ -75,7 +75,7 @@  instance RenderCsd (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where     renderCsdBy opt a = render opt (return a)-+{- instance RenderCsd      ( (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)     , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) ) where  @@ -87,7 +87,7 @@     , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)     , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) ) where       renderCsdBy opt a = render opt (return a)-+-} instance RenderCsd (SE Sig) where     renderCsdBy opt a = render opt a @@ -103,6 +103,7 @@ instance RenderCsd (SE (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)) where     renderCsdBy opt a = render opt a +{- instance RenderCsd (SE      ( (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)     , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) )) where  @@ -114,7 +115,7 @@     , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)     , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) )) where       renderCsdBy opt a = render opt a-+-} instance (Sigs a, Sigs b) => RenderCsd (a -> b) where     renderCsdBy opt f = renderEffBy opt (return . f) @@ -217,9 +218,10 @@  -- | 'Csound.Base.dac' with options. dacBy :: (RenderCsd a) => Options -> a -> IO ()-dacBy opt a = do+dacBy opt' a = do     writeCsdBy opt "tmp.csd" a     runWithUserInterrupt $ "csound -odac " ++ "tmp.csd" +    where opt = opt' <> setMa   -- | Output to dac with virtual midi keyboard. vdac :: (RenderCsd a) => a -> IO ()

@@ -6,7 +6,7 @@     setRates, setBufs, setGain, setJack,     setOutput, setInput,      setDac, setAdc, setDacBy, setAdcBy, setThru,-    setSilent,+    setSilent, setMidiDevice, setMa,      -- * Flags     -- | Csound's command line flags. See original documentation for @@ -91,3 +91,10 @@ setSilent :: Options setSilent = (def { csdFlags = def { audioFileOutput = def { nosound = True } } }) +-- | Sets midi device+setMidiDevice :: String -> Options+setMidiDevice a = def { csdFlags = def { midiRT = def { midiDevice = Just a } } }++-- | Sets midi device to all.+setMa :: Options+setMa = setMidiDevice "a"

@@ -1,15 +1,22 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language FlexibleInstances #-}+{-# Language +        TypeFamilies, +        MultiParamTypeClasses, +        FlexibleInstances, +        FlexibleContexts #-} module Csound.SigSpace(-    SigSpace(..), BindSig(..), mul, at,+    SigSpace(..), BindSig(..), mul, At(..), bat,     cfd, cfd4, cfds, cfdSpec, cfdSpec4, cfdsSpec,      wsum         ) where +import Control.Monad import Control.Applicative  import Csound.Typed-import Csound.Typed.Opcode(pvscross, pvscale, pvsmix)+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. class SigSpace a where@@ -23,10 +30,6 @@ 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@@ -108,38 +111,15 @@ 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  -- Num -instance Num (Sig, Sig) where-    (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)-    (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)-    negate (a1, a2) = (negate a1, negate a2)--    fromInteger n = (fromInteger n, fromInteger n)-    signum (a1, a2) = (signum a1, signum a2)-    abs (a1, a2) = (abs a1, abs a2)--instance Num (Sig, Sig, Sig) where-    (a1, a2, a3) + (b1, b2, b3) = (a1 + b1, a2 + b2, a3 + b3)-    (a1, a2, a3) * (b1, b2, b3) = (a1 * b1, a2 * b2, a3 * b3)-    negate (a1, a2, a3) = (negate a1, negate a2, negate a3)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3) = (signum a1, signum a2, signum a3)-    abs (a1, a2, a3) = (abs a1, abs a2, abs a3)--instance Num (Sig, Sig, Sig, Sig) where-    (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)-    (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)-    negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)-    abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)- instance Num (SE Sig) where     (+) = liftA2 (+)     (*) = liftA2 (*)@@ -310,4 +290,128 @@ instance Fractional (a -> (Sig, Sig, Sig, Sig)) where     (/) = liftA2 (/)     fromRational = return . fromRational++-----------------------------------------------------------------------+-----------------------------------------------------------------------++class SigSpace b => At a b c where+    type AtOut a b c :: *+    at :: (a -> b) -> c -> AtOut a b c++bat :: At Sig a b => (Sig -> a) -> b -> AtOut Sig a b+bat f = at (\x -> mapSig ( `balance` x) $ f x)++instance SigSpace a => At Sig Sig a where+    type AtOut Sig Sig a = a+    at f a = mapSig f a++------------------------------------------------------+-- for (Sig -> SE Sig)++instance At Sig (SE Sig) Sig where+    type AtOut Sig (SE Sig) Sig = SE Sig+    at f a = f a++instance At Sig (SE Sig) Sig2 where+    type AtOut Sig (SE Sig) Sig2 = SE Sig2+    at f a = bindSig f a++instance At Sig (SE Sig) Sig3 where+    type AtOut Sig (SE Sig) Sig3 = SE Sig3+    at f a = bindSig f a++instance At Sig (SE Sig) Sig4 where+    type AtOut Sig (SE Sig) Sig4 = SE Sig4+    at f a = bindSig f a++instance At Sig (SE Sig) (SE Sig) where+    type AtOut Sig (SE Sig) (SE Sig) = SE Sig+    at f a = join $ bindSig f a++instance At Sig (SE Sig) (SE Sig2) where+    type AtOut Sig (SE Sig) (SE Sig2) = SE Sig2+    at f a = join $ bindSig f a++instance At Sig (SE Sig) (SE Sig3) where+    type AtOut Sig (SE Sig) (SE Sig3) = SE Sig3+    at f a = join $ bindSig f a++instance At Sig (SE Sig) (SE Sig4) where+    type AtOut Sig (SE Sig) (SE Sig4) = SE Sig4+    at f a = join $ bindSig f a++-----------------------------------------------------+-- mono to stereo ++instance At Sig Sig2 Sig where+    type AtOut Sig Sig2 Sig = Sig2+    at f a = f a++instance At Sig Sig2 (SE Sig) where+    type AtOut Sig Sig2 (SE Sig) = SE Sig2+    at f a = fmap f a++instance At Sig Sig2 Sig2 where+    type AtOut Sig Sig2 Sig2 = Sig2+    at f a = 0.5 * (f (fst a) + f (snd a))++instance At Sig Sig2 (SE Sig2) where+    type AtOut Sig Sig2 (SE Sig2) = SE Sig2+    at f a = fmap (at f) a++---------------------------------------------------------   ++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++fromMono a = (a, a)++instance At Sig2 Sig2 Sig where+    type AtOut Sig2 Sig2 Sig = Sig2+    at f a = f $ fromMono a++instance At Sig2 Sig2 Sig2 where+    type AtOut Sig2 Sig2 Sig2 = Sig2+    at f a = f a++instance At Sig2 Sig2 (SE Sig) where+    type AtOut Sig2 Sig2 (SE Sig) = SE Sig2+    at f a = fmap (f . fromMono) a++instance At Sig2 Sig2 (SE Sig2) where+    type AtOut Sig2 Sig2 (SE Sig2) = SE Sig2+    at f a = fmap f a++---------------------------------------------+-- Sig2 -> SE Sig2++instance At Sig2 (SE Sig2) Sig where+    type AtOut Sig2 (SE Sig2) Sig = SE Sig2+    at f a = f $ fromMono a++instance At Sig2 (SE Sig2) Sig2 where+    type AtOut Sig2 (SE Sig2) Sig2 = SE Sig2+    at f a = f a++instance At Sig2 (SE Sig2) (SE Sig) where+    type AtOut Sig2 (SE Sig2) (SE Sig) = SE Sig2+    at f a = (f . fromMono) =<< a++instance At Sig2 (SE Sig2) (SE Sig2) where+    type AtOut Sig2 (SE Sig2) (SE Sig2) = SE Sig2+    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 

@@ -51,7 +51,7 @@     -- or     --     -- > asig = ar1 $ diskin2 "file.wav" 1-    Sig2, Sig4, Sig6, Sig8,+    Sig2, Sig3, Sig4, Sig6, Sig8,     ar1, ar2, ar4, ar6, ar8,      -- * Tuples@@ -79,6 +79,7 @@ import Csound.Typed.Types  type Sig2 = (Sig, Sig)+type Sig3 = (Sig, Sig, Sig) type Sig4 = (Sig, Sig, Sig, Sig) type Sig6 = (Sig, Sig, Sig, Sig, Sig, Sig) type Sig8 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)