csound-expression 4.5 → 4.6

raw patch · 7 files changed

+671/−37 lines, 7 filesdep ~csound-expression-dynamicdep ~csound-expression-opcodesdep ~csound-expression-typedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: csound-expression-dynamic, csound-expression-opcodes, csound-expression-typed

API changes (from Hackage documentation)

Files

• csound-expression.cabal +4/−3
• src/Csound/Air/Fx.hs +142/−27
• src/Csound/Air/Granular.hs +220/−4
• src/Csound/Air/Hvs.hs +152/−0
• src/Csound/Air/Spec.hs +88/−1
• src/Csound/Base.hs +1/−1
• src/Csound/Tab.hs +64/−1

@@ -1,5 +1,5 @@ Name:          csound-expression-Version:       4.5+Version:       4.6 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -68,8 +68,8 @@   Ghc-Options:    -Wall   Build-Depends:         base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0, transformers >= 0.3,-        csound-expression-typed >= 0.0.7.2, csound-expression-dynamic >= 0.1.3, -        csound-expression-opcodes >= 0.0.1+        csound-expression-typed >= 0.0.7.3, csound-expression-dynamic >= 0.1.4, +        csound-expression-opcodes >= 0.0.2   Hs-Source-Dirs:      src/   Exposed-Modules:         Csound.Base@@ -86,6 +86,7 @@         Csound.Air.Seg         Csound.Air.Sampler         Csound.Air.Misc+        Csound.Air.Hvs                  Csound.Types         Csound.Tab

@@ -6,12 +6,14 @@     smallRoom2, smallHall2, largeHall2, magicCave2,      -- * Delays-    echo, fdelay, fvdelay, fvdelays, funDelays,+    MaxDelayTime, DelayTime, Feedback, Balance,+    echo, fdelay, fvdelay, fvdelays, funDelays, tabDelay,      -- * Distortion     distortion,      -- * Chorus+    DepthSig, RateSig, WidthSig, ToneSig,     chorus,      -- * Flanger@@ -25,12 +27,17 @@     fxFlanger, fxFlanger2, analogDelay, analogDelay2, fxEcho, fxEcho2,     fxFilter, fxFilter2,     fxWhite, fxWhite2, fxPink, fxPink2, equalizer, equalizer2, eq4, eq7,-    fxGain +    fxGain,  +    -- * Misc+    trackerSplice+ ) where +import Data.Boolean+ import Csound.Typed-import Csound.Tab(sines4, startEnds, setSize, elins)+import Csound.Tab(sines4, startEnds, setSize, elins, newTab, tabSizeSecondsPower2, tablewa, sec2rel) import Csound.Typed.Opcode import Csound.SigSpace @@ -41,7 +48,7 @@ -- | Mono version of the cool reverberation opcode reverbsc. -- -- > reverbsc1 asig feedbackLevel cutOffFreq-reverbsc1 :: Sig -> Sig -> Sig -> Sig+reverbsc1 :: Sig -> Feedback -> ToneSig -> Sig reverbsc1 x k co = 0.5 * (a + b)     where (a, b) = ar2 $ reverbsc x x k co @@ -50,19 +57,19 @@ -- Reverbs  -- | Reverb with given time.-reverTime :: Sig -> Sig -> Sig+reverTime :: DelayTime -> Sig -> Sig reverTime dt a =  nreverb a dt 0.3   -- | Mono reverb (based on reverbsc) -- -- > rever1 feedback asig-rever1 :: Sig -> Sig -> (Sig, Sig)+rever1 :: Feedback -> Sig -> (Sig, Sig) rever1 fbk a = reverbsc a a fbk 12000  -- | Mono reverb (based on reverbsc) ----- > rever2 feedback asigLeft asigRight-rever2 :: Sig -> Sig2 -> Sig2+-- > rever2 feedback (asigLeft, asigRight)+rever2 :: Feedback -> Sig2 -> Sig2 rever2 fbk (a1, a2) = (a1 + wa1, a2 + wa2)     where (wa1, wa2) = reverbsc a1 a2 fbk 12000 @@ -98,24 +105,37 @@ magicCave2 :: Sig2 -> Sig2 magicCave2 = rever2 0.99 +--------------------------------------------------------------------------------- -- Delays +-- | The maximum delay time.+type MaxDelayTime = D++-- | The delaya time+type DelayTime = Sig++-- | Feedback for delay+type Feedback = Sig++-- | Dry/Wet mix value (ranges from 0 to 1). The 0 is all dry. The 1 is all wet.+type Balance = Sig+ -- | The simplest delay with feedback. Arguments are: delay length and decay ratio. -- -- > echo delayLength ratio-echo :: D -> Sig -> Sig -> SE Sig+echo :: MaxDelayTime -> Feedback -> Sig -> SE Sig echo len fb = fdelay len fb 1  -- | Delay with feedback.  -- -- > fdelay delayLength decayRatio balance-fdelay :: D -> Sig -> Sig -> Sig -> SE Sig+fdelay :: MaxDelayTime -> Feedback -> Balance -> Sig -> SE Sig fdelay len = fvdelay len (sig len)  -- | Delay with feedback.  -- -- > fdelay maxDelayLength delayLength feedback balance-fvdelay :: D -> Sig -> Sig -> Sig -> Sig -> SE Sig+fvdelay :: MaxDelayTime -> DelayTime -> Feedback -> Balance -> Sig -> SE Sig fvdelay len dt fb mx a = do     _ <- delayr len     aDel <- deltap3 dt@@ -126,7 +146,7 @@ -- balance of mixed signal with processed signal. -- -- > fdelay maxDelayLength  delays balance asig-fvdelays :: D -> [(Sig, Sig)] -> Sig -> Sig -> SE Sig+fvdelays :: MaxDelayTime -> [(DelayTime, Feedback)] -> Balance -> Sig -> SE Sig fvdelays len dtArgs mx a = funDelays len (zip dts fs) mx a     where          (dts, fbks) = unzip dtArgs@@ -137,7 +157,7 @@ -- it expects a function for processing a delayed signal on the tap. -- -- > fdelay maxDelayLength  delays balance asig-funDelays :: D -> [(Sig, Sig -> Sig)] -> Sig -> Sig -> SE Sig+funDelays :: MaxDelayTime -> [(DelayTime, Sig -> Sig)] -> Balance -> Sig -> SE Sig funDelays len dtArgs mx a = do     _ <- delayr len     aDels <- mapM deltap3 dts@@ -145,6 +165,33 @@     return $ a + mx * sum aDels      where (dts, fs) = unzip dtArgs +-- | Delay for functions that use some table (as a buffer). As granular synth or mincer.+--+-- > tabDelay fn maxDelayTime delayTime feedback balance asig+tabDelay :: (Tab -> Sig -> SE Sig) -> MaxDelayTime -> DelayTime -> Feedback -> Balance -> Sig -> SE Sig+tabDelay go maxLength delTim  kfeed kbalance asig = do+    buf <- newTab tabLen    +    ptrRef <- newSERef (0 :: Sig)+    aresRef <- newSERef (0 :: Sig)  +    ptr <- readSERef ptrRef+    when1 (ptr >=* sig tabLen) $ do+        writeSERef ptrRef 0+    ptr <- readSERef ptrRef ++    let kphs = (ptr / sig tabLen) - (delTim/(sig $ tabLen / getSampleRate))+    awet <-go buf (wrap kphs 0 1)+    writeSERef aresRef $ asig + kfeed * awet+    ares <- readSERef aresRef+    writeSERef ptrRef =<< tablewa buf ares 0+    return $ (1 - kbalance) * asig + kbalance * awet+    where+        tabLen = tabSizeSecondsPower2 maxLength++type DepthSig = Sig+type RateSig  = Sig+type WidthSig  = Sig+type ToneSig  = Sig+ -- Distortion  -- | Distortion. @@ -158,7 +205,7 @@ -- | Chorus. -- -- > chorus depth rate balance asig-chorus :: Sig -> Sig -> Sig -> Sig -> SE Sig+chorus :: DepthSig -> RateSig -> Balance -> Sig -> SE Sig chorus depth rate mx asig = do     _ <- delayr 1.2     adelSig <- deltap3 (0.03 * depth * oscBy fn (3 * rate) + 0.01)@@ -171,22 +218,22 @@ -- | Flanger. Lfo depth ranges in 0 to 1. -- -- flanger lfo feedback balance asig-flange :: Lfo -> Sig -> Sig -> Sig -> Sig+flange :: Lfo -> Feedback -> Balance -> Sig -> Sig flange alfo fbk mx asig = ntrpol asig (flanger asig ulfo fbk) mx     where ulfo = 0.0001 + 0.02 * unipolar alfo  -- Phaser  -- | First order phaser.-phase1 :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig+phase1 :: Sig -> Lfo -> Feedback -> Balance -> Sig -> Sig phase1 ord alfo fbk mx asig = ntrpol asig (phaser1 asig (20 + unipolar alfo) ord fbk) mx    -- | Second order phaser. Sweeping gaps in the timbre are placed harmonicaly-harmPhase :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig+harmPhase :: Sig -> Lfo -> Sig -> Sig -> Feedback -> Balance -> Sig -> Sig harmPhase ord alfo q sep fbk mx asig = ntrpol asig (phaser2 asig (20 + unipolar alfo) q ord 1 sep fbk) mx  -- | Second order phaser. Sweeping gaps in the timbre are placed by powers of the base frequency.-powerPhase :: Sig -> Lfo -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig+powerPhase :: Sig -> Lfo -> Sig -> Sig -> Feedback -> Balance -> Sig -> Sig powerPhase ord alfo q sep fbk mx asig = ntrpol asig (phaser2 asig (20 + unipolar alfo) q ord 2 sep fbk) mx  @@ -216,7 +263,7 @@ -- | Distortion -- -- > fxDistort level drive tone sigIn-fxDistort :: Sig -> Sig -> Sig -> Sig -> Sig+fxDistort :: Feedback -> Sig -> ToneSig -> Sig -> Sig fxDistort klevel kdrive ktone ain = aout * (scale klevel 0.8 0) * kGainComp1     where         aout = blp kLPF $ distort1 ain kpregain kpostgain 0 0@@ -230,7 +277,7 @@         kLPF = logScale 700 (200, 12000) ktone  -- | Stereo distortion.-fxDistort2 :: Sig -> Sig -> Sig -> Sig2 -> Sig2+fxDistort2 :: Feedback -> Sig -> ToneSig -> Sig2 -> Sig2 fxDistort2 klevel kdrive ktone (al, ar) = (fx al, fx ar)     where fx = fxDistort klevel kdrive ktone @@ -240,7 +287,7 @@ -- | Stereo chorus. -- -- > stChorus2 mix rate depth width sigIn-stChorus2 :: Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2+stChorus2 :: Balance -> RateSig -> DepthSig -> WidthSig -> Sig2 -> Sig2 stChorus2 kmix krate' kdepth kwidth (al, ar) = fxWet kmix (al, ar) (aoutL, aoutR)     where          krate = expScale 20 (0.001, 7) krate'@@ -260,7 +307,7 @@ -- | Phaser -- -- > fxPhaser mix rate depth freq feedback sigIn-fxPhaser :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig+fxPhaser ::Balance -> Feedback -> RateSig -> DepthSig -> Sig -> Sig -> Sig fxPhaser kmix fb krate' kdepth kfreq ain = fxWet kmix ain aout     where                krate = expScale 10 (0.01, 14) krate'@@ -268,7 +315,7 @@         aout  = phaser1 ain (cpsoct $ klfo + kfreq) 8 fb          -- | Stereo phaser.-fxPhaser2 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2+fxPhaser2 :: Balance -> Feedback -> RateSig -> DepthSig -> Sig -> Sig2 -> Sig2 fxPhaser2 kmix fb krate kdepth kfreq (al, ar) = (fx al, fx ar)     where fx = fxPhaser kmix fb krate kdepth kfreq   @@ -277,7 +324,7 @@ -- | Flanger -- -- > fxFlanger mix feedback rate depth delay sigIn-fxFlanger :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig+fxFlanger :: Balance -> Feedback -> RateSig -> DepthSig -> DelayTime -> Sig -> Sig fxFlanger kmix kfback krate' kdepth kdelay' ain = fxWet kmix ain aout     where         krate = expScale 50 (0.001, 14) krate'@@ -291,7 +338,7 @@         aout = mean [ain, adelsig]  -- | Stereo flanger-fxFlanger2 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig2 -> Sig2+fxFlanger2 :: Balance -> Feedback -> RateSig -> DepthSig -> DelayTime -> Sig2 -> Sig2 fxFlanger2 kmix kfback krate kdepth kdelay  (al ,ar) = (fx al, fx ar)     where fx = fxFlanger kmix kfback krate kdepth kdelay @@ -300,7 +347,7 @@ -- | Analog delay. -- -- > analogDelay mix feedback time tone sigIn-analogDelay :: Sig -> Sig -> Sig -> Sig -> Sig -> SE Sig+analogDelay :: Balance -> Feedback -> DelayTime -> ToneSig -> Sig -> SE Sig analogDelay kmix kfback ktime  ktone'  ain = do     aBuffer <- delayr 5     atap <- deltap3 aTime@@ -316,7 +363,7 @@         aTime = interp  kTime  -- | Stereo analog delay.-analogDelay2 :: Sig -> Sig -> Sig -> Sig -> Sig2 -> SE Sig2+analogDelay2 :: Balance -> Feedback -> DelayTime -> ToneSig -> Sig2 -> SE Sig2 analogDelay2 kmix kfback ktime ktone  = bindSig fx     where fx = analogDelay kmix kfback ktime ktone  @@ -424,3 +471,71 @@ fxEcho2 maxLen ktime fback = bindSig fx     where fx = fxEcho maxLen ktime fback ++++-- | Instrument plays an input signal in different modes. +-- The segments of signal can be played back and forth. +-- +-- > trackerSplice maxLength segLength mode+-- +-- * @maxLength@ -- the maximum length of the played segment (in seconds)+--+-- * @segLength@ -- the segment length in seconds+--+-- * @mode@ -- mode of the playing. If it's 1 - only a part of the sample is plyaed and+--   it's played forward. The portion of the signal starts from the current playback point.+--   It lasts for segLength. If it's 2 - the segment is played in reverse. +--   Other values produce the normal input signal.+--+-- Original author: Rory Walsh+--+-- Example:+--+-- > main = dac $ do    +-- >    let ev ch1 ch2 dt = fmap (\x -> (x, dt)) $ mconcat [+-- >          fmap (const 1.5) $ charOn ch1 +-- >        , fmap (const 2.5) $ charOn ch2 +-- >        , fmap (const 0) $ charOff ch1 <> charOff ch2]+-- > +-- >    (k, dt) <- stepper (0, 0.1) $ ev 'q' 'w' 0.1 <> ev 'a' 's' 0.2 <> ev 'z' 'x' 0.4+-- >    mul 1.3 $ trackerSplice 0.8 dt (int' k) $ fst $ loopWav 1 "drumLoop.wav"+trackerSplice :: D -> Sig -> Sig -> Sig -> SE Sig+trackerSplice maxLength segLengthSeconds kmode asig = do+    setksmps 1+    kindxRef <- newSERef (0 :: Sig)+    ksampRef <- newSERef (1 :: D)+    aoutRef  <- newSERef (0 :: Sig)++    buf <- newTab (tabSizeSecondsPower2 maxLength)+    let segLength = segLengthSeconds * sig getSampleRate+        andx = phasor (sig $ getSampleRate / ftlen buf)+        andx1 = delay andx 1+    tabw asig (andx * sig (ftlen buf)) buf+    ksamp <- readSERef ksampRef+    let apos = samphold (andx1 * sig (ftlen buf)) (sig ksamp)++    whens [+        (kmode >=* 1 &&* kmode <* 2, do             +                kindx <- readSERef kindxRef                             +                writeSERef kindxRef $ ifB (kindx >* segLength) 0 (kindx + 1)                +                kindx <- readSERef kindxRef+                when1 (kindx + apos >* sig (ftlen buf)) $ do+                    writeSERef kindxRef $ (-segLength)++                kindx <- readSERef kindxRef++                writeSERef aoutRef $ table (apos + kindx) buf `withDs` [0, 1]+                writeSERef ksampRef 0+        ), (kmode >=* 2 &&* kmode <* 3, do              +                kindx <- readSERef kindxRef+                writeSERef kindxRef $ ifB ((kindx+apos) <=* 0) (sig (ftlen buf) - apos) (kindx-1)+                kindx <- readSERef kindxRef+                writeSERef aoutRef $ table (apos+kindx) buf `withDs` [0, 1]+                writeSERef ksampRef 0   +        )] (do+                writeSERef ksampRef 1+                writeSERef aoutRef asig)++    aout <-readSERef aoutRef+    return aout

@@ -22,7 +22,7 @@ -- No need to set all 22 parameters. -- Look at the official tutorial (on github) for more examples. ----- The four functions are reimplemented in this way: sndwarp, syncgrain, partikkel, granule.+-- The five functions are reimplemented in this way: @sndwarp@, @syncgrain@, @partikkel@, @granule@, @fof2@. -- -- The most often used arguments are: --@@ -71,6 +71,37 @@ 	PartikkelSpec(..), 	partikkel,  +	-- * Fof2++	Fof2Spec(..),+	fof2, fof2Snd, fof2Snd1,++	-- * Granular delays++	-- | This block is for granular delay effects. To make granular delay from the granular functions+	-- it has to support reading from table with pointer (phasor).+	-- All functions have the same four parameters: +	--+	-- * @maxDelayTime@ -- maximum delay length in seсoncds.  +	--+	-- * @delayTime@ -- delay time (it can vary. it's a signal).  +	--+	-- * @feedback@ -- amount of feedback. How much of processed signal is mixed to+	--    the delayed signal+	--+	-- * @balance@ -- mix between dry and wet signal. 0 is dry only signal. 1 is wet only signl.+	--+	-- The rest arguments are taken from the original granular functions.+	grainyDelay, rndGrainyDelay, sndwarpDelay, +	syncgrainDelay, rndSyncgrainDelay, partikkelDelay, fofDelay,	++	-- * Granular effets+	+	-- | The functions are based on the granular delays. +	-- each function is a granular delay with zero feedback and instant delay time.+	grainyFx, rndGrainyFx, sndwarpFx, +	syncgrainFx, rndSyncgrainFx, partikkelFx, fofFx,+ 	-- * Csound functions 	csdSndwarp, csdSndwarpst, csdSyncgrain, csdGranule, csdPartikkel ) where@@ -78,16 +109,18 @@ -- http://www.youtube.com/watch?v=tVW809gMND0  import Data.Default+import Data.Boolean import Data.List(isSuffixOf) import Control.Applicative hiding ((<*)) import Control.Monad.Trans.Class-import Csound.Dynamic hiding (int)+import Csound.Dynamic hiding (int, when1, whens) import Csound.Typed -import Csound.Typed.Opcode hiding(partikkel, granule, grain, syncgrain, sndwarp, sndwarpst)-import qualified Csound.Typed.Opcode as C(partikkel, granule, grain, syncgrain, sndwarp, sndwarpst)+import Csound.Typed.Opcode hiding(partikkel, granule, grain, syncgrain, sndwarp, sndwarpst, fof2)+import qualified Csound.Typed.Opcode as C(partikkel, granule, grain, syncgrain, sndwarp, sndwarpst, fof2)  import Csound.Air.Wav(PitchSig, TempoSig, lengthSnd)+import Csound.Air.Fx(tabDelay, MaxDelayTime, DelayTime, Feedback, Balance) import Csound.Tab import Csound.SigSpace @@ -742,7 +775,179 @@ ptrSndwarpSnd1 spec xresample file xptr = ptrSndwarp spec xresample (wavs file 0 WavLeft) xptr  ------------------------------------------------------------------------+-- fof2+++-- | Defaults for @fof2@ opcode.+data Fof2Spec = Fof2Spec +	{ fof2TimeMod  :: Sig+	, fof2PitchMod :: Sig+	, fof2Oct   :: Sig +	, fof2Band  :: Sig+	, fof2Rise  :: Sig+	, fof2Decay :: Sig+	, fof2Gliss :: Sig+	, fof2Win   :: Tab+	}++instance Default Fof2Spec where+	def = Fof2Spec+		{ fof2TimeMod  	= 0.2+		, fof2PitchMod 	= 0 +		, fof2Oct   		= 0+		, fof2Band  		= 0+		, fof2Rise  		= 0.5+		, fof2Decay 		= 0.5+		, fof2Gliss 		= 0+		, fof2Win   		= setSize 8192 $ sines4 [(0.5, 1, 270, 1)]+		}++-- | Reimplementation of fof2 opcode for stereo  audio files.+fof2Snd :: Fof2Spec -> GrainRate -> GrainSize -> TempoSig -> String -> Sig2+fof2Snd spec kgrainrate kgrainsize kspeed file = (f 1, f 2)+	where f n = fof2Chn n spec kgrainrate kgrainsize kspeed file++-- | Reimplementation of fof2 opcode for mono audio files.+fof2Snd1 :: Fof2Spec -> GrainRate -> GrainSize -> TempoSig -> String -> Sig+fof2Snd1 spec kgrainrate kgrainsize kspeed file = f 1+	where f n = fof2Chn n spec kgrainrate kgrainsize kspeed file++fof2Chn :: Int -> Fof2Spec -> GrainRate -> GrainSize -> TempoSig -> String -> Sig+fof2Chn n spec kgrainrate kgrainsize kspeed file = +	fof2 spec kgrainrate kgrainsize (grainyTab n file) (grainyPtr kspeed file)++-- | Reimplementation of fof2 opcode.+fof2 :: Fof2Spec -> GrainRate -> GrainSize -> Tab -> Pointer -> Sig+fof2 spec grainRate grainSize buf kphs = go (ftlen buf) buf kphs+	where+		kfund = grainRate+		kris  = fof2Rise spec+		kdec  = fof2Decay spec+		kband = fof2Band spec+		koct  = fof2Oct spec+		kgliss = fof2Gliss spec++		go :: D -> Tab -> Sig -> Sig+		go tabLen buf kphs = do			    +			csdFof2 (ampdbfs (-8)) kfund kform koct kband (kris * kdur) +				kdur (kdec * kdur) 100	giLive giSigRise 86400 kphs kgliss+			where+				kdur = grainSize / kfund				+				kform = (sig $ getSampleRate / tabLen)	+				giSigRise = fof2Win spec+				giLive = buf+ ------------------------------------------------------------------------+-- granular effects++-- partikkelDelay :: PartikkelSpec -> D -> Sig -> GrainRate -> GrainSize -> Sig -> Sig -> SE Sig+-- partikkelDelay spec maxLength delTim ++-- | Granular delay effect for fof2. Good values for grain rate and size are+--+-- > grainRate = 25+-- > grainSize = 2.5+fofDelay :: MaxDelayTime -> DelayTime -> Feedback -> Balance -> Fof2Spec -> GrainRate -> GrainSize -> Sig -> SE Sig+fofDelay maxLength delTim kfeed kbalance spec grainRate grainSize asig = do+	rndTmod <- rnd31 kTmod 1+	rndFmod <- rnd31 kFmod 1+	tabDelay (go rndFmod tabLen) maxLength (delTim + rndTmod) kfeed kbalance asig+	where +		kTmod = fof2TimeMod spec+		kFmod = fof2PitchMod spec+		kfund = grainRate+		kris  = fof2Rise spec+		kdec  = fof2Decay spec+		kband = fof2Band spec+		koct  = fof2Oct spec+		kgliss = fof2Gliss spec++		tabLen = tabSizeSecondsPower2 maxLength++		go :: Sig -> D -> Tab -> Sig -> SE Sig+		go kFmod tabLen buf kphs = do			    +			return $ csdFof2 (ampdbfs (-8)) kfund kform koct kband (kris * kdur) +						kdur (kdec * kdur) 100	giLive giSigRise 86400 kphs kgliss+			where+				kdur = grainSize / kfund				+				kform   = (1+kFmod)*(sig $ getSampleRate / tabLen)			++				giSigRise = fof2Win spec+				giLive = buf++-- | Granular delay effect for @grainy@.+grainyDelay :: MaxDelayTime -> DelayTime -> Feedback -> Balance -> GrainRate -> GrainSize -> PitchSig -> Sig -> SE Sig+grainyDelay maxDel delTime kfeed kbalance grainRate grainSize pitch asig = tabDelay go maxDel delTime kfeed kbalance asig+	where go tab ptr = return $ ptrGrainy grainRate grainSize pitch tab ptr++-- | Granular delay effect for @rndGrainy@.+rndGrainyDelay :: MaxDelayTime -> DelayTime -> Feedback -> Balance -> RndGrainySpec -> GrainRate -> GrainSize -> PitchSig -> Sig -> SE Sig+rndGrainyDelay  maxDel delTime kfeed kbalance spec grainRate grainSize pitch asig = tabDelay go maxDel delTime kfeed kbalance asig+	where go = rndPtrGrainy spec grainRate grainSize pitch++-- | Granular delay effect for @sndwarp@.+sndwarpDelay :: MaxDelayTime -> DelayTime -> Feedback -> Balance -> SndwarpSpec -> PitchSig -> Sig -> SE Sig+sndwarpDelay maxDel delTime kfeed kbalance spec pitch asig = tabDelay go maxDel delTime kfeed kbalance asig+	where go tab ptr = return $ ptrSndwarp spec pitch tab (sec2rel tab ptr)++-- | Granular delay effect for @syncgrain@.+syncgrainDelay :: MaxDelayTime -> DelayTime -> Feedback -> Balance -> SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> Sig -> SE Sig+syncgrainDelay maxDel delTime kfeed kbalance spec grainSize tempo pitch asig = tabDelay go maxDel delTime kfeed kbalance asig+	where go tab _ = return $ syncgrain spec grainSize tempo pitch tab++-- | Granular delay effect for @rndSyncgrain@.+rndSyncgrainDelay :: MaxDelayTime -> DelayTime -> Feedback -> Balance -> RndSyncgrainSpec -> SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> Sig -> SE Sig+rndSyncgrainDelay maxDel delTime kfeed kbalance rndSpec spec grainSize tempo pitch asig = tabDelay go maxDel delTime kfeed kbalance asig+	where go tab _ = rndSyncgrain rndSpec spec grainSize tempo pitch tab++-- | Granular delay effect for @partikkel@.+partikkelDelay :: MaxDelayTime -> DelayTime -> Feedback -> Balance -> PartikkelSpec -> GrainRate -> GrainSize -> PitchSig -> Sig -> SE Sig+partikkelDelay maxDel delTime kfeed kbalance spec grainRate grainSize pitch asig = tabDelay go maxDel delTime kfeed kbalance asig+	where go tab ptr = return $ partikkel spec grainRate grainSize pitch [tab] [ptr]++-------------------------------------------------------------------------+-- effects++fxFeed = 0+fxBalance = 1+fxMaxLength = 1+fxDelTime = 0.05++type GrainDelay a = MaxDelayTime -> DelayTime -> Feedback -> Balance -> a++toGrainFx :: GrainDelay a -> a+toGrainFx f = f fxMaxLength fxDelTime fxFeed fxBalance++-- | Granular effect for @grainy@.+grainyFx :: GrainRate -> GrainSize -> PitchSig -> Sig -> SE Sig+grainyFx = toGrainFx grainyDelay++-- | Granular effect for @rndGrainy@.+rndGrainyFx :: RndGrainySpec -> GrainRate -> GrainSize -> PitchSig -> Sig -> SE Sig+rndGrainyFx = toGrainFx rndGrainyDelay++-- | Granular effect for @sndwarp@.+sndwarpFx :: SndwarpSpec -> PitchSig -> Sig -> SE Sig+sndwarpFx = toGrainFx sndwarpDelay++-- | Granular effect for @syncgrain@.+syncgrainFx :: SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> Sig -> SE Sig+syncgrainFx = toGrainFx syncgrainDelay++-- | Granular effect for @rndSyncgrain@.+rndSyncgrainFx :: RndSyncgrainSpec -> SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> Sig -> SE Sig+rndSyncgrainFx = toGrainFx rndSyncgrainDelay++-- | Granular effect for @partikkel@.+partikkelFx :: PartikkelSpec -> GrainRate -> GrainSize -> PitchSig -> Sig -> SE Sig+partikkelFx = toGrainFx partikkelDelay++-- | Granular effect for @fof2@.+fofFx :: Fof2Spec -> GrainRate -> GrainSize -> Sig -> SE Sig+fofFx = toGrainFx fofDelay++------------------------------------------------------------------------+------------------------------------------------------------------------ -- csound opcodes  -- | @@ -830,3 +1035,14 @@ -- csound doc: <http://www.csounds.com/manual/html/sndwarpst.html> csdSndwarpst :: Sig -> Sig -> Sig -> Tab -> D -> D -> D -> D -> Tab -> D -> Sig2 csdSndwarpst = C.sndwarpst++-- | +-- Produces sinusoid bursts including k-rate incremental indexing with each successive burst.+--+-- Audio output is a succession of sinusoid bursts initiated at frequency xfund with a spectral peak at xform. For xfund above 25 Hz these bursts produce a speech-like formant with spectral characteristics determined by the k-input parameters. For lower fundamentals this generator provides a special form of granular synthesis.+--+-- > ares  fof2  xamp, xfund, xform, koct, kband, kris, kdur, kdec, iolaps, \+-- >           ifna, ifnb, itotdur, kphs, kgliss [, iskip]+--+-- csound doc: <http://www.csounds.com/manual/html/fof2.html>+csdFof2 = C.fof2

@@ -0,0 +1,152 @@+-- | Hyper vectorial synthesis+module Csound.Air.Hvs(    +	HvsSnapshot, HvsMatrix1, HvsMatrix2, HvsMatrix3,+	hvs1, hvs2, hvs3,++	-- | Csound functions+	csdHvs1, csdHvs2, csdHvs3+) where++import Control.Applicative hiding ((<*))+import Control.Monad.Trans.Class+import Csound.Dynamic hiding (int)+import Csound.Typed++import Csound.Typed.Opcode hiding (hvs1, hvs2, hvs3)+import qualified Csound.Typed.Opcode as C(hvs1, hvs2, hvs3)++import Csound.Tab++-- | Hvs vector+type HvsSnapshot = [Double]++-- | 1D matrix+type HvsMatrix1 = [HvsSnapshot]++-- | 2D matrix (grid of vecotrs)+type HvsMatrix2 = [HvsMatrix1]++-- | 3D matrix (cube of vectors)+type HvsMatrix3 = [HvsMatrix2]++-- Hyper Vectorial Synthesis.++-- | +-- Allows one-dimensional Hyper Vectorial Synthesis (HVS) controlled by externally-updated k-variables.+--+-- hvs1 allows one-dimensional Hyper Vectorial Synthesis (HVS) controlled by externally-updated k-variables.+--+-- >  hvs1  kx, inumParms, inumPointsX, iOutTab, iPositionsTab, iSnapTab [, iConfigTab]+--+-- csound doc: <http://www.csounds.com/manual/html/hvs1.html>+csdHvs1 ::  Sig -> D -> D -> Tab -> Tab -> Tab -> SE ()+csdHvs1 b1 b2 b3 b4 b5 b6 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unD b2 <*> unD b3 <*> unTab b4 <*> unTab b5 <*> unTab b6+    where f a1 a2 a3 a4 a5 a6 = opcs "hvs1" [(Xr,[Kr,Ir,Ir,Ir,Ir,Ir,Ir])] [a1,a2,a3,a4,a5,a6]++-- | +-- Allows two-dimensional Hyper Vectorial Synthesis (HVS) controlled by externally-updated k-variables.+--+-- hvs2 allows two-dimensional Hyper Vectorial Synthesis (HVS) controlled by externally-updated k-variables.+--+-- >  hvs2  kx, ky, inumParms, inumPointsX, inumPointsY, iOutTab, iPositionsTab, iSnapTab [, iConfigTab]+--+-- csound doc: <http://www.csounds.com/manual/html/hvs2.html>+csdHvs2 ::  Sig -> Sig -> D -> D -> D -> Tab -> Tab -> Tab -> SE ()+csdHvs2 b1 b2 b3 b4 b5 b6 b7 b8 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unD b3 <*> unD b4 <*> unD b5 <*> unTab b6 <*> unTab b7 <*> unTab b8+    where f a1 a2 a3 a4 a5 a6 a7 a8 = opcs "hvs2" [(Xr,[Kr,Kr,Ir,Ir,Ir,Ir,Ir,Ir,Ir])] [a1+                                                                                      ,a2+                                                                                      ,a3+                                                                                      ,a4+                                                                                      ,a5+                                                                                      ,a6+                                                                                      ,a7+                                                                                      ,a8]++-- | +-- Allows three-dimensional Hyper Vectorial Synthesis (HVS) controlled by externally-updated k-variables.+--+-- hvs3 allows three-dimensional Hyper Vectorial Synthesis (HVS) controlled by externally-updated k-variables.+--+-- >  hvs3  kx, ky, kz, inumParms, inumPointsX, inumPointsY, inumPointsZ, iOutTab, iPositionsTab, iSnapTab [, iConfigTab]+--+-- csound doc: <http://www.csounds.com/manual/html/hvs3.html>+csdHvs3 ::  Sig -> Sig -> Sig -> D -> D -> D -> D -> Tab -> Tab -> Tab -> SE ()+csdHvs3 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unD b4 <*> unD b5 <*> unD b6 <*> unD b7 <*> unTab b8 <*> unTab b9 <*> unTab b10+    where f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = opcs "hvs3" [(Xr+                                                          ,[Kr,Kr,Kr,Ir,Ir,Ir,Ir,Ir,Ir,Ir,Ir])] [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10]++-- | One dimensional Hyper vectorial synthesis. +-- We can provide a list of vectors (of lists but the same length for all items is assumed)+-- and a signal that ranges from 0 to 1. It interpolates between vectors in the list.+-- As a result we get a n interpolated vector. It's a list but the actual length+-- equals to the length of input vectors.+-- +-- An example. We can set the center frequency and resonance of the filter with the single parameter:+--+-- > let f = hvs1 [[100, 0.1], [300, 0.1], [600, 0.5], [800, 0.9]]+-- >  dac $ lift1 (\x -> fmap (\[cps, q] -> mlp cps q (saw 110)) $ f x) (uknob 0.5)+--+-- Notice the exact pattern match with the list in the argument of the lambda function:+--+-- > \[cps, q] -> mlp cps q (saw 110)) $ f x+--+-- It's determined by the length of the items in the input list.+hvs1 :: HvsMatrix1 -> Sig -> SE [Sig]+hvs1 as x = do+	outTab <- newTab (int numParams)+	csdHvs1 x (int numParams) (int numPointsX) outTab positionsTab snapTab+	return $ fmap (kr . flip tab outTab . sig . int) [0 .. numParams - 1]+	where +		numParams  = length $ head as+		numPointsX = length as++		positionsTab = doubles $ fmap fromIntegral [0 .. numPointsX - 1]+		snapTab = doubles $ concat as++-- | Two dimensional Hyper vectorial synthesis. +-- Now we provide a list of lists of vectors. The length of all vectors should be the same +-- but there is no limit for the number! So that's how we can control a lot of parameters+-- with pair of signals. The input 2D atrix is the grid of samples.+-- It finds the closest four points in the grid and interpolates between them (it's a weighted sum).+--+-- > hvs2 matrix (x, y)+--+-- The usage is the same as in the case of @hvs1@. An example:+--+-- > g = hvs2 [[[100, 0.1, 0.3], [800, 0.1, 0.5], [1400, 0.1, 0.8]], +-- > 		  [[100, 0.5, 0.3], [800, 0.5, 0.5], [1400, 0.5, 0.8]], +-- > 		  [[100, 0.8, 0.3], [800, 0.8, 0.5], [1400, 0.8, 0.8]]]+-- > +-- > main = dac $ do+-- > 	(g1, kx) <- uknob 0.5+-- > 	(g2, ky) <- uknob 0.5+-- > 	[cfq, q, w] <- g (kx, ky)+-- > 	panel $ hor [g1, g2]+-- > 	at (mlp cfq q) $ fmap (cfd w (saw 110)) (white)+hvs2 :: HvsMatrix2 -> Sig2 -> SE [Sig]+hvs2 as (x, y) = do+	outTab <- newTab (int numParams)+	csdHvs2 x y (int numParams) (int numPointsX) (int numPointsY) outTab positionsTab snapTab+	return $ fmap (kr . flip tab outTab . sig . int) [0 .. numParams - 1]+	where +		numParams  = length $ head $ head as+		numPointsX = length $ head as+		numPointsY = length as++		positionsTab = doubles $ fmap fromIntegral [0 .. (numPointsX * numPointsY - 1)]+		snapTab = doubles $ concat $ concat as++-- | The three dimensional +hvs3 :: HvsMatrix3 -> Sig3 -> SE [Sig]+hvs3 as (x, y, z) = do+	outTab <- newTab (int numParams)+	csdHvs3 x y z (int numParams) (int numPointsX) (int numPointsY) (int numPointsZ) outTab positionsTab snapTab+	return $ fmap (kr . flip tab outTab . sig . int) [0 .. numParams - 1]+	where +		numParams  = length $ head $ head $ head as+		numPointsX = length $ head $ head as+		numPointsY = length $ head as+		numPointsZ = length as++		positionsTab = doubles $ fmap fromIntegral [0 .. (numPointsX * numPointsY * numPointsZ) - 1]+		snapTab = doubles $ concat $ concat $ concat as

@@ -1,10 +1,15 @@  -- | Spectral functions  module Csound.Air.Spec( 	-    toSpec, fromSpec, mapSpec, scaleSpec, addSpec, scalePitch+    toSpec, fromSpec, mapSpec, scaleSpec, addSpec, scalePitch,+    CrossSpec(..),+    crossSpecFilter, crossSpecVocoder, crossSpecFilter1, crossSpecVocoder1 ) where +import Data.Default+ import Csound.Typed import Csound.Typed.Opcode+import Csound.Tab(sine)  -------------------------------------------------------------------------- -- spectral functions@@ -38,3 +43,85 @@ scalePitch :: Sig -> Sig -> Sig scalePitch n = scaleSpec (semitone n) +--------------------------------------------------------------------------++at2 :: (Sig -> Sig -> Sig) -> Sig2 -> Sig2 -> Sig2+at2 f (left1, right1) (left2, right2) = (f left1 left2, f right1 right2)++-- | Settings for cross filtering algorithm.+--+-- They are the defaults for opvodes: @pvsifd@, @tradsyn@, @trcross@ and @partials@.+--+-- * Fft size degree --  it's the power of 2. The default is 12.+--+-- * Hop size degree -- it's the power of 2. The default is 9+--+-- * scale --amplitude scaling factor. default is 1+--+-- * pitch -- the pitch scaling factor. default is 1 +--+-- * @maxTracks@ -- max number of tracks in resynthesis (tradsyn) and analysis (partials).+--+-- * @winType@ -- O: Hamming, 1: Hanning (default)+--+-- * @Search@ -- search interval length. The default is 1.05+--+-- * @Depth@ -- depth of the effect+--+-- * @Thresh@ -- analysis threshold. Tracks below ktresh*max_magnitude will be discarded (1 > ktresh >= 0).The default is 0.01+--+-- * @MinPoints@ -- minimum number of time points for a detected peak to make a track (1 is the minimum).+--+-- * @MaxGap@ -- maximum gap between time-points for track continuation (> 0). Tracks that have no continuation after kmaxgap will be discarded.+data CrossSpec = CrossSpec +	{ crossFft 		:: D+	, crossHopSize 	:: D+	, crossScale    :: Sig+	, crossPitch    :: Sig+	, crossMaxTracks :: D+	, crossWinType  :: D+	, crossSearch   :: Sig+	, crossDepth    :: Sig+	, crossThresh   :: Sig+	, crossMinPoints :: Sig+	, crossMaxGap    :: Sig+	}++instance Default CrossSpec where+	def = CrossSpec +		{ crossFft 		= 12+		, crossHopSize 	= 9+		, crossScale    = 1+		, crossPitch    = 1+		, crossMaxTracks = 500+		, crossWinType  = 1+		, crossSearch   = 1.05+		, crossDepth    = 1+		, crossThresh   = 0.01+		, crossMinPoints = 1+		, crossMaxGap    = 3+		}+++-- | Filters the partials of the second signal with partials of the first signal.+crossSpecFilter :: CrossSpec -> Sig2 -> Sig2 -> Sig2+crossSpecFilter spec = at2 (crossSpecFilter1 spec)++-- | Substitutes the partials of the second signal with partials of the first signal.+crossSpecVocoder :: CrossSpec -> Sig2 -> Sig2 -> Sig2+crossSpecVocoder spec = at2 (crossSpecVocoder1 spec)++-- | @crossSpecFilter@ for mono signals.+crossSpecFilter1 :: CrossSpec -> Sig -> Sig -> Sig+crossSpecFilter1 = crossSpecBy 0++-- | @crossSpecVocoder@ for mono signals.+crossSpecVocoder1 :: CrossSpec -> Sig -> Sig -> Sig+crossSpecVocoder1 = crossSpecBy 1++crossSpecBy :: D -> CrossSpec -> Sig -> Sig -> Sig+crossSpecBy imode spec ain1 ain2 = +	tradsyn (trcross (getPartials ain2) (getPartials ain1) (crossSearch spec) (crossDepth spec) `withD` imode) (crossScale spec) (crossPitch spec) (sig $ crossMaxTracks spec) sine+	where+		getPartials asig = partials fs1 fsi2 (crossThresh spec) (crossMinPoints spec) (crossMaxGap spec) (crossMaxTracks spec)+			where (fs1, fsi2) = pvsifd asig (2 ** (crossFft spec)) (2 ** (crossHopSize spec)) (crossWinType spec) 

@@ -41,5 +41,5 @@     button, display, space, lfo, initc7, ctrl7     , oscInit, oscListen, oscSend,      lpshold, loopseg, loopxseg,-    partikkel, syncgrain, granule, sndwarp, sndwarpst)+    partikkel, syncgrain, granule, sndwarp, sndwarpst, fof2) 

@@ -16,6 +16,10 @@     -- * Fill table with numbers     doubles,    +    -- * Create new tables to write/update data++    newTab, newGlobalTab, tabSizeSeconds, tabSizePower2, tabSizeSecondsPower2,+     -- * Read from files     WavChn(..), Mp3Chn(..),     wavs, mp3s,@@ -79,19 +83,60 @@     -- | Low level Csound integer identifiers for tables. These names can be used in the function 'Csound.Base.fineFi'     idWavs, idMp3s, idDoubles, idSines, idSines3, idSines2     , idPartials, idSines4, idBuzzes, idConsts, idLins, idCubes-    , idExps, idSplines, idStartEnds,  idPolys, idChebs1, idChebs2, idBessels, idWins+    , idExps, idSplines, idStartEnds,  idPolys, idChebs1, idChebs2, idBessels, idWins,++    -- * Tabular opcodes+    tablewa, sec2rel ) where +import Control.Applicative hiding ((<*))+import Control.Monad.Trans.Class+import Csound.Dynamic hiding (int, when1, whens)+ import Data.Default import Csound.Typed+import Csound.Typed.Opcode(ftgentmp, ftgenonce)  -- | The default table. It's rendered to @(-1)@ in the Csound. noTab :: Tab noTab = fromE (-1) +-- | Creates a new table. The Tab could be used while the instrument+-- is playing. When the instrument is retriggered the new tab is allocated.+--+-- > newTab size+newTab :: D -> SE Tab+newTab size = ftgentmp 0 0 size 7 0 [size, 0]++-- | Creates a new global table. +-- It's generated only once. It's persisted between instrument calls.+--+-- > newGlobalTab identifier size+newGlobalTab :: D -> SE Tab+newGlobalTab size = do  +    identifier <- getNextGlobalGenId+    ref <- newGlobalSERef (0 :: D)        +    tabId <- ftgenonce 0 (int identifier) size 7 0 [size, 0]+    writeSERef ref (fromGE $ toGE tabId)+    fmap (fromGE . toGE) $ readSERef ref++-- | Calculates the number of samples needed to store the given amount of seconds.+-- It multiplies the value by the current sample rate.+tabSizeSeconds :: D -> D+tabSizeSeconds x = x * getSampleRate++-- | Calculates the closest power of two value for a given size.+tabSizePower2 :: D -> D+tabSizePower2 x = 2 ** (ceil' $ logBase 2 x)++-- | Calculates the closest power of two value in samples for a given size in seconds.+tabSizeSecondsPower2 :: D -> D+tabSizeSecondsPower2 = tabSizePower2 . tabSizeSeconds+ data WavChn = WavLeft | WavRight | WavAll     deriving (Show, Eq) + instance Default WavChn where     def = WavAll @@ -497,3 +542,21 @@ hhifi   = setDegree 2 hhhifi  = setDegree 3  ++-- | Writes tables in sequential locations.+--+-- This opcode writes to a table in sequential locations to and from an a-rate +-- variable. Some thought is required before using it. It has at least two major, +-- and quite different, applications which are discussed below.+--+-- > kstart tablewa kfn, asig, koff+--+-- csound docs: <http://www.csounds.com/manual/html/tablewa.html>+tablewa ::  Tab -> Sig -> Sig -> SE Sig+tablewa b1 b2 b3 = fmap (Sig . return) $ SE $ (depT =<<) $ lift $ f <$> unTab b1 <*> unSig b2 <*> unSig b3+    where f a1 a2 a3 = opcs "tablewa" [(Kr,[Kr,Ar,Kr])] [a1,a2,a3]+++-- | Transforms phasor that is defined in seconds to relative phasor that ranges in 0 to 1.+sec2rel :: Tab -> Sig -> Sig+sec2rel tab x = x / (sig $ ftlen tab / getSampleRate)