module Csound.Sam.Trig (
samCharTrig, samCharTap, samCharPush, samCharToggle, samCharGroup, samCharCycle,
samSyncCharTrig, samSyncCharPush, samSyncCharToggle, samSyncCharTap, samSyncCharGroup, samSyncCharCycle,
samMidiTrig, samMidiTap, samMidiPush, samMidiToggle, samMidiGroup,
samMidiTrigBy, samMidiTapBy, samMidiPushBy, samMidiToggleBy, samMidiGroupBy,
) where
import Data.Foldable(Foldable(foldMap))
import Data.Traversable hiding (mapM)
import Control.Arrow(first, second)
import Csound.Base
import qualified Csound.Sam.Core as S
import Csound.Sam.Core(Sam, bindSam, mapBpm, mapBpm2)
samCharTrig :: Maybe Sam -> String -> String -> Sam -> Sam
samCharTrig initVal starts stops x = case initVal of
Nothing -> fmap (charTrig Nothing starts stops) x
Just v0 -> liftA2 (\v sigs -> charTrig (Just v) starts stops sigs) v0 x
samCharPush :: Maybe Sam -> Char -> Sam -> Sam
samCharPush initVal ch x = case initVal of
Nothing -> fmap (charPush Nothing ch) x
Just v0 -> liftA2 (\v sigs -> charPush (Just v) ch sigs) v0 x
samCharToggle :: Maybe Sam -> Char -> Sam -> Sam
samCharToggle initVal ch x = case initVal of
Nothing -> fmap (charToggle Nothing ch) x
Just v0 -> liftA2 (\v sigs -> charToggle (Just v) ch sigs) v0 x
samCharTap :: Sig -> String -> Sam -> Sam
samCharTap stop starts = fmap (charTap stop starts)
samCharGroup :: Maybe Sam -> [(Char, Sam)] -> String -> Sam
samCharGroup initVal as stop = case initVal of
Nothing -> fmap (\xs -> charGroup Nothing (zip starts xs) stop) (sequenceA sams)
Just v0 -> liftA2 (\v xs -> charGroup (Just v) (zip starts xs) stop) v0 (sequenceA sams)
where (starts, sams) = unzip as
samCharCycle :: Maybe Sam -> Char -> String -> [Sam] -> Sam
samCharCycle initVal start stop as = case initVal of
Nothing -> fmap (charCycle Nothing start stop) (sequenceA as)
Just v0 -> liftA2 (\v xs -> charCycle (Just v) start stop xs) v0 (sequenceA as)
syncBeats :: Sig -> Sig -> Sig
syncBeats bpm beats = bpm / beats
samSyncCharTrig :: Sig -> Maybe Sam -> String -> String -> Sam -> Sam
samSyncCharTrig beats initVal starts stops x = case initVal of
Nothing -> mapBpm (\bpm a -> syncCharTrig (syncBeats bpm beats) Nothing starts stops a) x
Just v0 -> mapBpm2 (\bpm v sigs -> syncCharTrig (syncBeats bpm beats) (Just v) starts stops sigs) v0 x
samSyncCharPush :: Sig -> Maybe Sam -> Char -> Sam -> Sam
samSyncCharPush beats initVal ch x = case initVal of
Nothing -> mapBpm (\bpm a -> syncCharPush (syncBeats bpm beats) Nothing ch a) x
Just v0 -> mapBpm2 (\bpm v sigs -> syncCharPush (syncBeats bpm beats) (Just v) ch sigs) v0 x
samSyncCharToggle :: Sig -> Maybe Sam -> Char -> Sam -> Sam
samSyncCharToggle beats initVal ch x = case initVal of
Nothing -> mapBpm (\bpm a -> syncCharToggle (syncBeats bpm beats) Nothing ch a) x
Just v0 -> mapBpm2 (\bpm v sigs -> syncCharToggle (syncBeats bpm beats) (Just v) ch sigs) v0 x
samSyncCharTap :: Sig -> Sig -> String -> Sam -> Sam
samSyncCharTap beats stop starts = mapBpm (\bpm x -> syncCharTap (syncBeats bpm beats) stop starts x)
samSyncCharGroup :: Sig -> Maybe Sam -> [(Char, Sam)] -> String -> Sam
samSyncCharGroup beats initVal as stop = case initVal of
Nothing -> mapBpm (\bpm xs -> syncCharGroup (syncBeats bpm beats) Nothing (zip starts xs) stop) (sequenceA sams)
Just v0 -> mapBpm2 (\bpm v xs -> syncCharGroup (syncBeats bpm beats) (Just v) (zip starts xs) stop) v0 (sequenceA sams)
where (starts, sams) = unzip as
samSyncCharCycle :: Sig -> Maybe Sam -> Char -> String -> [Sam] -> Sam
samSyncCharCycle beats initVal start stop as = case initVal of
Nothing -> mapBpm (\bpm -> syncCharCycle (syncBeats bpm beats) Nothing start stop) (sequenceA as)
Just v0 -> mapBpm2 (\bpm v xs -> syncCharCycle (syncBeats bpm beats) (Just v) start stop xs) v0 (sequenceA as)
samMidiTrig :: MidiChn -> Int -> Sam -> Sam
samMidiTrig = samMidiTrigBy midiAmpInstr
samMidiTap :: MidiChn -> Sig -> Int -> Sam -> Sam
samMidiTap = samMidiTapBy midiAmpInstr
samMidiPush :: MidiChn -> Int -> Sam -> Sam
samMidiPush = samMidiPushBy midiAmpInstr
samMidiToggle :: MidiChn -> Int -> Sam -> Sam
samMidiToggle = samMidiToggleBy midiAmpInstr
samMidiGroup :: MidiChn -> [(Int, Sam)] -> Sam
samMidiGroup midiChn as = S.liftSam $ fmap (\xs -> midiGroup midiChn $ zip keys xs) $ sequenceA sams
where (keys, sams) = unzip as
samMidiTrigBy :: MidiTrigFun Sig2 -> MidiChn -> Int -> Sam -> Sam
samMidiTrigBy midiFun midiChn key = bindSam (midiTrigBy midiFun midiChn key)
samMidiTapBy :: MidiTrigFun Sig2 -> MidiChn -> Sig -> Int -> Sam -> Sam
samMidiTapBy midiFun midiChn dt key = bindSam (midiTapBy midiFun midiChn dt key)
samMidiPushBy :: MidiTrigFun Sig2 -> MidiChn -> Int -> Sam -> Sam
samMidiPushBy midiFun midiChn key = bindSam (midiPushBy midiFun midiChn key)
samMidiToggleBy :: MidiTrigFun Sig2 -> MidiChn -> Int -> Sam -> Sam
samMidiToggleBy midiFun midiChn key = bindSam (midiToggleBy midiFun midiChn key)
samMidiGroupBy :: MidiTrigFun Sig2 -> MidiChn -> [(Int, Sam)] -> Sam
samMidiGroupBy midiFun midiChn as = S.liftSam $ fmap (\xs -> midiGroupBy midiFun midiChn $ zip keys xs) $ sequenceA sams
where (keys, sams) = unzip as