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
freeSim :: [(String, Sam)] -> Source Sam
freeSim = genFreeSim ver
hfreeSim :: [(String, Sam)] -> Source Sam
hfreeSim = genFreeSim hor
freeSimWith :: [(String, Sam, Bool)] -> Source Sam
freeSimWith = genFreeSimInits ver
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
freeTog :: [(String, Sam)] -> Source Sam
freeTog = genFreeTog ver
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]
sim :: Int -> [(String, Sam)] -> Source Sam
sim = genSim ver
hsim :: Int -> [(String, Sam)] -> Source Sam
hsim = genSim hor
simWith :: Int -> [(String, Sam, Bool)] -> Source Sam
simWith = genSimInits ver
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]
tog :: Int -> [(String, Sam)] -> Source Sam
tog = genTog ver
htog :: Int -> [(String, Sam)] -> Source Sam
htog = genTog hor
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
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]
mixSam :: String -> Bpm -> Sam -> (String, SE Sig2)
mixSam name bpm sam = (name, runSam bpm sam)
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)
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)