module Csound.Control.Evt(
Evt(..), Bam,
boolToEvt, evtToBool, sigToEvt, stepper,
filterE, filterSE, accumSE, accumE, filterAccumE, filterAccumSE,
Snap, snapshot, snaps, sync, syncBpm,
metroE, changedE, triggerE,
cycleE, iterateE, repeatE, appendE, mappendE, partitionE, splitToggle,
oneOf, freqOf, freqAccum,
randDs, randInts, randSkip, randSkipBy,
range, listAt,
every, masked
) where
import Data.Monoid
import Data.Default
import Data.Boolean
import Data.Tuple
import Csound.Typed
import Csound.Typed.Opcode
metroE :: Sig -> Evt Unit
metroE = sigToEvt . metro
changedE :: [Sig] -> Evt Unit
changedE = sigToEvt . changed
triggerE :: Sig -> Sig -> Sig -> Evt Unit
triggerE a1 a2 a3 = sigToEvt $ trigger a1 a2 a3
syncBpm :: (Default a, Tuple a) => D -> Evt a -> Evt a
syncBpm dt = sync (dt / 60)
partitionE :: (a -> BoolD) -> Evt a -> (Evt a, Evt a)
partitionE p evts = (a, b)
where
a = filterE p evts
b = filterE (notB . p) evts
splitToggle :: Evt D -> (Evt D, Evt D)
splitToggle = swap . partitionE (==* 0)
cycleE :: (Tuple a, Arg a) => [a] -> Evt b -> Evt a
cycleE vals evts = listAt vals $ range (0, int $ length vals) evts
listAt :: (Tuple a, Arg a) => [a] -> Evt D -> Evt a
listAt vals evt
| null vals = mempty
| otherwise = fmap (atArg vals) $ filterE within evt
where
within x = (x >=* 0) &&* (x <* len)
len = int $ length vals
atArg :: (Tuple a, Arg a) => [a] -> D -> a
atArg as ind = guardedArg (zip (fmap (\x -> int x ==* ind) [0 .. ]) as) (head as)
range :: (D, D) -> Evt b -> Evt D
range (xMin, xMax) = iterateE xMin $ \x -> ifB ((x + 1) >=* xMax) xMin (x + 1)
randInts :: (D, D) -> Evt b -> Evt D
randInts (xMin, xMax) = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ getRnd
where getRnd = fmap (int' . readSnap) $ random (sig $ int' xMin) (sig $ int' xMax)
randDs :: Evt b -> Evt D
randDs = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ fmap readSnap $ random (0::D) 1
randSkip :: D -> Evt a -> Evt a
randSkip d = filterSE (const $ fmap (<=* d) $ random (0::D) 1)
randSkipBy :: (a -> D) -> Evt a -> Evt a
randSkipBy d = filterSE (\x -> fmap (<=* d x) $ random (0::D) 1)
iterateE :: (Tuple a) => a -> (a -> a) -> Evt b -> Evt a
iterateE s0 f = accumE s0 (const phi)
where phi s = (s, f s)
repeatE :: Tuple a => a -> Evt b -> Evt a
repeatE a = fmap (const a)
appendE :: Tuple a => a -> (a -> a -> a) -> Evt a -> Evt a
appendE empty append = accumE empty phi
where phi a s = let s1 = s `append` a in (s1, s1)
mappendE :: (Monoid a, Tuple a) => Evt a -> Evt a
mappendE = appendE mempty mappend
oneOf :: (Tuple a, Arg a) => [a] -> Evt b -> Evt a
oneOf vals evt = listAt vals $ randInts (0, int $ length vals) evt
type Rnds a = [(D, a)]
freqOf :: (Tuple a, Arg a) => Rnds a -> Evt b -> Evt a
freqOf rnds evt = fmap (takeByWeight accs vals) $ randDs evt
where
accs = accumWeightList $ fmap fst rnds
vals = fmap snd rnds
takeByWeight :: (Tuple a, Arg a) => [D] -> [a] -> D -> a
takeByWeight accumWeights vals at =
guardedArg (zipWith (\w val -> (at <* w, val)) accumWeights vals) (last vals)
accumWeightList :: Num a => [a] -> [a]
accumWeightList = go 0
where go !s xs = case xs of
[] -> []
a:as -> a + s : go (a + s) as
freqAccum :: (Tuple s, Tuple (b, s), Arg (b, s))
=> s -> (a -> s -> Rnds (b, s)) -> Evt a -> Evt b
freqAccum s0 f = accumSE s0 $ \a s ->
let rnds = f a s
accs = accumWeightList $ fmap fst rnds
vals = fmap snd rnds
in fmap (takeByWeight accs vals . readSnap) $ random (0 :: D) 1
every :: (Tuple a, Arg a) => Int -> [Int] -> Evt a -> Evt a
every empties beats = masked mask
where mask = (fmap (\x -> if x then 1 else 0) $ (replicate empties False) ++ patternToMask beats)
masked :: (Tuple a, Arg a) => [D] -> Evt a -> Evt a
masked ms = filterAccumE 0 $ \a s ->
let n = int $ length ms
s1 = ifB (s + 1 <* n) (s + 1) 0
in (atArg ms s ==* 1, a, s1)
patternToMask :: [Int] -> [Bool]
patternToMask xs = case xs of
[] -> []
a:as -> single a ++ patternToMask as
where single n
| n <= 0 = []
| otherwise = True : replicate (n 1) False