summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAntonKholomiov <>2017-07-18 20:43:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-07-18 20:43:00 (GMT)
commit697d009d9585654d3254c21a5da21b867708840d (patch)
tree5f26ee4e558e6b02eb87ad57943f3f887ca4ee91
parent2de53f2076ce30fcdd0cdc5ed9260054902e015e (diff)
version 0.0.8.10.0.8.1
-rw-r--r--csound-sampler.cabal8
-rw-r--r--src/Csound/Sam/Ui.hs108
2 files changed, 58 insertions, 58 deletions
diff --git a/csound-sampler.cabal b/csound-sampler.cabal
index f424479..c351ffb 100644
--- a/csound-sampler.cabal
+++ b/csound-sampler.cabal
@@ -1,5 +1,5 @@
name: csound-sampler
-version: 0.0.8.0
+version: 0.0.8.1
license: BSD3
license-file: LICENSE
author: Anton Kholomiov
@@ -12,7 +12,7 @@ cabal-version: >=1.8
synopsis: A musical sampler based on Csound
description: A simple sampler based on the library csound-expression. We can define loops
and patterns of samples. An intricate pattern of sound is just few strokes away.
- The library works in the interpreter. We can listen the results right in the ghci.
+ The library works in the interpreter. We can listen the results right in the ghci.
Here is the tutorial <https://github.com/anton-k/csound-sampler>
Homepage: https://github.com/anton-k/csound-sampler
@@ -25,8 +25,8 @@ Source-repository head
library
Ghc-Options: -Wall
Hs-Source-Dirs: src/
- build-depends: base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.2.0
- exposed-modules:
+ build-depends: base >= 4, base < 5, transformers >= 0.3, csound-expression >= 5.2.2
+ exposed-modules:
Csound.Sam
Csound.Sam.Core
Csound.Sam.Ui
diff --git a/src/Csound/Sam/Ui.hs b/src/Csound/Sam/Ui.hs
index d771460..b62dd93 100644
--- a/src/Csound/Sam/Ui.hs
+++ b/src/Csound/Sam/Ui.hs
@@ -2,10 +2,10 @@
-- | Graphical widgets for playing samples
module Csound.Sam.Ui(
freeSim, hfreeSim, freeSimWith, hfreeSimWith,
- freeTog, hfreeTog,
+ freeTog, hfreeTog,
sim, hsim, simWith, hsimWith,
tog, htog,
- live, liveEf,
+ live, liveEf,
mixSam, uiSam, addGain
) where
@@ -17,8 +17,8 @@ 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
+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.
@@ -30,8 +30,8 @@ freeSim = genFreeSim ver
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
+-- | 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
@@ -46,13 +46,13 @@ 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
+ (guis, ts) <- fmap unzip $ zipWithM (\a b -> unSource $ toggle a b) names initVals
let res = groupToggles mean sams ts
return (gcat guis, res)
- where
+ where
(names, sams, initVals) = unzip3 as
--- | The widget to toggle between several samples (aka `tog`gle).
+-- | 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
@@ -63,7 +63,7 @@ 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
+ (guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . flip setToggleSig False) names
curRef <- newGlobalRef (0 :: Sig)
current <- readRef curRef
zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids
@@ -71,12 +71,12 @@ genFreeTog gcat as = source $ do
when1 (sig x ==* 0 &&* current ==* i) $ do
writeRef curRef 0
when1 (sig x ==* 1) $ do
- writeRef curRef i
+ writeRef curRef i
) reads ids
let res = groupToggles sum sams $ fmap (snaps . (\i -> ifB (current ==* i) 1 0)) ids
return (gcat guis, res)
- where
+ where
(names, sams) = unzip as
ids = fmap (sig . int) [1 .. length as]
@@ -86,7 +86,7 @@ genSim gcat numBeats as = genSimInits gcat numBeats $ fmap (\(a, b) -> (a, b, Fa
genSimInits :: ([Gui] -> Gui) -> Int -> [(String, Sam, Bool)] -> Source Sam
genSimInits gcat numBeats as = source $ do
- (guis, writes, reads) <- fmap unzip3 $ zipWithM setToggleSig names initVals
+ (guis, writes, reads) <- fmap unzip3 $ zipWithM (\a b -> unSinkSource $ setToggleSig a b) names initVals
curRefs <- mapM (const $ newGlobalRef (0 :: Sig)) ids
currents <- mapM readRef curRefs
zipWithM_ (\w val -> w val) writes currents
@@ -95,28 +95,28 @@ genSimInits gcat numBeats as = source $ do
) reads curRefs
let res = bindBpm (\bpm x -> mkReaders bpm >> return x) $ groupToggles mean sams $ fmap snaps currents
return (gcat guis, res)
- where
+ 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.
+-- 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@).
+-- 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@.
+-- 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
+-- | 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
@@ -128,59 +128,59 @@ 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
+genTog gcat numBeats as = Source $ fmap (\(g, x) -> (g, fst x)) $ unSource $ 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 (flip setToggleSig False) names
+ (guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . 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
when1 (sig x ==* 0 &&* current ==* i) $ do
- writeRef curRef 0
+ writeRef curRef 0
when1 (sig x ==* 1) $ do
- writeRef curRef i
+ writeRef 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
+ where
(names, sams) = unzip as
ids = fmap (sig . int) [1 .. length as]
--- | A widget to toggle playing of several samples. The switch
+-- | 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@.
+-- 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
+-- | 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 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
+ (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
let (sigs, refs) = unzip xs
- (gMaster, masterVol) <- defSlider "master"
+ (gMaster, masterVol) <- unSource $ 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
+ where
rows = transpose $ splitRows n sams
ids = fmap (sig . int) [1 .. length (head rows)]
n = length names
@@ -189,27 +189,27 @@ 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 numBeats gMaster ids refs = do
- (guis, writes, reads) <- fmap unzip3 $ mapM (flip setToggleSig False) names
+mkLiveSceneRow numBeats gMaster ids refs = do
+ (guis, writes, reads) <- fmap unzip3 $ mapM (unSinkSource . 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
when1 (sig x ==* 0 &&* current ==* i) $ do
- writeRef curRef 0
+ writeRef curRef 0
mapM_ (flip writeRef 0) refs
when1 (sig x ==* 1) $ do
- writeRef curRef i
+ writeRef curRef i
mapM_ (flip writeRef i) refs
) reads ids
return (ver $ guis ++ [gMaster], mkReaders)
- where
- names = take len $ fmap show [1 ..]
+ where
+ names = take len $ fmap show [1 ..]
len = length ids
splitRows :: Int -> [a] -> [[a]]
-splitRows n as
+splitRows n as
| length as < n = []
| otherwise = take n as : splitRows n (drop n as)
@@ -221,19 +221,19 @@ defSlider tag = slider tag (linSpan 0 1) 0.5
-- 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 defSlider $ replicate n "vol"
- (gEffs, effCtrls) <- fmap unzip $
- mapM (\(tag, initVal) -> slider tag (linSpan 0 1) initVal) $ zip (replicate n "eff") (fmap fst effs)
+ (gVols, vols) <- fmap unzip $ mapM (unSource . 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)
let gCtrls = zipWith ctrlGui gEffs gVols
- (gs, xs) <- fmap unzip $ zipWithM (mkLiveRow numBeats) (zip names gCtrls) rows
+ (gs, xs) <- fmap unzip $ zipWithM (\a b -> unSource $ mkLiveRow numBeats a b) (zip names gCtrls) rows
let (sigs, refs) = unzip xs
- (gMaster, masterVol) <- defSlider "master"
- (gMasterEff, masterEffCtrl) <- slider "eff" (linSpan 0 1) (fst masterEff)
+ (gMaster, masterVol) <- unSource $ defSlider "master"
+ (gMasterEff, masterEffCtrl) <- unSource $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 $
+ 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
+ where
rows = transpose $ splitRows n sams
ids = fmap (sig . int) [1 .. length (head rows)]
n = length names
@@ -252,16 +252,16 @@ mixSam name bpm sam = (name, runSam bpm sam)
-- > uisam name isOn bpm samWidget
uiSam :: String -> Bool -> D -> Source Sam -> Source Fx2
uiSam name onOff bpm sam = uiSig name onOff (joinSource $ mapSource (runSam bpm) sam)
- where
+ where
joinSource :: Source (SE Sig2) -> Source Sig2
joinSource a = source $ do
- (g, mres) <- a
+ (g, mres) <- unSource a
res <- mres
return (g, res)
--- | Adds gain slider on top of the widget.
+-- | 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
+ (g, asig) <- unSource x
+ (gainGui, gain) <- unSource $ slider "gain" (linSpan 0 1) 0.5
return (ver [sca 0.15 gainGui, g], mul gain asig)