csound-sampler 0.0.8.1 → 0.0.9.0

raw patch · 5 files changed

+168/−154 lines, 5 filesdep ~csound-expressionPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: csound-expression

API changes (from Hackage documentation)

Files

• csound-sampler.cabal +2/−2
• src/Csound/Sam.hs +108/−109
• src/Csound/Sam/Core.hs +23/−9
• src/Csound/Sam/Trig.hs +13/−12
• src/Csound/Sam/Ui.hs +22/−22

@@ -1,5 +1,5 @@ name:                csound-sampler-version:             0.0.8.1+version:             0.0.9.0 license:             BSD3 license-file:        LICENSE author:              Anton Kholomiov@@ -25,7 +25,7 @@ library   Ghc-Options:    -Wall   Hs-Source-Dirs:      src/-  build-depends:       base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.2.2+  build-depends:       base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.3.2   exposed-modules:     Csound.Sam     Csound.Sam.Core

@@ -1,7 +1,7 @@ -- | The sampler {-# Language TypeFamilies, DeriveFunctor, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-} module Csound.Sam (-	Sample, Sam, Bpm, runSam, +	Sample, Sam, Bpm, runSam, 	-- * Lifters 	mapBpm, bindSam, bindBpm, liftSam, mapBpm2, bindBpm2, withBpm, 	-- * Constructors@@ -9,11 +9,11 @@ 	-- ** Stereo 	wav, wavr, seg, segr, rndWav, rndWavr, rndSeg, rndSegr, ramWav, 	-- ** Mono-	wav1, wavr1, seg1, segr1, rndWav1, rndWavr1, rndSeg1, rndSegr1, ramWav1,	+	wav1, wavr1, seg1, segr1, rndWav1, rndWavr1, rndSeg1, rndSegr1, ramWav1, 	-- * Reading from RAM 	-- ** Stereo 	ramLoop, ramRead, segLoop, segRead, relLoop, relRead,-	-- ** Mono	+	-- ** Mono 	ramLoop1, ramRead1, segLoop1, segRead1, relLoop1, relRead1,      -- ** Tempo/pitch scaling based on temposcal@@ -21,8 +21,8 @@ 	-- * Envelopes 	linEnv, expEnv, hatEnv, decEnv, riseEnv, edecEnv, eriseEnv, 	-- * Arrange-	wide, flow, pick, pickBy, -	atPan, atPch, atCps, atPanRnd, atVolRnd, atVolGauss,	+	wide, flow, pick, pickBy,+	atPan, atPch, atCps, atPanRnd, atVolRnd, atVolGauss, 	-- * Loops 	rep1, rep, pat1, pat, pat',	rndPat, rndPat', 	-- * Arpeggio@@ -51,7 +51,7 @@ import Csound.Sam.Ui import Csound.Sam.Trig -type instance DurOf Sam = D+type instance DurOf Sam = Sig  instance Melody Sam where 	mel = flow@@ -64,7 +64,7 @@ instance Delay Sam where 	del dt = tfmS phi 		where phi bpm x = x { samSig = asig, samDur = dur }-				where +				where 					absDt = toSec bpm dt 					asig  = delaySnd absDt $ samSig x 					dur   = addDur absDt $ samDur x@@ -73,8 +73,8 @@ 	str k (Sam a) = Sam $ withReaderT ( * k) a  instance Limit Sam where-	lim d = tfmS $ \bpm x -> -		let absD = toSec bpm d +	lim d = tfmS $ \bpm x ->+		let absD = toSec bpm d 		in  x { samSig = takeSnd absD $ samSig x 			  , samDur = Dur absD } @@ -99,15 +99,15 @@ instance At Sig Sig2 Sam where 	type AtOut Sig Sig2 Sam = Sam 	at f x = at phi x-		where +		where 			phi (a, b) = 0.5 * (f a + f b)  instance At Sig (SE Sig2) Sam where 	type AtOut Sig (SE Sig2) Sam = Sam 	at f x = at phi x-		where +		where 			phi (a, b) = do-				a' <- f a +				a' <- f a 				b' <- f b 				return $ 0.5 * (a' + b') @@ -135,40 +135,40 @@ infSig2 = pure  -- | Constructs sample from limited mono signal (duration is in seconds)-sig1 :: D -> Sig -> Sam+sig1 :: Sig -> Sig -> Sam sig1 dt a = Sam $ reader $ \_ -> S (a, a) (Dur dt)  -- | Constructs sample from limited stereo signal (duration is in seconds)-sig2 :: D -> Sig2 -> Sam+sig2 :: Sig -> Sig2 -> Sam sig2 dt a = Sam $ reader $ \_ -> S a (Dur dt)  -- | Constructs sample from limited mono signal (duration is in BPMs)-fromSig1 :: D -> Sig -> Sam+fromSig1 :: Sig -> Sig -> Sam fromSig1 dt = lim dt . infSig1  -- | Constructs sample from limited stereo signal (duration is in BPMs)-fromSig2 :: D -> Sig2 -> Sam+fromSig2 :: Sig -> Sig2 -> Sam fromSig2 dt = lim dt . infSig2  -- | Constructs sample from wav or aiff files. wav :: String -> Sam-wav fileName = Sam $ return $ S (readSnd fileName) (Dur $ lengthSnd fileName)+wav fileName = Sam $ return $ S (readSnd fileName) (Dur $ sig $ lengthSnd fileName)  -- | Constructs sample from wav that is played in reverse. wavr :: String -> Sam-wavr fileName = Sam $ return $ S (takeSnd len $ loopWav (-1) fileName) (Dur len)+wavr fileName = Sam $ return $ S (takeSnd (sig len) $ loopWav (-1) fileName) (Dur $ sig len) 	where len = lengthSnd fileName  -- | Constructs sample from the segment of a wav file. The start and end times are measured in seconds. -- -- > seg begin end fileName seg :: D -> D -> String -> Sam-seg start end fileName = Sam $ return $ S (readSegWav start end 1 fileName) (Dur len)+seg start end fileName = Sam $ return $ S (readSegWav start end 1 fileName) (Dur $ sig len) 	where len = end - start  --- | Constructs reversed sample from segment of an audio file. segr :: D -> D -> String -> Sam-segr start end fileName = Sam $ return $ S (readSegWav start end (-1) fileName) (Dur len)+segr start end fileName = Sam $ return $ S (readSegWav start end (-1) fileName) (Dur $ sig len) 	where len = end - start  -- | Picks segments from the wav file at random. The first argument is the length of the segment.@@ -192,40 +192,40 @@ 	x <- random 0 1 	let a = start + dl * x 	let b = a + len-	return $ S (readSegWav a b speed fileName) (Dur len)+	return $ S (readSegWav a b speed fileName) (Dur $ sig len) 	where dl = end - len  -- | Reads a sample from the file in RAM. -- -- > ramWav loopMode speed fileName ramWav :: LoopMode -> Sig -> String -> Sam-ramWav loopMode speed fileName = Sam $ return $ S (ramSnd loopMode speed fileName) (Dur $ lengthSnd fileName)+ramWav loopMode speed fileName = Sam $ return $ S (ramSnd loopMode speed fileName) (Dur $ sig $ lengthSnd fileName)  -- | Reads a sample from the mono file in RAM. -- -- > ramWav1 loopMode speed fileName ramWav1 :: LoopMode -> Sig -> String -> Sam-ramWav1 loopMode speed fileName = Sam $ return $ S (let x = ramSnd1 loopMode speed fileName in (x, x)) (Dur $ lengthSnd fileName)+ramWav1 loopMode speed fileName = Sam $ return $ S (let x = ramSnd1 loopMode speed fileName in (x, x)) (Dur $ sig $ lengthSnd fileName)  -- | Constructs sample from mono wav or aiff files. wav1 :: String -> Sam-wav1 fileName = Sam $ return $ S (let x = readSnd1 fileName in (x, x)) (Dur $ lengthSnd fileName)+wav1 fileName = Sam $ return $ S (let x = readSnd1 fileName in (x, x)) (Dur $ sig $ lengthSnd fileName)  -- | Constructs sample from mono wav that is played in reverse. wavr1 :: String -> Sam-wavr1 fileName = Sam $ return $ S (let x = takeSnd len $ loopWav1 (-1) fileName in (x, x)) (Dur len)+wavr1 fileName = Sam $ return $ S (let x = takeSnd (sig len) $ loopWav1 (-1) fileName in (x, x)) (Dur $ sig len) 	where len = lengthSnd fileName  -- | Constructs sample from the segment of a mono wav file. The start and end times are measured in seconds. -- -- > seg begin end fileName seg1 :: D -> D -> String -> Sam-seg1 start end fileName = Sam $ return $ S (let x = readSegWav1 start end 1 fileName in (x, x)) (Dur len)+seg1 start end fileName = Sam $ return $ S (let x = readSegWav1 start end 1 fileName in (x, x)) (Dur $ sig len) 	where len = end - start  --- | Constructs reversed sample from segment of a mono audio file. segr1 :: D -> D -> String -> Sam-segr1 start end fileName = Sam $ return $ S (let x = readSegWav1 start end (-1) fileName in (x, x)) (Dur len)+segr1 start end fileName = Sam $ return $ S (let x = readSegWav1 start end (-1) fileName in (x, x)) (Dur $ sig len) 	where len = end - start  -- | Picks segments from the mono wav file at random. The first argument is the length of the segment.@@ -249,17 +249,17 @@ 	x <- random 0 1 	let a = start + dl * x 	let b = a + len-	return $ S (let y = readSegWav1 a b speed fileName in (y, y)) (Dur len)+	return $ S (let y = readSegWav1 a b speed fileName in (y, y)) (Dur $ sig len) 	where dl = end - len  -toSec :: Bpm -> D -> D+toSec :: Bpm -> Sig -> Sig toSec bpm a = a * 60 / bpm -toSecSig :: Bpm -> Sig -> Sig-toSecSig bpm a = a * 60 / sig bpm+toSecD :: Bpm -> D -> D+toSecD bpm a = a * 60 / (ir bpm) -addDur :: D -> Dur -> Dur+addDur :: Sig -> Dur -> Dur addDur d x = case x of 	Dur a  -> Dur $ d + a 	InfDur -> InfDur@@ -283,7 +283,7 @@ tfmS f ra = Sam $ do 	bpm <- ask 	a <- unSam ra-	return $ f bpm a	+	return $ f bpm a  setInfDur :: Sam -> Sam setInfDur = Sam . fmap (\a -> a { samDur = InfDur }) . unSam@@ -291,13 +291,13 @@ -- | Makes the sampler broader. It's reciprocal of str -- -- > wide k = str (1 / k)-wide :: D -> Sam -> Sam+wide :: Sig -> Sam -> Sam wide = str . recip  -- | Plays a list of samples one after another. flow :: [Sam] -> Sam flow [] = 0-flow as = foldr1 flow2 as +flow as = foldr1 flow2 as  flow2 :: Sam -> Sam -> Sam flow2 (Sam ra) (Sam rb) = Sam $ do@@ -316,10 +316,11 @@ genPick pickFun dt as = Sam $ do 	bpm <- ask 	xs <- sequence $ fmap unSam as-	let ds = fmap (getDur . samDur)  xs+	let ds = fmap (ir . getDur . samDur)  xs 	let sigs = fmap samSig xs-	return $ S (sched (\n -> return $ atTuple sigs $ sig n) $ fmap (\(dt, a) -> str dt $ temp a) $ pickFun (zip ds (fmap int [0..])) $ metroS bpm dt) InfDur -	where getDur x = case x of+	return $ S (sched (\n -> return $ atTuple sigs $ sig n) $ fmap (\(dt, a) -> str (sig dt) $ temp a) $ pickFun (zip ds (fmap int [0..])) $ metroS bpm dt) InfDur+	where+		getDur x = case x of 			InfDur -> -1 			Dur d  -> d @@ -338,9 +339,9 @@ genEnv :: EnvFun -> D -> D -> Sam -> Sam genEnv env start end = tfmS f 	where f bpm a = a { samSig = mul (env (samDur a) absStart absEnd) $ samSig a }-			where -				absStart = toSec bpm start-				absEnd   = toSec bpm end+			where+				absStart = toSecD bpm start+				absEnd   = toSecD bpm end  -- | A linear rise-decay envelope. Times a given in BPMs. --@@ -349,25 +350,25 @@ linEnv = genEnv f 	where f dur start end = case dur of 			InfDur -> linseg [0, start, 1]-			Dur d  -> linseg [0, start, 1, maxB 0 (d - start - end), 1, end , 0]+			Dur d  -> linseg [0, start, 1, maxB 0 (ir d - start - end), 1, end , 0]  -- | An exponential rise-decay envelope. Times a given in BPMs. -- -- > expEnv rise dec sample expEnv :: D -> D -> Sam -> Sam expEnv = genEnv f-	where +	where 		f dur start end = case dur of 			InfDur -> expseg [zero, start, 1]-			Dur d  -> expseg [zero, start, 1, maxB 0 (d - start - end), 1, end , zero]+			Dur d  -> expseg [zero, start, 1, maxB 0 (ir d - start - end), 1, end , zero] 		zero = 0.00001  genEnv1 :: (D -> Sig) -> Sam -> Sam genEnv1 envFun = tfmBy f-	where +	where 		f a = flip mul (samSig a) $ case samDur a of 			InfDur -> 1-			Dur d  -> envFun d+			Dur d  -> envFun (ir d)   -- | Parabolic envelope that starts and ends at zero and reaches maximum at the center.@@ -390,11 +391,11 @@ edecEnv :: Sam -> Sam edecEnv = genEnv1 $ \d -> expseg [1, d, 0.0001] -type LoopFun = D -> D -> Sig2 -> Sig2+type LoopFun = Sig -> Sig -> Sig2 -> Sig2 -genLoop :: LoopFun -> Sam -> Sam +genLoop :: LoopFun -> Sam -> Sam genLoop g = setInfDur . tfmS f-	where +	where 		f bpm a = a { samSig = case samDur a of 			InfDur -> samSig a 			Dur d  -> g bpm d (samSig a)@@ -402,59 +403,59 @@   -- | Plays the sample at the given period (in BPMs). The samples don't overlap.-rep1 :: D -> Sam -> Sam+rep1 :: Sig -> Sam -> Sam rep1 = rep . return  -- | Plays the sample at the given period (in BPMs). The overlapped samples are mixed together.-pat1 :: D -> Sam -> Sam+pat1 :: Sig -> Sam -> Sam pat1 = pat . return  -- | Plays the sample at the given pattern of periods (in BPMs). The samples don't overlap.-rep :: [D] -> Sam -> Sam -rep dts = genLoop $ \bpm d asig -> sched (const $ return asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts)-	where notes bpm _ = har $ zipWith (\t dt-> singleEvent (toSec bpm t) (toSec bpm dt) unit) (patDurs dts) dts	 -		+rep :: [Sig] -> Sam -> Sam+rep dts = genLoop $ \bpm d asig -> sched (const $ return asig) $ fmap (const $ notes bpm) $ metroS bpm (sum dts)+	where notes bpm = har $ zipWith (\t dt-> singleEvent (toSec bpm t) (toSec bpm dt) unit) (patDurs dts) dts+ -- | Plays the sample at the given pattern of periods (in BPMs). The overlapped samples are mixed together.-pat :: [D] -> Sam -> Sam -pat dts = genLoop $ \bpm d asig -> sched (const $ return asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts)-	where notes bpm d = har $ fmap (\t -> fromEvent $ Event (toSec bpm t) d unit) $ patDurs dts		+pat :: [Sig] -> Sam -> Sam+pat dts = genLoop $ \bpm d asig -> sched (const $ return asig) $ fmap (const $ notes bpm d) $ metroS bpm (sum dts)+	where notes bpm d = har $ fmap (\t -> fromEvent $ Event (toSec bpm t) d unit) $ patDurs dts  -- | Plays the sample at the given pattern of periods (in BPMs) and sometimes skips the samples from playback. The overlapped samples are mixed together. -- The first argument is the probability of inclusion.-rndPat :: Sig -> [D] -> Sam -> Sam -rndPat prob dts = genLoop $ \bpm d asig -> sched (const $ rndSkipInstr prob asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts)-	where -		notes bpm d = har $ fmap (\t -> fromEvent $ Event (toSec bpm t) d unit) $ patDurs dts	+rndPat :: Sig -> [Sig] -> Sam -> Sam+rndPat prob dts = genLoop $ \bpm d asig -> sched (const $ rndSkipInstr prob asig) $ fmap (const $ notes bpm d) $ metroS bpm (sum dts)+	where+		notes bpm d = har $ fmap (\t -> fromEvent $ Event (toSec bpm t) d unit) $ patDurs dts  -- | Plays the sample at the given pattern of volumes and periods (in BPMs). The overlapped samples are mixed together. -- -- > pat' volumes periods-pat' :: [D] -> [D] -> Sam -> Sam -pat' vols dts = genLoop $ \bpm d asig -> sched (instr asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts')-	where -		notes bpm d = har $ zipWith (\v t -> singleEvent (toSec bpm t) d v) vols' $ patDurs dts'		+pat' :: [D] -> [Sig] -> Sam -> Sam+pat' vols dts = genLoop $ \bpm d asig -> sched (instr asig) $ fmap (const $ notes bpm d) $ metroS bpm (sum dts')+	where+		notes bpm d = har $ zipWith (\v t -> singleEvent (toSec bpm t) d v) vols' $ patDurs dts' 		instr asig v = return $ mul (sig v) asig 		(vols', dts') = unzip $ lcmList vols dts  rndSkipInstr probSig asig = do 	let prob = ir probSig-	ref <- newRef 0	+	ref <- newRef 0 	p <- random 0 (1 :: D)-	whenD1 (p `lessThan` prob) $ +	whenD1 (p `lessThan` prob) $ 		writeRef ref asig 	whenD1 (p `greaterThanEquals` prob) $ 		writeRef ref 0-	readRef ref	+	readRef ref  -- | Plays the sample at the given pattern of volumes and periods (in BPMs) and sometimes skips the samples from playback.  The overlapped samples are mixed together. -- The first argument is the probability of inclusion. -- -- > rndPat' probability volumes periods-rndPat' :: Sig -> [D] -> [D] -> Sam -> Sam -rndPat' prob vols dts = genLoop $ \bpm d asig -> sched (instr asig) $ fmap (const $ notes bpm d) $ metroS bpm (sig $ sum dts')-	where -		notes bpm d = har $ zipWith (\v t -> singleEvent (toSec bpm t) d v) vols' $ patDurs dts'		-		instr asig v = mul (sig v) $ rndSkipInstr prob asig			+rndPat' :: Sig -> [D] -> [Sig] -> Sam -> Sam+rndPat' prob vols dts = genLoop $ \bpm d asig -> sched (instr asig) $ fmap (const $ notes bpm d) $ metroS bpm (sum dts')+	where+		notes bpm d = har $ zipWith (\v t -> singleEvent (toSec bpm t) d v) vols' $ patDurs dts'+		instr asig v = mul (sig v) $ rndSkipInstr prob asig 		(vols', dts') = unzip $ lcmList vols dts  @@ -466,9 +467,9 @@ -- The segment length is given in BPMs. -- -- > wall segLength-wall :: D -> Sam -> Sam +wall :: Sig -> Sam -> Sam wall dt a = mean [b, del hdt b]-	where +	where 		hdt = 0.5 * dt 		f = pat1 hdt . hatEnv . lim dt 		b = f a@@ -479,13 +480,13 @@ type Arp1Fun = Evt Unit -> Evt D  arpInstr :: Sig2 -> D -> SE Sig2-arpInstr asig k = return $ mapSig (scalePitch (sig k)) asig +arpInstr asig k = return $ mapSig (scalePitch (sig k)) asig -patDurs :: [D] -> [D]+patDurs :: [Sig] -> [Sig] patDurs dts = reverse $ snd $ foldl (\(counter, res) a -> (a + counter, counter:res)) (0, []) dts  genArp1 :: Arp1Fun -> Sig -> Sam -> Sam-genArp1 arpFun dt = genLoop $ \bpm d asig -> +genArp1 arpFun dt = genLoop $ \bpm d asig -> 	sched (arpInstr asig) $ withDur d $ arpFun $ metroS bpm dt  -- | Plays ascending arpeggio of samples.@@ -505,69 +506,67 @@ arpFreqOf1 :: [Sig] -> Chord -> Sig -> Sam -> Sam arpFreqOf1 freqs ch = genArp1 (freqOf (zip freqs ch)) -genArp :: Arp1Fun -> [D] -> Sam -> Sam-genArp arpFun dts = genLoop $ \bpm d asig -> sched (arpInstr asig) $ fmap (notes bpm d) $ arpFun $ metroS bpm (sig $ sum dts)-	where notes bpm d pchScale = har $ fmap (\t -> singleEvent (toSec bpm t) d pchScale) $ patDurs dts		+genArp :: Arp1Fun -> [Sig] -> Sam -> Sam+genArp arpFun dts = genLoop $ \bpm d asig -> sched (arpInstr asig) $ fmap (notes bpm d) $ arpFun $ metroS bpm (sum dts)+	where notes bpm d pchScale = har $ fmap (\t -> singleEvent (toSec bpm t) d pchScale) $ patDurs dts  -- | Plays ascending arpeggio of samples.-arpUp :: Chord -> [D] -> Sam -> Sam+arpUp :: Chord -> [Sig] -> Sam -> Sam arpUp = genArp . cycleE  -- | Plays descending arpeggio of samples.-arpDown :: Chord -> [D] -> Sam -> Sam+arpDown :: Chord -> [Sig] -> Sam -> Sam arpDown ch = arpUp (reverse ch)  -- | Plays arpeggio of samles with random notes from the chord.-arpOneOf :: Chord -> [D] -> Sam -> Sam +arpOneOf :: Chord -> [Sig] -> Sam -> Sam arpOneOf = genArp . oneOf  -- | Plays arpeggio of samles with random notes from the chord. -- We can assign the frequencies of the notes.-arpFreqOf :: [Sig] -> Chord -> [D] -> Sam -> Sam+arpFreqOf :: [Sig] -> Chord -> [Sig] -> Sam -> Sam arpFreqOf freqs ch = genArp (freqOf $ zip freqs ch)  metroS :: Bpm -> Sig -> Evt Unit-metroS bpm dt = metroE (recip $ toSecSig bpm dt)+metroS bpm dt = metroE (recip $ toSec bpm dt)  -- | The pattern is influenced by the Brian Eno's work "Music fo Airports". -- The argument is list of tripples: -- -- > (delayTime, repeatPeriod, pitch)--- +-- -- It takes a Sample and plays it in the loop with given initial delay time. -- The third cell in the tuple pitch is a value for scaling of the pitch in tones.-forAirports :: [(D, D, D)] -> Sam -> Sam-forAirports xs sample = mean $ flip fmap xs $ -    \(delTime, loopTime, note) -> del delTime $ pat [loopTime] (atPch (sig note) sample)+forAirports :: [(Sig, Sig, Sig)] -> Sam -> Sam+forAirports xs sample = mean $ flip fmap xs $+    \(delTime, loopTime, note) -> del delTime $ pat [loopTime] (atPch note sample)  -- | The pattern is influenced by the Brian Eno's work "Music fo Airports". -- It's more generic than pattern @forAirport@ -- The argument is list of tripples: -- -- > (delayTime, repeatPeriod, Sample)--- +-- -- It takes a list of Samples and plays them in the loop with given initial delay time and repeat period.-genForAirports :: [(D, D, Sam)] -> Sam+genForAirports :: [(Sig, Sig, Sam)] -> Sam genForAirports xs = mean $ fmap (\(delTime, loopTime, sample) -> del delTime $ pat [loopTime] sample) xs ---arp1 :: (SigSpace a, Sigs a) => (D -> SE a) -> D -> D -> Int -> [D] -> a-arp1 instr bpm dt n ch = sched (\(amp, cps) -> fmap (mul (sig amp)) $ instr cps) $ -	withDur (toSec bpm dt) $ cycleE (lcmList (1 : replicate (n - 1) 0.7) ch) $ metroS bpm (sig dt)+arp1 :: (SigSpace a, Sigs a) => (D -> SE a) -> Sig -> Sig -> Int -> [D] -> a+arp1 instr bpm dt n ch = sched (\(amp, cps) -> fmap (mul (sig amp)) $ instr cps) $+	withDur (toSec bpm dt) $ cycleE (lcmList (1 : replicate (n - 1) 0.7) ch) $ metroS bpm dt --- | The arpeggiator for the sequence of chords. +-- | The arpeggiator for the sequence of chords. ----- > arpy instrument chordPeriod speedOfTheNote accentNumber chords +-- > arpy instrument chordPeriod speedOfTheNote accentNumber chords -- -- The first argument is an instrument that takes in a frequency of -- the note in Hz. The second argument is the period of--- chord change (in beats). The next argument is the speed +-- chord change (in beats). The next argument is the speed -- of the single note (in beats). The integer argument -- is number of notes in the group. Every n'th note is louder. -- The last argument is the sequence of chords. The chord is -- the list of frequencies.-arpy :: (D -> SE Sig2) -> D -> D -> Int -> [[D]] -> Sam+arpy :: (D -> SE Sig2) -> Sig -> Sig -> Int -> [[D]] -> Sam arpy instr chordPeriod speed accentNum chords = Sam $ do 	bpm <- ask 	res <- unSam $ loop $ flow $ map (linEnv 0.05 0.05 . fromSig2 chordPeriod . arp1 instr bpm speed accentNum) chords@@ -588,7 +587,7 @@ class ToSam a where 	toSam :: a -> Sam -limSam :: ToSam a => D -> a -> Sam+limSam :: ToSam a => Sig -> a -> Sam limSam dt = lim dt . toSam  instance ToSam Sig where@@ -616,7 +615,7 @@  -- | It's the same as readRam but wrapped in Sam (see "Csound.Air.Wav"). ramRead :: Fidelity -> TempoSig -> PitchSig -> String -> Sam-ramRead winSize tempo pitch file = sig2 (lengthSnd file / ir tempo) $ readRam winSize tempo pitch file+ramRead winSize tempo pitch file = sig2 (sig (lengthSnd file) / tempo) $ readRam winSize tempo pitch file  -- | It's the same as loopSeg but wrapped in Sam (see "Csound.Air.Wav"). segLoop :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam@@ -624,7 +623,7 @@  -- | It's the same as readSeg but wrapped in Sam (see "Csound.Air.Wav"). segRead :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam-segRead winSize ds@(kmin, kmax) tempo pitch file = sig2 (ir $ (kmax - kmin) / tempo) $ readSeg winSize ds tempo pitch file+segRead winSize ds@(kmin, kmax) tempo pitch file = sig2 ((kmax - kmin) / tempo) $ readSeg winSize ds tempo pitch file  -- | It's the same as loopRel but wrapped in Sam (see "Csound.Air.Wav"). relLoop :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam@@ -632,7 +631,7 @@  -- | It's the same as readRel but wrapped in Sam (see "Csound.Air.Wav"). relRead :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam-relRead winSize ds@(kmin, kmax) tempo pitch file = sig2 (ir $ (kmax - kmin) / tempo) $ readRel winSize ds tempo pitch file+relRead winSize ds@(kmin, kmax) tempo pitch file = sig2 ((kmax - kmin) / tempo) $ readRel winSize ds tempo pitch file  -- | It's the same as loopRam1 but wrapped in Sam (see "Csound.Air.Wav"). ramLoop1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sam@@ -640,7 +639,7 @@  -- | It's the same as readRam1 but wrapped in Sam (see "Csound.Air.Wav"). ramRead1 :: Fidelity -> TempoSig -> PitchSig -> String -> Sam-ramRead1 winSize tempo pitch file = sig1 (lengthSnd file / ir tempo) $ readRam1 winSize tempo pitch file+ramRead1 winSize tempo pitch file = sig1 (sig (lengthSnd file) / tempo) $ readRam1 winSize tempo pitch file  -- | It's the same as loopSeg1 but wrapped in Sam (see "Csound.Air.Wav"). segLoop1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam@@ -648,7 +647,7 @@  -- | It's the same as readSeg1 but wrapped in Sam (see "Csound.Air.Wav"). segRead1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam-segRead1 winSize ds@(kmin, kmax) tempo pitch file = sig1 (ir $ (kmax - kmin) / tempo) $ readSeg1 winSize ds tempo pitch file+segRead1 winSize ds@(kmin, kmax) tempo pitch file = sig1 ((kmax - kmin) / tempo) $ readSeg1 winSize ds tempo pitch file  -- | It's the same as loopRel1 but wrapped in Sam (see "Csound.Air.Wav"). relLoop1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam@@ -656,7 +655,7 @@  -- | It's the same as readRel1 but wrapped in Sam (see "Csound.Air.Wav"). relRead1 :: Fidelity -> (Sig, Sig) -> TempoSig -> PitchSig -> String -> Sam-relRead1 winSize ds@(kmin, kmax) tempo pitch file = sig1 (ir $ (kmax - kmin) / tempo) $ readRel1 winSize ds tempo pitch file+relRead1 winSize ds@(kmin, kmax) tempo pitch file = sig1 ((kmax - kmin) / tempo) $ readRel1 winSize ds tempo pitch file  ----------------------- -- temposcale

@@ -15,21 +15,29 @@ type Sam = Sample Sig2  instance RenderCsd Sam where-    renderCsdBy opt sample = renderCsdBy opt (runSam (120 * 4) sample)+    renderCsdBy opt sample = renderCsdBy opt (runSam (getBpm * 4) sample)  instance RenderCsd (Source Sam) where-	renderCsdBy opt sample = renderCsdBy opt (lift1 (runSam (120 * 4)) sample)	+	renderCsdBy opt sample = renderCsdBy opt (lift1 (runSam (getBpm * 4)) sample) +instance RenderCsd (SE Sam) where+    renderCsdBy opt sample = renderCsdBy opt (runSam (getBpm * 4) =<< sample)++instance RenderCsd (SE (Source Sam)) where+    renderCsdBy opt sample = renderCsdBy opt $ do+    	sample' <- sample+    	lift1 (runSam (getBpm * 4)) sample'+ runSam :: Bpm -> Sam -> SE Sig2 runSam bpm x = fmap samSig $ runReaderT (unSam x) bpm -data Dur = Dur D | InfDur+data Dur = Dur Sig | InfDur  -- | The Beats Per Minute measure (BPM). Almost all values are measured in BPMs.-type Bpm = D+type Bpm = Sig  -- | The generic type for samples.-newtype Sample a = Sam { unSam :: ReaderT Bpm SE (S a) +newtype Sample a = Sam { unSam :: ReaderT Bpm SE (S a) 	} deriving (Functor)  instance Applicative Sample where@@ -38,7 +46,7 @@  data S a = S 	{ samSig :: a-	, samDur :: Dur +	, samDur :: Dur 	} deriving (Functor)  instance Applicative S where@@ -63,6 +71,12 @@ instance SigSpace a => SigSpace (Sample a) where 	mapSig f = fmap (mapSig f) +instance SigSpace2 a => SigSpace2 (Sample a) where+	mapSig2 f = fmap (mapSig2 f)++instance BindSig2 a => BindSig2 (Sample a) where+	bindSig2 f = return . bindSam (bindSig2 f)+ -- Lifters  -- | Hides the effects inside sample.@@ -74,14 +88,14 @@ -- | Transforms the sample with BPM. mapBpm :: (Bpm -> a -> b) -> Sample a -> Sample b mapBpm f a = Sam $ do-	bpm <- ask	+	bpm <- ask 	unSam $ fmap (f bpm) a  -- | Transforms the sample with BPM. mapBpm2 :: (Bpm -> a -> b -> c) -> Sample a -> Sample b -> Sample c mapBpm2 f a b = Sam $ do-	bpm <- ask	-	unSam $ liftA2 (f bpm) a b	+	bpm <- ask+	unSam $ liftA2 (f bpm) a b  -- | Lifts bind on stereo signals to samples. bindSam :: (a -> SE b) -> Sample a -> Sample b

@@ -43,7 +43,7 @@  -- | Char trigger with fixed note limiting by length in second. -- It's useful optimization. It's good to use for drum notes and short sounds.-samCharTap :: D -> String -> Sam -> Sam+samCharTap :: Sig -> String -> Sam -> Sam samCharTap stop starts = fmap (charTap stop starts)  -- | Plays one of the sample from the list when corresponding char is pressed.@@ -54,7 +54,7 @@ 	Just v0 -> liftA2 (\v xs -> charGroup (Just v) (zip starts xs) stop) v0 (sequenceA sams) 	where (starts, sams) = unzip as --- | Plays samples in sequence when key is pressed. The last string is +-- | Plays samples in sequence when key is pressed. The last string is -- for stopping the sequence. samCharCycle :: Maybe Sam -> Char -> String -> [Sam] -> Sam samCharCycle initVal start stop as = case initVal of@@ -65,26 +65,27 @@ ------------------------------------------------------ -- synchronised -syncBeats bpm beats = sig $ bpm / beats+syncBeats :: Sig -> Sig -> Sig+syncBeats bpm beats = bpm / beats  -- | Triggers the sample with any char from the first string -- and stops the sample with any char from the second string. -- The first argument is the number of beats for syncronization.-samSyncCharTrig :: D -> Maybe Sam -> String -> String -> Sam -> Sam+samSyncCharTrig :: Sig -> Maybe Sam -> String -> String -> Sam -> Sam samSyncCharTrig beats initVal starts stops x = case initVal of 	Nothing -> mapBpm (\bpm a -> syncCharTrig (syncBeats bpm beats) Nothing starts stops a) x 	Just v0 -> mapBpm2 (\bpm v sigs -> syncCharTrig (syncBeats bpm beats) (Just v) starts stops sigs) v0 x  -- | Plays a sample while the key is pressed. -- The first argument is the number of beats for syncronization.-samSyncCharPush :: D -> Maybe Sam -> Char -> Sam -> Sam+samSyncCharPush :: Sig -> Maybe Sam -> Char -> Sam -> Sam samSyncCharPush beats initVal ch x = case initVal of 	Nothing -> mapBpm (\bpm a -> syncCharPush (syncBeats bpm beats) Nothing ch a) x 	Just v0 -> mapBpm2 (\bpm v sigs -> syncCharPush (syncBeats bpm beats) (Just v) ch sigs) v0 x  -- | Toggles the sample when the key is pressed. -- The first argument is the number of beats for syncronization.-samSyncCharToggle :: D -> Maybe Sam -> Char -> Sam -> Sam+samSyncCharToggle :: Sig -> Maybe Sam -> Char -> Sam -> Sam samSyncCharToggle beats initVal ch x = case initVal of 	Nothing -> mapBpm (\bpm a -> syncCharToggle (syncBeats bpm beats) Nothing ch a) x 	Just v0 -> mapBpm2 (\bpm v sigs -> syncCharToggle (syncBeats bpm beats) (Just v) ch sigs) v0 x@@ -92,21 +93,21 @@ -- | Char trigger with fixed note limiting by length in second. -- It's useful optimization. It's good to use for drum notes and short sounds. -- The first argument is the number of beats for syncronization.-samSyncCharTap :: D -> D -> String -> Sam -> Sam+samSyncCharTap :: Sig -> Sig -> String -> Sam -> Sam samSyncCharTap beats stop starts = mapBpm (\bpm x -> syncCharTap (syncBeats bpm beats) stop starts x)  -- | Plays one of the sample from the list when corresponding char is pressed. -- The last string is for stopping the samples.-samSyncCharGroup :: D -> Maybe Sam -> [(Char, Sam)] -> String -> Sam+samSyncCharGroup :: Sig -> Maybe Sam -> [(Char, Sam)] -> String -> Sam samSyncCharGroup beats initVal as stop = case initVal of 	Nothing -> mapBpm (\bpm xs -> syncCharGroup (syncBeats bpm beats) Nothing (zip starts xs) stop) (sequenceA sams) 	Just v0 -> mapBpm2 (\bpm v xs -> syncCharGroup (syncBeats bpm beats) (Just v) (zip starts xs) stop) v0 (sequenceA sams) 	where (starts, sams) = unzip as --- | Plays samples in sequence when key is pressed. The last string is +-- | Plays samples in sequence when key is pressed. The last string is -- for stopping the sequence. -- The first argument is the number of beats for syncronization.-samSyncCharCycle :: D -> Maybe Sam -> Char -> String -> [Sam] -> Sam+samSyncCharCycle :: Sig -> Maybe Sam -> Char -> String -> [Sam] -> Sam samSyncCharCycle beats initVal start stop as = case initVal of 	Nothing -> mapBpm (\bpm -> syncCharCycle (syncBeats bpm beats) Nothing start stop) (sequenceA as) 	Just v0 -> mapBpm2 (\bpm v xs -> syncCharCycle (syncBeats bpm beats) (Just v) start stop xs) v0 (sequenceA as)@@ -121,7 +122,7 @@ -- | Midi trigger with fixed note limiting by length in second. -- It's useful optimization. It's good to use for drum notes and short sounds. -- The key is an integer midi code. The C1 is 60 and the A1 is 69.-samMidiTap :: MidiChn -> D -> Int -> Sam -> Sam+samMidiTap :: MidiChn -> Sig -> Int -> Sam -> Sam samMidiTap = samMidiTapBy midiAmpInstr  samMidiPush :: MidiChn -> Int -> Sam -> Sam@@ -147,7 +148,7 @@ -- | Generic samMidiTap. We can specify the midi triggering function. -- The midi function takes in a signal and a volume of the pressed key (it ranges from 0 to 1). -- It produces some output. The default is scaling the signal with the amplitude.-samMidiTapBy :: MidiTrigFun Sig2 -> MidiChn -> D -> Int -> Sam -> Sam+samMidiTapBy :: MidiTrigFun Sig2 -> MidiChn -> Sig -> Int -> Sam -> Sam samMidiTapBy midiFun midiChn dt key = bindSam (midiTapBy midiFun midiChn dt key)  -- | Generic samMidiPush. We can specify the midi triggering function.

@@ -46,7 +46,7 @@  genFreeSimInits :: ([Gui] -> Gui) -> [(String, Sam, Bool)] -> Source Sam genFreeSimInits gcat as = source $ do-	(guis, ts) <- fmap unzip $ zipWithM (\a b -> unSource $ toggle a b) names initVals+	(guis, ts) <- fmap unzip $ zipWithM (\a b -> toggle a b) names initVals 	let res = groupToggles mean sams ts 	return (gcat guis, res) 	where@@ -63,7 +63,7 @@  genFreeTog :: ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam genFreeTog gcat as = source $ do-	(guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . flip setToggleSig False) names+	(guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names 	curRef <- newGlobalRef (0 :: Sig) 	current <- readRef curRef 	zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids@@ -86,11 +86,11 @@  genSimInits :: ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam genSimInits gcat numBeats as = source $ do-	(guis, writes, reads) <- fmap unzip3 $ zipWithM (\a b -> unSinkSource $ setToggleSig a b) names initVals+	(guis, writes, reads) <- fmap unzip3 $ zipWithM (\a b -> setToggleSig a b) names initVals 	curRefs <- mapM (const $ newGlobalRef (0 :: Sig)) ids 	currents <- mapM readRef curRefs 	zipWithM_ (\w val -> w val) writes currents-	let mkReaders bpm = zipWithM_ (\r ref -> runEvt (syncBpm (sig $ bpm / int numBeats) $ snaps r) $ \x -> do+	let mkReaders bpm = zipWithM_ (\r ref -> runEvt (syncBpm (bpm / sig (int numBeats)) $ snaps r) $ \x -> do 			writeRef ref (sig x) 		) reads curRefs 	let res = bindBpm (\bpm x -> mkReaders bpm >> return x) $ groupToggles mean sams $ fmap snaps currents@@ -128,15 +128,15 @@   genTog :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam-genTog gcat numBeats as = Source $ fmap (\(g, x) -> (g, fst x)) $ unSource $ genTogWithRef gcat numBeats as+genTog gcat numBeats as = fmap (\(g, x) -> (g, fst x)) $ genTogWithRef gcat numBeats as  genTogWithRef :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source (Sam, Ref Sig) genTogWithRef gcat numBeats as = source $ do-	(guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . flip setToggleSig False) names+	(guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names 	curRef <- newGlobalRef (0 :: Sig) 	current <- readRef curRef 	zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids-	let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (sig $ bpm / int numBeats) $ snaps r) $ \x -> do+	let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (bpm / (sig $ int numBeats)) $ snaps r) $ \x -> do 		when1 (sig x ==* 0 &&* current ==* i) $ do 			writeRef curRef 0 		when1 (sig x ==* 1) $ do@@ -174,10 +174,10 @@ -- in row-wise fashion. live :: Int -> [String] -> [Sam] -> Source Sam live numBeats names sams = source $ do-	(gVols, vols) <- fmap unzip $  mapM  (unSource . defSlider) $ replicate n "vol"-	(gs, xs) <- fmap unzip $ zipWithM (\a b -> unSource $ mkLiveRow numBeats a b) (zip names gVols) rows+	(gVols, vols) <- fmap unzip $  mapM  defSlider $ replicate n "vol"+	(gs, xs) <- fmap unzip $ zipWithM (\a b -> mkLiveRow numBeats a b) (zip names gVols) rows 	let (sigs, refs) = unzip xs-	(gMaster, masterVol) <- unSource $ defSlider "master"+	(gMaster, masterVol) <- defSlider "master" 	(g, proc) <- mkLiveSceneRow numBeats gMaster ids refs 	return $ (hor $ g : gs, bindBpm (\bpm asig -> proc bpm >> return asig) $ mul masterVol $ mean $ zipWith mul vols sigs) 	where@@ -188,13 +188,13 @@ mkLiveRow :: Int -> (String, Gui) -> [Sam] -> Source (Sam, Ref Sig) mkLiveRow numBeats (name, gVol) xs = genTogWithRef (\xs -> ver $ xs ++ [gVol]) numBeats (zip (name : repeat "") xs) -mkLiveSceneRow :: Int -> Gui -> [Sig] -> [Ref Sig] -> SE (Gui, D -> SE ())+mkLiveSceneRow :: Int -> Gui -> [Sig] -> [Ref Sig] -> SE (Gui, Sig -> SE ()) mkLiveSceneRow numBeats gMaster ids refs = do-	(guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . flip setToggleSig False) names+	(guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names 	curRef <- newGlobalRef (0 :: Sig) 	current <- readRef curRef 	zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids-	let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (sig $ bpm / int numBeats) $ snaps r) $ \x -> do+	let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (bpm / sig (int numBeats)) $ snaps r) $ \x -> do 		when1 (sig x ==* 0 &&* current ==* i) $ do 			writeRef curRef 0 			mapM_ (flip writeRef 0) refs@@ -221,14 +221,14 @@ -- between dry and wet signals. liveEf :: Int -> [String] -> [Sam] -> (Double, Fx2) -> [(Double, Fx2)] -> Source Sam liveEf numBeats names sams masterEff effs = source $ do-	(gVols, vols) <- fmap unzip $  mapM (unSource . defSlider) $ replicate n "vol"+	(gVols, vols) <- fmap unzip $  mapM defSlider $ replicate n "vol" 	(gEffs, effCtrls) <- fmap unzip $-		mapM (\(tag, initVal) -> unSource $ slider tag (linSpan 0 1) initVal) $ zip (replicate n "eff") (fmap fst effs)+		mapM (\(tag, initVal) -> slider tag (linSpan 0 1) initVal) $ zip (replicate n "eff") (fmap fst effs) 	let gCtrls = zipWith ctrlGui gEffs gVols-	(gs, xs) <- fmap unzip $ zipWithM (\a b -> unSource $ mkLiveRow numBeats a b) (zip names gCtrls) rows+	(gs, xs) <- fmap unzip $ zipWithM (\a b -> mkLiveRow numBeats a b) (zip names gCtrls) rows 	let (sigs, refs) = unzip xs-	(gMaster, masterVol) <- unSource $ defSlider "master"-	(gMasterEff, masterEffCtrl) <- unSource $slider "eff" (linSpan 0 1) (fst masterEff)+	(gMaster, masterVol) <- defSlider "master"+	(gMasterEff, masterEffCtrl) <- slider "eff" (linSpan 0 1) (fst masterEff) 	(g, proc) <- mkLiveSceneRow numBeats (ctrlGui gMasterEff gMaster) ids refs 	return $ (hor $ g : gs, bindBpm (\bpm asig -> proc bpm >> return asig) $ 		mul masterVol $ appEff (snd  masterEff) masterEffCtrl $@@ -250,18 +250,18 @@ -- | Creates fx-unit from sampler widget. -- -- > uisam name isOn bpm samWidget-uiSam :: String -> Bool -> D -> Source Sam -> Source Fx2+uiSam :: String -> Bool -> Sig -> Source Sam -> Source Fx2 uiSam name onOff bpm sam = uiSig name onOff (joinSource $ mapSource (runSam bpm) sam) 	where 		joinSource :: Source (SE Sig2) -> Source Sig2 		joinSource a = source $ do-			(g, mres) <- unSource a+			(g, mres) <- a 			res <- mres 			return (g, res)  -- | Adds gain slider on top of the widget. addGain :: SigSpace a => Source a -> Source a addGain x = source $ do-	(g, asig) <- unSource x-	(gainGui, gain) <- unSource $ slider "gain" (linSpan 0 1) 0.5+	(g, asig) <- x+	(gainGui, gain) <- slider "gain" (linSpan 0 1) 0.5 	return (ver [sca 0.15 gainGui, g], mul gain asig)