{-# Language FlexibleContexts, ScopedTypeVariables #-}
module Csound.Typed.Control.Mix(
Mix,
sco, eff, mix, mixBy, monoSco,
sco_, mix_, mixBy_,
Sco, CsdEventList(..), CsdEvent
) where
import Data.Boolean
import Control.Applicative
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad
import Data.Traversable
import System.Mem.StableName
import Temporal.Media
import Csound.Dynamic hiding (Instr, Sco, str)
import qualified Csound.Typed.GlobalState.Elements as C
import Csound.Typed.Types
import Csound.Typed.Types.MixSco
import Csound.Typed.GlobalState hiding (notes)
import Csound.Typed.Control.Instr
import Csound.Typed.InnerOpcodes
toCsdEventList :: Sco a -> CsdEventList a
toCsdEventList = id
singleCsdEvent :: (D, D, a) -> Sco a
singleCsdEvent (start, duration, content) = del start $ str duration $ temp content
newtype Mix a = Mix { unMix :: GE M }
type Sco a = Track D a
wrapSco :: Sco a -> (CsdEventList a -> GE M) -> Sco (Mix b)
wrapSco notes getContent = singleCsdEvent (0, csdEventListDur evts, Mix $ getContent evts)
where evts = toCsdEventList notes
sco :: (Arg a, Sigs b) => (a -> SE b) -> Sco a -> Sco (Mix b)
sco instr notes = wrapSco notes $ \events -> do
events' <- traverse toNote events
instrId <- saveSourceInstrCachedWithLivenessWatch (funArity instr) (insExp instr)
return $ Snd instrId events'
sco_ :: (Arg a) => (a -> SE ()) -> Sco a -> Sco (Mix Unit)
sco_ instr notes = wrapSco notes $ \events -> do
events' <- traverse toNote events
instrId <- saveSourceInstrCached_ (unitExp $ fmap (const unit) $ instr toArg)
return $ Snd instrId events'
eff :: (Sigs a, Sigs b) => (a -> SE b) -> Sco (Mix a) -> Sco (Mix b)
eff ef sigs = wrapSco sigs $ \events -> do
notes <- traverse unMix events
instrId <- saveEffectInstr (funArity ef) (effExp ef)
return $ Eff instrId notes (arityIns $ funArity ef)
monoSco :: forall a . Sigs a => (MonoArg -> SE a) -> Sco (D, D) -> Sco (Mix a)
monoSco instr notes = wrapSco notes $ \events -> do
events' <- traverse toNote events
argId <- saveSourceInstrCached_ (unitExp $ fmap (const unit) $ instrMonoArg toArg)
instrId <- saveEffectInstr ((funArity instr) { arityIns = 3 }) (effExp effInstr)
return $ MonoSnd instrId argId events'
where
instrMonoArg :: ((D, D), Port Sig3) -> SE ()
instrMonoArg ((amp, cps), port) =
modifyPort port $ \(_, _, notnum) -> (sig amp, sig cps, notnum + 1)
effInstr :: Sigs a => (Sig, Sig, Sig) -> SE a
effInstr (amp, cps, notnum) = instr (MonoArg amp cps gate (changed [amp, cps, gate]))
where gate = ifB (notnum ==* 0) 0 1
mix :: (Sigs a) => Sco (Mix a) -> a
mix a = flip apInstr unit $ do
key <- mixKey a
durE <- toGE $ dur a
withCache (ExpDur durE) getMixKey saveMixKey key $
saveMixInstr (mixArity a) =<< toEventList a'
where a' = toCsdEventList a
mixBy :: (Arg a, Sigs b) => (a -> Sco (Mix b)) -> (a -> b)
mixBy evts args = flip apInstr args $ do
key <- mixKey evts
durE <- toGE $ dur evts'
withCache (ExpDur durE) getMixKey saveMixKey key $
saveMixInstr (mixArityFun evts) =<< (toEventList evts')
where evts' = toCsdEventList $ evts toArg
mix_ :: Sco (Mix Unit) -> SE ()
mix_ a = fromDep_ $ hideGEinDep $ do
key <- mixKey a
durE <- toGE $ dur a
withCache (ExpDur durE) getMixProcKey saveMixProcKey key $
saveMixInstr_ =<< toEventList a'
where a' = toCsdEventList a
mixBy_ :: (Arg a) => (a -> Sco (Mix Unit)) -> (a -> SE ())
mixBy_ evts args = mix_ $ evts args
mixKey :: a -> GE MixKey
mixKey = liftIO . fmap (MixKey . hashStableName) . makeStableName
toEventList :: Sco (Mix a) -> GE (CsdEventList M)
toEventList evts = fmap delayAndRescaleCsdEventListM $ traverse unMix $ evts
mixArity :: Sigs b => f (Mix b) -> Int
mixArity = tupleArity . proxy
where
proxy :: f (Mix b) -> b
proxy = const undefined
mixArityFun :: Sigs b => (a -> f (Mix b)) -> Int
mixArityFun = tupleArity . proxy
where
proxy :: (a -> f (Mix b)) -> b
proxy = const undefined