{-# Language ScopedTypeVariables #-}
module Csound.Typed.GlobalState.InstrApi(
    InstrId, event, eventi,
    newInstr, newInstrLinked,
    turnoff, turnoff2
) where

import Control.Monad.Trans.Class

import Csound.Dynamic hiding (InstrId, when1)
import Csound.Typed.GlobalState.Instr
import Csound.Typed.GlobalState.GE
import Csound.Typed.GlobalState.SE
import Csound.Typed.Types.Tuple
import Csound.Typed.Types.Prim

import Csound.Typed.GlobalState.Port


import qualified Csound.Typed.GlobalState.Opcodes as Opcodes(Event(..), event, eventi, turnoff2, turnoff, activeKr)

data InstrId a
    = InstrId { InstrId a -> GE E
_unInstrId :: GE E }
    | InstrLinkedId { InstrId a -> PortCtrl Sig
_instrLivenessPort :: PortCtrl Sig, _unInstrId :: GE E }

newInstr :: Arg a => (a -> SE ()) -> InstrId a
newInstr :: (a -> SE ()) -> InstrId a
newInstr a -> SE ()
instr = GE E -> InstrId a
forall a. GE E -> InstrId a
InstrId (GE E -> InstrId a) -> GE E -> InstrId a
forall a b. (a -> b) -> a -> b
$ (InstrId -> E) -> GE InstrId -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InstrId -> E
instrIdE (GE InstrId -> GE E) -> GE InstrId -> GE E
forall a b. (a -> b) -> a -> b
$ SE () -> GE InstrId
saveInstr (a -> SE ()
instr a
forall a. Arg a => a
toArg)

event :: Arg a => InstrId a -> (Sig,Sig,a) -> SE ()
event :: InstrId a -> (Sig, Sig, a) -> SE ()
event InstrId a
idx (Sig, Sig, a)
note = do
    Event
e <- InstrId a -> (Sig, Sig, a) -> SE Event
forall a. Tuple a => InstrId a -> (Sig, Sig, a) -> SE Event
getEvent InstrId a
idx (Sig, Sig, a)
note
    Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
Opcodes.event Event
e

eventi :: Arg a => InstrId a -> (D,D,a) -> SE ()
eventi :: InstrId a -> (D, D, a) -> SE ()
eventi InstrId a
idx (D, D, a)
note = do
    Event
e <- InstrId a -> (D, D, a) -> SE Event
forall a. Tuple a => InstrId a -> (D, D, a) -> SE Event
getEventi InstrId a
idx (D, D, a)
note
    Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
Opcodes.eventi Event
e

getEvent :: Tuple a => InstrId a -> (Sig, Sig, a) -> SE Opcodes.Event
getEvent :: InstrId a -> (Sig, Sig, a) -> SE Event
getEvent (InstrId GE E
idx) (Sig
start, Sig
dur, a
args) = Dep Event -> SE Event
forall a. Dep a -> SE a
SE (Dep Event -> SE Event) -> Dep Event -> SE Event
forall a b. (a -> b) -> a -> b
$ GE Event -> Dep Event
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE Event -> Dep Event) -> GE Event -> Dep Event
forall a b. (a -> b) -> a -> b
$ do
            E
i <- GE E
idx
            E
s <- Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
start
            E
d <- Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
dur
            [E]
as <- a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
args
            Event -> GE Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> GE Event) -> Event -> GE Event
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> [E] -> Event
Opcodes.Event E
i E
s E
d [E]
as
getEvent (InstrLinkedId PortCtrl Sig
port GE E
idx) (Sig
start, Sig
dur, a
argument) = do
    InstrId (a, PortCtrl Sig)
-> (Sig, Sig, (a, PortCtrl Sig)) -> SE Event
forall a. Tuple a => InstrId a -> (Sig, Sig, a) -> SE Event
getEvent (GE E -> InstrId (a, PortCtrl Sig)
forall a. GE E -> InstrId a
InstrId GE E
idx) (Sig
start, Sig
dur, (a
argument, PortCtrl Sig
port))


getEventi :: Tuple a => InstrId a -> (D, D, a) -> SE Opcodes.Event
getEventi :: InstrId a -> (D, D, a) -> SE Event
getEventi (InstrId GE E
idx) (D
start, D
dur, a
args) = Dep Event -> SE Event
forall a. Dep a -> SE a
SE (Dep Event -> SE Event) -> Dep Event -> SE Event
forall a b. (a -> b) -> a -> b
$ GE Event -> Dep Event
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GE Event -> Dep Event) -> GE Event -> Dep Event
forall a b. (a -> b) -> a -> b
$ do
            E
i <- GE E
idx
            E
s <- D -> GE E
forall a. Val a => a -> GE E
toGE D
start
            E
d <- D -> GE E
forall a. Val a => a -> GE E
toGE D
dur
            [E]
as <- a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple a
args
            Event -> GE Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> GE Event) -> Event -> GE Event
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> [E] -> Event
Opcodes.Event E
i E
s E
d [E]
as
getEventi (InstrLinkedId PortCtrl Sig
port GE E
idx) (D
start, D
dur, a
argument) = do
    InstrId (a, PortCtrl Sig) -> (D, D, (a, PortCtrl Sig)) -> SE Event
forall a. Tuple a => InstrId a -> (D, D, a) -> SE Event
getEventi (GE E -> InstrId (a, PortCtrl Sig)
forall a. GE E -> InstrId a
InstrId GE E
idx) (D
start, D
dur, (a
argument, PortCtrl Sig
port))


turnoff2 :: InstrId a -> SE ()
turnoff2 :: InstrId a -> SE ()
turnoff2 = \case
  InstrId GE E
expr -> Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ E -> Dep ()
forall (m :: * -> *). Monad m => E -> DepT m ()
Opcodes.turnoff2 (E -> Dep ()) -> DepT GE E -> Dep ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GE E -> DepT GE E
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GE E
expr
  InstrLinkedId PortCtrl Sig
_ GE E
_ -> [Char] -> SE ()
forall a. HasCallStack => [Char] -> a
error [Char]
"turnoff2 is undefined for InstrLinkedId"

turnoff :: SE ()
turnoff :: SE ()
turnoff = Dep () -> SE ()
forall a. Dep a -> SE a
SE (Dep () -> SE ()) -> Dep () -> SE ()
forall a b. (a -> b) -> a -> b
$ Dep ()
forall (m :: * -> *). Monad m => DepT m ()
Opcodes.turnoff

newInstrLinked :: forall a. Arg a => (a -> SE ()) -> SE (InstrId a)
newInstrLinked :: (a -> SE ()) -> SE (InstrId a)
newInstrLinked a -> SE ()
instr = do
    PortCtrl Sig
p <- SE (PortCtrl Sig)
forall a. Sigs a => SE (PortCtrl a)
freePortCtrl
    PortCtrl Sig -> Sig -> SE ()
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> a -> SE ()
writePort PortCtrl Sig
p Sig
10
    let instrId :: GE E
instrId = (InstrId -> E) -> GE InstrId -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InstrId -> E
instrIdE (GE InstrId -> GE E) -> GE InstrId -> GE E
forall a b. (a -> b) -> a -> b
$ SE () -> GE InstrId
saveInstr ((a, PortCtrl Sig) -> SE ()
instr' (a, PortCtrl Sig)
forall a. Arg a => a
toArg)
    let resInstrId :: InstrId a
resInstrId = PortCtrl Sig -> GE E -> InstrId a
forall a. PortCtrl Sig -> GE E -> InstrId a
InstrLinkedId PortCtrl Sig
p GE E
instrId
    PortCtrl Sig -> Sig -> SE ()
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> a -> SE ()
writePort PortCtrl Sig
p (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ (GE E -> Sig
forall a. Val a => GE E -> a
fromGE (GE E -> Sig) -> GE E -> Sig
forall a b. (a -> b) -> a -> b
$ (E -> E) -> GE E -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> E
Opcodes.activeKr GE E
instrId) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
1
    InstrId a -> SE (InstrId a)
forall (m :: * -> *) a. Monad m => a -> m a
return InstrId a
forall a. InstrId a
resInstrId
    where
        instr' :: (a, PortCtrl Sig) -> SE ()
        instr' :: (a, PortCtrl Sig) -> SE ()
instr' (a
argument, PortCtrl Sig
port) = do
            a -> SE ()
instr a
argument
            PortCtrl Sig -> SE ()
testLiveness PortCtrl Sig
port

testLiveness :: PortCtrl Sig -> SE ()
testLiveness :: PortCtrl Sig -> SE ()
testLiveness PortCtrl Sig
p = do
    Sig
isAlive <- PortCtrl Sig -> SE Sig
forall (p :: * -> *) a. (IsPort p, Sigs a) => p a -> SE a
readPort PortCtrl Sig
p
    BoolSig -> SE () -> SE ()
when1 (Sig
isAlive Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` Sig
0) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ SE ()
turnoff
    PortCtrl Sig -> (Sig -> Sig) -> SE ()
forall a (port :: * -> *).
(Sigs a, IsPort port) =>
port a -> (a -> a) -> SE ()
modifyPort PortCtrl Sig
p (\Sig
x -> Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
1)