csound-expression 4.8.4 → 4.9.0

raw patch · 12 files changed

+514/−51 lines, 12 filesdep +containersdep ~csound-expression-typedPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependency ranges changed: csound-expression-typed

API changes (from Hackage documentation)

Files

• csound-expression.cabal +5/−3
• src/Csound/Air.hs +8/−0
• src/Csound/Air/Fm.hs +250/−0
• src/Csound/Air/Fx.hs +6/−1
• src/Csound/Air/Live.hs +3/−3
• src/Csound/Air/Misc.hs +49/−11
• src/Csound/Air/Pan.hs +42/−0
• src/Csound/Air/Patch.hs +107/−26
• src/Csound/Air/Sampler.hs +5/−1
• src/Csound/Air/Wave.hs +28/−2
• src/Csound/IO.hs +2/−2
• src/Csound/Tab.hs +9/−2

@@ -1,5 +1,5 @@ Name:          csound-expression-Version:       4.8.4+Version:       4.9.0 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -64,8 +64,8 @@ Library   Ghc-Options:    -Wall   Build-Depends:-        base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0, transformers >= 0.3,-        csound-expression-typed >= 0.0.8, csound-expression-dynamic >= 0.1.5, temporal-media >= 0.6.1,+        base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0, transformers >= 0.3, containers,+        csound-expression-typed >= 0.0.9, csound-expression-dynamic >= 0.1.5, temporal-media >= 0.6.1,         csound-expression-opcodes >= 0.0.3   Hs-Source-Dirs:      src/   Exposed-Modules:@@ -86,6 +86,8 @@         Csound.Air.Patch         Csound.Air.Misc         Csound.Air.Hvs+        Csound.Air.Fm+        Csound.Air.Pan                          Csound.Types         Csound.Tab

@@ -36,6 +36,12 @@     -- | Triggering sound samples with events, keyboard and midi.     module Csound.Air.Sampler, +    -- | Advanced panning functions+    module Csound.Air.Pan,++    -- | FM synth+    module Csound.Air.Fm,+     -- | Other usefull stuff.     module Csound.Air.Misc ) where@@ -52,5 +58,7 @@ import Csound.Air.Patch import Csound.Air.Seg import Csound.Air.Sampler+import Csound.Air.Pan+import Csound.Air.Fm import Csound.Air.Misc 

@@ -0,0 +1,250 @@+-- | Tools to build Fm synthesis graphs +--+-- Example+--+-- > f a = fmOut1 $ do+-- > 	x1 <- fmOsc 1+-- > 	x2 <- fmOsc 2+-- > 	x1 `fmod` [(a, x2)]+-- > 	return x1+module Csound.Air.Fm(+	-- * Fm graph+	Fm, FmNode,+	fmOsc', fmOsc, fmSig,+	fmod, +	fmOut, fmOut1, fmOut2,++	-- * Simplified Fm graph+	FmSpec(..), FmGraph(..), fmRun,+	-- ** Specific graphs+	-- | Algorithms for DX7 fm synth+	dx_1,  dx_2,  dx_3,  dx_4 {-,  dx_5,  dx_6,  dx_7,  dx_8,+	dx_9,  dx_10, dx_11, dx_12, dx_13, dx_14, dx_15, dx_16,+	dx_17, dx_18, dx_19, dx_20, dx_21, dx_22, dx_23, dx_24,+	dx_25, dx_26, dx_27, dx_28, dx_29, dx_30, dx_31, dx_32 -}+) where++import qualified Data.IntMap as IM++import Control.Monad.Trans.State.Strict+import Control.Monad++import Csound.Typed+import Csound.Air.Wave+import Csound.SigSpace++-- Fm graph rendering++type Fm a = State St a++newtype FmNode = FmNode { unFmNode :: Int }++type FmIdx = (Int, Sig)++data Fmod = Fmod (Sig -> SE Sig) Sig [FmIdx] | Fsig Sig++data St = St +	{ newIdx     :: Int+	, units      :: [Fmod]+	, links      :: IM.IntMap [FmIdx]+	}++defSt = St +	{ newIdx = 0+	, units = []	+	, links = IM.empty }++renderGraph :: [Fmod] -> [FmIdx] -> Sig -> SE [Sig]+renderGraph units outs cps = do+	refs <- initUnits (length units)+	mapM_ (loopUnit refs) (zip [0 .. ] units)+	mapM (renderIdx refs) outs+	where+		initUnits n = mapM (const $ newRef (0 :: Sig)) [1 .. n]++		loopUnit refs (n, x) = writeRef (refs !! n) =<< case x of+			Fsig asig -> return asig+			Fmod wave mod subs -> do+				s <- fmap sum $ mapM (renderModIdx refs) subs+				wave (cps * mod + s)+			where ++		renderIdx :: [Ref Sig] -> (Int, Sig) -> SE Sig+		renderIdx refs (idx, amp) = mul amp $ readRef (refs !! idx)++		renderModIdx :: [Ref Sig] -> (Int, Sig) -> SE Sig+		renderModIdx refs (idx, amp) = mul (amp * mod) $ readRef (refs !! idx)	+			where mod = case (units !! idx) of+					Fmod _ m _ -> m * cps+					_          -> 1+++mkGraph :: St -> [Fmod]+mkGraph s = zipWith extractMod (reverse $ units s) [0 .. ]+	where+		extractMod x n = case x of+			Fmod alg w _ -> Fmod alg w (maybe [] id $ IM.lookup n (links s))+			_            -> x++toFmIdx :: (Sig, FmNode) -> FmIdx+toFmIdx (amp, FmNode n) = (n, amp)++---------------------------------------------------------+-- constructors++-- | Creates fm node with generic wave.+--+-- > fmOsc' wave modFreq+fmOsc' :: (Sig -> SE Sig) -> Sig -> Fm FmNode+fmOsc' wave idx = newFmod (Fmod wave idx [])++-- | Creates fm node with sine wave.+--+-- > fmOsc modFreq+fmOsc :: Sig -> Fm FmNode+fmOsc = fmOsc' rndOsc++-- | Creates fm node with signal generator (it's independent from the main frequency).+fmSig :: Sig -> Fm FmNode+fmSig a = newFmod (Fsig a)++newFmod :: Fmod -> Fm FmNode+newFmod a = state $ \s -> +	let n  = newIdx s+	    s1 = s { newIdx = n + 1, units = a : units s }+	in  (FmNode n, s1)++-- modulator++fmod :: FmNode -> [(Sig, FmNode)] -> Fm ()+fmod (FmNode idx) mods = state $ \s -> +	((), s { links = IM.insertWithKey (\_ a b -> a ++ b) idx (fmap toFmIdx mods) (links s) })++-- outputs++-- | Renders Fm synth to function.+fmOut :: Fm [(Sig, FmNode)] -> Sig -> SE [Sig]+fmOut fm = renderGraph (mkGraph s) (fmap toFmIdx outs)+	where (outs, s) = runState fm defSt++-- | Renders mono output.+fmOut1 :: Fm FmNode -> Sig -> SE Sig+fmOut1 fm cps = fmap head $ fmOut (fmap (\x -> [(1, x)]) fm) cps++-- | Renders stereo output.+fmOut2 :: Fm (FmNode, FmNode) -> Sig -> SE Sig2+fmOut2 fm cps = fmap (\[a, b] -> (a, b)) $ fmOut (fmap (\(a, b) -> [(1, a), (1, b)]) fm) cps++-----------------------------------------------------------------------++data FmSpec = FmSpec +	{ fmWave :: [Sig -> SE Sig]+	, fmCps :: [Sig]+	, fmInd :: [Sig]+	, fmOuts :: [Sig] }++data FmGraph = FmGraph +	{ fmGraph 	:: [(Int, [Int])]+	, fmGraphOuts :: [Int] }++fmRun :: FmGraph -> FmSpec -> Sig -> SE Sig+fmRun graph spec' cps = fmap sum $ ($ cps) $ fmOut $ do+	ops <- zipWithM fmOsc' (fmWave spec) (fmCps spec)+	mapM_ (mkMod ops (fmInd spec)) (fmGraph graph)+	return $ zipWith (toOut ops) (fmOuts spec) (fmGraphOuts graph)+	where +		spec = addDefaults spec'+		toOut xs amp n = (amp, xs !! n)+		mkMod ops ixs (n, ms) = (ops !! n) `fmod` (fmap (\m -> (ixs !! m, ops !! m)) ms)++addDefaults :: FmSpec -> FmSpec+addDefaults spec = spec +	{ fmWave = fmWave spec ++ repeat rndOsc	+	, fmCps  = fmCps  spec ++ repeat 1+	, fmInd  = fmInd  spec ++ repeat 1+	, fmOuts = fmOuts spec ++ repeat 1 }++{-|+>	 	+--++>		6  |+>		+--++>		5+>		|+>	2	4+>	|	|+>	1	3+>	+---++-}+dx_1 = FmGraph +	{ fmGraphOuts = [1, 3]+	, fmGraph = +		[ (1, [2])+		, (3, [4])+		, (4, [5])+		, (5, [6])+		, (6, [6]) ]}++{-|+>         6 +>         |+>         5+>   +--+  |+>	2  |  4+>	+--+  |+>	1     3+>   +-----++-}+dx_2 = FmGraph +	{ fmGraphOuts = [1, 3]+	, fmGraph = +		[ (1, [2])+		, (2, [2])+		, (3, [4])+		, (5, [6]) ]}++{-|+>	    +--++>	3   6  |+>	|   +--++>	2   5+>	|	|+>	1 	4+>	+---++-}+dx_3 = FmGraph +	{ fmGraphOuts = [1, 4]+	, fmGraph = +		[ (1, [2])+		, (2, [3])+		, (4, [5])+		, (5, [6])+		, (6, [6]) ]}++{-|+>			+--++>		3	6  |+>		|	|  |	+>		2	5  |+>		|	|  |+>		1	4  |+>		|	+--++>       +---+ +-}+dx_4 = FmGraph+	{ fmGraphOuts = [1, 4]+	, fmGraph = +		[ (1, [2])+		, (2, [3])+		, (4, [5])+		, (5, [6])+		, (6, [4]) ]}++{-+dx12 = DxGraph +	{ dxGraphOuts = [3, 1]+	, dxGraph = +		[ (3, [4, 5, 6])+		, (1, [2])+		, (2, [2]) ]}++-}

@@ -43,7 +43,6 @@  import Csound.Air.Wave(Lfo, unipolar, oscBy, utri, white, pink) import Csound.Air.Filter-import Csound.Air.Misc(mean)  -- | Mono version of the cool reverberation opcode reverbsc. --@@ -539,3 +538,9 @@      aout <-readRef aoutRef     return aout++++-- | Mean value.+mean :: Fractional a => [a] -> a+mean xs = sum xs / (fromIntegral $ length xs)

@@ -412,13 +412,13 @@ ---------------------------------------------------- -- effect choosers -hpatchChooser :: (SigSpace a, Sigs a) => [(String, Patch a)] -> Int -> Source a +hpatchChooser :: (SigSpace a, Sigs a) => [(String, Patch D a)] -> Int -> Source a  hpatchChooser = genPatchChooser hradioSig -vpatchChooser :: (SigSpace a, Sigs a) => [(String, Patch a)] -> Int -> Source a +vpatchChooser :: (SigSpace a, Sigs a) => [(String, Patch D a)] -> Int -> Source a  vpatchChooser = genPatchChooser vradioSig -genPatchChooser :: (SigSpace a, Sigs a) => ([String] -> Int -> Source Sig) -> [(String, Patch a)] -> Int -> Source a+genPatchChooser :: (SigSpace a, Sigs a) => ([String] -> Int -> Source Sig) -> [(String, Patch D a)] -> Int -> Source a genPatchChooser widget xs initVal = joinSource $ lift1 go $ widget names initVal     where          (names, patches) = unzip xs                

@@ -21,6 +21,9 @@     -- * Effects     delaySig, +    -- * Wave shaper+    wshaper, genSaturator, saturator, mildSaturator, hardSaturator, hardSaturator2,+     -- * Function composition     funSeq, funPar, @@ -31,10 +34,7 @@     ticks4, nticks4,      -- * Drone-    testDrone, testDrone2, testDrone3, testDrone4,--    hrtf-+    testDrone, testDrone2, testDrone3, testDrone4 ) where  import Control.Monad@@ -518,13 +518,51 @@  type Feedback = Sig -----------------------------------------------------------+------------------------------------------------------+-- wave shaper -hrtf :: (Sig, Sig) -> Sig -> (Sig,Sig)-hrtf (a, b) asig = hrtfmove' asig a b+-- | Wave shaper. The signal should be bepolar. It ranges within the interval [-1, 1].+--+-- > wshaper table amount asig+--+-- wave shaper transforms the input signal with the table. +-- The amount of transformation scales the signal from 0 to 10. +-- the amount is ratio of scaling. It expects the values from the interval [0, 1].+-- +wshaper :: Tab -> Sig -> Sig -> Sig+wshaper t amt asig = tablei (0.5 + amt * asig / 20) t `withD` 1  -hrtfmove' ::  Sig -> Sig -> Sig -> (Sig,Sig)-hrtfmove' b1 b2 b3 = pureTuple $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> (unStr $ text "hrtf-44100-left.dat") <*> (unStr $ text "hrtf-44100-right.dat")-    where f a1 a2 a3 a4 a5 = mopcs "hrtfmove" ([Ar,Ar],[Ar,Kr,Kr,Sr,Sr,Ir,Ir,Ir]) [a1,a2,a3,a4,a5]+-- | Wave shaper with sigmoid.+-- +-- > genSaturator sigmoidRadius amount asig+--+-- * sigmoid radius is 5 to 100.+--+-- * amount is [0, 1]+genSaturator :: Double -> Sig -> Sig -> Sig+genSaturator rad amt = wshaper (tanhSigmoid rad) amt --- "hrtf-44100-left.dat","hrtf-44100-right.dat"+-- | Alias for+--+-- > genSaturator 5+mildSaturator :: Sig -> Sig -> Sig+mildSaturator = genSaturator 10++-- | Alias for+--+-- > genSaturator 10+saturator :: Sig -> Sig -> Sig+saturator = genSaturator 15++-- | Alias for+--+-- > genSaturator 50+hardSaturator :: Sig -> Sig -> Sig+hardSaturator = genSaturator 35++-- | Alias for+--+-- > genSaturator 100+hardSaturator2 :: Sig -> Sig -> Sig+hardSaturator2 = genSaturator 65+

@@ -0,0 +1,42 @@+-- | Effects+module Csound.Air.Pan(    +    HeadPanSpec(..),+    headPan, headPan', staticHeadPan,+    headPan2, headPan2', staticHeadPan2,+    headPanNet, headPanNet2+) where++import Csound.Typed+import Csound.Air.Wav(toMono)++-- | The same as headPan but for stereo signals.+headPan2 :: (Sig, Sig) -> Sig2 -> Sig2+headPan2 point = headPan point . toMono++-- | The same as headPan' but for stereo signals.+headPan2' :: HeadPanSpec -> (Sig, Sig) -> Sig2 -> Sig2+headPan2' spec point = headPan' spec point . toMono++-- | The same as staticHeadPan but for stereo signals.+staticHeadPan2 :: (D, D) -> Sig2 -> Sig2+staticHeadPan2 point = staticHeadPan point . toMono++-- | Net of sounds evenly distributed oround the head.+-- First argument is a pair of numbers (column, rows) in the matrix.+-- The second argument is a matrix written in a single list.+-- The rows are for elevation and the columns are for azimuth.+--+-- A ghci session example:+--+-- > let f t x = mul 0.4 $ sched (\_ -> return $ fades 0.07 0.1 * tri x) $ withDur 0.2 $ metro t+-- > dac $ headPanNet (3, 2) [f 1 220, f 0.75 330, f 0.5 440, f 0.2 660, delaySnd 0.75 $ f 2 (220 * 5/4),delaySnd 0.4 $  f 1 (220 * 9/8)]+headPanNet :: (Int, Int) -> [Sig] -> Sig2+headPanNet (m, n) sigs = sum $ zipWith staticHeadPan [(double a, double b) | a <- xs m, b <- xs n] sigs+    where xs t = fmap (( / fromIntegral t) . fromIntegral) [0 .. (t - 1)]+  +-- | The same as headPanNet but for stereo signals.+headPanNet2 :: (Int, Int) -> [Sig2] -> Sig2+headPanNet2 (m, n) sigs = headPanNet (m, n) (fmap toMono sigs)+++

@@ -2,10 +2,11 @@ module Csound.Air.Patch( 	CsdNote, Instr, Fx, Fx1, Fx2, FxSpec(..), DryWetRatio, 	Patch1, Patch2, Patch(..),	+	PatchSig1, PatchSig2, 	getPatchFx, dryPatch, atMix, atMixes,  	-- * Midi-	atMidi,+	atMidi, atMono, atMono', atMonoSharp, atHoldMidi,  	-- * Events 	atSched,@@ -24,7 +25,16 @@ 	harmonPatch, deepPad,  	-- * Misc-	patchWhen, mixInstr+	patchWhen, mixInstr,++	-- * Rever+	withSmallRoom, withSmallRoom', +	withSmallHall, withSmallHall',+	withLargeHall, withLargeHall',+	withMagicCave, withMagicCave',++	-- * Sound font patches+	sfPatch, sfPatchHall ) where  import Control.Monad@@ -34,13 +44,15 @@ import Csound.SigSpace import Csound.Control.Midi import Csound.Control.Instr+import Csound.Control.Sf+import Csound.Air.Fx  -- | A simple csound note (good for playing with midi-keyboard). -- It's a pair of amplitude (0 to 1) and freuqncy (Hz).-type CsdNote = (D, D)+type CsdNote a = (a, a)  -- | An instrument transforms a note to a signal.-type Instr a = CsdNote -> SE a+type Instr a b = CsdNote a -> SE b  -- | An effect processes the input signal. type Fx a = a  -> SE a@@ -53,27 +65,33 @@ type Fx2 = Fx Sig2  -- | Mono patches.-type Patch1 = Patch Sig+type Patch1 = Patch D Sig  -- | Stereo patches.-type Patch2 = Patch Sig2+type Patch2 = Patch D Sig2 +-- | Mono continuous patches.+type PatchSig1 = Patch Sig Sig++-- | Stereo continuous patches.+type PatchSig2 = Patch Sig Sig2+ data FxSpec a = FxSpec 	{ fxMix :: DryWetRatio 	, fxFun :: Fx a	 	}  -- | A patch. It's an instrument, an effect and default dry/wet ratio.-data Patch a = Patch-	{ patchInstr :: Instr a-	, patchFx	 :: [FxSpec a]+data Patch a b = Patch+	{ patchInstr :: Instr a b+	, patchFx	 :: [FxSpec b] 	} -dryPatch :: Patch a -> Patch a+dryPatch :: Patch a b -> Patch a b dryPatch p = p { patchFx = [] }  -- | Sets the mix of the last effect.-atMix :: Sig -> Patch a -> Patch a+atMix :: Sig -> Patch a b -> Patch a b atMix k p = p { patchFx = mapHead (\x -> x { fxMix = k }) (patchFx p) } 	where  		mapHead f xs = case xs of@@ -81,7 +99,7 @@ 			a:as -> f a : as  -- | Sets the mix of the effects from last to first.-atMixes :: [Sig] -> Patch a -> Patch a+atMixes :: [Sig] -> Patch a b -> Patch a b atMixes ks p = p { patchFx = zipFirst (\k x -> x { fxMix = k }) ks (patchFx p) } 	where 		zipFirst f xs ys = case (xs, ys) of@@ -94,19 +112,19 @@ wet (FxSpec k fx) asig = fmap ((mul (1 - k) asig + ) . mul k) $ fx asig  -- | Transforms all the effects for the given patch into a single function. -getPatchFx :: (SigSpace a, Sigs a) => Patch a -> Fx a+getPatchFx :: (SigSpace a, Sigs a) => Patch b a -> Fx a getPatchFx p = foldr (<=<) return $ fmap wet $ patchFx p  -------------------------------------------------------------- -instance SigSpace a => SigSpace (Patch a) where+instance SigSpace a => SigSpace (Patch b a) where 	mapSig f p = p { patchInstr = fmap (mapSig f) . patchInstr p }  -------------------------------------------------------------- -- note  -- | Plays a patch at the given note.-atNote :: (SigSpace a, Sigs a) => Patch a -> CsdNote -> SE a+atNote :: (SigSpace b, Sigs b) => Patch a b -> CsdNote a -> SE b atNote p note = getPatchFx p =<< patchInstr p note  --------------------------------------------------------------@@ -114,18 +132,38 @@  -- | Plays a patch with midi. Supplies a custom value for mixing effects (dry/wet). -- The 0 is a dry signal, the 1 is a wet signal.-atMidi :: (SigSpace a, Sigs a) => Patch a -> SE a+atMidi :: (SigSpace a, Sigs a) => Patch D a -> SE a atMidi a = getPatchFx a =<< midi (patchInstr a . ampCps)	 +-- | Simplified monosynth patch+atMono :: (SigSpace a, Sigs a) => Patch Sig a -> SE a+atMono = atMono' ChnAll 0.01 0.1++-- | Simplified monosynth patch (sharp attack and transitions)+atMonoSharp :: (SigSpace a, Sigs a) => Patch Sig a -> SE a+atMonoSharp = atMono' ChnAll 0.005 0.05++-- | Monosynth patch. Plays the patch with function @monoMsg@+--+-- > atMonoMidi midiChn portamentotime releaseTime patch+atMono' :: (SigSpace a, Sigs a) => MidiChn -> D -> D -> Patch Sig a -> SE a+atMono' chn port rel a = getPatchFx a =<< patchInstr a =<< monoMsg chn port rel++-- | Monosynth patch. Plays the patch with function @holdMsg@+--+-- > atMonoMidi midiChn portamentotime patch+atHoldMidi :: (SigSpace a, Sigs a) => MidiChn -> D -> Patch Sig a -> SE a+atHoldMidi chn port a = getPatchFx a =<< patchInstr a =<< holdMsg chn port+ -------------------------------------------------------------- -- sched  -- | Plays a patch with event stream. Supplies a custom value for mixing effects (dry/wet). -- The 0 is a dry signal, the 1 is a wet signal.-atSched :: (SigSpace a, Sigs a) => Patch a -> Evt (Sco CsdNote) -> SE a+atSched :: (SigSpace a, Sigs a) => Patch D a -> Evt (Sco (CsdNote D)) -> SE a atSched p evt = getPatchFx p $ sched (patchInstr p) evt -atSchedUntil :: (SigSpace a, Sigs a) => Patch a -> Evt CsdNote -> Evt b -> SE a+atSchedUntil :: (SigSpace a, Sigs a) => Patch D a -> Evt (CsdNote D) -> Evt b -> SE a atSchedUntil p evt stop = getPatchFx p $ schedUntil (patchInstr p) evt stop  --------------------------------------------------------------@@ -133,43 +171,86 @@   -- | Plays a patch with scores. Supplies a custom value for mixing effects (dry/wet). -- The 0 is a dry signal, the 1 is a wet signal.-atSco :: (SigSpace a, Sigs a) => Patch a -> Sco CsdNote -> Sco (Mix a)+atSco :: (SigSpace a, Sigs a) => Patch D a -> Sco (CsdNote D) -> Sco (Mix a) atSco p sc = eff (getPatchFx p) $ sco (patchInstr p) sc	  --------------------------------------------------------------  -- | Adds an effect to the patch's instrument.-addInstrFx :: Fx a -> Patch a -> Patch a+addInstrFx :: Fx b -> Patch a b -> Patch a b addInstrFx f p = p { patchInstr = f <=< patchInstr p }  -- | Appends an effect before patch's effect.-addPreFx :: DryWetRatio -> Fx a -> Patch a -> Patch a+addPreFx :: DryWetRatio -> Fx b -> Patch a b -> Patch a b addPreFx dw f p = p { patchFx = patchFx p ++ [FxSpec dw f] }  -- | Appends an effect after patch's effect.-addPostFx :: DryWetRatio -> Fx a -> Patch a -> Patch a+addPostFx :: DryWetRatio -> Fx b -> Patch a b -> Patch a b addPostFx dw f p = p { patchFx = FxSpec dw f : patchFx p }  ----------------------------------------------------------------  -- | Plays the patch when confition is true otherwise it produces silence.-patchWhen :: Sigs a => BoolSig -> Patch a -> Patch a+patchWhen :: Sigs b => BoolSig -> Patch a b -> Patch a b patchWhen cond p = p  	{ patchInstr = playWhen cond (patchInstr p) 	, patchFx    = fmap (mapFun $ playWhen cond) (patchFx p) } 	where mapFun f x = x { fxFun = f $ fxFun x }  -mixInstr :: (SigSpace a, Num a) => Sig -> Patch a -> Patch a -> Patch a+mixInstr :: (SigSpace b, Num b) => Sig -> Patch a b -> Patch a b -> Patch a b mixInstr k f p = p { patchInstr = \x -> liftA2 (+) (patchInstr p x) (fmap (mul k) (patchInstr f x)) }  ------------------------------------------------ -- pads -harmonPatch :: (SigSpace a, Sigs a) => [Sig] -> [D] -> Patch a -> Patch a+harmonPatch :: (Fractional a, SigSpace b, Sigs b) => [Sig] -> [a] -> Patch a b -> Patch a b harmonPatch amps freqs p = p {  		patchInstr = \(amp, cps) -> fmap sum $ zipWithM (\a f -> fmap (mul a) $ patchInstr p (amp, cps * f)) amps freqs	 	} -deepPad :: (SigSpace a, Sigs a) => Patch a -> Patch a+deepPad :: (Fractional a, SigSpace b, Sigs b) => Patch a b -> Patch a b deepPad = harmonPatch (fmap (* 0.75) [1, 0.5]) [1, 0.5]++------------------------------------------------+-- revers++withSmallRoom :: Patch2 -> Patch2+withSmallRoom = withSmallRoom' 0.25++withSmallRoom' :: DryWetRatio -> Patch2 -> Patch2+withSmallRoom' = withRever smallRoom2++withSmallHall :: Patch2 -> Patch2+withSmallHall = withSmallHall' 0.25++withSmallHall' :: DryWetRatio -> Patch2 -> Patch2+withSmallHall' = withRever smallHall2++withLargeHall :: Patch2 -> Patch2+withLargeHall = withLargeHall' 0.25++withLargeHall' :: DryWetRatio -> Patch2 -> Patch2+withLargeHall' = withRever largeHall2++withMagicCave :: Patch2 -> Patch2+withMagicCave = withMagicCave' 0.25++withMagicCave' :: DryWetRatio -> Patch2 -> Patch2+withMagicCave' = withRever magicCave2++withRever :: (Sig2 -> Sig2) -> DryWetRatio -> Patch2 -> Patch2+withRever fx ratio p = addPostFx ratio (return . fx) p++------------------------------------------------+-- sound font patch++sfPatchHall :: Sf -> Patch2+sfPatchHall sf = Patch +    { patchInstr = \(amp, cps) -> return $ sfCps sf 0.5 amp cps+    , patchFx    = [(FxSpec 0.25 (return . smallHall2))] }++sfPatch :: Sf -> Patch2+sfPatch sf = Patch +    { patchInstr = \(amp, cps) -> return $ sfCps sf 0.5 amp cps+    , patchFx    = [] }

@@ -26,7 +26,8 @@      -- | Keyboard char columns     keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, -    keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0+    keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0,+    keyColumns  ) where @@ -357,3 +358,6 @@ keyColumn8 = ['8', 'i', 'k', ','] keyColumn9 = ['9', 'o', 'l', '.'] keyColumn0 = ['0', 'p', ';', '/']++keyColumns :: [[Char]]+keyColumns = [keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0]

@@ -35,12 +35,15 @@     multiHz, multiCent, multiRnd, multiGauss, multiRndSE, multiGaussSE,      -- * Random splines-    urspline, birspline+    urspline, birspline,++    -- * Buzzes+    buz, gbuz, buz', gbuz'     ) where  import Csound.Typed import Csound.Typed.Opcode hiding (lfo)-import Csound.Tab(sine, sines4)+import Csound.Tab(sine, cosine, sines4) import Csound.SigSpace  -- | A pure tone (sine wave).@@ -312,3 +315,26 @@ -- | Mean value. mean :: Fractional a => [a] -> a mean xs = sum xs / (fromIntegral $ length xs)++---------------------------------------------+-- buzzes++-- |  Output is a set of harmonically related sine partials.+--+-- > buz numOfHarmonics frequency+buz :: Sig -> Sig -> Sig+buz kh x = buzz 1 x kh sine++-- | Buz with phase+buz' :: D -> Sig -> Sig -> Sig+buz' phs kh x = buz kh x `withD` phs++-- |  Output is a set of harmonically related cosine partials.+--+-- > gbuz (minHarm, maxHarm) ratio frequency+gbuz :: (Sig, Sig) -> Sig -> Sig -> Sig+gbuz (hmin, hmax) hratio x = gbuzz 1 x hmax hmin hratio cosine++-- | Gbuz with phase+gbuz' :: D -> (Sig, Sig) -> Sig -> Sig -> Sig+gbuz' phs hs hratio x = gbuz hs hratio x `withD` phs

@@ -46,7 +46,7 @@ import Csound.Typed import Csound.Control.Gui -import Csound.Options(setSilent, setMa, setDac)+import Csound.Options(setSilent, setDac)  render :: Sigs a => Options -> SE a -> IO String render = renderOutBy @@ -225,7 +225,7 @@ dacBy opt' a = do     writeCsdBy opt "tmp.csd" a     runWithUserInterrupt $ "csound " ++ "tmp.csd" -    where opt = opt' <> (setMa <> setDac)+    where opt = opt' <> setDac  -- | Output to dac with virtual midi keyboard. vdac :: (RenderCsd a) => a -> IO ()

@@ -28,7 +28,7 @@     PartialStrength, PartialNumber, PartialPhase, PartialDC,     sines, sines3, sines2, sines1, sines4, buzzes,     -- ** Special cases-    sine, cosine, sigmoid,+    sine, cosine, sigmoid, tanhSigmoid,      -- * Interpolants         -- | All funtions have the same shape of arguments:@@ -86,7 +86,10 @@     , idExps, idSplines, idStartEnds,  idPolys, idChebs1, idChebs2, idBessels, idWins,      -- * Tabular opcodes-    tablewa, sec2rel+    tablewa, sec2rel,++    -- * Tables of tables+    TabList, tabList, fromTabList, fromTabListD ) where  import Control.Applicative hiding ((<*))@@ -404,6 +407,10 @@ -- | Table for sigmoid wave. sigmoid :: Tab sigmoid = sines4 [(0.5, 0.5, 270, 0.5)]++-- | Creates tanh sigmoid. The argument is the radius of teh sigmoid.+tanhSigmoid :: Double -> Tab+tanhSigmoid x = esplines (fmap tanh [-x, (-x +0.5) .. x])   -- | Generates values similar to the opcode 'Csound.Opcode.Basic.buzz'.  --