module Csound.Air.Sampler (
evtTrig, evtTap, evtGroup, evtCycle,
syncEvtTrig, syncEvtTap, syncEvtGroup, syncEvtCycle,
charTrig, charTap, charPush, charToggle, charGroup, charCycle,
syncCharTrig, syncCharTap, syncCharPush,syncCharToggle, syncCharGroup, syncCharCycle,
midiTrig, midiTap, midiPush, midiToggle, midiGroup,
midiTrigBy, midiTapBy, midiPushBy, midiToggleBy, midiGroupBy,
MidiTrigFun, midiAmpInstr, midiLpInstr, midiAudioLpInstr, midiConstInstr,
keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5,
keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0,
keyColumns
) where
import Data.Monoid
import Data.Boolean
import Temporal.Class
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) => Maybe a -> Tick -> Tick -> a -> a
evtTrig minitVal x st a = case minitVal of
Nothing -> ons
Just v0 -> ons + offs v0 + first v0
where
ons = evtTrigNoInit x st a
offs v = evtTrigNoInit st x v
first v = evtTrigger loadbang x v
evtTrigNoInit x st a = runSeg $ loop $ lim st $ del x $ loop (lim x $ toSeg a)
syncEvtTrig :: (Sigs a) => Sig -> Maybe a -> Tick -> Tick -> a -> a
syncEvtTrig bpm minitVal x st a = evtTrig minitVal (syncBpm bpm x) (syncBpm bpm st) a
evtToggle :: (Sigs a) => Maybe a -> Tick -> a -> a
evtToggle initVal evt = evtTrig initVal (fmap (const unit) ons) (fmap (const unit) offs)
where (offs, ons) = splitToggle $ toTog evt
syncEvtToggle :: (Sigs a) => Sig -> Maybe a -> Tick -> a -> a
syncEvtToggle bpm initVal evt = evtToggle initVal (syncBpm bpm evt)
evtTap :: (Sigs a) => D -> Tick -> a -> a
evtTap dt x a = runSeg $ del x $ loop $ lim x $ toSeg $ takeSnd dt a
syncEvtTap :: (Sigs a) => Sig -> D -> Tick -> a -> a
syncEvtTap bpm dt x = evtTap dt (syncBpm bpm x)
evtGroup :: (Sigs a) => Maybe a -> [(Tick, a)] -> Tick -> a
evtGroup initVal as stop = sum $ fmap (\(a, b, c) -> evtTrig initVal 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)
syncEvtGroup :: (Sigs a) => Sig -> Maybe a -> [(Tick, a)] -> Tick -> a
syncEvtGroup bpm initVal as stop = evtGroup initVal (fmap (\(e, a) -> (syncBpm bpm e, a)) as) (syncBpm bpm stop)
evtCycle :: (Sigs a) => Maybe a -> Tick -> Tick -> [a] -> a
evtCycle minitVal start stop sigs = case minitVal of
Nothing -> ons
Just _ -> ons + offs
where
ons = evtCycleNoInit start stop sigs
offs = evtGroup minitVal [(start, 0)] stop
evtCycleNoInit start stop sigs = runSeg $ loop $ lim stop $ del start $ loop $ mel $ fmap (lim start . toSeg) sigs
syncEvtCycle :: (Sigs a) => Sig -> Maybe a -> Tick -> Tick -> [a] -> a
syncEvtCycle bpm minitVal start stop sigs = evtCycle minitVal (syncBpm bpm start) (syncBpm bpm stop) sigs
charTrig :: (Sigs a) => Maybe a -> String -> String -> a -> a
charTrig minitVal starts stops asig = case minitVal of
Nothing -> ons
Just initVal -> ons + offs initVal + first initVal
where
ons = charTrigNoInit starts stops asig
offs initVal = charTrigNoInit stops starts initVal
first initVal = evtTrigger loadbang (strOn starts) initVal
charTrigNoInit starts stops asig = runSeg $ loop $ lim (strOn stops) $ toSeg $ retrig (const $ return asig) (strOn starts)
syncCharTrig :: (Sigs a) => Sig -> Maybe a -> String -> String -> a -> a
syncCharTrig bpm minitVal starts stops asig = case minitVal of
Nothing -> ons
Just initVal -> ons + offs initVal + first initVal
where
ons = charTrigNoInit starts stops asig
offs initVal = charTrigNoInit stops starts initVal
first initVal = syncEvtTrigger bpm loadbang (strOn starts) initVal
charTrigNoInit starts stops asig = runSeg $ loop $ lim (syncBpm bpm $ strOn stops) $ toSeg $ retrig (const $ return asig) (syncBpm bpm $ strOn starts)
charPush :: Sigs a => Maybe a -> Char -> a -> a
charPush = genCharPush evtTrigger
syncCharPush :: Sigs a => Sig -> Maybe a -> Char -> a -> a
syncCharPush bpm = genCharPush (syncEvtTrigger bpm)
genCharPush :: Sigs a => (Tick -> Tick -> a -> a) -> Maybe a -> Char -> a -> a
genCharPush trig minitVal ch asig = case minitVal of
Nothing -> ons
Just v0 -> ons + offs v0 + first v0
where
ons = trig (charOn ch) (charOff ch) asig
offs v = trig (charOff ch) (charOn ch) v
first v = trig loadbang (charOn ch) v
charToggle :: (Sigs a) => Maybe a -> Char -> a -> a
charToggle = genCharToggle id
syncCharToggle :: (Sigs a) => Sig -> Maybe a -> Char -> a -> a
syncCharToggle bpm = genCharToggle (syncBpm bpm)
genCharToggle :: (Sigs a) => (Tick -> Tick) -> Maybe a -> Char -> a -> a
genCharToggle needSync minitVal key asig = retrig (togInstr minitVal asig)
$ accumE (1 :: D) (\_ s -> (s, mod' (s + 1) 2))
$ needSync $ charOn key
where
togInstr mv0 asig isPlay = do
ref <- newRef 0
case mv0 of
Nothing -> return ()
Just v0 -> writeRef ref v0
when1 (sig isPlay ==* 1) $ do
writeRef ref asig
readRef ref
charTap :: Sigs a => D -> String -> a -> a
charTap stop starts = evtTap stop (strOn starts)
syncCharTap :: Sigs a => Sig -> D -> String -> a -> a
syncCharTap bpm stop starts = syncEvtTap bpm stop (strOn starts)
charGroup :: (Sigs a) => Maybe a -> [(Char, a)] -> String -> a
charGroup = genCharGroup evtTrigger
syncCharGroup :: (Sigs a) => Sig -> Maybe a -> [(Char, a)] -> String -> a
syncCharGroup bpm = genCharGroup (syncEvtTrigger bpm)
genCharGroup :: (Sigs a) => (Tick -> Tick -> a -> a) -> Maybe a -> [(Char, a)] -> String -> a
genCharGroup trig minitVal as stop = case minitVal of
Nothing -> charGroupNoInit as stop
Just initVal -> ons + offs initVal + first initVal
where
ons = charGroupNoInit as stop
offs initVal = charGroupNoInit (fmap (\ch -> (ch, initVal)) stop) onKeys
first initVal = trig loadbang (mconcat $ fmap charOn onKeys) initVal
onKeys = fmap fst as
charGroupNoInit as stop = sum $ fmap f as
where
allKeys = fmap fst as ++ stop
f (key, asig) = trig ons offs asig
where
ons = charOn key
offs = strOn allKeys
charCycle :: Sigs a => (Maybe a) -> Char -> String -> [a] -> a
charCycle initVal start stops sigs = evtCycle initVal (charOn start) (strOn stops) sigs
syncCharCycle :: Sigs a => Sig -> Maybe a -> Char -> String -> [a] -> a
syncCharCycle bpm initVal start stops sigs = syncEvtCycle bpm initVal (charOn start) (strOn stops) sigs
evtTrigger :: (Sigs a) => Tick -> Tick -> a -> a
evtTrigger ons offs asig = schedUntil (const $ return asig) ons offs
syncEvtTrigger :: (Sigs a) => Sig -> Tick -> Tick -> a -> a
syncEvtTrigger bpm ons offs asig = schedUntil (const $ return asig) (syncBpm bpm ons) (syncBpm bpm 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 <- newRef 0
when1 (sig isPlay ==* 1) $ do
writeRef ref =<< midiInstr asig amp
readRef 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
keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0 :: [Char]
keyColumn1 = ['1', 'q', 'a', 'z']
keyColumn2 = ['2', 'w', 's', 'x']
keyColumn3 = ['3', 'e', 'd', 'c']
keyColumn4 = ['4', 'r', 'f', 'v']
keyColumn5 = ['5', 't', 'g', 'b']
keyColumn6 = ['6', 'y', 'h', 'n']
keyColumn7 = ['7', 'u', 'j', 'm']
keyColumn8 = ['8', 'i', 'k', ',']
keyColumn9 = ['9', 'o', 'l', '.']
keyColumn0 = ['0', 'p', ';', '/']
keyColumns :: [[Char]]
keyColumns = [keyColumn1, keyColumn2, keyColumn3, keyColumn4, keyColumn5, keyColumn6, keyColumn7, keyColumn8, keyColumn9, keyColumn0]