{-# Language FlexibleContexts #-}
module Csound.Typed.Control.Evt(
    sched, sched_, schedBy, schedHarp, schedHarpBy,
    monoSched, monoSchedUntil, monoSchedHarp,
    retrigs, evtLoop, evtLoopOnce
) where

import Data.Boolean

import Control.Applicative
import Control.Monad

import qualified Temporal.Media as T(render, Event(..))

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.GlobalState.Opcodes(primInstrId)
import Csound.Typed.Control.Instr
import Csound.Typed.Control.Mix(Sco)
import qualified Csound.Typed.GlobalState.InstrApi as I
import qualified Csound.Typed.GlobalState.Port as I

import Csound.Typed.Control.Ref
import Csound.Typed.Constants(infiniteDur)
import Csound.Typed.InnerOpcodes

renderEvts :: Evt (Sco a) -> Evt [(Sig, Sig, a)]
renderEvts :: forall a. Evt (Sco a) -> Evt [(Sig, Sig, a)]
renderEvts = (Sco a -> [(Sig, Sig, a)]) -> Evt (Sco a) -> Evt [(Sig, Sig, a)]
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Event Sig a -> (Sig, Sig, a)) -> [Event Sig a] -> [(Sig, Sig, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event Sig a -> (Sig, Sig, a)
forall {t} {c}. Event t c -> (t, t, c)
unEvt ([Event Sig a] -> [(Sig, Sig, a)])
-> (Sco a -> [Event Sig a]) -> Sco a -> [(Sig, Sig, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sco a -> [Event Sig a]
forall t a. Num t => Track t a -> [Event t a]
T.render)
    where unEvt :: Event t c -> (t, t, c)
unEvt Event t c
e = (Event t c -> t
forall t a. Event t a -> t
T.eventStart Event t c
e, Event t c -> t
forall t a. Event t a -> t
T.eventDur Event t c
e, Event t c -> c
forall t a. Event t a -> a
T.eventContent Event t c
e)

sched :: (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched :: forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched a -> SE b
instr Evt (Sco a)
evts = GE InstrId -> b
forall b. Sigs b => GE InstrId -> b
apInstr0 (GE InstrId -> b) -> GE InstrId -> b
forall a b. (a -> b) -> a -> b
$ do
    InstrId
instrId <- Arity -> InsExp -> GE InstrId
saveSourceInstrCachedWithLivenessWatch ((a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) ((a -> SE b) -> InsExp
forall a b. (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp a -> SE b
instr)
    Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
forall a.
Arg a =>
Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
saveEvtInstr (Arity -> Int
arityOuts (Arity -> Int) -> Arity -> Int
forall a b. (a -> b) -> a -> b
$ (a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) InstrId
instrId (Evt (Sco a) -> Evt [(Sig, Sig, a)]
forall a. Evt (Sco a) -> Evt [(Sig, Sig, a)]
renderEvts Evt (Sco a)
evts)

-- | Triggers a procedure on the event stream.
sched_ :: (Arg a) => (a -> SE ()) -> Evt (Sco a) -> SE ()
sched_ :: forall a. Arg a => (a -> SE ()) -> Evt (Sco a) -> SE ()
sched_ a -> SE ()
instr Evt (Sco a)
evts = Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ do
    InstrId
instrId <- SE () -> GE InstrId
saveSourceInstrCached_ (SE Unit -> SE ()
unitExp (SE Unit -> SE ()) -> SE Unit -> SE ()
forall a b. (a -> b) -> a -> b
$ (() -> Unit) -> SE () -> SE Unit
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit -> () -> Unit
forall a b. a -> b -> a
const Unit
unit) (SE () -> SE Unit) -> SE () -> SE Unit
forall a b. (a -> b) -> a -> b
$ a -> SE ()
instr a
forall a. Arg a => a
toArg)
    Dep () -> GE (Dep ())
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dep () -> GE (Dep ())) -> Dep () -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ InstrId -> Evt [(Sig, Sig, a)] -> Dep ()
forall a. Arg a => InstrId -> Evt [(Sig, Sig, a)] -> Dep ()
saveEvtInstr_ InstrId
instrId (Evt (Sco a) -> Evt [(Sig, Sig, a)]
forall a. Evt (Sco a) -> Evt [(Sig, Sig, a)]
renderEvts Evt (Sco a)
evts)

-- | A closure to trigger an instrument inside the body of another instrument.
schedBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt (Sco a)) -> (c -> b)
schedBy :: forall a b c.
(Arg a, Sigs b, Arg c) =>
(a -> SE b) -> (c -> Evt (Sco a)) -> c -> b
schedBy a -> SE b
instr c -> Evt (Sco a)
evts c
args = (GE InstrId -> c -> b) -> c -> GE InstrId -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip GE InstrId -> c -> b
forall a b. (Arg a, Sigs b) => GE InstrId -> a -> b
apInstr c
args (GE InstrId -> b) -> GE InstrId -> b
forall a b. (a -> b) -> a -> b
$ do
    InstrId
instrId <- Arity -> InsExp -> GE InstrId
saveSourceInstrCachedWithLivenessWatch ((a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) ((a -> SE b) -> InsExp
forall a b. (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp a -> SE b
instr)
    Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
forall a.
Arg a =>
Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
saveEvtInstr (Arity -> Int
arityOuts (Arity -> Int) -> Arity -> Int
forall a b. (a -> b) -> a -> b
$ (a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) InstrId
instrId (Evt (Sco a) -> Evt [(Sig, Sig, a)]
forall a. Evt (Sco a) -> Evt [(Sig, Sig, a)]
renderEvts (Evt (Sco a) -> Evt [(Sig, Sig, a)])
-> Evt (Sco a) -> Evt [(Sig, Sig, a)]
forall a b. (a -> b) -> a -> b
$ c -> Evt (Sco a)
evts c
forall a. Arg a => a
toArg)

-------------------------------------------------
-- triggereing the events

saveEvtInstr :: Arg a => Int -> C.InstrId -> Evt [(Sig, Sig, a)] -> GE C.InstrId
saveEvtInstr :: forall a.
Arg a =>
Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
saveEvtInstr Int
arity InstrId
instrId Evt [(Sig, Sig, a)]
evts = SE () -> GE InstrId
saveInstr (SE () -> GE InstrId) -> SE () -> GE InstrId
forall a b. (a -> b) -> a -> b
$ do
    Ref D
aliveCountRef <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
10 :: D)
    Ref D -> SE ()
evtMixInstr Ref D
aliveCountRef
    where
        evtMixInstr :: Ref D -> SE ()
        evtMixInstr :: Ref D -> SE ()
evtMixInstr Ref D
aliveCountRef = do
            GE ChnRef
chnId <- Dep ChnRef -> SE (GE ChnRef)
forall a. Dep a -> SE (GE a)
fromDep (Dep ChnRef -> SE (GE ChnRef)) -> Dep ChnRef -> SE (GE ChnRef)
forall a b. (a -> b) -> a -> b
$ Int -> Dep ChnRef
forall (m :: * -> *). Monad m => Int -> DepT m ChnRef
C.chnRefAlloc Int
arity
            Ref D -> GE ChnRef -> Evt [(Sig, Sig, a)] -> SE ()
forall a.
Arg a =>
Ref D -> GE ChnRef -> Evt [(Sig, Sig, a)] -> SE ()
go Ref D
aliveCountRef GE ChnRef
chnId Evt [(Sig, Sig, a)]
evts
            Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> Dep ()) -> GE ChnRef -> GE (Dep ())
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ChnRef
chn -> Int -> [E] -> Dep ()
forall (m :: * -> *). Monad m => Int -> [E] -> DepT m ()
C.sendOut Int
arity ([E] -> Dep ()) -> DepT GE [E] -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChnRef -> DepT GE [E]
forall (m :: * -> *). Monad m => ChnRef -> DepT m [E]
C.readChn ChnRef
chn) GE ChnRef
chnId
            D
aliveCount <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
aliveCountRef
            Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> E -> Dep ()) -> GE ChnRef -> GE E -> GE (Dep ())
forall a b c. (a -> b -> c) -> GE a -> GE b -> GE c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ChnRef -> E -> Dep ()
forall (m :: * -> *). Monad m => ChnRef -> E -> DepT m ()
masterUpdateChnAlive GE ChnRef
chnId (GE E -> GE (Dep ())) -> GE E -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ D -> GE E
forall a. Val a => a -> GE E
toGE D
aliveCount

        go :: Arg a => Ref D -> GE C.ChnRef -> Evt [(Sig, Sig, a)] -> SE ()
        go :: forall a.
Arg a =>
Ref D -> GE ChnRef -> Evt [(Sig, Sig, a)] -> SE ()
go Ref D
aliveCountRef GE ChnRef
mchnId Evt [(Sig, Sig, a)]
events =
            Evt [(Sig, Sig, a)] -> Bam [(Sig, Sig, a)] -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt [(Sig, Sig, a)]
events (Bam [(Sig, Sig, a)] -> SE ()) -> Bam [(Sig, Sig, a)] -> SE ()
forall a b. (a -> b) -> a -> b
$ \[(Sig, Sig, a)]
es -> do
                Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
aliveCountRef (D -> SE ()) -> D -> SE ()
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [(Sig, Sig, a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Sig, Sig, a)]
es
                ChnRef
chnId <- GE ChnRef -> SE ChnRef
forall a. GE a -> SE a
geToSe GE ChnRef
mchnId
                Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ ((Sig, Sig, a) -> Dep ()) -> [(Sig, Sig, a)] -> Dep ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ChnRef -> (Sig, Sig, a) -> Dep ()
forall a. Arg a => ChnRef -> (Sig, Sig, a) -> Dep ()
event ChnRef
chnId) [(Sig, Sig, a)]
es

        event :: Arg a => C.ChnRef -> (Sig, Sig, a) -> Dep ()
        event :: forall a. Arg a => ChnRef -> (Sig, Sig, a) -> Dep ()
event ChnRef
chnId (Sig
start, Sig
dur, a
args) = GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (Event -> Dep ()) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
C.event (GE Event -> GE (Dep ())) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$
            E -> E -> E -> [E] -> Event
C.Event (InstrId -> E
primInstrId InstrId
instrId) (E -> E -> [E] -> Event) -> GE E -> GE (E -> [E] -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
start GE (E -> [E] -> Event) -> GE E -> GE ([E] -> Event)
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
dur GE ([E] -> Event) -> GE [E] -> GE Event
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([E] -> [E]) -> GE [E] -> GE [E]
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [ChnRef -> E
C.chnRefId ChnRef
chnId]) (GE [E] -> GE [E]) -> GE [E] -> GE [E]
forall a b. (a -> b) -> a -> b
$ a -> GE [E]
forall a. Arg a => a -> GE [E]
toNote a
args)

-- | Retriggers an instrument every time an event happens. The note
-- is held until the next event happens.
retrigs :: (Arg a, Sigs b) => (a -> SE b) -> Evt [a] -> b
retrigs :: forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt [a] -> b
retrigs a -> SE b
instr Evt [a]
evts = GE InstrId -> b
forall b. Sigs b => GE InstrId -> b
apInstr0 (GE InstrId -> b) -> GE InstrId -> b
forall a b. (a -> b) -> a -> b
$ do
    InstrId
instrId <- Arity -> InsExp -> GE InstrId
saveSourceInstrCachedWithLivenessWatchAndRetrig ((a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) ((a -> SE b) -> InsExp
forall a b. (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp a -> SE b
instr)
    Int -> InstrId -> Evt [a] -> GE InstrId
forall a. Arg a => Int -> InstrId -> Evt [a] -> GE InstrId
saveRetrigEvtInstr (Arity -> Int
arityOuts (Arity -> Int) -> Arity -> Int
forall a b. (a -> b) -> a -> b
$ (a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) InstrId
instrId Evt [a]
evts

saveRetrigEvtInstr :: Arg a => Int -> C.InstrId -> Evt [a] -> GE C.InstrId
saveRetrigEvtInstr :: forall a. Arg a => Int -> InstrId -> Evt [a] -> GE InstrId
saveRetrigEvtInstr Int
arity InstrId
instrId Evt [a]
evts = SE () -> GE InstrId
saveInstr (SE () -> GE InstrId) -> SE () -> GE InstrId
forall a b. (a -> b) -> a -> b
$ do
    Ref D
aliveCountRef  <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
10 :: D)
    Ref D
retrigWatchRef <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
0  :: D)
    Ref D -> Ref D -> SE ()
evtMixInstr Ref D
aliveCountRef Ref D
retrigWatchRef
    where
        evtMixInstr :: Ref D -> Ref D -> SE ()
        evtMixInstr :: Ref D -> Ref D -> SE ()
evtMixInstr Ref D
aliveCountRef Ref D
retrigWatchRef = do
            GE ChnRef
chnId <- Dep ChnRef -> SE (GE ChnRef)
forall a. Dep a -> SE (GE a)
fromDep (Dep ChnRef -> SE (GE ChnRef)) -> Dep ChnRef -> SE (GE ChnRef)
forall a b. (a -> b) -> a -> b
$ Int -> Dep ChnRef
forall (m :: * -> *). Monad m => Int -> DepT m ChnRef
C.chnRefAlloc Int
arity
            Ref D -> Ref D -> GE ChnRef -> Evt [a] -> SE ()
forall a. Arg a => Ref D -> Ref D -> GE ChnRef -> Evt [a] -> SE ()
go Ref D
aliveCountRef Ref D
retrigWatchRef GE ChnRef
chnId Evt [a]
evts
            Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> Dep ()) -> GE ChnRef -> GE (Dep ())
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ChnRef
chn -> Int -> [E] -> Dep ()
forall (m :: * -> *). Monad m => Int -> [E] -> DepT m ()
C.sendOut Int
arity ([E] -> Dep ()) -> DepT GE [E] -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChnRef -> DepT GE [E]
forall (m :: * -> *). Monad m => ChnRef -> DepT m [E]
C.readChn ChnRef
chn) GE ChnRef
chnId
            D
aliveCount <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
aliveCountRef
            Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> E -> Dep ()) -> GE ChnRef -> GE E -> GE (Dep ())
forall a b c. (a -> b -> c) -> GE a -> GE b -> GE c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ChnRef -> E -> Dep ()
forall (m :: * -> *). Monad m => ChnRef -> E -> DepT m ()
masterUpdateChnAlive GE ChnRef
chnId (GE E -> GE (Dep ())) -> GE E -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ D -> GE E
forall a. Val a => a -> GE E
toGE D
aliveCount

        go :: Arg a => Ref D -> Ref D -> GE C.ChnRef -> Evt [a] -> SE ()
        go :: forall a. Arg a => Ref D -> Ref D -> GE ChnRef -> Evt [a] -> SE ()
go Ref D
aliveCountRef Ref D
retrigWatchRef GE ChnRef
mchnId Evt [a]
events =
            Evt [a] -> Bam [a] -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt [a]
events (Bam [a] -> SE ()) -> Bam [a] -> SE ()
forall a b. (a -> b) -> a -> b
$ \[a]
es -> do
                Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
aliveCountRef (D -> SE ()) -> D -> SE ()
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
es
                Ref D -> (D -> D) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref D
retrigWatchRef (D -> D -> D
forall a. Num a => a -> a -> a
+ D
1)
                ChnRef
chnId <- GE ChnRef -> SE ChnRef
forall a. GE a -> SE a
geToSe GE ChnRef
mchnId
                D
currentRetrig <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
retrigWatchRef
                Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> E -> Dep ()) -> GE ChnRef -> GE E -> GE (Dep ())
forall a b c. (a -> b -> c) -> GE a -> GE b -> GE c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ChnRef -> E -> Dep ()
forall (m :: * -> *). Monad m => ChnRef -> E -> DepT m ()
masterUpdateChnRetrig GE ChnRef
mchnId (GE E -> GE (Dep ())) -> GE E -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ D -> GE E
forall a. Val a => a -> GE E
toGE D
currentRetrig
                Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ (a -> Dep ()) -> [a] -> Dep ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ChnRef -> D -> a -> Dep ()
forall a. Arg a => ChnRef -> D -> a -> Dep ()
event ChnRef
chnId D
currentRetrig) [a]
es

        event :: Arg a => C.ChnRef -> D -> a -> Dep ()
        event :: forall a. Arg a => ChnRef -> D -> a -> Dep ()
event ChnRef
chnId D
currentRetrig a
args = GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (Event -> Dep ()) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
C.event (GE Event -> GE (Dep ())) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ do
            E
currentRetrigExp <- D -> GE E
forall a. Val a => a -> GE E
toGE D
currentRetrig
            E -> E -> E -> [E] -> Event
C.Event (InstrId -> E
primInstrId InstrId
instrId) E
0 E
forall a. Num a => a
infiniteDur ([E] -> Event) -> GE [E] -> GE Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([E] -> [E]) -> GE [E] -> GE [E]
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [ChnRef -> E
C.chnRefId ChnRef
chnId, E
currentRetrigExp]) (GE [E] -> GE [E]) -> GE [E] -> GE [E]
forall a b. (a -> b) -> a -> b
$ a -> GE [E]
forall a. Arg a => a -> GE [E]
toNote a
args)

evtLoop :: (Num a, Tuple a, Sigs a) => Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
evtLoop :: forall a.
(Num a, Tuple a, Sigs a) =>
Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
evtLoop = Bool -> Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Bool -> Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
evtLoopGen Bool
True

evtLoopOnce :: (Num a, Tuple a, Sigs a) => Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
evtLoopOnce :: forall a.
(Num a, Tuple a, Sigs a) =>
Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
evtLoopOnce = Bool -> Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Bool -> Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
evtLoopGen Bool
False

evtLoopGen :: (Num a, Tuple a, Sigs a) => Bool -> Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
evtLoopGen :: forall a.
(Num a, Tuple a, Sigs a) =>
Bool -> Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a
evtLoopGen Bool
mustLoop Maybe (Evt Unit)
maybeOffEvt [SE a]
instruments [Evt Unit]
evts = GE InstrId -> a
forall b. Sigs b => GE InstrId -> b
apInstr0 (GE InstrId -> a) -> GE InstrId -> a
forall a b. (a -> b) -> a -> b
$ do
    (InstrId
instrId, InstrId
evtInstrId) <- Arity -> InsExp -> SE () -> GE (InstrId, InstrId)
saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop (SE a -> Arity
forall a. Tuple a => SE a -> Arity
constArity SE a
instr) ((Unit -> SE a) -> InsExp
forall a b. (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp ((Unit -> SE a) -> InsExp) -> (Unit -> SE a) -> InsExp
forall a b. (a -> b) -> a -> b
$ SE a -> Unit -> SE a
forall a. a -> Unit -> a
toInstrExp SE a
instr) ([Evt Unit] -> SE ()
toSingleEvt [Evt Unit]
evts)
    Bool
-> D -> Maybe (Evt Unit) -> Int -> InstrId -> InstrId -> GE InstrId
saveEvtLoopInstr Bool
mustLoop D
loopLength Maybe (Evt Unit)
maybeOffEvt (Arity -> Int
arityOuts (Arity -> Int) -> Arity -> Int
forall a b. (a -> b) -> a -> b
$ SE a -> Arity
forall a. Tuple a => SE a -> Arity
constArity SE a
instr) InstrId
instrId InstrId
evtInstrId
    where
        loopLength :: D
loopLength = Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
lcm ([SE a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SE a]
instruments) ([Evt Unit] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Evt Unit]
evts)
        instr :: SE a
instr = [SE a] -> SE a
forall a. (Num a, Tuple a) => [SE a] -> SE a
toSingleInstr [SE a]
instruments

        toInstrExp :: a -> (Unit -> a)
        toInstrExp :: forall a. a -> Unit -> a
toInstrExp = a -> Unit -> a
forall a b. a -> b -> a
const

        toSingleInstr :: (Num a, Tuple a) => [SE a] -> SE a
        toSingleInstr :: forall a. (Num a, Tuple a) => [SE a] -> SE a
toSingleInstr [SE a]
as = do
            let n :: Sig
n = Sig -> Sig -> Sig
forall a. SigOrD a => a -> a -> a
mod' (E -> Sig
forall a. Val a => E -> a
fromE (E -> Sig) -> E -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> E
getRetrigVal Int
4) (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [SE a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SE a]
as)
            Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
0
            (Sig -> SE a -> SE ()) -> [Sig] -> [SE a] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Ref a -> Sig -> Sig -> SE a -> SE ()
forall a. Tuple a => Ref a -> Sig -> Sig -> SE a -> SE ()
f Ref a
ref Sig
n) ((Int -> Sig) -> [Int] -> [Sig]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0 .. ]) [SE a]
as
            Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref
            where
                f :: Tuple a => Ref a -> Sig -> Sig -> SE a -> SE ()
                f :: forall a. Tuple a => Ref a -> Sig -> Sig -> SE a -> SE ()
f Ref a
ref Sig
n Sig
ix SE a
a = BoolSig -> SE () -> SE ()
when1 (Sig
n Sig -> Sig -> BoolSig
forall bool. (bool ~ BooleanOf Sig) => Sig -> Sig -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
ix) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref (a -> SE ()) -> SE a -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE a
a

        toSingleEvt :: [Evt Unit] -> SE ()
        toSingleEvt :: [Evt Unit] -> SE ()
toSingleEvt [Evt Unit]
es = do
            let n :: Sig
n = Sig -> Sig -> Sig
forall a. SigOrD a => a -> a -> a
mod' (E -> Sig
forall a. Val a => E -> a
fromE (E -> Sig) -> E -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> E
getRetrigVal Int
4) (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ [Evt Unit] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Evt Unit]
es)
            (Sig -> Evt Unit -> SE ()) -> [Sig] -> [Evt Unit] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Sig -> Sig -> Evt Unit -> SE ()
f Sig
n) ((Int -> Sig) -> [Int] -> [Sig]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0 .. ]) [Evt Unit]
es
            where
                f :: Sig -> Sig -> Evt Unit -> SE ()
                f :: Sig -> Sig -> Evt Unit -> SE ()
f Sig
n Sig
ix Evt Unit
evt = BoolSig -> SE () -> SE ()
when1 (Sig
n Sig -> Sig -> BoolSig
forall bool. (bool ~ BooleanOf Sig) => Sig -> Sig -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
ix) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Evt Unit -> SE ()
evtLoopInstr Evt Unit
evt

evtLoopInstr :: Evt Unit -> SE ()
evtLoopInstr :: Evt Unit -> SE ()
evtLoopInstr Evt Unit
evts = do
    Evt Unit -> Bam Unit -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt Unit
evts (Bam Unit -> SE ()) -> Bam Unit -> SE ()
forall a b. (a -> b) -> a -> b
$ SE () -> Bam Unit
forall a b. a -> b -> a
const (SE () -> Bam Unit) -> SE () -> Bam Unit
forall a b. (a -> b) -> a -> b
$ Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ Int -> Dep ()
forall (m :: * -> *). Monad m => Int -> DepT m ()
servantUpdateChnEvtLoop (Int -> Int
C.chnPargId (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
0)

saveEvtLoopInstr :: Bool -> D -> Maybe (Evt Unit) -> Int -> C.InstrId -> C.InstrId -> GE C.InstrId
saveEvtLoopInstr :: Bool
-> D -> Maybe (Evt Unit) -> Int -> InstrId -> InstrId -> GE InstrId
saveEvtLoopInstr Bool
mustLoop D
loopLength Maybe (Evt Unit)
maybeOffEvt Int
arity InstrId
instrId InstrId
evtInstrId = SE () -> GE InstrId
saveInstr (SE () -> GE InstrId) -> SE () -> GE InstrId
forall a b. (a -> b) -> a -> b
$ do
    Ref D
aliveCountRef  <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
10 :: D)
    Ref D
retrigWatchRef <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
0  :: D)
    Ref D -> Ref D -> SE ()
evtMixInstr Ref D
aliveCountRef Ref D
retrigWatchRef
    where
        evtMixInstr :: Ref D -> Ref D -> SE ()
        evtMixInstr :: Ref D -> Ref D -> SE ()
evtMixInstr Ref D
aliveCountRef Ref D
retrigWatchRef = do
            GE ChnRef
chnId <- Dep ChnRef -> SE (GE ChnRef)
forall a. Dep a -> SE (GE a)
fromDep (Dep ChnRef -> SE (GE ChnRef)) -> Dep ChnRef -> SE (GE ChnRef)
forall a b. (a -> b) -> a -> b
$ Int -> Dep ChnRef
forall (m :: * -> *). Monad m => Int -> DepT m ChnRef
C.chnRefAlloc Int
arity
            GE ChnRef -> SE ()
initStartInstrs GE ChnRef
chnId
            Sig
isOn <- (D -> Sig) -> SE D -> SE Sig
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap D -> Sig
sig (SE D -> SE Sig) -> SE D -> SE Sig
forall a b. (a -> b) -> a -> b
$ case Maybe (Evt Unit)
maybeOffEvt of
                Maybe (Evt Unit)
Nothing     -> D -> SE D
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return D
1
                Just Evt Unit
offEvt -> do
                    Ref D
isOn <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
1 :: D)
                    Evt Unit -> Bam Unit -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt Unit
offEvt (Bam Unit -> SE ()) -> Bam Unit -> SE ()
forall a b. (a -> b) -> a -> b
$ SE () -> Bam Unit
forall a b. a -> b -> a
const (SE () -> Bam Unit) -> SE () -> Bam Unit
forall a b. (a -> b) -> a -> b
$ do
                        Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
isOn D
0
                        Ref D -> (D -> D) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref D
retrigWatchRef (D -> D -> D
forall a. Num a => a -> a -> a
+ D
1)
                        D
currentRetrig <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
retrigWatchRef
                        Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> E -> Dep ()) -> GE ChnRef -> GE E -> GE (Dep ())
forall a b c. (a -> b -> c) -> GE a -> GE b -> GE c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ChnRef -> E -> Dep ()
forall (m :: * -> *). Monad m => ChnRef -> E -> DepT m ()
masterUpdateChnRetrig GE ChnRef
chnId (GE E -> GE (Dep ())) -> GE E -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ D -> GE E
forall a. Val a => a -> GE E
toGE D
currentRetrig
                    Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
isOn

            Evt Unit
masterEvt <- (Sig -> Evt Unit) -> SE Sig -> SE (Evt Unit)
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Evt Unit
sigToEvt (Sig -> Evt Unit) -> (Sig -> Sig) -> Sig -> Evt Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
isOn) (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GE E -> Sig
forall a. Val a => GE E -> a
fromGE (GE E -> Sig) -> (Sig -> GE E) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (E -> E) -> GE E -> GE E
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> E
C.changed (GE E -> GE E) -> (Sig -> GE E) -> Sig -> GE E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> GE E
forall a. Val a => a -> GE E
toGE) (SE Sig -> SE (Evt Unit)) -> SE Sig -> SE (Evt Unit)
forall a b. (a -> b) -> a -> b
$ GE ChnRef -> SE Sig
readServantEvt GE ChnRef
chnId
            Ref D -> Ref D -> GE ChnRef -> Evt Unit -> SE ()
go Ref D
aliveCountRef Ref D
retrigWatchRef GE ChnRef
chnId Evt Unit
masterEvt
            Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> Dep ()) -> GE ChnRef -> GE (Dep ())
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ChnRef
chn -> Int -> [E] -> Dep ()
forall (m :: * -> *). Monad m => Int -> [E] -> DepT m ()
C.sendOut Int
arity ([E] -> Dep ()) -> DepT GE [E] -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChnRef -> DepT GE [E]
forall (m :: * -> *). Monad m => ChnRef -> DepT m [E]
C.readChn ChnRef
chn) GE ChnRef
chnId
            D
aliveCount <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
aliveCountRef
            Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> E -> Dep ()) -> GE ChnRef -> GE E -> GE (Dep ())
forall a b c. (a -> b -> c) -> GE a -> GE b -> GE c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ChnRef -> E -> Dep ()
forall (m :: * -> *). Monad m => ChnRef -> E -> DepT m ()
masterUpdateChnAlive GE ChnRef
chnId (GE E -> GE (Dep ())) -> GE E -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ D -> GE E
forall a. Val a => a -> GE E
toGE D
aliveCount

        go :: Ref D -> Ref D -> GE ChnRef -> Evt Unit -> SE ()
go = (D -> D) -> Ref D -> Ref D -> GE ChnRef -> Evt Unit -> SE ()
goBy (D -> D -> D
forall a. Num a => a -> a -> a
+ D
1)

        goBy :: (D -> D) -> Ref D -> Ref D -> GE C.ChnRef -> Evt Unit -> SE ()
        goBy :: (D -> D) -> Ref D -> Ref D -> GE ChnRef -> Evt Unit -> SE ()
goBy D -> D
updateRetrig Ref D
_aliveCountRef Ref D
retrigWatchRef GE ChnRef
mchnId Evt Unit
events =
            Evt Unit -> Bam Unit -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt Unit
events (Bam Unit -> SE ()) -> Bam Unit -> SE ()
forall a b. (a -> b) -> a -> b
$ \Unit
_es -> do
                Ref D -> (D -> D) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref D
retrigWatchRef D -> D
updateRetrig
                ChnRef
chnId <- GE ChnRef -> SE ChnRef
forall a. GE a -> SE a
geToSe GE ChnRef
mchnId
                D
currentRetrig <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
retrigWatchRef
                if Bool -> Bool
not Bool
mustLoop
                    then do
                        BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
currentRetrig Sig -> Sig -> BoolSig
forall bool. (bool ~ BooleanOf Sig) => Sig -> Sig -> bool
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
>=* (D -> Sig
sig D
loopLength)) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
                            Dep () -> SE ()
fromDep_ Dep ()
forall (m :: * -> *). Monad m => DepT m ()
turnoff
                    else () -> SE ()
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (ChnRef -> E -> Dep ()) -> GE ChnRef -> GE E -> GE (Dep ())
forall a b c. (a -> b -> c) -> GE a -> GE b -> GE c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ChnRef -> E -> Dep ()
forall (m :: * -> *). Monad m => ChnRef -> E -> DepT m ()
masterUpdateChnRetrig GE ChnRef
mchnId (GE E -> GE (Dep ())) -> GE E -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ D -> GE E
forall a. Val a => a -> GE E
toGE D
currentRetrig
                ChnRef -> D -> SE ()
audioEvent ChnRef
chnId D
currentRetrig
                ChnRef -> D -> SE ()
evtEvent ChnRef
chnId D
currentRetrig



        fireEventFor :: (C.ChnRef -> E -> C.Event) -> C.ChnRef -> D -> SE ()
        fireEventFor :: (ChnRef -> E -> Event) -> ChnRef -> D -> SE ()
fireEventFor ChnRef -> E -> Event
f ChnRef
chnId D
currentRetrig = Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (Event -> Dep ()) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
C.event (GE Event -> GE (Dep ())) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ do
            E
currentRetrigExp <- D -> GE E
forall a. Val a => a -> GE E
toGE D
currentRetrig
            Event -> GE Event
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> GE Event) -> Event -> GE Event
forall a b. (a -> b) -> a -> b
$ ChnRef -> E -> Event
f ChnRef
chnId E
currentRetrigExp

        audioEvent :: ChnRef -> D -> SE ()
audioEvent = (ChnRef -> E -> Event) -> ChnRef -> D -> SE ()
fireEventFor ChnRef -> E -> Event
eventForAudioInstr
        evtEvent :: ChnRef -> D -> SE ()
evtEvent   = (ChnRef -> E -> Event) -> ChnRef -> D -> SE ()
fireEventFor ChnRef -> E -> Event
eventForEvtInstr

        -- startEvtInstr chnId currentRetrig = C.event $ eventForEvtInstr chnId currentRetrig

        initStartInstrs :: GE ChnRef -> SE ()
initStartInstrs GE ChnRef
mchnId = Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ do
            ChnRef
chnId <- GE ChnRef
mchnId
            Dep () -> GE (Dep ())
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dep () -> GE (Dep ())) -> Dep () -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ ChnRef -> Dep ()
forall {m :: * -> *}. Monad m => ChnRef -> DepT m ()
initStartEvtInstr   ChnRef
chnId Dep () -> Dep () -> Dep ()
forall a b. DepT GE a -> DepT GE b -> DepT GE b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ChnRef -> Dep ()
forall {m :: * -> *}. Monad m => ChnRef -> DepT m ()
initStartAudioInstr ChnRef
chnId

        initStartEvtInstr :: ChnRef -> DepT m ()
initStartEvtInstr   ChnRef
chnId = Event -> DepT m ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
C.event_i (Event -> DepT m ()) -> Event -> DepT m ()
forall a b. (a -> b) -> a -> b
$ ChnRef -> E -> Event
eventForEvtInstr ChnRef
chnId E
0
        initStartAudioInstr :: ChnRef -> DepT m ()
initStartAudioInstr ChnRef
chnId = Event -> DepT m ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
C.event_i (Event -> DepT m ()) -> Event -> DepT m ()
forall a b. (a -> b) -> a -> b
$ ChnRef -> E -> Event
eventForAudioInstr ChnRef
chnId E
0

        eventForEvtInstr :: ChnRef -> E -> Event
eventForEvtInstr   = InstrId -> ChnRef -> E -> Event
eventFor InstrId
evtInstrId
        eventForAudioInstr :: ChnRef -> E -> Event
eventForAudioInstr = InstrId -> ChnRef -> E -> Event
eventFor InstrId
instrId

        eventFor :: InstrId -> ChnRef -> E -> Event
eventFor InstrId
idx ChnRef
chnId E
currentRetrig =
            E -> E -> E -> [E] -> Event
C.Event (InstrId -> E
primInstrId InstrId
idx) E
0 E
forall a. Num a => a
infiniteDur [ChnRef -> E
C.chnRefId ChnRef
chnId, E
currentRetrig]

        readServantEvt :: GE C.ChnRef -> SE Sig
        readServantEvt :: GE ChnRef -> SE Sig
readServantEvt GE ChnRef
chnId = Dep Sig -> SE Sig
forall a. Dep a -> SE a
SE (Dep Sig -> SE Sig) -> Dep Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ (E -> Sig) -> DepT GE E -> Dep Sig
forall a b. (a -> b) -> DepT GE a -> DepT GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> Sig
forall a. Val a => E -> a
fromE (DepT GE E -> Dep Sig) -> DepT GE E -> Dep Sig
forall a b. (a -> b) -> a -> b
$ GE (DepT GE E) -> DepT GE E
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (DepT GE E) -> DepT GE E) -> GE (DepT GE E) -> DepT GE E
forall a b. (a -> b) -> a -> b
$ (ChnRef -> DepT GE E) -> GE ChnRef -> GE (DepT GE E)
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChnRef -> DepT GE E
forall (m :: * -> *). Monad m => ChnRef -> DepT m E
readChnEvtLoop GE ChnRef
chnId


-- | An instrument is triggered with event stream and delay time is set to zero
-- (event fires immediately) and duration is set to inifinite time. The note is
-- held while the instrument is producing something. If the instrument is silent
-- for some seconds (specified in the first argument) then it's turned off.
schedHarp :: (Arg a, Sigs b) => D -> (a -> SE b) -> Evt [a] -> b
schedHarp :: forall a b. (Arg a, Sigs b) => D -> (a -> SE b) -> Evt [a] -> b
schedHarp D
turnOffTime a -> SE b
instr Evt [a]
evts = GE InstrId -> b
forall b. Sigs b => GE InstrId -> b
apInstr0 (GE InstrId -> b) -> GE InstrId -> b
forall a b. (a -> b) -> a -> b
$ do
    InstrId
instrId <- Arity -> InsExp -> GE InstrId
saveSourceInstrCachedWithLivenessWatch ((a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) ((a -> SE b) -> InsExp
forall a b. (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp ((a -> SE b) -> InsExp) -> (a -> SE b) -> InsExp
forall a b. (a -> b) -> a -> b
$ (D -> b -> SE b
forall a. Sigs a => D -> a -> SE a
autoOff D
turnOffTime (b -> SE b) -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ) (SE b -> SE b) -> (a -> SE b) -> a -> SE b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SE b
instr)
    Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
forall a.
Arg a =>
Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
saveEvtInstr (Arity -> Int
arityOuts (Arity -> Int) -> Arity -> Int
forall a b. (a -> b) -> a -> b
$ (a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) InstrId
instrId (([a] -> [(Sig, Sig, a)]) -> Evt [a] -> Evt [(Sig, Sig, a)]
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> (Sig, Sig, a)) -> [a] -> [(Sig, Sig, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> (Sig, Sig, a)
forall {a} {b} {c}. (Num a, Num b) => c -> (a, b, c)
phi) Evt [a]
evts)
    where phi :: c -> (a, b, c)
phi c
a = (a
0, b
forall a. Num a => a
infiniteDur, c
a)

-- | A closure to trigger an instrument inside the body of another instrument.
schedHarpBy :: (Arg a, Sigs b, Arg c) => D -> (a -> SE b) -> (c -> Evt [a]) -> (c -> b)
schedHarpBy :: forall a b c.
(Arg a, Sigs b, Arg c) =>
D -> (a -> SE b) -> (c -> Evt [a]) -> c -> b
schedHarpBy D
turnOffTime a -> SE b
instr c -> Evt [a]
evts c
args = (GE InstrId -> c -> b) -> c -> GE InstrId -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip GE InstrId -> c -> b
forall a b. (Arg a, Sigs b) => GE InstrId -> a -> b
apInstr c
args (GE InstrId -> b) -> GE InstrId -> b
forall a b. (a -> b) -> a -> b
$ do
    InstrId
instrId <- Arity -> InsExp -> GE InstrId
saveSourceInstrCachedWithLivenessWatch ((a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) ((a -> SE b) -> InsExp
forall a b. (Arg a, Tuple b) => (a -> SE b) -> InsExp
insExp ((a -> SE b) -> InsExp) -> (a -> SE b) -> InsExp
forall a b. (a -> b) -> a -> b
$ (D -> b -> SE b
forall a. Sigs a => D -> a -> SE a
autoOff D
turnOffTime (b -> SE b) -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ) (SE b -> SE b) -> (a -> SE b) -> a -> SE b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SE b
instr)
    Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
forall a.
Arg a =>
Int -> InstrId -> Evt [(Sig, Sig, a)] -> GE InstrId
saveEvtInstr (Arity -> Int
arityOuts (Arity -> Int) -> Arity -> Int
forall a b. (a -> b) -> a -> b
$ (a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
instr) InstrId
instrId (([a] -> [(Sig, Sig, a)]) -> Evt [a] -> Evt [(Sig, Sig, a)]
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> (Sig, Sig, a)) -> [a] -> [(Sig, Sig, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> (Sig, Sig, a)
forall {a} {b} {c}. (Num a, Num b) => c -> (a, b, c)
phi) (Evt [a] -> Evt [(Sig, Sig, a)]) -> Evt [a] -> Evt [(Sig, Sig, a)]
forall a b. (a -> b) -> a -> b
$ c -> Evt [a]
evts c
forall a. Arg a => a
toArg)
    where phi :: c -> (a, b, c)
phi c
a = (a
0, b
forall a. Num a => a
infiniteDur, c
a)

autoOff :: Sigs a => D -> a -> SE a
autoOff :: forall a. Sigs a => D -> a -> SE a
autoOff D
dt a
sigs = (GE [E] -> a) -> SE (GE [E]) -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GE [E] -> a
forall a. Tuple a => GE [E] -> a
toTuple (SE (GE [E]) -> SE a) -> SE (GE [E]) -> SE a
forall a b. (a -> b) -> a -> b
$ DepT GE [E] -> SE (GE [E])
forall a. Dep a -> SE (GE a)
fromDep (DepT GE [E] -> SE (GE [E])) -> DepT GE [E] -> SE (GE [E])
forall a b. (a -> b) -> a -> b
$ GE (DepT GE [E]) -> DepT GE [E]
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (DepT GE [E]) -> DepT GE [E])
-> GE (DepT GE [E]) -> DepT GE [E]
forall a b. (a -> b) -> a -> b
$ [E] -> GE (DepT GE [E])
forall {m :: * -> *}. Monad m => [E] -> GE (DepT m [E])
phi ([E] -> GE (DepT GE [E])) -> GE [E] -> GE (DepT GE [E])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
sigs
    where
        phi :: [E] -> GE (DepT m [E])
phi [E]
x = do
            E
dtE <- D -> GE E
forall a. Val a => a -> GE E
toGE D
dt
            DepT m [E] -> GE (DepT m [E])
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return (DepT m [E] -> GE (DepT m [E])) -> DepT m [E] -> GE (DepT m [E])
forall a b. (a -> b) -> a -> b
$ E -> [E] -> DepT m [E]
forall (m :: * -> *). Monad m => E -> [E] -> DepT m [E]
C.autoOff E
dtE [E]
x


saveEvtInstr_ :: Arg a => C.InstrId -> Evt [(Sig, Sig, a)] -> Dep ()
saveEvtInstr_ :: forall a. Arg a => InstrId -> Evt [(Sig, Sig, a)] -> Dep ()
saveEvtInstr_ InstrId
instrId Evt [(Sig, Sig, a)]
evts = SE () -> Dep ()
forall a. SE a -> Dep a
unSE (SE () -> Dep ()) -> SE () -> Dep ()
forall a b. (a -> b) -> a -> b
$ Evt [(Sig, Sig, a)] -> Bam [(Sig, Sig, a)] -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt [(Sig, Sig, a)]
evts (Bam [(Sig, Sig, a)] -> SE ()) -> Bam [(Sig, Sig, a)] -> SE ()
forall a b. (a -> b) -> a -> b
$ \[(Sig, Sig, a)]
es -> Dep () -> SE ()
fromDep_ (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ ((Sig, Sig, a) -> Dep ()) -> [(Sig, Sig, a)] -> Dep ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Sig, Sig, a) -> Dep ()
forall {a} {a} {a}. (Val a, Val a, Arg a) => (a, a, a) -> Dep ()
event [(Sig, Sig, a)]
es
    where event :: (a, a, a) -> Dep ()
event (a
start, a
dur, a
args) = GE (Dep ()) -> Dep ()
forall a. GE (Dep a) -> Dep a
hideGEinDep (GE (Dep ()) -> Dep ()) -> GE (Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ (Event -> Dep ()) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
C.event (GE Event -> GE (Dep ())) -> GE Event -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> [E] -> Event
C.Event (InstrId -> E
primInstrId InstrId
instrId) (E -> E -> [E] -> Event) -> GE E -> GE (E -> [E] -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> GE E
forall a. Val a => a -> GE E
toGE a
start GE (E -> [E] -> Event) -> GE E -> GE ([E] -> Event)
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> GE E
forall a. Val a => a -> GE E
toGE a
dur GE ([E] -> Event) -> GE [E] -> GE Event
forall a b. GE (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> GE [E]
forall a. Arg a => a -> GE [E]
toNote a
args

-------------------------------------------------------------
-- monophonic scheduling

-- | Turns
monoSched :: Evt (Sco (D, D)) -> SE MonoArg
monoSched :: Evt (Sco (D, D)) -> SE MonoArg
monoSched Evt (Sco (D, D))
evts = (((D, D), Port (Sig, Sig, Sig)) -> SE ())
-> Evt (Sco (D, D))
-> (Port (Sig, Sig, Sig) -> SE MonoArg)
-> SE MonoArg
forall a p b.
(Arg a, Sigs p) =>
((a, Port p) -> SE ()) -> Evt (Sco a) -> (Port p -> SE b) -> SE b
evtPort ((D, D), Port (Sig, Sig, Sig)) -> SE ()
forall {p :: * -> *} {c}.
(IsPort p, Sigs c) =>
((D, D), p (Sig, Sig, c)) -> SE ()
instr Evt (Sco (D, D))
evts Port (Sig, Sig, Sig) -> SE MonoArg
readP
    where
        instr :: ((D, D), p (Sig, Sig, c)) -> SE ()
instr ((D
amp, D
cps), p (Sig, Sig, c)
p) = do
            (Sig
_, Sig
_, c
gate) <- p (Sig, Sig, c) -> SE (Sig, Sig, c)
forall a. Sigs a => p a -> SE a
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> SE a
I.readPort p (Sig, Sig, c)
p
            p (Sig, Sig, c) -> (Sig, Sig, c) -> SE ()
forall a. Sigs a => p a -> a -> SE ()
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> a -> SE ()
I.writePort p (Sig, Sig, c)
p (D -> Sig
sig D
amp, D -> Sig
sig D
cps, c
gate c -> c -> c
forall a. Num a => a -> a -> a
+ c
1)

        readP :: I.Port (Sig, Sig, Sig) -> SE MonoArg
        readP :: Port (Sig, Sig, Sig) -> SE MonoArg
readP Port (Sig, Sig, Sig)
p = do
            (Sig
amp, Sig
cps, Sig
gate) <- Port (Sig, Sig, Sig) -> SE (Sig, Sig, Sig)
forall a. Sigs a => Port a -> SE a
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> SE a
I.readPort Port (Sig, Sig, Sig)
p
            Port (Sig, Sig, Sig) -> (Sig, Sig, Sig) -> SE ()
forall a. Sigs a => Port a -> a -> SE ()
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> a -> SE ()
I.writePort Port (Sig, Sig, Sig)
p (Sig
amp, Sig
cps, Sig
0)
            MonoArg -> SE MonoArg
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (MonoArg -> SE MonoArg) -> MonoArg -> SE MonoArg
forall a b. (a -> b) -> a -> b
$ Sig -> Sig -> Sig -> Sig -> MonoArg
MonoArg Sig
amp Sig
cps (BoolSig -> Sig -> Sig -> Sig
forall bool. (bool ~ BooleanOf Sig) => bool -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig
gate Sig -> Sig -> BooleanOf Sig
forall a. EqB a => a -> a -> BooleanOf a
`equalsTo` Sig
0) Sig
0 Sig
1) ([Sig] -> Sig
changed [Sig
amp, Sig
cps, Sig
gate])

runSco :: Arg a => Evt (Sco a) -> ((Sig,Sig,a) -> SE ()) -> SE ()
runSco :: forall a. Arg a => Evt (Sco a) -> ((Sig, Sig, a) -> SE ()) -> SE ()
runSco Evt (Sco a)
evts (Sig, Sig, a) -> SE ()
f = Evt [(Sig, Sig, a)] -> Bam [(Sig, Sig, a)] -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (Evt (Sco a) -> Evt [(Sig, Sig, a)]
forall a. Evt (Sco a) -> Evt [(Sig, Sig, a)]
renderEvts Evt (Sco a)
evts) (Bam [(Sig, Sig, a)] -> SE ()) -> Bam [(Sig, Sig, a)] -> SE ()
forall a b. (a -> b) -> a -> b
$ ((Sig, Sig, a) -> SE ()) -> Bam [(Sig, Sig, a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Sig, Sig, a) -> SE ()
f

-- | Plays the note until next note comes or something happens on the second event stream.
monoSchedUntil :: Evt (D, D) -> Evt a -> SE MonoArg
monoSchedUntil :: forall a. Evt (D, D) -> Evt a -> SE MonoArg
monoSchedUntil Evt (D, D)
evts Evt a
stop = do
    Ref MonoArg
ref <- MonoArg -> SE (Ref MonoArg)
forall a. Tuple a => a -> SE (Ref a)
newRef (Sig -> Sig -> Sig -> Sig -> MonoArg
MonoArg Sig
0 Sig
0 Sig
0 Sig
0)
    Ref MonoArg -> SE ()
clearTrig Ref MonoArg
ref
    Evt (Either (D, D) a) -> Bam (Either (D, D) a) -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (Evt (Either (D, D) a)
-> Evt (Either (D, D) a) -> Evt (Either (D, D) a)
forall a. Monoid a => a -> a -> a
mappend (((D, D) -> Either (D, D) a) -> Evt (D, D) -> Evt (Either (D, D) a)
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D, D) -> Either (D, D) a
forall a b. a -> Either a b
Left Evt (D, D)
evts) ((a -> Either (D, D) a) -> Evt a -> Evt (Either (D, D) a)
forall a b. (a -> b) -> Evt a -> Evt b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either (D, D) a
forall a b. b -> Either a b
Right Evt a
stop)) (Ref MonoArg -> Bam (Either (D, D) a)
forall {b}. Ref MonoArg -> Either (D, D) b -> SE ()
go Ref MonoArg
ref)
    Ref MonoArg -> SE MonoArg
forall a. Tuple a => Ref a -> SE a
readRef Ref MonoArg
ref
    where
        go :: Ref MonoArg -> Either (D, D) b -> SE ()
go Ref MonoArg
ref = ((D, D) -> SE ()) -> (b -> SE ()) -> Either (D, D) b -> SE ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Ref MonoArg -> (D, D) -> SE ()
ons Ref MonoArg
ref) (SE () -> b -> SE ()
forall a b. a -> b -> a
const (SE () -> b -> SE ()) -> SE () -> b -> SE ()
forall a b. (a -> b) -> a -> b
$ Ref MonoArg -> SE ()
offs Ref MonoArg
ref)

        ons :: Ref MonoArg -> (D, D) -> SE ()
ons Ref MonoArg
ref (D
amp, D
cps) =
            Ref MonoArg -> MonoArg -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref MonoArg
ref (MonoArg -> SE ()) -> MonoArg -> SE ()
forall a b. (a -> b) -> a -> b
$ MonoArg { monoAmp :: Sig
monoAmp = D -> Sig
sig D
amp, monoCps :: Sig
monoCps = D -> Sig
sig D
cps, monoGate :: Sig
monoGate = Sig
1, monoTrig :: Sig
monoTrig = Sig
1 }

        offs :: Ref MonoArg -> SE ()
offs Ref MonoArg
ref = Ref MonoArg -> (MonoArg -> MonoArg) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref MonoArg
ref ((MonoArg -> MonoArg) -> SE ()) -> (MonoArg -> MonoArg) -> SE ()
forall a b. (a -> b) -> a -> b
$ \MonoArg
a -> MonoArg
a { monoGate = 0 }

        clearTrig :: Ref MonoArg -> SE ()
clearTrig Ref MonoArg
ref = Ref MonoArg -> (MonoArg -> MonoArg) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref MonoArg
ref ((MonoArg -> MonoArg) -> SE ()) -> (MonoArg -> MonoArg) -> SE ()
forall a b. (a -> b) -> a -> b
$ \MonoArg
a -> MonoArg
a { monoTrig = 0 }

-- | Plays the note until next note comes
monoSchedHarp :: Evt (D, D) -> SE MonoArg
monoSchedHarp :: Evt (D, D) -> SE MonoArg
monoSchedHarp Evt (D, D)
evts = Evt (D, D) -> Evt Any -> SE MonoArg
forall a. Evt (D, D) -> Evt a -> SE MonoArg
monoSchedUntil Evt (D, D)
evts Evt Any
forall a. Monoid a => a
mempty


evtPort :: (Arg a, Sigs p) => ((a, I.Port p) -> SE ()) -> Evt (Sco a) -> (I.Port p -> SE b) -> SE b
evtPort :: forall a p b.
(Arg a, Sigs p) =>
((a, Port p) -> SE ()) -> Evt (Sco a) -> (Port p -> SE b) -> SE b
evtPort (a, Port p) -> SE ()
instr Evt (Sco a)
evts Port p -> SE b
readP = do
    Port p
port <- SE (Port p)
forall a. Sigs a => SE (Port a)
I.freePort
    InstrId (a, Port p)
idx <- ((a, Port p) -> SE ()) -> SE (InstrId (a, Port p))
forall a. Arg a => (a -> SE ()) -> SE (InstrId a)
I.newInstrLinked (a, Port p) -> SE ()
instr
    Evt (Sco a) -> ((Sig, Sig, a) -> SE ()) -> SE ()
forall a. Arg a => Evt (Sco a) -> ((Sig, Sig, a) -> SE ()) -> SE ()
runSco Evt (Sco a)
evts (((Sig, Sig, a) -> SE ()) -> SE ())
-> ((Sig, Sig, a) -> SE ()) -> SE ()
forall a b. (a -> b) -> a -> b
$ InstrId (a, Port p) -> Port p -> (Sig, Sig, a) -> SE ()
forall {a} {b}.
(Arg a, Arg b) =>
InstrId (a, b) -> b -> (Sig, Sig, a) -> SE ()
go InstrId (a, Port p)
idx Port p
port
    Port p -> SE b
readP Port p
port
    where
        go :: InstrId (a, b) -> b -> (Sig, Sig, a) -> SE ()
go InstrId (a, b)
idx b
port (Sig
start,Sig
dur,a
a) = InstrId (a, b) -> (Sig, Sig, (a, b)) -> SE ()
forall a. Arg a => InstrId a -> (Sig, Sig, a) -> SE ()
I.event InstrId (a, b)
idx (Sig
start, Sig
dur, (a
a, b
port))