{-# Language ScopedTypeVariables #-}
module Csound.Typed.Control.Api(
trigByName, trigByName_,
trigByNameMidi, trigByNameMidi_,
namedMonoMsg
) where
import Data.Boolean
import Control.Monad.Trans.Class
import Control.Applicative
import qualified Csound.Dynamic as D
import Csound.Dynamic(Rate(..), opcs, depT_)
import Data.Boolean((==*), (>*), ifB)
import Csound.Typed.Types
import Csound.Typed.Control.Ref
import Csound.Typed.GlobalState
import Csound.Typed.GlobalState.Opcodes(eventi, Event(..), turnoff, port, downsamp)
import Csound.Typed.InnerOpcodes
import Csound.Typed.Plugins.TabQueue
trigByName_ :: Arg a => String -> (a -> SE ()) -> SE ()
trigByName_ name instr = geToSe $ saveNamedInstr name =<< (execSE $ instr toArg)
trigByName :: (Arg a, Sigs b) => String -> (a -> SE b) -> SE b
trigByName name instr = do
ref <- newClearableGlobalRef 0
trigByName_ name (go ref)
readRef ref
where go ref x = mixRef ref =<< instr x
trigByNameMidi_ :: forall a . Arg a => String -> ((D, D, a) -> SE ()) -> SE ()
trigByNameMidi_ name instr = do
instrId <- geToSe $ saveInstr (instr toArg)
trigByName_ name (go instrId)
where
go :: D.InstrId -> (D, D, D, a) -> SE ()
go instrId (noteFlag, pch, vol, other) = fromDep_ $ hideGEinDep $ do
pchExpr <- toGE pch
let instrIdExpr = D.instrIdE instrId + pchExpr / 1000
noteFlagExpr <- toGE noteFlag
args <- fromTuple (pch, vol, other)
return $ do
D.when1 D.Ir (noteFlagExpr ==* 1) $ do
eventi (Event instrIdExpr 0 (-1) args)
D.when1 D.Ir (noteFlagExpr ==* 0) $ do
eventi (Event (negate instrIdExpr) 0 0 args)
turnoff
trigByNameMidi :: (Arg a, Sigs b) => String -> ((D, D, a) -> SE b) -> SE b
trigByNameMidi name instr = do
ref <- newClearableGlobalRef 0
trigByNameMidi_ name (go ref)
readRef ref
where go ref x = mixRef ref =<< instr x
namedMonoMsg ::String -> SE MonoArg
namedMonoMsg name = do
refPch <- newGlobalRef 0
refVol <- newGlobalRef 0
tab <- newGlobalTab 24
let onFlag = tabQueue2_hasElements tab
trigByNameMidiCbk name (onNote tab) (offNote tab)
when1 onFlag $ do
let (pch, vol) = tabQueue2_readLastElement tab
writeRef refPch pch
writeRef refVol vol
when1 (notB onFlag) $ do
writeRef refVol 0
pchKey <- readRef refPch
volKey <- readRef refVol
let kgate = ifB onFlag 1 0
kamp = downsamp' volKey
kcps = downsamp' pchKey
trig = changed [kamp, kcps]
return $ MonoArg kamp kcps kgate trig
where
onNote = tabQueue2_append
offNote tab (pch, vol) = tabQueue2_delete tab pch
trigByNameMidiCbk :: String -> ((D, D) -> SE ()) -> ((D, D) -> SE ()) -> SE ()
trigByNameMidiCbk name noteOn noteOff =
trigByName_ name go
where
go :: (D, D, D) -> SE ()
go (noteFlag, pch, vol) = do
whenD1 (noteFlag ==* 1) $ noteOn (pch, vol)
whenD1 (noteFlag ==* 0) $ noteOff (pch, vol)
SE turnoff
port' :: Sig -> D -> Sig
port' a b = fromGE $ do
a' <- toGE a
b' <- toGE b
return $ port a' b'
downsamp' :: Sig -> Sig
downsamp' a = fromGE $ do
a' <- toGE a
return $ downsamp a'
tabw :: Sig -> Sig -> Tab -> SE ()
tabw b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unTab b3
where f a1 a2 a3 = opcs "tabw" [(Xr,[Kr,Kr,Ir,Ir])] [a1,a2,a3]
tab :: Sig -> Tab -> Sig
tab b1 b2 = Sig $ f <$> unSig b1 <*> unTab b2
where f a1 a2 = opcs "tab" [(Kr,[Kr,Ir,Ir]),(Ar,[Xr,Ir,Ir])] [a1,a2]