module Csound.Air.Sampler (
evtTrig, evtTap, evtGroup, evtCycle,
charTrig, charTap, charPush, charToggle, charGroup, charCycle,
midiTrig, midiTap, midiPush, midiToggle, midiGroup,
midiTrigBy, midiTapBy, midiPushBy, midiToggleBy, midiGroupBy,
MidiTrigFun, midiAmpInstr, midiLpInstr, midiAudioLpInstr, midiConstInstr
) where
import Data.Monoid
import Data.Boolean
import Csound.Typed
import Csound.Control
import Csound.SigSpace
import Csound.Air.Filter(mlp)
import Csound.Air.Wav(takeSnd)
import Csound.Air.Seg
evtTrig :: (Sigs a) => Tick -> Tick -> a -> a
evtTrig x st a = runSeg $ sloop $ slim st $ sdel x $ sloop (slim x $ toSeg a)
evtToggle :: (Sigs a) => Tick -> a -> a
evtToggle evt = evtTrig (fmap (const unit) ons) (fmap (const unit) offs)
where (offs, ons) = splitToggle $ toTog evt
evtTap :: (Sigs a) => D -> Tick -> a -> a
evtTap dt x a = runSeg $ sdel x $ sloop $ slim x $ toSeg $ takeSnd dt a
evtGroup :: (Sigs a) => [(Tick, a)] -> Tick -> a
evtGroup as stop = sum $ fmap (\(a, b, c) -> evtTrig a (mappend b stop) c)
$ zipWith (\n (a, sam) -> (a, mconcat $ fmap snd $ filter ((/= n) . fst) allEvts, sam)) [(0 :: Int)..] as
where
allEvts :: [(Int, Tick)]
allEvts = zip [0 ..] (fmap fst as)
evtCycle :: (Sigs a) => Tick -> Tick -> [a] -> a
evtCycle start stop sigs = runSeg $ sloop $ slim stop $ sdel start $ sloop $ sflow $ fmap (slim start . toSeg) sigs
charTrig :: (Sigs a) => String -> String -> a -> a
charTrig starts stops asig = runSeg $ sloop $ slim (strOn stops) $ toSeg $ retrig (const $ return asig) (strOn starts)
charPush :: Sigs a => Char -> a -> a
charPush ch = evtTrigger (charOn ch) (charOff ch)
charToggle :: (Sigs a) => Char -> a -> a
charToggle key asig = retrig (togInstr asig)
$ accumE (1 :: D) (\_ s -> (s, mod' (s + 1) 2))
$ charOn key
where
togInstr asig isPlay = do
ref <- newSERef 0
when1 (sig isPlay ==* 1) $ do
writeSERef ref asig
readSERef ref
charTap :: Sigs a => D -> String -> a -> a
charTap stop starts = evtTap stop (strOn starts)
charGroup :: (Sigs a) => [(Char, a)] -> String -> a
charGroup as stop = sum $ fmap f as
where
allKeys = fmap fst as ++ stop
f (key, asig) = evtTrigger ons offs asig
where
ons = charOn key
offs = strOn allKeys
charCycle :: Sigs a => Char -> String -> [a] -> a
charCycle start stop = evtCycle (charOn start) (strOn stop)
evtTrigger :: (Sigs a) => Tick -> Tick -> a -> a
evtTrigger ons offs asig = schedUntil (const $ return asig) ons offs
type MidiTrigFun a = a -> D -> SE a
midiAmpInstr :: (SigSpace a, Sigs a) => a -> D -> SE a
midiAmpInstr asig amp = return $ mul (sig amp) asig
midiLpInstr :: (SigSpace a, Sigs a) => (Sig, Sig) -> Sig -> a -> D -> SE a
midiLpInstr (minC, maxC) q asig amp = return $ mapSig (mlp (minC * ((maxC / minC) ** sig amp) ) q) asig
midiAudioLpInstr :: (SigSpace a, Sigs a) => Sig -> a -> D -> SE a
midiAudioLpInstr = midiLpInstr (50, 10000)
midiConstInstr :: (SigSpace a, Sigs a) => a -> D -> SE a
midiConstInstr asig amp = return asig
midiTrig :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiTrig = midiTrigBy midiAmpInstr
midiTap :: (SigSpace a, Sigs a) => MidiChn -> D -> Int -> a -> SE a
midiTap = midiTapBy midiAmpInstr
midiPush :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiPush = midiPushBy midiAmpInstr
midiToggle :: (SigSpace a, Sigs a) => MidiChn -> Int -> a -> SE a
midiToggle = midiToggleBy midiAmpInstr
midiGroup :: (SigSpace a, Sigs a) => MidiChn -> [(Int, a)] -> SE a
midiGroup = midiGroupBy midiAmpInstr
midiTrigBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiTrigBy midiInstr midiChn key asig = fmap (\evt -> retrig (midiInstr asig) evt) (midiKeyOn midiChn $ int key)
midiTapBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> D -> Int -> a -> SE a
midiTapBy midiInstr midiChn dt key asig = midiTrigBy midiInstr midiChn key (takeSnd dt asig)
midiPushBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiPushBy midiInstr midiChn key asig = do
ons <- midiKeyOn midiChn (int key)
offs <- midiKeyOff midiChn (int key)
return $ midiEvtTriggerBy midiInstr ons offs asig
midiToggleBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> Int -> a -> SE a
midiToggleBy midiInstr midiChn key asig = fmap (\evt -> retrig (togMidiInstr asig) evt)
(fmap (accumE (1 :: D) (\a s -> ((a, s), mod' (s + 1) 2))) $ midiKeyOn midiChn $ int key)
where
togMidiInstr asig (amp, isPlay) = do
ref <- newSERef 0
when1 (sig isPlay ==* 1) $ do
writeSERef ref =<< midiInstr asig amp
readSERef ref
midiGroupBy :: (SigSpace a, Sigs a) => MidiTrigFun a -> MidiChn -> [(Int, a)] -> SE a
midiGroupBy midiInstr midiChn as = fmap sum $ mapM f as
where
allKeys = fmap fst as
f (key, asig) = do
ons <- midiKeyOn midiChn (int key)
offs <- fmap (fmap (const unit) . mconcat) $ mapM (midiKeyOn midiChn . int) allKeys
return $ midiEvtTriggerBy midiInstr ons offs asig
midiEvtTriggerBy :: (SigSpace a, Sigs a) => (a -> D -> SE a) -> Evt D -> Tick -> a -> a
midiEvtTriggerBy midiInstr ons offs asig = schedUntil (midiAmpInstr asig) ons offs