packages feed

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 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