csound-expression 5.2.1 → 5.2.2
raw patch · 9 files changed
+279/−274 lines, 9 filesdep ~csound-expression-dynamicdep ~csound-expression-typedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: csound-expression-dynamic, csound-expression-typed
API changes (from Hackage documentation)
- Csound.Control.Gui: type Display = SE Gui
- Csound.Control.Gui: type Sink a = SE (Gui, Output a)
- Csound.Control.Gui: type SinkSource a = SE (Gui, Output a, Input a)
- Csound.Control.Gui: type Source a = SE (Gui, Input a)
+ Csound.Control.Gui: Display :: SE Gui -> Display
+ Csound.Control.Gui: Sink :: SE (Gui, Output a) -> Sink a
+ Csound.Control.Gui: SinkSource :: SE (Gui, Output a, Input a) -> SinkSource a
+ Csound.Control.Gui: Source :: SE (Gui, Input a) -> Source a
+ Csound.Control.Gui: [unDisplay] :: Display -> SE Gui
+ Csound.Control.Gui: [unSinkSource] :: SinkSource a -> SE (Gui, Output a, Input a)
+ Csound.Control.Gui: [unSink] :: Sink a -> SE (Gui, Output a)
+ Csound.Control.Gui: [unSource] :: Source a -> SE (Gui, Input a)
+ Csound.Control.Gui: newtype Display :: *
+ Csound.Control.Gui: newtype Sink a :: * -> *
+ Csound.Control.Gui: newtype SinkSource a :: * -> *
+ Csound.Control.Gui: newtype Source a :: * -> *
+ Csound.IO: saveUserOptions :: Options -> IO ()
Files
- csound-expression.cabal +2/−2
- examples/Events.hs +5/−5
- src/Csound/Air/Live.hs +20/−20
- src/Csound/Air/Looper.hs +30/−30
- src/Csound/Air/Wav.hs +62/−60
- src/Csound/Control/Evt.hs +40/−40
- src/Csound/Control/Gui.hs +52/−52
- src/Csound/Control/Gui/Widget.hs +64/−64
- src/Csound/IO.hs +4/−1
csound-expression.cabal view
@@ -1,5 +1,5 @@ Name: csound-expression-Version: 5.2.1+Version: 5.2.2 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE@@ -79,7 +79,7 @@ Ghc-Options: -Wall Build-Depends: base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0, transformers >= 0.3, containers,- csound-expression-typed >= 0.2.0.1, csound-expression-dynamic >= 0.3.0, temporal-media >= 0.6.1,+ csound-expression-typed >= 0.2.0.2, csound-expression-dynamic >= 0.3.2, temporal-media >= 0.6.1, csound-expression-opcodes >= 0.0.3.2 Hs-Source-Dirs: src/ Exposed-Modules:
examples/Events.hs view
@@ -32,7 +32,7 @@ e5 = mappendE e2 e51 :: Evt (D, D)-e51 = mappend +e51 = mappend (repeatE (0.7, 220) (metro (2/7))) (cycleE [(0.5, 440), (0.5, 330)] (metro 2)) @@ -42,12 +42,12 @@ e7 = randInts (0, 10) src -e8 = oneOf [100, 200, 300] src+e8 = oneOf [100, 200, 300, 400, 500, 600, 700] src e9 = avgSum $ freqOf [(0.1, 0), (0.9, 1)] src avgSum :: Evt D -> Evt D-avgSum = accumE (0, 0) $ \a (s, n) -> +avgSum = accumE (0, 0) $ \a (s, n) -> let s1 = s + a n1 = n + 1 in (s1 / n1, (s1, n1))@@ -55,7 +55,7 @@ -- mask e10 :: Evt (Sco D)-e10 = withDur 0.5 $ filterE (>* 110) $ mconcat +e10 = withDur 0.5 $ filterE (>* 110) $ mconcat [ every 0 [5,7] $ repeatE 330 src , every 3 [11] $ repeatE 550 src , every 2 [2] $ repeatE 440 src@@ -68,5 +68,5 @@ -- output with sound resSnd e = sched pureTone $ withDur 0.1 e -main = dac $ res e7+main = dac $ res e8
src/Csound/Air/Live.hs view
@@ -61,13 +61,13 @@ genMixer :: (Sigs a) => ([Gui] -> Gui, [Gui] -> Gui) -> [(String, SE a)] -> Source a genMixer (parentGui, childGui) as = source $ do- gTags <- mapM box names- (gs, vols) <- fmap unzip $ mapM (const $ defSlider "") names- (gMutes, mutes) <- fmap unzip $ mapM (const $ toggleSig "" False) names+ gTags <- mapM (unDisplay . box) names+ (gs, vols) <- fmap unzip $ mapM (const $ unSource $ defSlider "") names+ (gMutes, mutes) <- fmap unzip $ mapM (const $ unSource $ toggleSig "" False) names - gMasterTag <- box "master"- (gMaster, masterVol) <- defSlider ""- (gMasterMute, masterMute) <- toggleSig "" False+ gMasterTag <- unDisplay $ box "master"+ (gMaster, masterVol) <- unSource $ defSlider ""+ (gMasterMute, masterMute) <- unSource $ toggleSig "" False let g = parentGui $ zipWith3 (\tag slid mute -> childGui [sca 0.8 tag, sca 8 slid, sca 1.1 mute]) (gMasterTag : gTags) (gMaster : gs) (gMasterMute : gMutes) muteVols = zipWith appMute mutes vols@@ -116,12 +116,12 @@ -- fxBox :: forall a. (FxUI a, Num (FxArg a), Tuple (FxArg a)) => String -> a -> Bool -> [(String, Double)] -> Source (Fx (FxArg a)) fxBox :: forall a. Sigs a => String -> ([Sig] -> Fx a) -> Bool -> [(String, Double)] -> Source (Fx a) fxBox name fx onOff args = source $ do- (gOff0, off) <- toggleSig name onOff+ (gOff0, off) <- unSource $ toggleSig name onOff let gOff = setFontSize 25 gOff0 offRef <- newGlobalRef (0 :: Sig) writeRef offRef off let (names, initVals) = unzip args- (gs, as) <- fmap unzip $ mapM (\(name, initVal) -> slider name (linSpan 0 1) initVal) $ zip names initVals+ (gs, as) <- fmap unzip $ mapM (\(name, initVal) -> unSource $ slider name (linSpan 0 1) initVal) $ zip names initVals let f x = do ref <- newRef (0 :: a) goff <- readRef offRef@@ -155,7 +155,7 @@ uiGroupGui a b =ver [sca uiOnOffSize a, sca uiBoxSize b] sourceColor2 :: Color -> Source a -> Source a-sourceColor2 col a = source $ do+sourceColor2 col (Source a) = source $ do (g, x) <- a return (setColor2 col g, x) @@ -166,22 +166,22 @@ -- combine effects fxGroupMS :: ([Gui] -> Gui) -> [Source Fx1] -> Maybe (Source (Sig -> SE Sig2)) -> [Source Fx2] -> Source (Sig -> SE Sig2)-fxGroupMS guiGroup as bridge bs = do+fxGroupMS guiGroup as bridge bs = Source $ do (gsA, fA) <- getChain as (gsB, fB) <- getChain bs case bridge of Nothing -> return $ (guiGroup $ gsA ++ gsB, fA >=> fB . fromMono) Just widget -> do- (gBridge, fBridge) <- widget+ (gBridge, fBridge) <- unSource widget return $ (guiGroup $ gsA ++ gBridge : gsB, fA >=> fBridge >=> fB) where getChain xs = do- (gs, fs) <- fmap unzip $ sequence xs+ (gs, fs) <- fmap unzip $ sequence $ fmap unSource xs return (gs, foldl (\a b -> a >=> b) return fs) fxGroup :: ([Gui] -> Gui) -> [Source (Fx a)] -> Source (Fx a)-fxGroup guiGroup as = do- (gs, fs) <- fmap unzip $ sequence as+fxGroup guiGroup as = Source $ do+ (gs, fs) <- fmap unzip $ sequence $ fmap unSource as return (guiGroup gs, foldl (\a b -> a >=> b) return fs) -- | Scales the gui for signal processing widgets.@@ -343,8 +343,8 @@ -- | the widget for mixing in a signal to the signal. uiSig :: (Sigs a) => String -> Bool -> Source a -> Source (Fx a) uiSig name onOff widget = source $ do- (gs, asig) <- widget- (gOff0, off) <- toggleSig name onOff+ (gs, asig) <- unSource widget+ (gOff0, off) <- unSource $ toggleSig name onOff let gOff = setFontSize 25 gOff0 f x = return $ x + mul (portk off 0.05) asig return (setBorder UpBoxBorder $ uiGroupGui gOff gs, f)@@ -380,10 +380,10 @@ genAdsr :: (D -> D -> D -> D -> Sig) -> String -> AdsrBound -> AdsrInit -> Source Sig genAdsr mkAdsr name b inits = source $ do- (gatt, att) <- knob "A" (linSpan expEps $ attBound b) (attInit inits)- (gdec, dec) <- knob "D" (linSpan expEps $ decBound b) (decInit inits)- (gsus, sus) <- knob "S" (linSpan expEps 1) (susInit inits)- (grel, rel) <- knob "R" (linSpan expEps $ relBound b) (relInit inits)+ (gatt, att) <- unSource $ knob "A" (linSpan expEps $ attBound b) (attInit inits)+ (gdec, dec) <- unSource $ knob "D" (linSpan expEps $ decBound b) (decInit inits)+ (gsus, sus) <- unSource $ knob "S" (linSpan expEps 1) (susInit inits)+ (grel, rel) <- unSource $ knob "R" (linSpan expEps $ relBound b) (relInit inits) let val = mkAdsr (ir att) (ir dec) (ir sus) (ir rel) gui <- setTitle name $ hor [gatt, gdec, gsus, grel] return (gui, val)
src/Csound/Air/Looper.hs view
@@ -10,16 +10,16 @@ import Data.Default import Data.Boolean-import Csound.Typed +import Csound.Typed import Csound.Typed.Gui hiding (button) import Csound.Control.Evt import Csound.Control.Instr-import Csound.Control.Gui +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.Live import Csound.Air.Wave import Csound.Air.Fx import Csound.Air.Filter@@ -28,7 +28,7 @@ -- | 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)@@ -46,22 +46,22 @@ -- 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 +-- * @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. +-- 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 +data LoopSpec = LoopSpec { loopMixVal :: [Sig] , loopPrefx :: [Fx2] , loopPostfx :: [Fx2] , loopPrefxVal :: [Sig]- , loopPostfxVal :: [Sig] + , loopPostfxVal :: [Sig] , loopInitInstr :: Int- , loopFades :: [[Int]] + , loopFades :: [[Int]] , loopRepeatFades :: [Sig] , loopControl :: LoopControl }@@ -77,7 +77,7 @@ , loopFades = [] , loopRepeatFades = [] , loopControl = def- } + } -- | External controllers. We can control the looper with -- UI-widgets but sometimes it's convenient to control the@@ -102,7 +102,7 @@ -- We can use the value @def@ to set the rest parameters: -- -- > def { loopTap = Just someEvt }-data LoopControl = LoopControl +data LoopControl = LoopControl { loopTap :: Maybe (Evt D) , loopFade :: Maybe ([Evt D]) , loopDel :: Maybe Tick@@ -130,7 +130,7 @@ -- | 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 +midiLoop = genLoop $ \cond midiInstr -> midi $ playWhen cond midiInstr {- -- | Some instruments not work well with the looper. Alwo be aware of limitation of software resources.@@ -139,9 +139,9 @@ -} -- | Simple multitap Looper. We can create as many taps as we like--- also we can create fade outs/ins insert effects and control mix. +-- also we can create fade outs/ins insert effects and control mix. ----- > sigLoop spec bpm times imputs +-- > sigLoop spec bpm times imputs -- -- Arguments: --@@ -159,22 +159,22 @@ sigLoop = genLoop $ \cond asig -> return $ mul (ifB cond 1 0) asig getControls :: LoopControl -> (TapControl, FadeControl, DelControl, ThroughControl)-getControls a = +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)) + , (\f -> f "through" False) $ maybe toggleSig (toggleSig' . evtToSig (-1)) (loopThrough a)) genLoop :: forall a. (BoolSig -> a -> SE Sig2) -> LoopSpec -> D -> [D] -> [a] -> Source Sig2-genLoop playInstr spec dtBpm times' instrs = do- (preFxKnobGui, preFxKnobWrite, preFxKnobRead) <- setKnob "pre" (linSpan 0 1) 0.5- (postFxKnobGui, postFxKnobWrite, postFxKnobRead) <- setKnob "post" (linSpan 0 1) 0.5- (mixKnobGui, mixKnobWrite, mixKnobRead) <- setKnob "mix" (linSpan 0 1) 0.5+genLoop playInstr spec dtBpm times' instrs = Source $ do+ (preFxKnobGui, preFxKnobWrite, preFxKnobRead) <- unSinkSource $ setKnob "pre" (linSpan 0 1) 0.5+ (postFxKnobGui, postFxKnobWrite, postFxKnobRead) <- unSinkSource $ setKnob "post" (linSpan 0 1) 0.5+ (mixKnobGui, mixKnobWrite, mixKnobRead) <- unSinkSource $ 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 + unSource $ 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@@ -186,7 +186,7 @@ where (tapControl, fadeControl, delControl, throughControl) = getControls (loopControl spec) - dt = 60 / dtBpm + dt = 60 / dtBpm times = take len $ times' ++ repeat 1 @@ -199,7 +199,7 @@ initPreVals = take len $ loopPrefxVal spec ++ repeat 0.5 initPostVals = take len $ loopPostfxVal spec ++ repeat 0.5 - silencer + silencer | null (loopFades spec) = fmap return ids | otherwise = loopFades spec @@ -210,14 +210,14 @@ delete = delControl throughDel = hlift2' 6 1 (\a b -> (a, b)) through delete- sw = tapControl (fmap show ids) initInstr + sw = tapControl (fmap show ids) initInstr sil = hlifts id $ zipWith (\f n -> f (show n)) fadeControl [0 .. length silencer - 1] maxDel = 3 f :: Tick -> Sig -> Sig -> (D, Int, Sig) -> (Sig, Fx2, Sig, Fx2, Sig) -> (Ref Sig, Ref Sig, a) -> SE Sig2 f delEvt thr x (t, n, repeatFadeWeight) (mixCoeff, preFx, preCoeff, postFx, postCoeff) (delRef, silRef, instr) = do- silVal <- readRef silRef + silVal <- readRef silRef runEvt delEvt $ \_ -> do a <- readRef delRef when1 isCurrent $ writeRef delRef (ifB (a + 1 `lessThan` maxDel) (a + 1) 0)@@ -232,16 +232,16 @@ mul mixCoeff $ mixAt postCoeff postFx $ sum [ return $ sum $ fmap playEcho [d0, d1, d2] , playSf 1]- where + where playSf thrVal = mixAt preCoeff preFx $ playInstr (isCurrent &&* thr ==* thrVal) instr isCurrent = x ==* (sig $ int n) - setSilencer refs silIds evt = runEvt evt $ \v -> + setSilencer refs silIds evt = runEvt evt $ \v -> mapM_ (\ref -> writeRef ref $ sig v) $ fmap (refs !! ) silIds tabSigs :: Output Sig -> Input Sig -> Sig -> [Sig] -> SE [Sig]-tabSigs writeWidget readWidget switch initVals = do - refs <- mapM newGlobalRef initVals +tabSigs writeWidget readWidget switch initVals = do+ refs <- mapM newGlobalRef initVals vs <- mapM readRef refs runEvt (changedE [switch]) $ \_ -> do
src/Csound/Air/Wav.hs view
@@ -1,20 +1,20 @@ -- | Sound file playback module Csound.Air.Wav( -- * Stereo- readSnd, loopSnd, loopSndBy, - readWav, loopWav, readSegWav, + readSnd, loopSnd, loopSndBy,+ readWav, loopWav, readSegWav, tempoLoopWav, tempoReadWav,- + -- * Mono- readSnd1, loopSnd1, loopSndBy1, + readSnd1, loopSnd1, loopSndBy1, readWav1, loopWav1, readSegWav1, tempoLoopWav1, tempoReadWav1,- + -- * Read sound with RAM- -- + -- -- Loads the sample in the table and plays it back from RAM. The sample should be short. The size of the table is limited. -- It's up to 6 minutes for 44100 sample rate, 5 minutes for 48000 and 2.8 minutes for 96000.- LoopMode(..), ramSnd, ramSnd1, + LoopMode(..), ramSnd, ramSnd1, ramTab, mincer, temposcal, Phsr(..), lphase, relPhsr, sndPhsr, phsrBounce, phsrOnce, ram, ram1,@@ -72,12 +72,12 @@ -- | Delays signals by the given amount (in seconds). delaySnd :: Sigs a => D -> a -> a-delaySnd dt = segmentSnd dt infiniteDur - +delaySnd dt = segmentSnd dt infiniteDur+ -- | Delays a signal by the first argument and takes only second argument amount -- of signal (everything is measured in seconds). segmentSnd ::Sigs a => D -> D -> a -> a-segmentSnd dt dur asig = sched (const $ return asig) $ fmap (del dt) $ withDur dur $ loadbang +segmentSnd dt dur asig = sched (const $ return asig) $ fmap (del dt) $ withDur dur $ loadbang -- | Repeats the signal with the given period. repeatSnd :: Sigs a => D -> a -> a@@ -89,14 +89,14 @@ 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 +-- | 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. +-- | 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@@ -126,7 +126,7 @@ -- | Reads stereo signal from the sound-file (wav or mp3 or aiff). readSnd :: String -> (Sig, Sig) readSnd fileName- | isMp3 fileName = mp3in (text fileName) + | isMp3 fileName = mp3in (text fileName) | otherwise = diskin2 (text fileName) 1 -- | Reads stereo signal from the sound-file (wav or mp3 or aiff)@@ -148,7 +148,7 @@ loopWav :: Sig -> String -> (Sig, Sig) loopWav speed fileName = flip withDs [0, 1] $ ar2 $ diskin2 (text fileName) speed --- | Reads a segment from wav file. +-- | Reads a segment from wav file. readSegWav :: D -> D -> Sig -> String -> (Sig, Sig) readSegWav start end speed fileName = takeSnd (end - start) $ diskin2 (text fileName) speed `withDs` [start, 1] @@ -165,7 +165,7 @@ -- | The mono variant of the function @readSnd@. readSnd1 :: String -> Sig-readSnd1 fileName +readSnd1 fileName | isMp3 fileName = toMono $ readSnd fileName | otherwise = diskin2 (text fileName) 1 @@ -208,14 +208,14 @@ -- It's up to 3 minutes for 44100 sample rate (sr), 2.9 minutes for 48000 sr, 1.4 minutes for 96000 sr. ramSnd :: LoopMode -> Sig -> String -> Sig2 ramSnd loopMode speed file = loscil3 1 speed t `withDs` [1, int $ fromEnum loopMode]- where t + where t | isMp3 file = mp3s file 0 def | otherwise = wavs file 0 def -- | Loads the sample in the table. The sample should be short. The size of the table is limited. -- It's up to 6 minutes for 44100 sample rate (sr), 5.9 minutes for 48000 sr, 2.8 minutes for 96000 sr. ramSnd1 :: LoopMode -> Sig -> String -> Sig-ramSnd1 loopMode speed file +ramSnd1 loopMode speed file | isMp3 file = (\(aleft, aright) -> 0.5 * (aleft + aright)) $ loscil3 1 speed (mp3s file 0 def) `withDs` [1, int $ fromEnum loopMode] | otherwise = loscil3 1 speed (wavs file 0 WavLeft) `withDs` [1, int $ fromEnum loopMode] @@ -223,13 +223,13 @@ -- writing sound files -- | The sample format.-data SampleFormat +data SampleFormat = NoHeaderFloat32 -- ^ 32-bit floating point samples without header | NoHeaderInt16 -- ^ 16-bit integers without header | HeaderInt16 -- ^ 16-bit integers with a header. The header type depends on the render (-o) format | UlawSamples -- ^ u-law samples with a header | Int16 -- ^ 16-bit integers with a header- | Int32 -- ^ 32-bit integers with a header + | Int32 -- ^ 32-bit integers with a header | Float32 -- ^ 32-bit floats with a header | Uint8 -- ^ 8-bit unsigned integers with a header | Int24 -- ^ 24-bit integers with a header@@ -239,8 +239,8 @@ -- | Writes a sound signal to the file with the given format. -- It supports only four formats: Wav, Aiff, Raw and Ircam. writeSigs :: FormatType -> SampleFormat -> String -> [Sig] -> SE ()-writeSigs fmt sample file = fout (text file) formatToInt - where +writeSigs fmt sample file = fout (text file) formatToInt+ where formatToInt = int $ formatTypeToInt fmt * 10 + fromEnum sample formatTypeToInt :: FormatType -> Int@@ -281,45 +281,45 @@ -- | mincer — Phase-locked vocoder processing. ----- mincer implements phase-locked vocoder processing --- using function tables containing sampled-sound sources, +-- mincer implements phase-locked vocoder processing+-- using function tables containing sampled-sound sources, -- with GEN01, and mincer will accept deferred allocation tables. ----- This opcode allows for time and frequency-independent scaling. --- Time is controlled by a time index (in seconds) to the function --- table position and can be moved forward and backward at any --- chosen speed, as well as stopped at a given position ("frozen"). +-- This opcode allows for time and frequency-independent scaling.+-- Time is controlled by a time index (in seconds) to the function+-- table position and can be moved forward and backward at any+-- chosen speed, as well as stopped at a given position ("frozen"). -- The quality of the effect is generally improved with phase locking switched on. -- -- > asig mincer atimpt, kamp, kpitch, ktab, klock[,ifftsize,idecim] -- -- csound doc: <http://www.csounds.com/manual/html/mincer.html> mincer :: Sig -> Sig -> Sig -> Tab -> Sig -> Sig-mincer b1 b2 b3 b4 b5 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unTab b4 <*> unSig b5 +mincer b1 b2 b3 b4 b5 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unTab b4 <*> unSig b5 where f a1 a2 a3 a4 a5 = opcs "mincer" [(Ar,[Ar,Kr,Kr,Kr,Kr,Ir,Ir])] [a1,a2,a3,a4,a5] --- | temposcal — Phase-locked vocoder processing with onset detection/processing, 'tempo-scaling'. +-- | temposcal — Phase-locked vocoder processing with onset detection/processing, 'tempo-scaling'. ----- temposcal implements phase-locked vocoder processing using function tables containing +-- temposcal implements phase-locked vocoder processing using function tables containing -- sampled-sound sources, with GEN01, and temposcal will accept deferred allocation tables. ----- This opcode allows for time and frequency-independent scaling. Time is advanced internally, --- but controlled by a tempo scaling parameter; when an onset is detected, timescaling is --- momentarily stopped to avoid smearing of attacks. The quality of the effect is generally +-- This opcode allows for time and frequency-independent scaling. Time is advanced internally,+-- but controlled by a tempo scaling parameter; when an onset is detected, timescaling is+-- momentarily stopped to avoid smearing of attacks. The quality of the effect is generally -- improved with phase locking switched on. ----- temposcal will also scale pitch, independently of frequency, using a transposition factor (k-rate). +-- temposcal will also scale pitch, independently of frequency, using a transposition factor (k-rate). -- -- > asig temposcal ktimescal, kamp, kpitch, ktab, klock [,ifftsize, idecim, ithresh] -- -- csound doc: <http://www.csounds.com/manual/html/temposcal.html> temposcal :: Sig -> Sig -> Sig -> Tab -> Sig -> Sig-temposcal b1 b2 b3 b4 b5 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unTab b4 <*> unSig b5 +temposcal b1 b2 b3 b4 b5 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unTab b4 <*> unSig b5 where f a1 a2 a3 a4 a5 = opcs "temposcal" [(Ar,[Kr,Kr,Kr,Kr,Kr,Ir,Ir,Ir])] [a1,a2,a3,a4,a5] -- | Mincer. We can playback a table and scale by tempo and pitch. ----- > mincer fidelity table pointer pitch +-- > mincer fidelity table pointer pitch -- -- fidelity is the parameter that specifies the size of the window (for FFT transform). -- The size equals to formula (fidelity + 11) ^ 2. If you don't know what to choose@@ -355,7 +355,7 @@ -- | Looping phasor. It creates a looping pointer to the file. -- It's used in the function ram.--- +-- -- Ther arguments are: file name, start and end of the looping segment (in seconds), -- and the playback speed. data Phsr = Phsr@@ -366,11 +366,11 @@ } -- | Forces phasor to play only once.-phsrOnce :: Phsr -> Phsr +phsrOnce :: Phsr -> Phsr phsrOnce a = a { phsrSpeed = phsrSpeed a * linseg [1, dt, 1, 0.01, 0] } where dt = ir $ abs $ (phsrEnd a - phsrStart a) / phsrSpeed a --- | Reads the file forth and back. +-- | Reads the file forth and back. phsrBounce :: Phsr -> Phsr phsrBounce a = a { phsrSpeed = phsrSpeed a * sqr (1 / dt) } where dt = abs $ (phsrEnd a - phsrStart a) / phsrSpeed a@@ -384,9 +384,11 @@ , phsrStart = start * sig len , phsrEnd = end * sig len , phsrSpeed = speed }- where len = filelen $ text file+ where+ len = (filelen $ text file) / srFactor+ srFactor = getSampleRate / filesr (text file) --- | Creates a phasor for reading the whole audio file in loops +-- | Creates a phasor for reading the whole audio file in loops -- with given speed. sndPhsr :: String -> Sig -> Phsr sndPhsr file speed = relPhsr file 0 1 speed@@ -394,7 +396,7 @@ ram1 :: Fidelity -> Phsr -> Sig -> Sig ram1 = ramChn True 1 --- | Reads audio files in loops. The file is loaded in RAM. +-- | Reads audio files in loops. The file is loaded in RAM. -- The size of the file is limited. It should be not more than 6 minutes -- for sample rate of 44100. 5.9 minutes for 48000. --@@ -403,13 +405,13 @@ -- without affecting pitch, and we can scale the sound by pitch -- without affecting the tempo. Let's study the arguments. ----- > ram fidelity phasor pitch +-- > ram fidelity phasor pitch ----- fidelity corresponds to the size of the FFT-window. +-- fidelity corresponds to the size of the FFT-window. -- The function performs the FFT transform and it has to know the size. -- It's not the value for the size it's an integer value -- that proportional to the size. The higher the value the higher the size--- the lower the value the lower the size. The default value is 0. +-- the lower the value the lower the size. The default value is 0. -- Zero is best for most of the cases. For drums we can lower it to (-2). -- -- The phasor is a quadruple of values@@ -420,10 +422,10 @@ -- and we can set the speed for playback. If speed is negative -- file is played in reverse. The playback is looped. -- So to scale the tempo or play in reverse we can change the playbackSpeed.--- +-- -- The last argument is pitch factor. We can rise by octave with factor 2. -- It's good place to use the function semitone. It produces factors for a number in semitones.--- +-- -- Note that all parameters (except window size) are signals. -- It makes this function very flexible. We can change the speed of playback -- and start and end of the reading segment as we wish.@@ -433,34 +435,34 @@ -- PS: here is the formula for window size: 2 ** (fidelity + 11) ram :: Fidelity -> Phsr -> Sig -> Sig2 ram winSize phsr pitch = (ramChn False 1 winSize phsr pitch, ramChn False 2 winSize phsr pitch)- + ramChn :: Bool -> Int -> Fidelity -> Phsr -> Sig -> Sig-ramChn isMono n winSize (Phsr file start end speed) pitch = - ifB (abs speed `lessThan` 0.001) 0 $ +ramChn isMono n winSize (Phsr file start end speed) pitch =+ ifB (abs speed `lessThan` 0.001) 0 $ ramTab winSize (mkTab isMono n file ) (lphase (filelen $ text file) start end (speed * srFactor)) (pitch * srFactor) where srFactor = sig $ (filesr $ text file) / getSampleRate mkTab :: Bool -> Int -> String -> Tab-mkTab isMono chn file +mkTab isMono chn file | mp3 && isMono = mp3s file 0 Mp3Mono | mp3 && isStereo = mp3s file 0 (if chn == 1 then Mp3Left else Mp3Right) | otherwise = wavs file 0 (if chn == 1 then WavLeft else WavRight)- where - mp3 = isMp3 file + where+ mp3 = isMp3 file isStereo = not isMono ---------------------------------------- -- std funs --- | Fidelity corresponds to the size of the FFT-window that is used by functions of RAM-family. +-- | Fidelity corresponds to the size of the FFT-window that is used by functions of RAM-family. -- The function performs the FFT transform and it has to know the size. -- It's not the value for the size it's an integer value -- that proportional to the size. The higher the value the higher the size--- the lower the value the lower the size. The default value is 0. +-- the lower the value the lower the size. The default value is 0. -- Zero is best for most of the cases. For drums we can lower it to (-2). -- -- PS: here is the formula for window size: 2 ** (fidelity + 11).--- So the fidelity is actually the degree for power of two. +-- So the fidelity is actually the degree for power of two. -- The FFT-algorithm requires the window size to be a power of two. -- -- The lower fidelity is the less power is consumed by the function.@@ -548,14 +550,14 @@ -- | Scaling mono audio files (accepts both midi and wav). It's based on temposcal Csound opcode. scaleWav1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sig scaleWav1 winSizePowerOfTwo tempo pitch filename = go $ if mp3 then mp3Left filename else wavLeft filename- where - go = simpleTempoScale winSizePowerOfTwo tempo pitch - mp3 = isMp3 filename + where+ go = simpleTempoScale winSizePowerOfTwo tempo pitch+ mp3 = isMp3 filename -- | Scaling stereo audio files (accepts both midi and wav). It's based on temposcal Csound opcode. scaleWav :: Fidelity -> TempoSig -> PitchSig -> String -> Sig2-scaleWav winSizePowerOfTwo tempo pitch filename = (go $ mkTab False 0 filename, go $ mkTab False 1 filename) +scaleWav winSizePowerOfTwo tempo pitch filename = (go $ mkTab False 0 filename, go $ mkTab False 1 filename) where go = simpleTempoScale winSizePowerOfTwo tempo pitch simpleTempoScale winSizePowerOfTwo tempo pitch t = temposcal tempo 1 pitch t 1 `withD` (2 ** (winSizePowerOfTwo + 11))
src/Csound/Control/Evt.hs view
@@ -1,26 +1,26 @@ {-#Language BangPatterns, TupleSections, FlexibleContexts #-} module Csound.Control.Evt(- Evt(..), Bam, Tick, + Evt(..), Bam, Tick, -- * Core functions boolToEvt, evtToBool, evtToTrig, sigToEvt, evtToSig, stepper, filterE, filterSE, accumSE, accumE, filterAccumE, filterAccumSE, - Snap, snapshot, readSnap, snaps, snaps2, sync, syncBpm, - + Snap, snapshot, readSnap, snaps, snaps2, sync, syncBpm,+ -- * Opcodes metro, gaussTrig, dust, metroSig, dustSig, dustSig2, impulseE, changedE, triggerE, loadbang, impulse, metroE, -- * Higher-level event functions devt, eventList,- cycleE, iterateE, repeatE, appendE, mappendE, partitionE, + cycleE, iterateE, repeatE, appendE, mappendE, partitionE, takeE, dropE, takeWhileE, dropWhileE, splitToggle, toTog, toTog1, Rnds,- oneOf, freqOf, freqAccum, - randDs, randList, randInts, randSkip, randSkipBy, - range, listAt, - every, masked + oneOf, freqOf, freqAccum,+ randDs, randList, randInts, randSkip, randSkipBy,+ range, listAt,+ every, masked ) where import Data.Monoid@@ -57,11 +57,11 @@ {-# DEPRECATED metroE "Use metro instead" #-} -- | Behaves like 'Csound.Opcode.Basic.metro', but returns an event stream.-metroE :: Sig -> Evt Unit +metroE :: Sig -> Evt Unit metroE = sigToEvt . O.metro -- | Creates a stream of events that happen with the given frequency.-metro :: Sig -> Evt Unit +metro :: Sig -> Evt Unit metro = sigToEvt . O.metro -- | Csound's original metro function.@@ -69,7 +69,7 @@ metroSig = O.metro -- | Creates a stream of ticks that happen around the given frequency with given deviation.--- +-- -- > gaussTrig freq deviation gaussTrig :: Sig -> Sig -> Tick gaussTrig afreq adev = Evt $ \bam -> do@@ -99,7 +99,7 @@ loadbang = impulseE 0 -- | Fires a single true value in the given time ahead.-impulse :: D -> Sig +impulse :: D -> Sig impulse dt = downsamp (mpulse (sig $ getBlockSize) 0 `withD` dt) `withD` getBlockSize -- | Fires a single event in the given time ahead.@@ -116,7 +116,7 @@ changedE = sigToEvt . changed -- | Behaves like 'Csound.Opcode.Basic.trigger', but returns an event stream.-triggerE :: Sig -> Sig -> Sig -> Evt Unit +triggerE :: Sig -> Sig -> Sig -> Evt Unit triggerE a1 a2 a3 = sigToEvt $ trigger a1 a2 a3 -- | the sync function but time is measured in beats per minute.@@ -126,7 +126,7 @@ -- | Splits event stream on two streams with predicate. partitionE :: (a -> BoolD) -> Evt a -> (Evt a, Evt a) partitionE p evts = (a, b)- where + where a = filterE p evts b = filterE (notB . p) evts @@ -144,14 +144,14 @@ -- higher level evt-funs -- | Constructs an event stream that contains an infinite repetition--- values from the given list. When an event happens this function takes +-- values from the given list. When an event happens this function takes -- the next value from the list, if there is no values left it starts -- from the beggining of the list. cycleE :: (Tuple a, Arg a) => [a] -> Evt b -> Evt a cycleE vals evts = listAt vals $ range (0, int $ length vals) evts -- | Turns an event of indices to the event of the values from the list.--- A value is taken with index. +-- A value is taken with index. listAt :: (Tuple a, Arg a) => [a] -> Evt D -> Evt a listAt vals evt | null vals = mempty@@ -160,7 +160,7 @@ within x = (x >=* 0) &&* (x `lessThan` len) len = int $ length vals --- | +-- | -- -- > range (xMin, xMax) === cycleE [xMin .. pred xMax] range :: (D, D) -> Evt b -> Evt D@@ -173,19 +173,19 @@ -- | An event stream of the random values in the interval @(0, 1)@. randDs :: Evt b -> Evt D-randDs = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ fmap readSnap $ random (0::D) 1 +randDs = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ fmap readSnap $ random (0::D) 1 -- | An event stram of lists of random values in the interval @(0, 1)@. -- The first argument is the length of the each list. randList :: Int -> Evt b -> Evt [D]-randList n = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ +randList n = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ sequence $ replicate n $ fmap readSnap $ random (0::D) 1 -- | Skips elements at random. -- -- > randSkip prob ----- where @prob@ is probability of includinng the element in the output stream. +-- where @prob@ is probability of includinng the element in the output stream. randSkip :: Sig -> Evt a -> Evt a randSkip d = filterSE (const $ fmap (<=* ir d) $ random (0::D) 1) @@ -198,7 +198,7 @@ randSkipBy d = filterSE (\x -> fmap (<=* ir (d x)) $ random (0::D) 1) -- | When something happens on the given event stream resulting--- event stream contains an application of some unary function to the +-- event stream contains an application of some unary function to the -- given initial value. So the event stream contains the values: -- -- > [s0, f s0, f (f s0), f (f (f s0)), ...]@@ -221,7 +221,7 @@ appendE empty append = accumE empty phi where phi a s = let s1 = s `append` a in (s1, s1) --- | A special variant of the function `appendE` for the monoids. +-- | A special variant of the function `appendE` for the monoids. -- Initial value is `mempty` and binary function is `mappend` which -- belong to the instance of the class `Monoid`. mappendE :: (Monoid a, Tuple a) => Evt a -> Evt a@@ -238,16 +238,16 @@ -- | Constructs an event stream that contains values from the -- given list which are taken in the random order. In the list we specify--- not only values but the frequencies of occurrence. Sum of the frequencies +-- not only values but the frequencies of occurrence. Sum of the frequencies -- should be equal to one. freqOf :: (Tuple a, Arg a) => Rnds a -> Evt b -> Evt a-freqOf rnds evt = fmap (takeByWeight accs vals) $ randDs evt +freqOf rnds evt = fmap (takeByWeight accs vals) $ randDs evt where accs = accumWeightList $ fmap fst rnds vals = fmap snd rnds takeByWeight :: (Tuple a, Arg a) => [Sig] -> [a] -> D -> a-takeByWeight accumWeights vals at = +takeByWeight accumWeights vals at = guardedArg (zipWith (\w val -> (at `lessThan` ir w, val)) accumWeights vals) (last vals) accumWeightList :: Num a => [a] -> [a]@@ -255,44 +255,44 @@ where go !s xs = case xs of [] -> [] a:as -> a + s : go (a + s) as- + -- | This function combines the functions 'Csound.Control.Evt.accumE' and -- 'Csound.Control.Evt.freqOf'. We transform the values of the event stream -- with stateful function that produce not just values but the list of values -- with frequencies of occurrence. We apply this function to the current state -- and the value and then at random pick one of the values.-freqAccum :: (Tuple s, Tuple (b, s), Arg (b, s)) - => s -> (a -> s -> Rnds (b, s)) -> Evt a -> Evt b -freqAccum s0 f = accumSE s0 $ \a s -> +freqAccum :: (Tuple s, Tuple (b, s), Arg (b, s))+ => s -> (a -> s -> Rnds (b, s)) -> Evt a -> Evt b+freqAccum s0 f = accumSE s0 $ \a s -> let rnds = f a s accs = accumWeightList $ fmap fst rnds vals = fmap snd rnds in fmap (takeByWeight accs vals . readSnap) $ random (0 :: D) 1 --- | Specialization of the function 'Csound.Control.Evt.masked'. +-- | Specialization of the function 'Csound.Control.Evt.masked'. -- -- > every n [a, b, c, ..] evt -- -- constructs a mask that skips first @n@ elements and then produces -- an event and skips next (a - 1) events, then produces an event and--- skips next (b - 1) events and so on. It's useful for construction of --- the percussive beats. For example +-- skips next (b - 1) events and so on. It's useful for construction of+-- the percussive beats. For example -- -- > every 0 [2] (metroE 2) ----- triggers an event on the odd beats. With this function we can +-- triggers an event on the odd beats. With this function we can -- create a complex patterns of cyclic events. -- every :: (Tuple a, Arg a) => Int -> [Int] -> Evt a -> Evt a-every empties beats = masked mask +every empties beats = masked mask where mask = (fmap (\x -> if x then 1 else 0) $ (replicate empties False) ++ patternToMask beats) --- | Filters events with the mask. A mask is a list of ones and zeroes. +-- | Filters events with the mask. A mask is a list of ones and zeroes. -- n'th element from the given list should be included in the resulting stream--- if the n'th element from the list equals to one or skipped if the element +-- if the n'th element from the list equals to one or skipped if the element -- equals to zero. masked :: (Tuple a, Arg a) => [D] -> Evt a -> Evt a-masked ms = filterAccumE 0 $ \a s -> +masked ms = filterAccumE 0 $ \a s -> let n = int $ length ms s1 = ifB (s + 1 `lessThan` n) (s + 1) 0 in (atArg ms s ==* 1, a, s1)@@ -301,7 +301,7 @@ patternToMask xs = case xs of [] -> [] a:as -> single a ++ patternToMask as- where single n + where single n | n <= 0 = [] | otherwise = True : replicate (n - 1) False @@ -336,9 +336,9 @@ -- | 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)) +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)) +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))
src/Csound/Control/Gui.hs view
@@ -1,29 +1,29 @@-{-# Language - TypeSynonymInstances, - FlexibleInstances, - MultiParamTypeClasses, - FlexibleContexts, +{-# 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. +-- | 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. -- -- A GUI element consists of two parts. They are view (how it looks) -- and logic (what's going on with it). For example a slider can be--- horizontal or vertical or green or yellow or small or big. It's the view --- of the slider. And a slider can produce a continuous signal within the --- given interval. It's a logic of the slider. +-- horizontal or vertical or green or yellow or small or big. It's the view+-- of the slider. And a slider can produce a continuous signal within the+-- given interval. It's a logic of the slider. -- -- Let's talk about the view. The view is divided on two parts: ----- * where element is placed or Layout. +-- * where element is placed or Layout. ----- * all other properties or just Properties. +-- * all other properties or just Properties. ----- The layout is defined with very simple functions. There are vertical and horizontal grouping +-- The layout is defined with very simple functions. There are vertical and horizontal grouping -- of the elements. We can scale the element within the group and include an empty--- space in the group. Everything is aligned (see "Csound.Gui.Layout"). --- Other properties include colors, fonts (size and type), borders, specific properties +-- space in the group. Everything is aligned (see "Csound.Gui.Layout").+-- Other properties include colors, fonts (size and type), borders, specific properties -- of the widgets (see "Csound.Gui.Props"). -- -- Let's consider the logic. The logic consists of three parts:@@ -34,7 +34,7 @@ -- -- * what's going on inside ('Csound.Gui.Inner') ----- A widget can react on values, produce values or do something useful. +-- A widget can react on values, produce values or do something useful. -- There are special types of widgets: -- -- * 'Csound.Gui.Source' - they produce values only@@ -42,22 +42,22 @@ -- * 'Csound.Gui.Sink' - they consume values only -- -- * 'Csound.Gui.Display' - something is going on inside them (for example, it can show a "hello world" message)--- --+-- -- Widgets can be simple and compound. Simple widgets are primitive elements--- (sliders, knobs, rollers, buttons). We have a special constructors that +-- (sliders, knobs, rollers, buttons). We have a special constructors that -- produce simple widgets (see "Csound.Gui.Widget"). Compound widgets glue together--- several widgets. That is the view contains several elements and all of them +-- several widgets. That is the view contains several elements and all of them -- involved in the logic of the widget. -- -- module Csound.Control.Gui ( -- * Gui- Gui, + Gui, Widget, Input, Output, Inner,- Sink, Source, Display, SinkSource,+ Sink(..), Source(..), Display(..), SinkSource(..), widget, sink, source, display, sinkSource, sinkSlice, sourceSlice,- mapSource, mapGuiSource, + mapSource, mapGuiSource, mhor, mver, msca, joinSource, fromSource, fromSourceSE, resizeSource, @@ -77,7 +77,7 @@ lift1, hlift2, vlift2, hlift3, vlift3, hlift4, vlift4, hlift5, vlift5, -- ** Lifters with visual scaling- hlifts', vlifts', + hlifts', vlifts', hlift2', vlift2', hlift3', vlift3', hlift4', vlift4', hlift5', vlift5', @@ -123,16 +123,16 @@ -- | Hides the SE inside Source. joinSource :: Source (SE a) -> Source a-joinSource a = do- (g, mv) <- a+joinSource a = Source $ do+ (g, mv) <- unSource a v <- mv return (g, v) fromSource :: Source a -> SE a fromSource a = do- (gui, asig) <- a+ (gui, asig) <- unSource a panel gui- return asig + return asig fromSourceSE :: Source (SE a) -> SE a fromSourceSE = join . fromSource@@ -156,12 +156,12 @@ vlifts :: ([a] -> b) -> [Source a] -> Source b vlifts = genLifts ver --- | Groups a list of Source-widgets. The visuals are put on the grid. +-- | Groups a list of Source-widgets. The visuals are put on the grid. -- The first argument is numer of elements i each row. gridLifts :: Int -> ([a] -> b) -> [Source a] -> Source b gridLifts rowLength = genLifts (grid rowLength) --- | Groups a list of Source-widgets. The visuals are horizontally aligned. +-- | 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)@@ -175,8 +175,8 @@ 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 +genLifts gf f as = Source $ fmap phi $ mapM unSource as+ where phi xs = (gf gs, f vs) where (gs, vs) = unzip xs @@ -187,20 +187,20 @@ lift2 :: (Gui -> Gui -> Gui) -> (a -> b -> c) -> Source a -> Source b -> Source c lift2 gf f ma mb = source $ do- (ga, a) <- ma- (gb, b) <- mb+ (ga, a) <- unSource ma+ (gb, b) <- unSource mb return $ (gf ga gb, f a b) lift2' a b gf = lift2 (tfm2 a b gf) where tfm2 sa sb gf = \a b -> gf (sca sa a) (sca sb b) -- | Combines two sound sources. Visuals are aligned horizontally--- and the sound sources a grouped with the given function. +-- and the sound sources a grouped with the given function. hlift2 :: (a -> b -> c) -> Source a -> Source b -> Source c hlift2 = lift2 (\a b -> hor [a, b]) -- | Combines two sound sources. Visuals are aligned vertically--- and the sound sources a grouped with the given function. +-- and the sound sources a grouped with the given function. vlift2 :: (a -> b -> c) -> Source a -> Source b -> Source c vlift2 = lift2 (\a b -> ver [a, b]) @@ -214,9 +214,9 @@ lift3 :: (Gui -> Gui -> Gui -> Gui) -> (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d lift3 gf f ma mb mc = source $ do- (ga, a) <- ma- (gb, b) <- mb- (gc, c) <- mc+ (ga, a) <- unSource $ ma+ (gb, b) <- unSource $ mb+ (gc, c) <- unSource $ mc return $ (gf ga gb gc, f a b c) lift3' sa sb sc gf = lift3 (tfm3 sa sb sc gf)@@ -240,10 +240,10 @@ lift4 :: (Gui -> Gui -> Gui -> Gui -> Gui) -> (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e lift4 gf f ma mb mc md = source $ do- (ga, a) <- ma- (gb, b) <- mb- (gc, c) <- mc- (gd, d) <- md+ (ga, a) <- unSource $ ma+ (gb, b) <- unSource $ mb+ (gc, c) <- unSource $ mc+ (gd, d) <- unSource $ md return $ (gf ga gb gc gd, f a b c d) lift4' sa sb sc sd gf = lift4 (tfm3 sa sb sc sd gf)@@ -268,11 +268,11 @@ lift5 :: (Gui -> Gui -> Gui -> Gui -> Gui -> Gui) -> (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b lift5 gf f ma1 ma2 ma3 ma4 ma5 = source $ do- (ga1, a1) <- ma1- (ga2, a2) <- ma2- (ga3, a3) <- ma3- (ga4, a4) <- ma4- (ga5, a5) <- ma5+ (ga1, a1) <- unSource $ ma1+ (ga2, a2) <- unSource $ ma2+ (ga3, a3) <- unSource $ ma3+ (ga4, a4) <- unSource $ ma4+ (ga5, a5) <- unSource $ ma5 return $ (gf ga1 ga2 ga3 ga4 ga5, f a1 a2 a3 a4 a5) lift5' sa sb sc sd se gf = lift5 (tfm3 sa sb sc sd se gf)@@ -333,8 +333,8 @@ genBind :: (Gui -> Gui -> Gui) -> Source a -> (a -> Source b) -> Source b genBind gui ma mf = source $ do- (ga, a) <- ma- (gb, b) <- mf a+ (ga, a) <- unSource ma+ (gb, b) <- unSource $ mf a return (gui ga gb, b) -- | Creates a list of sources with mapping a function and stacks them horizontally.@@ -360,5 +360,5 @@ genMapM :: ([Gui] -> Gui) -> (a -> Source b) -> [a] -> Source [b] genMapM gui f xs = source $ do- (gs, vs) <- fmap unzip $ mapM f xs- return (gui gs, vs) + (gs, vs) <- fmap unzip $ mapM (unSource . f) xs+ return (gui gs, vs)
src/Csound/Control/Gui/Widget.hs view
@@ -1,24 +1,24 @@ -- | Primitive GUI elements. ----- There is a convention that constructors take only parameters that --- specify the logic of the widget. The view is set for GUI-elements with +-- There is a convention that constructors take only parameters that+-- specify the logic of the widget. The view is set for GUI-elements with -- other functions. module Csound.Control.Gui.Widget (- -- * Common properties + -- * Common properties ValDiap(..), ValStep, ValScaleType(..), ValSpan(..), linSpan, expSpan, uspan, bspan, uspanExp, -- * Valuators- count, countSig, joy, + count, countSig, joy, knob, KnobType(..), setKnobType,- roller, + roller, slider, sliderBank, SliderType(..), setSliderType, numeric, TextType(..), setTextType, -- * Other widgets box, BoxType(..), setBoxType,- button, ButtonType(..), setButtonType, + button, ButtonType(..), setButtonType, toggle, butBank, toggleSig, butBankSig,- butBank1, butBankSig1, + butBank1, butBankSig1, radioButton, matrixButton, funnyRadio, funnyMatrix, setNumeric, meter, setKnob, setSlider,@@ -29,7 +29,7 @@ KeyEvt(..), Key(..), keyIn, charOn, charOff, strOn, strOff, -- * Easy to use widgets- uknob, xknob, uslider, xslider, ujoy, + uknob, xknob, uslider, xslider, ujoy, hradio, vradio, hradioSig, vradioSig, -- * Number selectors@@ -69,9 +69,9 @@ readMatrix :: Int -> Int -> [a] -> [a] readMatrix xn yn as = transp $ take (xn * yn) $ as ++ repeat (head as)- where + where transp xs = concat $ transpose $ parts yn xn xs- parts x y qs + parts x y qs | x == 0 = [] | otherwise = a : parts (x - 1) y b where (a, b) = splitAt y qs@@ -79,9 +79,9 @@ -- | A radio button. It takes a list of values with labels. radioButton :: Arg a => String -> [(String, a)] -> Int -> Source (Evt a) radioButton title as initVal = source $ do- (g, ind) <- butBank1 "" 1 (length as) (0, initVal)- gnames <- mapM box names- let val = listAt vals ind + (g, ind) <- unSource $ butBank1 "" 1 (length as) (0, initVal)+ gnames <- mapM (unDisplay . box) names+ let val = listAt vals ind gui <- setTitle title $ padding 0 $ hor [sca 0.15 g, ver gnames] return (gui, val) where (names, vals) = unzip as@@ -89,7 +89,7 @@ -- | A matrix of values. matrixButton :: Arg a => String -> Int -> Int -> [a] -> (Int, Int) -> Source (Evt a) matrixButton name xn yn vals initVal = source $ do- (gui, ind) <- butBank1 name xn yn initVal+ (gui, ind) <- unSource $ butBank1 name xn yn initVal let val = listAt allVals ind return (gui, val) where allVals = readMatrix xn yn vals@@ -97,7 +97,7 @@ -- | Radio button that returns functions. Useful for picking a waveform or type of filter. funnyRadio :: Tuple b => String -> [(String, a -> b)] -> Int -> Source (a -> b) funnyRadio name as initVal = source $ do- (gui, ind) <- radioButton name (zip names (fmap int [0 ..])) initVal+ (gui, ind) <- unSource $ radioButton name (zip names (fmap int [0 ..])) initVal contInd <- stepper (sig $ int initVal) $ fmap sig ind let instr x = guardedTuple ( zipWith (\n f -> (contInd ==* (sig $ int n), f x)) [0 ..] funs@@ -108,13 +108,13 @@ -- | Matrix of functional values. funnyMatrix :: Tuple b => String -> Int -> Int -> [(a -> b)] -> (Int, Int) -> Source (a -> b) funnyMatrix name xn yn funs initVal@(x0, y0) = source $ do- (gui, ind) <- butBank1 name xn yn initVal+ (gui, ind) <- unSource $ butBank1 name xn yn initVal contInd <- stepper flattenInitVal $ fmap sig ind let instr x = guardedTuple ( zipWith (\n f -> (contInd ==* (sig $ int n), f x)) [0 ..] allFuns ) (head allFuns x) return (gui, instr)- where + where allFuns = readMatrix xn yn funs flattenInitVal = sig $ int $ y0 + x0 * yn @@ -145,7 +145,7 @@ uknob :: Double -> Source Sig uknob = knob "" (linSpan 0 1) --- | Exponential slider (usefull for exploring frequencies or decibels). +-- | Exponential slider (usefull for exploring frequencies or decibels). -- -- > xknob (min, max) initVal --@@ -154,7 +154,7 @@ xslider :: Range Double -> Double -> Source Sig xslider (a, b) initVal = slider "" (expSpan a b) initVal --- | Exponential knob (usefull for exploring frequencies or decibels). +-- | Exponential knob (usefull for exploring frequencies or decibels). -- -- > xknob (min, max) initVal --@@ -187,8 +187,8 @@ genNumbers :: ([Gui] -> Gui) -> [Double] -> Source Sig genNumbers gx as@(d:ds) = source $ do ref <- newGlobalCtrlRef (sig $ double d)- (gs, evts) <- fmap unzip $ mapM (button . show) as- zipWithM_ (\x e -> runEvt e $ \_ -> writeRef ref (sig $ double x)) as evts + (gs, evts) <- fmap unzip $ mapM (unSource . button . show) as+ zipWithM_ (\x e -> runEvt e $ \_ -> writeRef ref (sig $ double x)) as evts res <- readRef ref return (gx gs, res) @@ -198,21 +198,21 @@ -- | The matrix of unipolar knobs. ----- > knobPad columnNum rowNum names initVals +-- > knobPad columnNum rowNum names initVals ----- It takes in the dimensions of matrix, the names (we can leave it empty +-- It takes in the dimensions of matrix, the names (we can leave it empty -- if names are not important) and list of init values. -- It returns a function that takes in indices and produces the signal in -- the corresponding cell. knobPad :: Int -> Int -> [String] -> [Double] -> Source (Int -> Int -> Sig) knobPad = genPad mkKnob 0.5- where mkKnob name = knob name uspan + where mkKnob name = knob name uspan -- | The matrix of toggle buttons. ----- > togglePad columnNum rowNum names initVals +-- > togglePad columnNum rowNum names initVals ----- It takes in the dimensions of matrix, the names (we can leave it empty +-- It takes in the dimensions of matrix, the names (we can leave it empty -- if names are not important) and list of init values (on/off booleans). -- It returns a function that takes in indices and produces the event stream in -- the corresponding cell.@@ -223,7 +223,7 @@ -- -- > buttonPad columnNum rowNum names ----- It takes in the dimensions of matrix, the names (we can leave it empty +-- It takes in the dimensions of matrix, the names (we can leave it empty -- if names are not important). -- It returns a function that takes in indices and produces the event stream in -- the corresponding cell.@@ -240,9 +240,9 @@ (gui, vals) <- fmap reGroupCol $ mapM mkRow inits let f x y = (vals !! y) !! x return $ (gui, f)- where - mkRow xs = fmap reGroupRow $ mapM (uncurry mk) xs- + where+ mkRow xs = fmap reGroupRow $ mapM (unSource . uncurry mk) xs+ inits = split height width $ zip (names ++ repeat "") (as ++ repeat initVal) split m n xs = case m of@@ -277,20 +277,20 @@ radioGroupSig :: ([Gui] -> Gui) -> [String] -> Int -> Source Sig radioGroupSig gcat names initVal = source $ do- (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> flip setToggleSig (i == initVal) tag) $ zip [0 ..] names+ (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> unSinkSource $ flip setToggleSig (i == initVal) tag) $ zip [0 ..] names curRef <- newGlobalCtrlRef (sig $ int initVal)- current <- readRef curRef + current <- readRef curRef zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids- zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do + zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do when1 (sig x ==* 1) $ do writeRef curRef i when1 (sig x ==* 0 &&* current ==* i) $ do- writeRef curRef i - ) reads ids + writeRef curRef i+ ) reads ids res <- readRef curRef return (gcat guis, res)- where + where ids = fmap (sig . int) [0 .. length names - 1] @@ -301,14 +301,14 @@ -- | Creates a knob that outputs only integers in the given range. -- It produces a signal of integer values. ----- > rangeKnobSig (min, max) initVal +-- > 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 (min, max) initVal rangeSliderSig :: Range Int -> Int -> Source Sig rangeSliderSig = rangeSig1 uslider @@ -344,7 +344,7 @@ | isInit = ((devt (int initVal) loadbang) <> ) | otherwise = id --- | 2d range range slider. Outputs a pair of event streams. +-- | 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)@@ -353,13 +353,13 @@ -- 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) + 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. +-- | 2d range range slider. It produces a single event stream. -- The event fires when any signal changes. -- -- > rangeJoy2 needsInit rangeX rangeY (initX, initY)@@ -375,12 +375,12 @@ -- | 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 $ +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) +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)@@ -399,23 +399,23 @@ -- 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+ (gui, output, input) <- unSinkSource $ setToggle name initVal output ctrl return $ (gui, mappend ctrl input) toggleSig' :: Sig -> String -> Bool -> Source Sig-toggleSig' ctrl name initVal = +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 +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 +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.@@ -430,7 +430,7 @@ -- | 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 +hradioSig' = radioGroupSig' hor -- | It's like simple @vradioSig@, but it can be controlled with external control. -- The first argument is for external control.@@ -439,8 +439,8 @@ -- | 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 +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.@@ -452,33 +452,33 @@ 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 <- newGlobalCtrlRef (sig $ int initVal) + (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> unSinkSource $ flip setToggleSig (i == initVal) tag) $ zip [0 ..] names+ curRef <- newGlobalCtrlRef (sig $ int initVal) when1 (changed [ctrl] ==* 1) $ writeRef curRef ctrl - current <- readRef curRef + current <- readRef curRef zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids- zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do + zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do when1 (sig x ==* 1) $ do writeRef curRef i when1 (sig x ==* 0 &&* current ==* i) $ do- writeRef curRef i - ) reads ids + writeRef curRef i+ ) reads ids res <- readRef curRef return (gcat guis, res)- where + 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+ (gui, output, input) <- unSinkSource v ref <- newGlobalCtrlRef (sig initVal)- when1 (changed [ctrl] ==* 1) $ writeRef ref ctrl - when1 (changed [input] ==* 1) $ writeRef ref input + when1 (changed [ctrl] ==* 1) $ writeRef ref ctrl+ when1 (changed [input] ==* 1) $ writeRef ref input res <- readRef ref output res return (gui, res)- +
src/Csound/IO.hs view
@@ -37,6 +37,9 @@ -- * Render and run csd, csdBy, + -- * Save user options+ saveUserOptions,+ -- * Render and run with cabbage runCabbage, runCabbageBy, @@ -116,7 +119,7 @@ instance {-# OVERLAPPING #-} RenderCsd (Source ()) where renderCsdBy opt src = renderCsdBy opt $ do- (ui, _) <- src+ (ui, _) <- unSource src panel ui instance {-# OVERLAPPING #-} RenderCsd (Source (SE ())) where