module Csound.Typed.Control.Evt(
trig, sched, schedHarp,
trigBy, schedBy, schedHarpBy,
trig_, sched_,
) where
import System.Mem.StableName
import Control.Applicative
import Control.Monad.IO.Class
import qualified Csound.Dynamic as C
import qualified Csound.Typed.GlobalState.Elements as C
import Csound.Typed.Types
import Csound.Typed.GlobalState
import Csound.Typed.Control.Instr
trig :: (Arg a, Sigs b) => (a -> SE b) -> Evt (D, D, a) -> b
trig instr evts = apInstr0 $ do
key <- evtKey evts instr
withCache InfiniteDur getEvtKey saveEvtKey key $ do
cacheName <- liftIO $ C.makeCacheName instr
instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)
saveEvtInstr (arityOuts $ funArity instr) instrId evts
trigBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt (D, D, a)) -> (c -> b)
trigBy instr evts args = flip apInstr args $ do
key <- evtKey evts instr
withCache InfiniteDur getEvtKey saveEvtKey key $ do
cacheName <- liftIO $ C.makeCacheName instr
instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)
saveEvtInstr (arityOuts $ funArity instr) instrId (evts toArg)
saveEvtInstr :: Arg a => Int -> C.InstrId -> Evt (D, D, a) -> GE C.InstrId
saveEvtInstr arity instrId evts = saveInstr evtMixInstr
where
evtMixInstr :: SE ()
evtMixInstr = do
chnId <- fromDep $ C.chnRefAlloc arity
go chnId evts
fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId
go :: Arg a => GE C.ChnRef -> Evt (D, D, a) -> SE ()
go mchnId es =
runEvt es $ \(start, dur, args) -> fromDep_ $ hideGEinDep $ do
chnId <- mchnId
e <- C.Event instrId <$> toGE start <*> toGE dur <*> (fmap (++ [C.chnRefId chnId]) $ toNote args)
return $ C.event e
sched :: (Arg a, Sigs b) => (a -> SE b) -> Evt (D, a) -> b
sched instr evts = apInstr0 $ do
key <- evtKey evts instr
withCache InfiniteDur getEvtKey saveEvtKey key $ do
cacheName <- liftIO $ C.makeCacheName instr
instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)
saveEvtInstr (arityOuts $ funArity instr) instrId (fmap phi evts)
where phi (a, b) = (0, a, b)
schedBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt (D, a)) -> (c -> b)
schedBy instr evts args = flip apInstr args $ do
key <- evtKey evts instr
withCache InfiniteDur getEvtKey saveEvtKey key $ do
cacheName <- liftIO $ C.makeCacheName instr
instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)
saveEvtInstr (arityOuts $ funArity instr) instrId (fmap phi $ evts toArg)
where phi (a, b) = (0, a, b)
schedHarp :: (Arg a, Sigs b) => D -> (a -> SE b) -> Evt a -> b
schedHarp turnOffTime instr evts = apInstr0 $ do
key <- evtKey evts instr
withCache InfiniteDur getEvtKey saveEvtKey key $ do
cacheName <- liftIO $ C.makeCacheName instr
instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)
saveEvtInstr (arityOuts $ funArity instr) instrId (fmap phi evts)
where phi a = (0, 1, a)
schedHarpBy :: (Arg a, Sigs b, Arg c) => D -> (a -> SE b) -> (c -> Evt a) -> (c -> b)
schedHarpBy turnOffTime instr evts args = flip apInstr args $ do
key <- evtKey evts instr
withCache InfiniteDur getEvtKey saveEvtKey key $ do
cacheName <- liftIO $ C.makeCacheName instr
instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)
saveEvtInstr (arityOuts $ funArity instr) instrId (fmap phi $ evts toArg)
where phi a = (0, 1, a)
autoOff :: Sigs a => D -> a -> SE a
autoOff dt sigs = fmap toTuple $ fromDep $ hideGEinDep $ phi =<< fromTuple sigs
where
phi x = do
dtE <- toGE dt
return $ C.autoOff dtE x
trig_ :: (Arg a) => (a -> SE ()) -> Evt (D, D, a) -> SE ()
trig_ instr evts = fromDep_ $ hideGEinDep $ do
key <- evtKey evts instr
withCache InfiniteDur getEvtProcKey saveEvtProcKey key $ do
cacheName <- liftIO $ C.makeCacheName instr
instrId <- saveSourceInstrCached_ cacheName (unitExp $ fmap (const unit) $ instr toArg)
return $ saveEvtInstr_ instrId evts
sched_ :: (Arg a) => (a -> SE ()) -> Evt (D, a) -> SE ()
sched_ instr evts = fromDep_ $ hideGEinDep $ do
key <- evtKey evts instr
withCache InfiniteDur getEvtProcKey saveEvtProcKey key $ do
cacheName <- liftIO $ C.makeCacheName instr
instrId <- saveSourceInstrCached_ cacheName (unitExp $ fmap (const unit) $ instr toArg)
return $ saveEvtInstr_ instrId $ fmap phi evts
where phi (a, b) = (0, a, b)
saveEvtInstr_ :: Arg a => C.InstrId -> Evt (D, D, a) -> Dep ()
saveEvtInstr_ instrId evts = unSE $ runEvt evts $ \(start, dur, args) -> fromDep_ $ hideGEinDep$
fmap C.event $ C.Event instrId <$> toGE start <*> toGE dur <*> toNote args
evtKey :: a -> b -> GE EvtKey
evtKey a b = liftIO $ EvtKey <$> hash a <*> hash b
where hash x = hashStableName <$> makeStableName x