csound-expression 4.4.1 → 4.5

raw patch · 11 files changed

+1159/−23 lines, 11 filesdep +csound-expression-dynamicdep +transformersdep ~csound-expression-typedPVP ok

version bump matches the API change (PVP)

Dependencies added: csound-expression-dynamic, transformers

Dependency ranges changed: csound-expression-typed

API changes (from Hackage documentation)

Files

• csound-expression.cabal +6/−4
• src/Csound/Air.hs +5/−0
• src/Csound/Air/Fx.hs +0/−1
• src/Csound/Air/Granular.hs +832/−0
• src/Csound/Air/Live.hs +0/−1
• src/Csound/Air/Misc.hs +0/−1
• src/Csound/Air/Wav.hs +257/−6
• src/Csound/Base.hs +5/−1
• src/Csound/IO.hs +0/−1
• src/Csound/Tab.hs +52/−6
• src/Csound/Types.hs +2/−2

@@ -1,5 +1,5 @@ Name:          csound-expression-Version:       4.4.1+Version:       4.5 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -67,14 +67,16 @@ Library   Ghc-Options:    -Wall   Build-Depends:-        base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0,-        csound-expression-typed >= 0.0.7.1, csound-expression-opcodes >= 0.0.1+        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   Hs-Source-Dirs:      src/   Exposed-Modules:         Csound.Base -        Csound.Air+        Csound.Air                 Csound.Air.Wave+        Csound.Air.Granular                 Csound.Air.Envelope         Csound.Air.Filter         Csound.Air.Wav

@@ -12,6 +12,9 @@     -- | Sound file playback     module Csound.Air.Wav, +    -- | Granular synthesis+    module Csound.Air.Granular,+     -- | Spectral Processing     module Csound.Air.Spec,  @@ -35,9 +38,11 @@ import Csound.Air.Envelope import Csound.Air.Filter import Csound.Air.Wav+import Csound.Air.Granular import Csound.Air.Spec import Csound.Air.Fx import Csound.Air.Live import Csound.Air.Seg import Csound.Air.Sampler import Csound.Air.Misc+

@@ -32,7 +32,6 @@ import Csound.Typed import Csound.Tab(sines4, startEnds, setSize, elins) import Csound.Typed.Opcode-import Csound.Types(Sig2) import Csound.SigSpace  import Csound.Air.Wave(Lfo, unipolar, oscBy, utri, white, pink)

@@ -0,0 +1,832 @@+-- | The Csound contains a set of functions for granular synthesis.+-- Unfortunately they are very hard to use due to large number of arguments.+-- This module attempts to set most of the arguments with sensible defaults.+-- So that a novice could start to use it. The defaults are implemented with+-- the help of the class @Default@. It's a standard way to implement defaults +-- in the Haskell. The class @Defaults@ defines a single constnat called @def@.+-- With @def@ we can get the default value for the given type.+--+-- Several csound opcodes are reimplemented so that first argument contains+-- secondary parameters. The type for parameters always has the instance for the +-- class @Default@. The original csound opcodes are defined in the end of the module+-- with prefix @csd@.+--+-- Also many granular synth opcodes expect the sound file as input. +-- There are predefined versions of the opcodes that take in the file names +-- instead of tables with sampled sound. They have suffix @Snd@ for stereo and @Snd1@ for mono files.+--+-- For example, that's how we can use the @granule@ opcode:+--+-- > dac $ granuleSnd1 spec [1, 2, 3] grainSize "fox.wav"+--+-- 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 most often used arguments are:+--+-- * Scale factors for tempo and pitch: @TempoSig@ or @speed@ and @PitchSig@. Ranges in 0 to 1+--+-- * Grain size is the size of produced grains in seconds. Good range is 0.005 to 0.01 or even 0.1.+--    The higer the value the more it sounds like the original sound.+--+-- * Grain rate. It's the speed of grain production in Hz. If it's in audio range+-- we can no longer percieve the original pitch of the file. Then the pitch is determined+-- with grain rate value.+--+-- * Grain gap. It's the gap in samples between the grains. Good values are 1 to 100.+--+-- * Grain window function. For the sound to be a grain it have to be enveloped+-- with grain window (some sort of bell shaped envelope). We can use half-sine for this purpose+-- (and it's so in most of the defauts) or we can use a table in the @GEN20@ family. In the library+-- they implemented as window tables see the table constructors with prefix @win@.+--+-- Usual order of arguments is: @GrainRate@, @GrainSize@, @TempoSig@, @PitchSig@, file @table@ or @name@, @poniter@ to the table.+-- +module Csound.Air.Granular(+	GrainRate, GrainSize, Pointer, ConstPitchSig,++	-- * Grainy (simple partikkel)+	RndGrainySpec(..),+	grainy, grainy1, rndGrainy, rndGrainy1,+	ptrGrainy, rndPtrGrainy, +	ptrGrainySnd, ptrGrainySnd1,++	-- * Sndwarp+	SndwarpSpec(..), +	sndwarp, sndwarpst, sndwarpSnd, sndwarpSnd1,+	ptrSndwarp, ptrSndwarpst, ptrSndwarpSnd, ptrSndwarpSnd1,++	-- * Syncgrain	+	SyncgrainSpec(..), RndSyncgrainSpec(..),+	syncgrain, syncgrainSnd, syncgrainSnd1,+	rndSyncgrain, rndSyncgrainSnd, rndSyncgrainSnd1,++	-- * Granule	+	GranuleSpec(..), GranuleMode(..),+	granule, granuleSnd, granuleSnd1,++	-- * Partikkel+	PartikkelSpec(..),+	partikkel, ++	-- * Csound functions+	csdSndwarp, csdSndwarpst, csdSyncgrain, csdGranule, csdPartikkel+) where++-- http://www.youtube.com/watch?v=tVW809gMND0++import Data.Default+import Data.List(isSuffixOf)+import Control.Applicative hiding ((<*))+import Control.Monad.Trans.Class+import Csound.Dynamic hiding (int)+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.Air.Wav(PitchSig, TempoSig, lengthSnd)+import Csound.Tab+import Csound.SigSpace++-- example+--+-- let q n = mul 0.1 $ grainy2 w2 1 (60 + 260 * uosc 0.25) (0.01 + 0.1 * uosc 0.1) (semitone n)+-- let w a b c = mul 0.1 $ q a + q b + q c+-- dac $ at magicCave2 $ (w 0 7 12) + delaySnd 2 (w (-12) (12 + 5) (12 + 7)) + delaySnd 1.3 (w 0 5 24)+++w1 = "/home/anton/house2.wav"+w2 = "/home/anton/fox.wav"+w3 = "/home/anton/music/csd/ClassGuit.wav"++-----------------------------------------------------------------+-- partikkel++type GrainRate 	= Sig+type GrainSize 	= Sig+type Pointer 	= Sig++type ConstPitchSig = D+----------------------------------------------------------------------+-- partikkel++-- | Secondary parameters for the partikkel opcode. We can use the @def@ to get the defaults.+-- See the official docs to know the complete description:+--+-- csound doc: <http://www.csounds.com/manual/html/partikkel.html>+data PartikkelSpec = PartikkelSpec+	{ partikkelDistribution		:: Sig+	, partikkelDisttab			:: Tab+	, partikkelSync				:: Sig+	, partikkelEnv2amt			:: Sig+	, partikkelEnv2tab			:: Tab+	, partikkelEnv_attack		:: Tab+	, partikkelEnv_decay		:: Tab+	, partikkelSustain_amount	:: Sig+	, partikkelA_d_ratio		:: Sig	+	, partikkelAmp 				:: Sig	+	, partikkelGainmasks 		:: Tab	+	, partikkelSweepshape 		:: Sig+	, partikkelWavfreqstarttab 	:: Tab+	, partikkelWavfreqendtab 	:: Tab	+	, partikkelWavfm 			:: Sig+	, partikkelFmamptab 		:: Tab+	, partikkelFmenv 			:: Tab+	, partikkelCosine 			:: Tab	+	, partikkelNumpartials 		:: Sig+	, partikkelChroma 			:: Sig+	, partikkelChannelmasks 	:: Tab	+	, partikkelRandommask 		:: Sig	+	, partikkelWaveamptab 		:: Tab	+	, partikkelWavekeys 		:: [Sig]+	, partikkelMax_grains		:: D+	}++instance Default PartikkelSpec where+	def = PartikkelSpec +		{ partikkelDistribution		= 1+		, partikkelDisttab			= setSize 32768 $ lins [0, 1, 1]+		, partikkelSync				= 0+		, partikkelEnv2amt			= 1+		, partikkelEnv2tab			= setSize 4096 $ winSync [1]+		, partikkelEnv_attack		= noTab+		, partikkelEnv_decay		= noTab+		, partikkelSustain_amount	= 0+		, partikkelA_d_ratio		= 0		+		, partikkelAmp 				= 1+		, partikkelGainmasks 		= noTab		+		, partikkelSweepshape 		= 0+		, partikkelWavfreqstarttab 	= noTab+		, partikkelWavfreqendtab 	= noTab+		, partikkelWavfm 			= 0+		, partikkelFmamptab 		= noTab+		, partikkelFmenv 			= noTab+		, partikkelCosine 			= setSize 8193 $ sines3 [(1, 1, 90)]		+		, partikkelNumpartials 		= 1+		, partikkelChroma 			= 1+		, partikkelChannelmasks 	= noTab+		, partikkelRandommask 		= 0+		, partikkelWaveamptab 		= noTab		+		, partikkelWavekeys 		= [1] +		, partikkelMax_grains		= 1000+		}++-- | Randomized parameters for function @grainy@. We can randomize pitch scaleing factor (0 to 1), +-- read position (in ratio: 0 to 1), and duration of the grains (in seconds, in magnitude of 0.005 to 0.5). +data RndGrainySpec = RndGrainySpec +	{ rndGrainyPitch	:: Sig+	, rndGrainyPos		:: Sig+	, rndGrainyDur		:: Sig+	}++instance Default RndGrainySpec where+	def = RndGrainySpec+		{ rndGrainyPitch	= 0.25+		, rndGrainyPos		= 0.1+		, rndGrainyDur		= 0.2+		}++-- | +-- Granular synthesizer with "per grain" control+--       over many of its parameters.  Has a sync input to+--       sychronize its internal grain scheduler clock to an external+--       clock source.+--+-- partikkel was conceived after reading Curtis Roads' book+--       "Microsound", and the goal was to create an opcode that was+--       capable of all time-domain varieties of granular synthesis+--       described in this book. The idea being that most of the+--       techniques only differ in parameter values, and by having a+--       single opcode that can do all varieties of granular synthesis+--       makes it possible to interpolate between techniques. Granular synthesis is sometimes dubbed particle+--       synthesis, and it was thought apt to name the opcode partikkel+--       to distinguish it from other granular opcodes.+--+-- > partikkel spec grainrate grainsize kpitch ifiltabs apnters+--+-- * @spec@ - secondary parameters+--+-- * @grainrate@ - rate of the grain creation+--+-- * @grainsize@ - grain size in sec (!!!not in ms as for Csound!!!).+--+-- * @kpitch@ -- pitch scaling factor.+--+-- * @apnters@ -- list of pointers (up to 4 values can be used)+--+-- * @ifiltabs@ -- list of tables (up to 4 values can be used)+partikkel :: PartikkelSpec -> GrainRate -> GrainSize -> PitchSig -> [Tab] -> [Pointer] -> Sig+partikkel spec kgrainrate kgrainsize kpitch ifiltab apnter = mul 0.2 res+	where+		res = csdPartikkel +				kgrainrate (partikkelDistribution spec) (partikkelDisttab spec) (partikkelSync spec)+				(partikkelEnv2amt spec) (partikkelEnv2tab spec) (partikkelEnv_attack spec) (partikkelEnv_decay spec)+				(partikkelSustain_amount spec) (partikkelA_d_ratio spec) (kgrainsize * 1000) (partikkelAmp spec)+				(partikkelGainmasks spec) kwavfreq (partikkelSweepshape spec) (partikkelWavfreqstarttab spec)+				(partikkelWavfreqendtab spec) (partikkelWavfm spec) (partikkelFmamptab spec) (partikkelFmenv spec)+				(partikkelCosine spec) kgrainrate (partikkelNumpartials spec) (partikkelChroma spec)+				(partikkelChannelmasks spec) (partikkelRandommask spec) +				filtab1 filtab2 filtab3 filtab4+				(partikkelWaveamptab spec)+				apnter1 apnter2 apnter3 apnter4+				keys1 keys2 keys3 keys4+				(partikkelMax_grains spec)++		iorig		= 		1 / (ftlen(head ifiltab)/getSampleRate) +		kwavfreq	= 		sig iorig * kpitch++		filtab1 : filtab2 : filtab3 : filtab4 : _ = cycle ifiltab +		apnter1 : apnter2 : apnter3 : apnter4 : _ = cycle apnter+		keys1   : keys2   : keys3   : keys4   : _ = cycle (partikkelWavekeys spec)++-- | Simplified version of partikkel. The partikkel for mono sounds.+-- +-- > grainy1 speed grainrate grainsize kfreqFactor file+--+-- * @speed@ - speed of the playback+--+-- * @grainrate@ - rate of the grain creation+--+-- * @grainsize@ - size of the grains+--+-- * @file@ - filename of an audio file to read the grains.+grainy1 :: GrainRate -> GrainSize -> TempoSig -> PitchSig -> String -> Sig+grainy1 = grainyChn 1++-- | Simplified version of partikkel. The partikkel for stereo sounds.+-- +-- > grainy1 speed grainrate grainsize kfreqFactor file+--+-- * @speed@ - speed of the playback+--+-- * @grainrate@ - rate of the grain creation+--+-- * @grainsize@ - size of the grains+--+-- * @file@ - filename of an audio file to read the grains.+grainy :: GrainRate -> GrainSize -> TempoSig -> PitchSig -> String -> Sig2+grainy kgrainrate kgrainsize kspeed kfreqFactor file = (f 1, f 2)	+	where f n = grainyChn n kgrainrate kgrainsize kspeed kfreqFactor file++grainyChn :: Int -> GrainRate -> GrainSize -> TempoSig -> PitchSig -> String -> Sig+grainyChn n kgrainrate kgrainsize kspeed kpitch file = +	ptrGrainy kgrainrate kgrainsize kpitch (grainyTab n file) (grainyPtr kspeed file)++-- | Randomized version of @grainy1@.+rndGrainy1 :: RndGrainySpec -> GrainRate -> GrainSize -> TempoSig -> PitchSig -> String -> SE Sig+rndGrainy1 = rndGrainyChn 1++-- | Randomized version of @grainy@.+rndGrainy :: RndGrainySpec -> GrainRate -> GrainSize -> TempoSig -> PitchSig -> String -> SE Sig2+rndGrainy spec kgrainrate kgrainsize kspeed kfreqFactor file = do+	asig1 <- f 1140+	asig2 <- f 2+	return (asig1, asig2)+	where f n = rndGrainyChn n spec kgrainrate kgrainsize kspeed kfreqFactor file++rndGrainyChn :: Int -> RndGrainySpec -> GrainRate -> GrainSize -> TempoSig -> PitchSig -> String -> SE Sig+rndGrainyChn n spec kgrainrate kgrainsize kspeed kpitch file = +	rndPtrGrainy spec kgrainrate kgrainsize kpitch (grainyTab n file) (grainyPtr kspeed file)+++-- | Simplified version of partikkel with pointer access to the table. The partikkel for mono sounds.+-- +-- > ptrGrainy grainrate grainsize kfreqFactor tab apnter+--+-- * @speed@ - speed of the playback+--+-- * @grainrate@ - rate of the grain creation+--+-- * @grainsize@ - size of the grains+--+-- * @tab@ - table with sampled sound.+--+-- * @apnter@ - pointer to the table. pointer is relative to total size (0 to 1).+ptrGrainy :: GrainRate -> GrainSize -> PitchSig -> Tab -> Pointer -> Sig+ptrGrainy kgrainrate kgrainsize kcent ifiltab apnter = +	partikkel def kgrainrate kgrainsize kcent [ifiltab] [apnter]++-- | Simplified version of partikkel with pointer access to the table. The partikkel for mono sounds.+-- +-- > ptrGrainy grainrate grainsize kfreqFactor tab apnter+--+-- * @speed@ - speed of the playback+--+-- * @grainrate@ - rate of the grain creation+--+-- * @grainsize@ - size of the grains+--+-- * @file@ - file with sampled sound.+--+-- * @apnter@ - pointer to the table in seconds+ptrGrainySnd :: GrainRate -> GrainSize -> PitchSig -> String -> Pointer -> Sig2+ptrGrainySnd kgrainrate kgrainsize kcent file apnter = (f (wavs file 0 WavLeft), f (wavs file 0 WavRight))+	where f tab = partikkel def kgrainrate kgrainsize kcent [tab] [apnter / sig (lengthSnd file)]++-- | Simplified version of partikkel with pointer access to the table. The partikkel for mono sounds.+-- +-- > ptrGrainy grainrate grainsize kfreqFactor tab apnter+--+-- * @speed@ - speed of the playback+--+-- * @grainrate@ - rate of the grain creation+--+-- * @grainsize@ - size of the grains+--+-- * @file@ - file with sampled sound.+--+-- * @apnter@ - pointer to the table in seconds+ptrGrainySnd1 :: GrainRate -> GrainSize -> PitchSig -> String -> Pointer -> Sig+ptrGrainySnd1 kgrainrate kgrainsize kcent file apnter = f (wavs file 0 WavLeft)+	where f tab = partikkel def kgrainrate kgrainsize kcent [tab] [apnter / sig (lengthSnd file)]++-- | Randomized version of @ptrGrainy@.+rndPtrGrainy :: RndGrainySpec -> GrainRate -> GrainSize -> PitchSig -> Tab -> Pointer -> SE Sig+rndPtrGrainy rndSpec kgrainrate kgrainsize kpitch ifiltab apnter = do+	kpitchRandVal <- rand (rndGrainyPitch rndSpec)+	arndpos <- linrand (rndGrainyPos rndSpec)+	krndsize <- rand (rndGrainyDur rndSpec)+	return $ ptrGrainy kgrainrate (kgrainsize + krndsize) (kpitch + kpitchRandVal) ifiltab (apnter + arndpos)++grainyTab :: Int -> String -> Tab+grainyTab n file = wavs file 0 (if n == 1 then WavLeft else WavRight)++grainyPtr :: Sig -> String -> Sig+grainyPtr kspeed file = apnter+	where+		ifildur = filelen $ text file		+		apnter = phasor (kspeed / sig ifildur)++-----------------------------------------------------------------+-- granule++-- | Granule playback mode.+data GranuleMode = GranuleForward | GranuleBackward | GranuleRandom++fromGranuleMode :: GranuleMode -> D+fromGranuleMode x = case x of+	GranuleForward -> 1+	GranuleBackward -> -1+	GranuleRandom -> 0++-- | Secondary parameters for @granule@. We can use the @def@ to get the defaults.+--+-- * @Gap@ - gap between grains in sec.+--+-- * Voice - number of voices (integer value in magnitude of 1 to 128, 64 is default)+--+-- * Ratio - ratio of the speed of the gskip pointer relative to output audio sample rate (the default is 1)+--+-- * Mode  - playback mode (see @GranuleMode@, play forward is the default)+--+-- * Skip_os - gskip pointer random offset in sec, 0 will be no offset (0.5 is default). +--+-- * Gap_os - gap random offset in ratios (0 to 1) of the gap size, 0 gives no offset (0.5 is default).+--+-- * Size_os -grain size random offset in ratios (0 to 1) of grain size, 0 gives no offset (0.5 is default).+--+-- * Seed - seed for the random number generator (0.5 is default).+--+-- * Att   -  attack of the grain envelope in ratios (0 to 1) of grain size (0.3 is default).+--+-- * Dec  - decay of the grain envelope in ratios (0 to 1) of grain size (0.3 is default).+--+data GranuleSpec = GranuleSpec +	{ granuleGap   :: Sig+	, granuleVoice :: D+	, granuleRatio :: D+	, granuleMode  :: GranuleMode+	, granuleSkip_os :: D+	, granuleGap_os :: D+	, granuleSize_os :: D+	, granuleSeed :: D+	, granuleAtt   :: D+	, granuleDec   :: D	+	}++instance Default GranuleMode where+	def = GranuleForward++instance Default GranuleSpec where+	def = GranuleSpec +		{ granuleGap = 0+		, granuleVoice = 64+		, granuleRatio = 1+		, granuleMode  = def+		, granuleSkip_os = 0.5+		, granuleGap_os = 0.5+		, granuleSize_os = 0.5+		, granuleSeed = 0.5+		, granuleAtt   = 0.3+		, granuleDec   = 0.3	+		}++toPercent = (100 * )++-- | A more complex granular synthesis texture generator.+-- +-- granule is a Csound unit generator which employs a wavetable as input +-- to produce granularly synthesized audio output. Wavetable data may be +-- generated by any of the GEN subroutines such as GEN01 which reads an +-- audio data file into a wavetable. This enable a sampled sound to be used +-- as the source for the grains. Up to 128 voices are implemented internally. +-- The maximum number of voices can be increased by redefining the variable MAXVOICE +-- in the grain4.h file. granule has a build-in random number generator to handle +-- all the random offset parameters. Thresholding is also implemented to scan the source +-- function table at initialization stage. This facilitates features such as skipping +-- silence passage between sentences.+--+-- > granule spec chord grainSize ftab+--+-- * @spec@ -- secondary parameters. We can use @def@ to get the defaults.+--+-- * @chord :: [D]@ -- the list of pitch factors to scale the original sound. +--    It can be up to 4 items long. This parameters allows us to create a chords out of grains.+--+-- * @grainSize@ -- grain size in sec.+--+-- * @ftab@ - table with sampled sound.+granule :: GranuleSpec -> [ConstPitchSig] -> GrainSize -> Tab -> Sig+granule spec chord kgsize ifn = granuleWithLength len spec chord kgsize ifn+	where len = nsamp ifn / getSampleRate++-- | @granule@ that is defined on stereo audio files. We provide the filename instead of table.+-- The rest is the same. +granuleSnd :: GranuleSpec -> [ConstPitchSig] -> GrainSize -> String -> Sig2+granuleSnd spec chord kgsize file = +	( granuleWithLength len spec chord kgsize (wavs file 0 WavLeft)+	, granuleWithLength len spec chord kgsize (wavs file 0 WavRight))+	where len = filelen $ text file++-- | @granule@ that is defined on mono audio files. We provide the filename instead of table.+-- The rest is the same.+granuleSnd1 :: GranuleSpec -> [ConstPitchSig] -> GrainSize -> String -> Sig+granuleSnd1 spec chord kgsize file = granuleWithLength len spec chord kgsize (wavs file 0 WavLeft)+	where len = filelen $ text file++granuleWithLength :: D -> GranuleSpec -> [ConstPitchSig] -> GrainSize -> Tab -> Sig+granuleWithLength len spec chord kgsize ifn = mul 0.2 res +	where+		kgap 		= granuleGap spec+		kamp 		= 1+		ivoice      = granuleVoice spec+		iratio      = granuleRatio spec+		imode       = fromGranuleMode $ granuleMode spec+		ithd        = 0+		ipshift     = int $ min (length $ chord) 4+		igskip      = 0+		igskip_os   = toPercent $ granuleSkip_os spec+		ilength     = len+		igap_os     = toPercent $ granuleGap_os spec+		igsize_os   = toPercent $ granuleSize_os spec+		iatt        = toPercent $ granuleAtt spec+		idec        = toPercent $ granuleDec spec+		iseed       = granuleSeed spec+		ipitch1 : ipitch2 : ipitch3 : ipitch4 : _ = chord ++ [1, 1, 1, 1]+		+		-- create the granular synthesis textures; one for each channel+		res  = csdGranule kamp ivoice iratio imode ithd ifn ipshift igskip+				igskip_os ilength kgap igap_os kgsize igsize_os iatt idec `withDs` [iseed, ipitch1, ipitch2, ipitch3, ipitch4]++main = print "hi"++-----------------------------------------------------------------+-- grain++{-+	grain doesn't work with deferred tables++csdGrain = C.grain++data GrainSpec = GrainSpec +	{ grainPitch :: Sig+	, grainAmpoff :: Sig+	, grainPitchoff :: Sig+	, grainDur :: Sig+	, grainMaxDur :: D+	, grainWin :: Tab+	, grainRandom :: Bool+	}++instance Default GrainSpec where+	def = GrainSpec+		{ grainPitch 		= 1+		, grainAmpoff		= 0+		, grainPitchoff 	= 0+		, grainDur 			= 1+		, grainMaxDur		= 1+		, grainWin			= setSize 1025 $ winHanning [1]+		, grainRandom		= True+		}++grain :: GrainSpec -> Sig -> Tab -> Sig+grain spec kdens ftab = setRnd $ csdGrain 1 (grainPitch spec * sig (getSampleRate / ftlen ftab)) kdens +	(grainAmpoff spec) (grainPitchoff spec) (grainDur spec) ftab (grainWin spec) (grainMaxDur spec) +	where setRnd = if (grainRandom spec) then id else ( `withD` 1)++grainSnd :: GrainSpec -> Sig -> String -> Sig2+grainSnd spec kdens file = (grainSndChn 1 spec kdens file, grainSndChn 2 spec kdens file)++grainSnd1 :: GrainSpec -> Sig -> String -> Sig+grainSnd1 = grainSndChn 1++grainSndChn :: Int -> GrainSpec -> Sig -> String -> Sig+grainSndChn n spec kdens file = setRnd $ csdGrain 1 (grainPitch spec / sig (filelen $ text file)) kdens +	(grainAmpoff spec) (grainPitchoff spec) (grainDur spec) ftab (grainWin spec) (grainMaxDur spec) +	where +		setRnd = if (grainRandom spec) then id else ( `withD` 1)+		ftab = wavs file 0 (if (n == 1) then WavLeft else WavRight)+-}++---------------------------------------------------------+-- syncgrain++-- | Secondary parameters for syncgrain.+--+-- * @Win@ -- grain window function (half-sine is used by default)+--+-- * @Overlap@ -- grain overlap (use values in range 0 to 100, the 25 is default)+data SyncgrainSpec = SyncgrainSpec +	{ syncgrainWin 	 :: Tab+	, syncgrainOverlap :: D	+	}++-- | Randomized parameters for arguments (in range 0 to 1).+data RndSyncgrainSpec = RndSyncgrainSpec +	{ rndSyncTimescale :: Sig+	, rndSyncgrainPitch :: Sig+	, rndSyncgrainGrainDur :: Sig+	}++instance  Default SyncgrainSpec where+	def = SyncgrainSpec +		{ syncgrainWin 	   = setSize 16384 $ sines3 [(0.5, 1, 0)]+		, syncgrainOverlap   = 25		+		}++instance Default RndSyncgrainSpec where+	def = RndSyncgrainSpec +		{ rndSyncTimescale     = 0.5+		, rndSyncgrainPitch    = 0.51 +		, rndSyncgrainGrainDur = 0.2+		}++-- | Synchronous granular synthesis.+--+-- syncgrain implements synchronous granular synthesis. +-- The source sound for the grains is obtained by reading +-- a function table containing the samples of the source waveform. +-- For sampled-sound sources, GEN01 is used. syncgrain will accept +-- deferred allocation tables.+--+-- > syncgrain spec graidDuration timeScale PitchSig ftab+--+-- * @spec@ - secondary params (use @def@ to get the defaults)+-- +-- * @graidDuration@ - duration of grains in seconds.+--+-- * @timeScale@ - tempo scaling factor.+--+-- * @PitchSig@ - pitch scaling factor.+--+-- * @ftab@ - table with sampled sound.+syncgrain :: SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> Tab -> Sig +syncgrain spec kgrdur ktimescale kpitch ftab = mul 0.2 res+	where+		kgroverlap = sig $ (syncgrainOverlap spec) / 2++		ko1 = int' (kgroverlap + 0.15)+		kfr = ko1 / kgrdur +		kps = 1 / ko1++		awp = phasor (sig $ getSampleRate / ftlen ftab)+		res = csdSyncgrain 1 kfr kpitch kgrdur (kps * ktimescale) ftab (syncgrainWin spec) (syncgrainOverlap spec)++-- | The syncgrain with randomized parameters.+rndSyncgrain :: RndSyncgrainSpec -> SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> Tab -> SE Sig+rndSyncgrain rndSpec spec kgrdur ktimescale kpitch ftab = do	+		let kgroverlap = sig $ (syncgrainOverlap spec) / 2+		    ko1 = int' (kgroverlap + 0.15)+		    kgr = kgrdur + rnd (rndSyncgrainGrainDur rndSpec)+		    kfr = ko1 / kgr +		    kps = 1 / ko1++		    awp = phasor (sig $ getSampleRate / ftlen ftab)+		    res = csdSyncgrain 1 kfr (kpitch + birnd (rndSyncgrainPitch rndSpec)) kgr (kps * ktimescale + birnd (rndSyncTimescale rndSpec)) ftab (syncgrainWin spec) (syncgrainOverlap spec)+		return res++-- | syncgrain that is defined on stereo audio files. We provide the filename instead of table.+-- The rest is the same.+syncgrainSnd :: SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> String -> Sig2+syncgrainSnd spec kgrdur ktimescale kpitch  file = +	(f $ wavs file 0 WavLeft, f $ wavs file 0 WavRight)+	where f = syncgrain spec kgrdur ktimescale kpitch ++-- | syncgrain that is defined on mono audio files. We provide the filename instead of table.+-- The rest is the same.+syncgrainSnd1 :: SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> String -> Sig+syncgrainSnd1 spec kgrdur ktimescale kpitch  file = f $ wavs file 0 WavLeft	+	where f = syncgrain spec kgrdur ktimescale kpitch ++-- | rndSyncgrain that is defined on stereo audio files. We provide the filename instead of table.+-- The rest is the same.+rndSyncgrainSnd :: RndSyncgrainSpec -> SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> String -> SE Sig2+rndSyncgrainSnd rndSpec spec kgrdur ktimescale kpitch  file = do+	aleft  <- f $ wavs file 0 WavLeft+	aright <- f $ wavs file 0 WavRight+	return (aleft, aright)+	where f = rndSyncgrain rndSpec spec kgrdur ktimescale kpitch ++-- | rndSyncgrain that is defined on mono audio files. We provide the filename instead of table.+-- The rest is the same.+rndSyncgrainSnd1 :: RndSyncgrainSpec -> SyncgrainSpec -> GrainSize -> TempoSig -> PitchSig -> String -> SE Sig+rndSyncgrainSnd1 rndSpec spec kgrdur ktimescale kpitch  file = f $ wavs file 0 WavLeft	+	where f = rndSyncgrain rndSpec spec kgrdur ktimescale kpitch ++-------------------------------------------------------+-- sndwarp++-- | Sndwarp secondary parameters. It's instance of @Default@, we can use the constant @def@ to get the value.+--+-- * @WinSize@ - window size in seconds (not in samples as in Csound!). The default is 0.1+--+-- * @Randw@ -  the bandwidth of a random number generator. +--    The random numbers will be added to iwsize. It's measured in ratio to WinSize.+--    So the 1 means the one WinSize length. The default is 0.3+--+-- * @Overlap@  - determines the density of overlapping windows. The default value is 50. +--  It's in range (0 to 100)+data SndwarpSpec = SndwarpSpec +	{ sndwarpWinSize :: D+	, sndwarpRandw   :: D+	, sndwarpOvelrap :: D+	, sndwarpWin     :: Tab+	}++instance Default SndwarpSpec where+	def = SndwarpSpec+		{ sndwarpWinSize  = 0.1+		, sndwarpRandw    = 0.3+		, sndwarpOvelrap  = 50+		, sndwarpWin      = setSize 16384 $ sines3 [(0.5, 1, 0)]+		}++-- | Simple sndwarp with scaling mode (corresponds to Csound's @initmode == 0@).+--+-- > sndwarp spec resample speed ftab +--+-- * @spec@ - secondary params (use @def@ to get the defaults)+--+-- * @resample@ -  the factor by which to change the pitch of the sound. For example, a value of 2 will produce a +--     sound one octave higher than the original. The timing of the sound, however, will not be altered.+--+-- * @speed@  - the factor by which to change the tempo of the sound. +--+-- * @ftab@ -- table with the samples+sndwarp :: SndwarpSpec -> TempoSig -> PitchSig -> Tab -> Sig+sndwarp spec kspeed xresample ftab = mul 0.2 $ csdSndwarp 1 kspeed xresample ftab 0 +	(getSampleRate * sndwarpWinSize spec) (getSampleRate * sndwarpRandw spec) +	(sndwarpOvelrap spec) (sndwarpWin spec) 0++-- | Stereo version of the @sndwarp@.+sndwarpst :: SndwarpSpec -> TempoSig -> PitchSig -> Tab -> Sig2+sndwarpst spec xspeed xresample ftab = mul 0.2 $ csdSndwarpst 1 xspeed xresample ftab 0 +	(getSampleRate * sndwarpWinSize spec) (getSampleRate * sndwarpRandw spec) +	(sndwarpOvelrap spec) (sndwarpWin spec) 0++-- | Sndwarp that is defined on stereo audio files. We provide the filename instead of table.+-- The rest is the same.+sndwarpSnd :: SndwarpSpec -> TempoSig -> PitchSig -> String -> Sig2+sndwarpSnd spec kspeed xresample file = sndwarpst spec kspeed xresample (wavs file 0 WavAll)++-- | Sndwarp that is defined on mono audio files. We provide the filename instead of table.+-- The rest is the same.+sndwarpSnd1 :: SndwarpSpec -> TempoSig -> PitchSig -> String -> Sig+sndwarpSnd1 spec kspeed xresample file = sndwarp spec kspeed xresample (wavs file 0 WavLeft)+++-- | The simple sndwarp with pointer (Csound @initmode = 1@). +--+-- > sndwarp spec resample ftab ptr+--+-- * @spec@ - secondary params (use @def@ to get the defaults)+--+-- * @resample@ -  the factor by which to change the pitch of the sound. For example, a value of 2 will produce a +--     sound one octave higher than the original. The timing of the sound, however, will not be altered.+--+-- * @ftab@ -- table with the samples+--+-- * @ptr@  - pointer to read the table (in seconds). +ptrSndwarp :: SndwarpSpec -> PitchSig -> Tab -> Pointer -> Sig+ptrSndwarp spec xresample ftab xptr = mul 0.2 $ csdSndwarp 1 xptr xresample ftab 0 +	(getSampleRate * sndwarpWinSize spec) (getSampleRate * sndwarpRandw spec) +	(sndwarpOvelrap spec) (sndwarpWin spec) 1++-- | Stereo version of @ptrSndwarp@.+ptrSndwarpst :: SndwarpSpec -> PitchSig -> Tab -> Pointer -> Sig2+ptrSndwarpst spec xresample ftab xptr = csdSndwarpst 1 xptr xresample ftab 0 +	(getSampleRate * sndwarpWinSize spec) (getSampleRate * sndwarpRandw spec) +	(sndwarpOvelrap spec) (sndwarpWin spec) 1++-- | ptrSndwarp that is defined on stereo audio files. We provide the filename instead of table.+-- The rest is the same.+ptrSndwarpSnd :: SndwarpSpec -> PitchSig -> String -> Pointer -> Sig2+ptrSndwarpSnd spec xresample file xptr = ptrSndwarpst spec xresample (wavs file 0 WavAll) xptr++-- | ptrSndwarp that is defined on mono audio files. We provide the filename instead of table.+-- The rest is the same.+ptrSndwarpSnd1 :: SndwarpSpec -> PitchSig -> String -> Pointer -> Sig+ptrSndwarpSnd1 spec xresample file xptr = ptrSndwarp spec xresample (wavs file 0 WavLeft) xptr++------------------------------------------------------------------------+------------------------------------------------------------------------+-- csound opcodes++-- | +-- Granular synthesizer with "per grain" control+--       over many of its parameters.  Has a sync input to+--       sychronize its internal grain scheduler clock to an external+--       clock source.+--+-- partikkel was conceived after reading Curtis Roads' book+--       "Microsound", and the goal was to create an opcode that was+--       capable of all time-domain varieties of granular synthesis+--       described in this book. The idea being that most of the+--       techniques only differ in parameter values, and by having a+--       single opcode that can do all varieties of granular synthesis+--       makes it possible to interpolate between techniques. Granular synthesis is sometimes dubbed particle+--       synthesis, and it was thought apt to name the opcode partikkel+--       to distinguish it from other granular opcodes.+--+-- > a1 [, a2, a3, a4, a5, a6, a7, a8]  partikkel  agrainfreq, \+-- >                   kdistribution, idisttab, async, kenv2amt, ienv2tab, ienv_attack, \+-- >                   ienv_decay, ksustain_amount, ka_d_ratio, kduration, kamp, igainmasks, \+-- >                   kwavfreq, ksweepshape, iwavfreqstarttab, iwavfreqendtab, awavfm, \+-- >                   ifmamptab, kfmenv, icosine, ktraincps, knumpartials, kchroma, \+-- >                   ichannelmasks, krandommask, kwaveform1, kwaveform2, kwaveform3, \+-- >                   kwaveform4, iwaveamptab, asamplepos1, asamplepos2, asamplepos3, \+-- >                   asamplepos4, kwavekey1, kwavekey2, kwavekey3, kwavekey4, imax_grains \+-- >                   [, iopcode_id]+--+-- csound doc: <http://www.csounds.com/manual/html/partikkel.html>+csdPartikkel :: Tuple a => Sig	-> Sig -> Tab -> Sig -> Sig -> Tab -> Tab -> Tab -> Sig	-> Sig -> Sig -> Sig -> Tab -> Sig 	-> Sig 	-> Tab-> Tab -> Sig	-> Tab -> Tab -> Tab -> Sig -> Sig -> Sig -> Tab -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> D -> a+csdPartikkel b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25 b26 b27 b28 b29 b30 b31 b32 b33 b34 b35 b36 b37 b38 b39 b40 = pureTuple $ f <$> unSig b1 <*> unSig b2 <*> unTab b3 <*> unSig b4 <*> unSig b5 <*> unTab b6 <*> unTab b7 <*> unTab b8 <*> unSig b9 <*> unSig b10 <*> unSig b11 <*> unSig b12 <*> unTab b13 <*> unSig b14 <*> unSig b15 <*> unTab b16 <*> unTab b17 <*> unSig b18 <*> unTab b19 <*> unTab b20 <*> unTab b21 <*> unSig b22 <*> unSig b23 <*> unSig b24 <*> unTab b25 <*> unSig b26 <*> unTab b27 <*> unTab b28 <*> unTab b29 <*> unTab b30 <*> unTab b31 <*> unSig b32 <*> unSig b33 <*> unSig b34 <*> unSig b35 <*> unSig b36 <*> unSig b37 <*> unSig b38 <*> unSig b39 <*> unD b40+    where f a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 = +    			mopcs "partikkel" ([Ar,Ar,Ar,Ar,Ar,Ar,Ar,Ar],[Ar,Kr,Ir,Ar,Kr,Ir,Ir,Ir,Kr,Kr,Kr,Kr,Ir,Kr,Kr,Ir,Ir,Ar,Ir,Kr,Ir,Kr,Kr,Kr,Ir,Kr,Kr,Kr,Kr,Kr,Ir,Ar,Ar,Ar,Ar,Kr,Kr,Kr,Kr,Ir,Ir]) [a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20,a21,a22,a23,a24,a25,a26,a27,a28,a29,a30,a31,a32,a33,a34,a35,a36,a37,a38,a39,a40]++-- | +-- Synchronous granular synthesis.+--+-- syncgrain implements synchronous granular synthesis. The source sound for the+-- grains is obtained by reading a function table containing the samples of the source waveform. +-- For sampled-sound sources, GEN01 is used.+-- syncgrain will accept deferred allocation tables.+--+-- > asig  syncgrain  kamp, kfreq, kpitch, kgrsize, kprate, ifun1, \+-- >           ifun2, iolaps+--+-- csound doc: <http://www.csounds.com/manual/html/syncgrain.html>+csdSyncgrain :: Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> D -> Sig+csdSyncgrain b1 b2 b3 b4 b5 b6 b7 b8 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 <*> unSig b4 <*> unSig b5 <*> unTab b6 <*> unTab b7 <*> unD b8+	where f a1 a2 a3 a4 a5 a6 a7 a8 = opcs "syncgrain" [(Ar, [Kr,Kr,Kr,Kr,Kr,Ir,Ir,Ir])] [a1, a2, a3, a4, a5, a6, a7, a8]++-- | +-- A more complex granular synthesis texture generator.+--+-- The granule unit generator is more complex than grain, but does add new possibilities.+--+-- > ares  granule  xamp, ivoice, iratio, imode, ithd, ifn, ipshift, igskip, \+-- >           igskip_os, ilength, kgap, igap_os, kgsize, igsize_os, iatt, idec \+-- >           [, iseed] [, ipitch1] [, ipitch2] [, ipitch3] [, ipitch4] [, ifnenv]+--+-- csound doc: <http://www.csounds.com/manual/html/granule.html>+csdGranule :: Sig -> D -> D -> D -> D -> Tab -> D -> D -> D -> D -> Sig -> D -> Sig -> D -> D -> D -> Sig+csdGranule = C.granule++-- | +-- Reads a mono sound sample from a table and applies time-stretching and/or pitch modification.+--+-- sndwarp reads sound samples from a table and applies time-stretching and/or pitch modification. Time and frequency modification are independent from one another. For example, a sound can be stretched in time while raising the pitch!+--+-- > ares [, ac]  sndwarp  xamp, xtimewarp, xresample, ifn1, ibeg, iwsize, \+-- >           irandw, ioverlap, ifn2, itimemode+--+-- csound doc: <http://www.csounds.com/manual/html/sndwarp.html>+csdSndwarp :: Sig -> Sig -> Sig -> Tab -> D -> D -> D -> D -> Tab -> D -> Sig+csdSndwarp = C.sndwarp+++-- | +-- Reads a stereo sound sample from a table and applies time-stretching and/or pitch modification.+--+-- sndwarpst reads stereo sound samples from a table and applies time-stretching and/or pitch modification. Time and frequency modification are independent from one another. For example, a sound can be stretched in time while raising the pitch!+--+-- > ar1, ar2 [,ac1] [, ac2]  sndwarpst  xamp, xtimewarp, xresample, ifn1, \+-- >           ibeg, iwsize, irandw, ioverlap, ifn2, itimemode+--+-- 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

@@ -30,7 +30,6 @@ import Csound.Typed.Gui import Csound.Control.Gui(funnyRadio, mapSource) import Csound.Typed.Opcode hiding (space)-import Csound.Types(Sig2) import Csound.SigSpace import Csound.Air.Wave import Csound.Air.Fx

@@ -32,7 +32,6 @@ import Csound.SigSpace import Csound.IO(writeSndBy) import Csound.Options(setRates)-import Csound.Types(Sig2)  -------------------------------------------------------------------------- -- patterns

@@ -15,7 +15,19 @@     -- 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, +    ramTab, mincer, +    Phsr(..), lphase, relPhsr, sndPhsr, phsrBounce, phsrOnce,+    ram, ram1, +    -- ** Simple audio reading functions (Stereo)+    Fidelity, TempoSig, PitchSig,++    readRam, loopRam, readSeg, loopSeg, readRel, loopRel,++    -- ** Simple audio reading functions (Mono)++    readRam1, loopRam1, readSeg1, loopSeg1, readRel1, loopRel1,    +     -- * Writing sound files     SampleFormat(..),     writeSigs, writeWav, writeAiff, writeWav1, writeAiff1,@@ -28,14 +40,19 @@ ) where  import Data.List(isSuffixOf)+import Data.Default+import Data.Boolean+import Control.Applicative hiding((<*)) +import Control.Monad.Trans.Class+import Csound.Dynamic hiding (int)+ import Csound.Typed import Csound.Typed.Opcode-import Csound.Tab(mp3s, wavs)+import Csound.Tab(mp3s, wavs, WavChn(..), Mp3Chn(..)) import Csound.Control.Instr(withDur, sched)  import Csound.SigSpace(mapSig)-import Csound.Types(Sig2) import Csound.Control.Evt(metroE, eventList)  import Csound.Air.Spec@@ -186,15 +203,15 @@ ramSnd :: LoopMode -> Sig -> String -> Sig2 ramSnd loopMode speed file = loscil3 1 speed t `withDs` [1, int $ fromEnum loopMode]     where t -            | isMp3 file = mp3s file 0-            | otherwise  = wavs file 0 0+            | 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 -    | isMp3 file = (\(aleft, aright) -> 0.5 * (aleft + aright)) $ loscil3 1 speed (mp3s file 0) `withDs` [1, int $ fromEnum loopMode]-    | otherwise  = loscil3 1 speed (wavs file 0 1) `withDs` [1, int $ fromEnum loopMode]+    | 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]  -------------------------------------------------------------------------- -- writing sound files@@ -244,3 +261,237 @@ writeAiff1 :: String -> Sig -> SE () writeAiff1 file = writeAiff file . \x -> (x, x) +-------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------+-- mincer++-- | mincer — Phase-locked vocoder processing.+--+-- 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"). +-- 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    +    where f a1 a2 a3 a4 a5 = opcs "mincer" [(Ar,[Ar,Kr,Kr,Kr,Kr,Ir,Ir])] [a1,a2,a3,a4,a5]++-- | Mincer. We can playback a table and scale by tempo and 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+-- choose 0 for pitched sounds and -2 for drums. The table contains the sample to playback.+-- The pointer loops over the table. The pitch specifies a scaling factor for pitch.+-- So we can raise tone an octave up by setting the pitch to 2.+ramTab :: Fidelity -> Tab -> Sig -> Sig -> Sig+ramTab winSizePowerOfTwo tab aptr pitch = mincer aptr 1 pitch tab 1 `withD` (2 ** (winSizePowerOfTwo + 11))+++-- > let x n = mincer2 (Phsr "/home/anton/fox.wav" 0 (stepSeq [0.2, 1, 0.1, 0.5] 0.5) (lpshold [1, 0.8, -1, 0.2] 0.25)) n+-- > dac $ mul 3 $ at (lp18 0.7 800 0.1) $ cfd (slide 0.5 $ usqr 0.2) (x 1) (sum [x $ 6/5, x $ 2])++-- | Creates a pointer signal for reading audio from the table in loops.+--+-- > lphase length start end speed+--+-- Arguments are:+--+-- * length of the table  in seconds+--+-- * start and end points of the reading interval+--+-- * playback speed+lphase :: D -> Sig -> Sig -> Sig -> Sig+lphase irefdur kloopstart kloopend kspeed  = atimpt+    where+        kstart1 = kloopstart / sig irefdur+        kend1 = kloopend / sig irefdur+        ifqbas = 1 / irefdur+        kfqrel = kspeed * sig ifqbas / (kend1 - kstart1)+        andxrel = phasor kfqrel+        atimpt = andxrel * (kloopend-kloopstart) + kloopstart+++----------------------------------------------------------------------++-- | 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+    { phsrFile  :: String+    , phsrStart :: Sig+    , phsrEnd   :: Sig+    , phsrSpeed :: Sig+    }++-- | Forces phasor to play only once.+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. +phsrBounce :: Phsr -> Phsr+phsrBounce a = a { phsrSpeed = phsrSpeed a * sqr (1 / dt) }+    where dt = abs $ (phsrEnd a - phsrStart a) / phsrSpeed a++-- | Creates a phasor if segments are relative to the total length.+-- It can be useful for drum loops. If we don't know the complete length+-- but we know that loop contains four distinct parts.+relPhsr :: String -> Sig -> Sig -> Sig -> Phsr+relPhsr file start end speed = Phsr+    { phsrFile  = file+    , phsrStart = start * sig len+    , phsrEnd   = end   * sig len+    , phsrSpeed = speed }+    where len = filelen $ text file++-- | 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++ram1 :: Fidelity -> Phsr -> Sig -> Sig+ram1 = ramChn True 1++-- | 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.+--+-- What makes this function so cool is+-- that we can scale the sound by tempo+-- without affecting pitch, and we can scale the sound by pitch+-- without affecting the tempo. Let's study the arguments.+--+-- > ram fidelity phasor pitch +--+-- 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. +-- Zero is best for most of the cases. For drums we can lower it to (-2).+--+-- The phasor is a quadruple of values+--+-- > (Phsr fileName startTime endTime playbackSpeed)+--+-- we can read the file from startTime to endTime (in seconds)+-- 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.+--+-- > ram 0 (Phsr "file.wav" 0 1 1.2) 1+--+-- 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 <* 0.001) 0 $ +        ramTab winSize (mkTab isMono n file ) (lphase (filelen $ text file) start end speed) pitch++mkTab :: Bool -> Int ->  String -> Tab+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        +        isStereo = not isMono++----------------------------------------+-- std funs++-- | 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. +-- 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. +-- 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.+type Fidelity = D++-- | Scaling factor for tempo. The 1 is inherent tempo.+type TempoSig = Sig++-- | Scaling factor for pitch. The 1 is inherent pitch.+type PitchSig = Sig++-- | Reads file once and scales it by tempo and pitch.+readRam :: Fidelity -> TempoSig-> PitchSig -> String -> Sig2+readRam winSize tempo pitch file = ram winSize (phsrOnce $ sndPhsr file tempo) pitch++-- | Loop over file and scales it by tempo and pitch.+loopRam :: Fidelity -> TempoSig-> PitchSig -> String -> Sig2+loopRam winSize tempo pitch file = ram winSize (sndPhsr file tempo) pitch++-- | Reads a segment from file once and scales it by tempo and pitch.+-- Segment is defined in seconds.+readSeg :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2+readSeg winSize (kmin, kmax) tempo pitch file = ram winSize (phsrOnce $ Phsr file kmin kmax tempo) pitch++-- | Loops over a segment of file and scales it by tempo and pitch.+-- Segment is defined in seconds.+loopSeg :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2+loopSeg winSize (kmin, kmax) tempo pitch file = ram winSize (Phsr file kmin kmax tempo) pitch++-- | Reads a relative segment from file once and scales it by tempo and pitch.+-- Segment is defined in seconds. The end ponits for the segment are relative to the+-- total length of the file.+readRel :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2+readRel winSize (kmin, kmax) tempo pitch file = ram winSize (phsrOnce $ relPhsr file kmin kmax tempo) pitch++-- | Loops over a relative segment of file and scales it by tempo and pitch.+-- Segment is defined in seconds. The end ponits for the segment are relative to the+-- total length of the file.+loopRel :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig2+loopRel winSize (kmin, kmax) tempo pitch file = ram winSize (relPhsr file kmin kmax tempo) pitch++-- | The mono version of readRam.+readRam1 :: Fidelity -> TempoSig-> PitchSig -> String -> Sig+readRam1 winSize tempo pitch file = ram1 winSize (phsrOnce $ sndPhsr file tempo) pitch++-- | The mono version of loopRam.+loopRam1 :: Fidelity -> TempoSig-> PitchSig -> String -> Sig+loopRam1 winSize tempo pitch file = ram1 winSize (sndPhsr file tempo) pitch++-- | The mono version of readSeg.+readSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig+readSeg1 winSize (kmin, kmax) tempo pitch file = ram1 winSize (phsrOnce $ Phsr file kmin kmax tempo) pitch++-- | The mono version of loopSeg.+loopSeg1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig+loopSeg1 winSize (kmin, kmax) tempo pitch file = ram1 winSize (Phsr file kmin kmax tempo) pitch++-- |  The mono version of readRel.+readRel1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig+readRel1 winSize (kmin, kmax) tempo pitch file = ram1 winSize (phsrOnce $ relPhsr file kmin kmax tempo) pitch++-- |  The mono version of loopRel.+loopRel1 :: Fidelity -> (Sig, Sig) -> TempoSig-> PitchSig -> String -> Sig+loopRel1 winSize (kmin, kmax) tempo pitch file = ram1 winSize (relPhsr file kmin kmax tempo) pitch

@@ -37,5 +37,9 @@ import Data.Monoid import Control.Applicative hiding ((<*))     -import Csound.Typed.Opcode hiding (button, display, space, lfo, initc7, ctrl7, oscInit, oscListen, oscSend, lpshold, loopseg, loopxseg)+import Csound.Typed.Opcode hiding (+    button, display, space, lfo, initc7, ctrl7+    , oscInit, oscListen, oscSend, +    lpshold, loopseg, loopxseg,+    partikkel, syncgrain, granule, sndwarp, sndwarpst) 

@@ -44,7 +44,6 @@ import Data.Monoid import Data.Default import Csound.Typed-import Csound.Types(Sig2, Sig4, Sig6, Sig8) import Csound.Control.Gui  import Csound.Options(setSilent, setMa, setDac)

@@ -4,7 +4,7 @@     -- you are pobably not aware of the fact that for efficiency reasons Csound requires that table size is equal     -- to power of 2 or power of two plus one which stands for guard point (you do need guard point if your intention is to read the      -- table once but you don't need the guard point if you read the table in many cycles, then the guard point is the the first point of your table).  -    Tab,+    Tab, noTab,      -- * Table querries @@ -17,6 +17,7 @@     doubles,         -- * Read from files+    WavChn(..), Mp3Chn(..),     wavs, mp3s,      -- * (In)Harmonic series@@ -84,15 +85,60 @@ import Data.Default import Csound.Typed -wavs :: String -> Double -> Int -> Tab+-- | The default table. It's rendered to @(-1)@ in the Csound.+noTab :: Tab+noTab = fromE (-1)++data WavChn = WavLeft | WavRight | WavAll+    deriving (Show, Eq)++instance Default WavChn where+    def = WavAll++fromWavChn :: WavChn -> Int+fromWavChn x = case x of+    WavAll   -> 0+    WavLeft  -> 1+    WavRight -> 2++-- | Loads wav or aiff file to table+--+-- > wavs fileName skipTime channel+--+-- skipTime specifies from what second it should read the file.+--+-- with channel argument we can read left, right or both channels.+wavs :: String -> Double -> WavChn -> Tab wavs filename skiptime channel = preTab (SizePlain 0) idWavs -    (FileAccess filename [skiptime, format, fromIntegral $ channel])+    (FileAccess filename [skiptime, format, fromIntegral $ fromWavChn channel])     where format = 0 -mp3s :: String -> Double -> Tab-mp3s filename skiptime = preTab (SizePlain 0) idMp3s +data Mp3Chn = Mp3Mono | Mp3Stereo | Mp3Left | Mp3Right | Mp3All+    deriving (Show, Eq)++fromMp3Chn :: Mp3Chn -> Int+fromMp3Chn x = case x of+    Mp3Mono     -> 1+    Mp3Stereo   -> 2+    Mp3Left     -> 3+    Mp3Right    -> 4+    Mp3All      -> 0++instance Default Mp3Chn where+    def = Mp3All++-- | Loads mp3 file to table:+--+-- > mp3s fileName skipTime format+--+-- skipTime specifies from what second it should read the file.+-- +-- format is: 1 - for mono files, 2 - for stereo files, 3 - for left channel of stereo file,+-- 4 for right channel of stereo file+mp3s :: String -> Double -> Mp3Chn -> Tab+mp3s filename skiptime channel = preTab (SizePlain 0) idMp3s      (FileAccess filename [skiptime, format])-    where format = 0+    where format = fromIntegral $ fromMp3Chn channel  interp :: Int -> [Double] -> Tab interp genId as = preTab def genId (ArgsRelative as)

@@ -24,6 +24,7 @@     Sig, D, Tab, Str, Spec, Wspec,         BoolSig, BoolD, Val(..), SigOrD, +    Sig2, Sig3, Sig4, Sig5, Sig6, Sig8,     -- ** Constructors     double, int, text,      @@ -50,8 +51,7 @@     --      -- or     ---    -- > asig = ar1 $ diskin2 "file.wav" 1-    Sig2, Sig3, Sig4, Sig6, Sig8,+    -- > asig = ar1 $ diskin2 "file.wav" 1         ar1, ar2, ar4, ar6, ar8,      -- * Tuples