{-# 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 -- | Creates an instrument that can be triggered by name with Csound API. -- The arguments are determined from the structure of the input for the instrument. -- -- With Csound API we can send messages -- -- > i "name" time duration arg1 arg2 arg3 trigByName_ :: Arg a => String -> (a -> SE ()) -> SE () trigByName_ name instr = geToSe $ saveNamedInstr name =<< (execSE $ instr toArg) -- | Creates an instrument that can be triggered by name with Csound API. -- The arguments are determined from the structure of the input for the instrument. -- If we have a tuple of arguments: @(D, D, Tab)@ -- The would be rendered to instrument arguments that strts from @p4@. -- @p1@ is the name of teh instrument, @p2@ is the start time of the note, -- @p3@ is the duration of the note. Then @p4@ and @p5@ are going to be doubles and @p6@ -- is an integer that denotes a functional table. 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 -- | It behaves just like the function @trigByNameMidi@. Only it doesn't produce an audio -- signal. It performs some procedure on note on and stops doing the precedure on note off. 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 -- | Creates an instrument that can be triggered by name with Csound API. -- -- It's intended to be used like a midi instrument. It simulates a simplified midi protocol. -- We can trigger notes: -- -- > i "givenName" delay duration 1 pitchKey volumeKey auxParams -- note on -- > i "givenName" delay duration 0 pitchKey volumeKey auxParams -- note off -- -- The arguments are -- -- > trigByNameMidi name instrument -- -- The instrument takes a triplet of @(pitchKey, volumeKey, auxilliaryTuple)@. -- The order does matter. Please don't pass the @volumeKey@ as the first argument. -- The instrument expects the pitch key to be a first argument. -- Under the hood -- it creates held notes that are indexed by pitch. If you know the Csound it creates -- the notes with indexes: -- -- > i 18.pitchKey -- -- Here the 18 is some generated integer index. And then on receiving a note a note off message for the specific key the -- Csound procedure invokes: -- -- > turnoff 18.pitchKey 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' -- | -- Fast table opcodes. -- -- Fast table opcodes. Faster than -- table and -- tablew because don't -- allow wrap-around and limit and don't check index validity. Have -- been implemented in order to provide fast access to -- arrays. Support non-power of two tables (can be generated by any -- GEN function by giving a negative length value). -- -- > tabw ksig, kndx, ifn [,ixmode] -- > tabw asig, andx, ifn [,ixmode] -- -- csound doc: 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] -- | -- Fast table opcodes. -- -- Fast table opcodes. Faster than -- table and -- tablew because don't -- allow wrap-around and limit and don't check index validity. Have -- been implemented in order to provide fast access to -- arrays. Support non-power of two tables (can be generated by any -- GEN function by giving a negative length value). -- -- > kr tab kndx, ifn[, ixmode] -- > ar tab xndx, ifn[, ixmode] -- -- csound doc: 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]