packages feed

csound-sampler 0.0.2 → 0.0.3

raw patch · 4 files changed

+363/−75 lines, 4 files

Files

csound-sampler.cabal view
@@ -1,5 +1,5 @@ name:                csound-sampler-version:             0.0.2+version:             0.0.3 license:             BSD3 license-file:        LICENSE author:              Anton Kholomiov@@ -28,5 +28,8 @@   build-depends:       base >= 4, base < 5, transformers >= 0.3, csound-expression >= 4.1.0   exposed-modules:          Csound.Sam+    Csound.Sam.Core+    Csound.Sam.Ui     Csound.Sam.Chord+
src/Csound/Sam.hs view
@@ -21,7 +21,10 @@ 	arpUp, arpDown, arpOneOf, arpFreqOf, 	arpUp1, arpDown1, arpOneOf1, arpFreqOf1,     -- * Misc patterns-    wall, forAirports, genForAirports+    wall, forAirports, genForAirports,++    -- UIs+    module Csound.Sam.Ui ) where  import Control.Monad.Trans.Class@@ -29,76 +32,8 @@ import Control.Monad.Trans.Reader  import Csound.Base---- | The main type. A stereo sample.-type Sam = Sample Sig2--data Dur = Dur D | InfDur---- | The Beats Per Minute measure (BPM). Almost all values are measured in BPMs.-type Bpm = D---- | The generic type for samples.-newtype Sample a = Sam { unSam :: ReaderT Bpm SE (S a) -	} deriving (Functor)--instance Applicative Sample where-	pure = Sam . pure . pure-	(Sam rf) <*> (Sam ra) = Sam $ liftA2 (<*>) rf ra--data S a = S-	{ samSig :: a-	, samDur :: Dur -	} deriving (Functor)--instance Applicative S where-	pure a = S a InfDur-	(S f df) <*> (S a da) = S (f a) $ case (df, da) of-		(Dur durF, Dur durA) -> Dur $ maxB durF durA-		_			     -> InfDur--instance Num a => Num (Sample a) where-	(+) = liftA2 (+)-	(*) = liftA2 (*)-	(-) = liftA2 (-)-	negate = fmap negate-	abs = fmap abs-	signum = fmap signum-	fromInteger = pure . fromInteger--instance Fractional a => Fractional (Sample a) where-	recip = fmap recip-	fromRational = pure . fromRational--instance SigSpace a => SigSpace (Sample a) where-	mapSig f = fmap (mapSig f)--instance RenderCsd Sam where-    renderCsdBy opt sample = renderCsdBy opt (runSam (120 * 4) sample)---- | Hides the effects inside sample.-liftSam :: Sample (SE a) -> Sample a-liftSam (Sam ra) = Sam $ do-	a <- ra-	lift $ fmap (\x -> a{ samSig = x}) $ samSig a---- | Transforms the sample with BPM.-mapBpm :: (Bpm -> Sig2 -> Sig2) -> Sam -> Sam-mapBpm f (Sam ra) = Sam $ do-	bpm <- ask-	a <- ra-	return $ a { samSig = f bpm $ samSig a }---- | Lifts bind on stereo signals to samples.-bindSam :: (Sig2 -> SE Sig2) -> Sam -> Sam-bindSam f = liftSam . fmap f---- | Lifts bind on stereo signals to samples with BPM.-bindBpm :: (Bpm -> Sig2 -> SE Sig2) -> Sam -> Sam-bindBpm f (Sam ra) = Sam $ do-	bpm <- ask-	a <- ra-	lift $ fmap (\x -> a{ samSig = x}) $ f bpm $ samSig a+import Csound.Sam.Core+import Csound.Sam.Ui  -- | Constructs sample from mono signal infSig1 :: Sig -> Sam@@ -236,9 +171,6 @@  toSecSig :: Bpm -> Sig -> Sig toSecSig bpm a = a * 60 / sig bpm--runSam :: Bpm -> Sam -> SE Sig2-runSam bpm x = fmap samSig $ runReaderT (unSam x) bpm  addDur :: D -> Dur -> Dur addDur d x = case x of
+ src/Csound/Sam/Core.hs view
@@ -0,0 +1,87 @@+-- | The core types/ They are not imported by default.+{-# Language DeriveFunctor, TypeSynonymInstances, FlexibleInstances #-}+module Csound.Sam.Core (+	Sam, runSam, Sample(..), S(..), Dur(..), Bpm,+	liftSam, mapBpm, bindSam, bindBpm+) where++import Control.Applicative+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Class++import Csound.Base++-- | The main type. A stereo sample.+type Sam = Sample Sig2++instance RenderCsd Sam where+    renderCsdBy opt sample = renderCsdBy opt (runSam (120 * 4) sample)++runSam :: Bpm -> Sam -> SE Sig2+runSam bpm x = fmap samSig $ runReaderT (unSam x) bpm++data Dur = Dur D | InfDur++-- | The Beats Per Minute measure (BPM). Almost all values are measured in BPMs.+type Bpm = D++-- | The generic type for samples.+newtype Sample a = Sam { unSam :: ReaderT Bpm SE (S a) +	} deriving (Functor)++instance Applicative Sample where+	pure = Sam . pure . pure+	(Sam rf) <*> (Sam ra) = Sam $ liftA2 (<*>) rf ra++data S a = S+	{ samSig :: a+	, samDur :: Dur +	} deriving (Functor)++instance Applicative S where+	pure a = S a InfDur+	(S f df) <*> (S a da) = S (f a) $ case (df, da) of+		(Dur durF, Dur durA) -> Dur $ maxB durF durA+		_			     -> InfDur++instance Num a => Num (Sample a) where+	(+) = liftA2 (+)+	(*) = liftA2 (*)+	(-) = liftA2 (-)+	negate = fmap negate+	abs = fmap abs+	signum = fmap signum+	fromInteger = pure . fromInteger++instance Fractional a => Fractional (Sample a) where+	recip = fmap recip+	fromRational = pure . fromRational++instance SigSpace a => SigSpace (Sample a) where+	mapSig f = fmap (mapSig f)++-- Lifters++-- | Hides the effects inside sample.+liftSam :: Sample (SE a) -> Sample a+liftSam (Sam ra) = Sam $ do+	a <- ra+	lift $ fmap (\x -> a{ samSig = x}) $ samSig a++-- | Transforms the sample with BPM.+mapBpm :: (Bpm -> Sig2 -> Sig2) -> Sam -> Sam+mapBpm f (Sam ra) = Sam $ do+	bpm <- ask+	a <- ra+	return $ a { samSig = f bpm $ samSig a }++-- | Lifts bind on stereo signals to samples.+bindSam :: (Sig2 -> SE Sig2) -> Sam -> Sam+bindSam f = liftSam . fmap f++-- | Lifts bind on stereo signals to samples with BPM.+bindBpm :: (Bpm -> Sig2 -> SE Sig2) -> Sam -> Sam+bindBpm f (Sam ra) = Sam $ do+	bpm <- ask+	a <- ra+	lift $ fmap (\x -> a{ samSig = x}) $ f bpm $ samSig a
+ src/Csound/Sam/Ui.hs view
@@ -0,0 +1,266 @@+-- | Graphical widgets for playing samples+module Csound.Sam.Ui(+	freeSim, hfreeSim, freeSimWith, hfreeSimWith,+	freeTog, hfreeTog, +	sim, hsim, simWith, hsimWith,+	tog, htog,+	live, liveEf,	+	mixSam, uiSam, addGain+) where++import Data.List(transpose)+import Control.Monad+import Control.Monad.Trans.Reader++import Csound.Base+import Csound.Sam.Core++groupToggles :: ([Sig2] -> Sig2) -> [Sam] -> [Evt D] -> Sam+groupToggles group sams ts = Sam $ reader $ \r -> +	S (group $ zipWith (\sam t -> schedToggle (runSam r sam) t) sams ts) InfDur ++-- | A widget for playing several samples at the same time (aka `sim`ultaneously).+-- The prefix `free` means no syncronization. the samples start to play when the button is pressed.+freeSim :: [(String, Sam)] -> Source Sam+freeSim = genFreeSim ver++-- | It's just like the function @freeSim@ but the visual representation is horizontal.+-- That's why there is a prefix @h@.+hfreeSim :: [(String, Sam)] -> Source Sam+hfreeSim = genFreeSim hor++-- | It's just like the function `freeSim` but the user can +-- activate some samples right in the code. If the third +-- element is @True@ the sample is played.+freeSimWith :: [(String, Sam, Bool)] -> Source Sam+freeSimWith = genFreeSimInits ver++-- | It's just like the function `freeSimWith` but the visual representation is horizontal.+-- That's why there is a prefix @h@.+hfreeSimWith :: [(String, Sam, Bool)] -> Source Sam+hfreeSimWith = genFreeSimInits hor++genFreeSim :: ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam+genFreeSim gcat as = genFreeSimInits gcat $ fmap (\(a, b) -> (a, b, False)) as++genFreeSimInits :: ([Gui] -> Gui) -> [(String, Sam, Bool)] -> Source Sam+genFreeSimInits gcat as = source $ do+	(guis, ts) <- fmap unzip $ zipWithM toggle names initVals+	let res = groupToggles mean sams ts+	return (gcat guis, res)+	where +		(names, sams, initVals) = unzip3 as++-- | The widget to toggle between several samples (aka `tog`gle). +-- The prefix `free` means no syncronization. the samples start to play when the button is pressed.+freeTog :: [(String, Sam)] -> Source Sam+freeTog = genFreeTog ver++-- | It's just like the function @freeTog@ but the visual representation is horizontal.+hfreeTog :: [(String, Sam)] -> Source Sam+hfreeTog = genFreeTog hor++genFreeTog :: ([Gui] -> Gui) -> [(String, Sam)] -> Source Sam+genFreeTog gcat as = source $ do+	(guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names+	curRef <- newGlobalSERef (0 :: Sig)+	current <- readSERef curRef+	zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids+	zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do+		when1 (sig x ==* 0 &&* current ==* i) $ do+			writeSERef curRef 0+		when1 (sig x ==* 1) $ do+			writeSERef curRef i		+		) reads ids++	let res = groupToggles sum sams $ fmap (snaps . (\i -> ifB (current ==* i) 1 0)) ids+	return (gcat guis, res)+	where +		(names, sams) = unzip as+		ids = fmap (sig . int) [1 .. length as]+++genSim :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam+genSim gcat numBeats as = genSimInits gcat numBeats $ fmap (\(a, b) -> (a, b, False)) as++genSimInits :: ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam+genSimInits gcat numBeats as = source $ do+	(guis, writes, reads) <- fmap unzip3 $ zipWithM setToggleSig names initVals+	curRefs <- mapM (const $ newGlobalSERef (0 :: Sig)) ids+	currents <- mapM readSERef curRefs+	zipWithM_ (\w val -> w val) writes currents+	let mkReaders bpm = zipWithM_ (\r ref -> runEvt (syncBpm (bpm / int numBeats) $ snaps r) $ \x -> do+			writeSERef ref (sig x)+		) reads curRefs+	let res = bindBpm (\bpm x -> mkReaders bpm >> return x) $ groupToggles mean sams $ fmap snaps currents+	return (gcat guis, res)+	where +		(names, sams, initVals) = unzip3 as+		ids = fmap (sig . int) [1 .. length as]++-- | A widget for playing several samples at the same time (aka `sim`ultaneously).+-- The first argument is about syncronization. +--+-- > sim n nameAndSamples+--+-- The samples are started only on every n'th beat.+-- The tempo is specified with rendering the sample (see the function @runSam@). +sim :: Int -> [(String, Sam)] -> Source Sam+sim = genSim ver++-- | It's just like the function @sim@ but the visual representation is horizontal.+-- That's why there is a prefix @h@. +hsim :: Int -> [(String, Sam)] -> Source Sam+hsim = genSim hor+++-- | It's just like the function `sim` but the user can +-- activate some samples right in the code. If the third +-- element is @True@ the sample is played.+simWith :: Int -> [(String, Sam, Bool)] -> Source Sam+simWith = genSimInits ver++-- | It's just like the function `hsimWith` but the visual representation is horizontal.+-- That's why there is a prefix @h@.+hsimWith :: Int -> [(String, Sam, Bool)] -> Source Sam+hsimWith = genSimInits hor+++genTog :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source Sam+genTog gcat numBeats as = fmap (\(g, x) -> (g, fst x)) $ genTogWithRef gcat numBeats as++genTogWithRef :: ([Gui] -> Gui) -> Int -> [(String, Sam)] -> Source (Sam, SERef Sig)+genTogWithRef gcat numBeats as = source $ do+	(guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names+	curRef <- newGlobalSERef (0 :: Sig)+	current <- readSERef curRef+	zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids+	let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (bpm / int numBeats) $ snaps r) $ \x -> do+		when1 (sig x ==* 0 &&* current ==* i) $ do+			writeSERef curRef 0			+		when1 (sig x ==* 1) $ do+			writeSERef curRef i					+		) reads ids++	let res = bindBpm (\bpm x -> mkReaders bpm >> return x) $ groupToggles sum sams $ fmap (snaps . (\i -> ifB (current ==* i) 1 0)) ids+	return (gcat guis, (res, curRef))+	where +		(names, sams) = unzip as+		ids = fmap (sig . int) [1 .. length as]++-- | A widget to toggle playing of several samples. The switch +-- of the playing is synchronized with each n'th beat where+-- n is the first argument of the function.+tog :: Int -> [(String, Sam)] -> Source Sam+tog = genTog ver++-- | It's just like the function @tog@ but the visual representation is horizontal.+-- That's why there is a prefix @h@. +htog :: Int -> [(String, Sam)] -> Source Sam+htog = genTog hor++-- | The widget resembles the Ableton Live session view. +-- We create a matrix of samples. we can toggle the samples in +-- each row and we can start playing the whole row of samples.+--+-- > live n groupNames samples+--+-- The first argument is for synchroization. we can start samples+-- only on every n'th beat. The second argument gives names to the columns.+-- the length of the list is the number of columns. +-- the column represents samples that belong to the same group.+-- The third argument is a list of samples. It represents the matrix of samples+-- in row-wise fashion.+live :: Int -> [String] -> [Sam] -> Source Sam+live numBeats names sams = source $ do+	(gVols, vols) <- fmap unzip $  mapM  defSlider $ replicate n "vol"+	(gs, xs) <- fmap unzip $ zipWithM (mkLiveRow numBeats) (zip names gVols) rows	+	let (sigs, refs) = unzip xs+	(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 +		rows = transpose $ splitRows n sams+		ids = fmap (sig . int) [1 .. length (head rows)]+		n = length names++mkLiveRow :: Int -> (String, Gui) -> [Sam] -> Source (Sam, SERef Sig)+mkLiveRow numBeats (name, gVol) xs = genTogWithRef (\xs -> ver $ xs ++ [gVol]) numBeats (zip (name : repeat "") xs)++mkLiveSceneRow :: Int -> Gui -> [Sig] -> [SERef Sig] -> SE (Gui, D -> SE ())+mkLiveSceneRow numBeats gMaster ids refs = do			+	(guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names+	curRef <- newGlobalSERef (0 :: Sig)+	current <- readSERef curRef+	zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids+	let mkReaders bpm = zipWithM_ (\r i -> runEvt (syncBpm (bpm / int numBeats) $ snaps r) $ \x -> do+		when1 (sig x ==* 0 &&* current ==* i) $ do+			writeSERef curRef 0			+			mapM_ (flip writeSERef 0) refs+		when1 (sig x ==* 1) $ do+			writeSERef curRef i	+			mapM_ (flip writeSERef i) refs+		) reads ids++	return (ver $ guis ++ [gMaster], mkReaders)+	where +		names = take len $ fmap show [1 ..]				+		len = length ids++splitRows :: Int -> [a] -> [[a]]+splitRows n as +	| length as < n = []+	| otherwise     = take n as : splitRows n (drop n as)++defSlider :: String -> Source Sig+defSlider tag = slider tag (linSpan 0 1) 0.5++-- | It's just like the function @live@ but we can provide the list+-- of effects for each column. The double value specifies the mix+-- between dry and wet signals.+liveEf :: Int -> [String] -> [Sam] -> (Double, FxFun) -> [(Double, FxFun)] -> Source Sam+liveEf numBeats names sams masterEff effs = source $ do+	(gVols, vols) <- fmap unzip $  mapM  defSlider $ replicate n "vol"+	(gEffs, effCtrls) <- fmap unzip $  +		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 (mkLiveRow numBeats) (zip names gCtrls) rows	+	let (sigs, refs) = unzip xs+	(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 $ +		mean $ zipWith mul vols $ zipWith (uncurry appEff) (zip (fmap snd effs) effCtrls) sigs)+	where +		rows = transpose $ splitRows n sams+		ids = fmap (sig . int) [1 .. length (head rows)]+		n = length names++		appEff f depth a = bindSam (\x -> fmap (\y -> y + (mul (1 - depth) x)) $ mul depth $ f x) a++		ctrlGui eff vol = sca 2.5 $ ver [eff, vol]++-- | It's useful to convert samples to signals an insert+-- them in the widget @mixer@.+mixSam :: String -> Bpm -> Sam -> (String, SE Sig2)+mixSam name bpm sam = (name, runSam bpm sam)++-- | Creates fx-unit from sampler widget.+--+-- > uisam name isOn bpm samWidget+uiSam :: String -> Bool -> D -> Source Sam -> Source FxFun+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) <- 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) <- x+	(gainGui, gain) <- slider "gain" (linSpan 0 1) 0.5+	return (ver [sca 0.15 gainGui, g], mul gain asig)