module Csound.Typed.Types.MixSco(
    M(..), CsdEventList, csdEventListDur, csdEventListNotes,
    delayAndRescaleCsdEventListM, renderMixSco, renderMixSco_
) where

import Control.Applicative
import Control.Monad

import Csound.Dynamic hiding (int)
import Csound.Typed.GlobalState.Elements
import Csound.Typed.GlobalState.Opcodes
import Csound.Typed.GlobalState.GE hiding (notes)
import Csound.Typed.GlobalState.SE
import Csound.Typed.Control.Ref
import Csound.Typed.Types.Prim

import qualified Temporal.Media as T

type CsdEventList a = T.Track Sig a

csdEventListNotes :: CsdEventList a -> [(Sig, Sig, a)]
csdEventListNotes :: forall a. CsdEventList a -> [(Sig, Sig, a)]
csdEventListNotes CsdEventList a
a = (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 (\(T.Event Sig
start Sig
dur a
content) -> (Sig
start, Sig
dur, a
content)) ([Event Sig a] -> [(Sig, Sig, a)])
-> [Event Sig a] -> [(Sig, Sig, a)]
forall a b. (a -> b) -> a -> b
$ CsdEventList a -> [Event Sig a]
forall t a. Num t => Track t a -> [Event t a]
T.render CsdEventList a
a

csdEventListDur :: CsdEventList a -> Sig
csdEventListDur :: forall a. CsdEventList a -> Sig
csdEventListDur = CsdEventList a -> DurOf (CsdEventList a)
CsdEventList a -> Sig
forall a. Duration a => a -> DurOf a
T.dur

rescaleCsdEventList :: Sig -> CsdEventList a -> CsdEventList a
rescaleCsdEventList :: forall a. Sig -> CsdEventList a -> CsdEventList a
rescaleCsdEventList = DurOf (CsdEventList a) -> CsdEventList a -> CsdEventList a
Sig -> CsdEventList a -> CsdEventList a
forall a. Stretch a => DurOf a -> a -> a
T.str

delayCsdEventList :: Sig -> CsdEventList a -> CsdEventList a
delayCsdEventList :: forall a. Sig -> CsdEventList a -> CsdEventList a
delayCsdEventList = DurOf (CsdEventList a) -> CsdEventList a -> CsdEventList a
Sig -> CsdEventList a -> CsdEventList a
forall a. Delay a => DurOf a -> a -> a
T.del


data M
    = Snd InstrId (CsdEventList [E])
    | MonoSnd { M -> InstrId
monoSndInstr :: InstrId, M -> InstrId
monoSndArgs :: InstrId, M -> CsdEventList [E]
monoSndNotes :: (CsdEventList [E]) }
    | Eff InstrId (CsdEventList M) Int

delayAndRescaleCsdEventListM :: CsdEventList M -> CsdEventList M
delayAndRescaleCsdEventListM :: CsdEventList M -> CsdEventList M
delayAndRescaleCsdEventListM = CsdEventList M -> CsdEventList M
delayCsdEventListM (CsdEventList M -> CsdEventList M)
-> (CsdEventList M -> CsdEventList M)
-> CsdEventList M
-> CsdEventList M
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsdEventList M -> CsdEventList M
rescaleCsdEventListM

delayCsdEventListM :: CsdEventList M -> CsdEventList M
delayCsdEventListM :: CsdEventList M -> CsdEventList M
delayCsdEventListM = (Event Sig M -> Event Sig M) -> CsdEventList M -> CsdEventList M
forall t a b.
Num t =>
(Event t a -> Event t b) -> Track t a -> Track t b
T.mapEvents Event Sig M -> Event Sig M
delayCsdEventM

delayCsdEventM :: T.Event Sig M -> T.Event Sig M
delayCsdEventM :: Event Sig M -> Event Sig M
delayCsdEventM (T.Event Sig
start Sig
dur M
evt) = Sig -> Sig -> M -> Event Sig M
forall t a. t -> t -> a -> Event t a
T.Event Sig
start Sig
dur (M -> M
phi M
evt)
    where phi :: M -> M
phi M
x = case M
x of
            Snd InstrId
n CsdEventList [E]
evts                  -> InstrId -> CsdEventList [E] -> M
Snd InstrId
n (CsdEventList [E] -> M) -> CsdEventList [E] -> M
forall a b. (a -> b) -> a -> b
$ Sig -> CsdEventList [E] -> CsdEventList [E]
forall a. Sig -> CsdEventList a -> CsdEventList a
delayCsdEventList Sig
start CsdEventList [E]
evts
            MonoSnd InstrId
instrId InstrId
argId CsdEventList [E]
evts  -> InstrId -> InstrId -> CsdEventList [E] -> M
MonoSnd InstrId
instrId InstrId
argId  (CsdEventList [E] -> M) -> CsdEventList [E] -> M
forall a b. (a -> b) -> a -> b
$ Sig -> CsdEventList [E] -> CsdEventList [E]
forall a. Sig -> CsdEventList a -> CsdEventList a
delayCsdEventList Sig
start CsdEventList [E]
evts
            Eff InstrId
n CsdEventList M
evts Int
arityIn          -> InstrId -> CsdEventList M -> Int -> M
Eff InstrId
n (CsdEventList M -> CsdEventList M
delayCsdEventListM (CsdEventList M -> CsdEventList M)
-> CsdEventList M -> CsdEventList M
forall a b. (a -> b) -> a -> b
$ Sig -> CsdEventList M -> CsdEventList M
forall a. Sig -> CsdEventList a -> CsdEventList a
delayCsdEventList Sig
start CsdEventList M
evts) Int
arityIn

rescaleCsdEventListM :: CsdEventList M -> CsdEventList M
rescaleCsdEventListM :: CsdEventList M -> CsdEventList M
rescaleCsdEventListM = (Event Sig M -> Event Sig M) -> CsdEventList M -> CsdEventList M
forall t a b.
Num t =>
(Event t a -> Event t b) -> Track t a -> Track t b
T.mapEvents Event Sig M -> Event Sig M
rescaleCsdEventM

rescaleCsdEventM :: T.Event Sig M -> T.Event Sig M
rescaleCsdEventM :: Event Sig M -> Event Sig M
rescaleCsdEventM (T.Event Sig
start Sig
dur M
evt) = Sig -> Sig -> M -> Event Sig M
forall t a. t -> t -> a -> Event t a
T.Event Sig
start Sig
dur (M -> M
phi M
evt)
    where phi :: M -> M
phi M
x = case M
x of
            Snd InstrId
n CsdEventList [E]
evts                  -> InstrId -> CsdEventList [E] -> M
Snd InstrId
n (CsdEventList [E] -> M) -> CsdEventList [E] -> M
forall a b. (a -> b) -> a -> b
$ Sig -> CsdEventList [E] -> CsdEventList [E]
forall a. Sig -> CsdEventList a -> CsdEventList a
rescaleCsdEventList (Sig
durSig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
localDur) CsdEventList [E]
evts
            MonoSnd InstrId
instrId InstrId
argId CsdEventList [E]
evts  -> InstrId -> InstrId -> CsdEventList [E] -> M
MonoSnd InstrId
instrId InstrId
argId  (CsdEventList [E] -> M) -> CsdEventList [E] -> M
forall a b. (a -> b) -> a -> b
$ Sig -> CsdEventList [E] -> CsdEventList [E]
forall a. Sig -> CsdEventList a -> CsdEventList a
rescaleCsdEventList (Sig
durSig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
localDur) CsdEventList [E]
evts
            Eff InstrId
n CsdEventList M
evts Int
arityIn          -> InstrId -> CsdEventList M -> Int -> M
Eff InstrId
n (CsdEventList M -> CsdEventList M
rescaleCsdEventListM (CsdEventList M -> CsdEventList M)
-> CsdEventList M -> CsdEventList M
forall a b. (a -> b) -> a -> b
$ Sig -> CsdEventList M -> CsdEventList M
forall a. Sig -> CsdEventList a -> CsdEventList a
rescaleCsdEventList (Sig
durSig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
localDur) CsdEventList M
evts) Int
arityIn
            where localDur :: Sig
localDur = case M
x of
                    Snd InstrId
_ CsdEventList [E]
evts       -> CsdEventList [E] -> Sig
forall a. CsdEventList a -> Sig
csdEventListDur CsdEventList [E]
evts
                    MonoSnd InstrId
_ InstrId
_ CsdEventList [E]
evts -> CsdEventList [E] -> Sig
forall a. CsdEventList a -> Sig
csdEventListDur CsdEventList [E]
evts
                    Eff InstrId
_ CsdEventList M
evts Int
_     -> CsdEventList M -> Sig
forall a. CsdEventList a -> Sig
csdEventListDur CsdEventList M
evts

renderMixSco :: Int -> CsdEventList M -> Dep [E]
renderMixSco :: Int -> CsdEventList M -> Dep [E]
renderMixSco Int
arity CsdEventList M
evts = do
    ChnRef
chnId <- Int -> DepT GE ChnRef
forall (m :: * -> *). Monad m => Int -> DepT m ChnRef
chnRefAlloc Int
arity
    Ref D
aliveCountRef <- SE (Ref D) -> Dep (Ref D)
forall a. SE a -> Dep a
unSE (SE (Ref D) -> Dep (Ref D)) -> SE (Ref D) -> Dep (Ref D)
forall a b. (a -> b) -> a -> b
$ D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
10 :: D)
    Ref D -> ChnRef -> CsdEventList M -> Dep ()
go Ref D
aliveCountRef ChnRef
chnId CsdEventList M
evts
    ChnRef -> Dep [E]
forall (m :: * -> *). Monad m => ChnRef -> DepT m [E]
readChn ChnRef
chnId
    where
        go :: Ref D -> ChnRef -> CsdEventList M -> Dep ()
        go :: Ref D -> ChnRef -> CsdEventList M -> Dep ()
go Ref D
aliveCountRef ChnRef
outId CsdEventList M
xs = do
            ((Sig, Sig, M) -> Dep ()) -> [(Sig, Sig, M)] -> Dep ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ref D -> ChnRef -> (Sig, Sig, M) -> Dep ()
onEvent Ref D
aliveCountRef ChnRef
outId) [(Sig, Sig, M)]
notes
            SE () -> Dep ()
forall a. SE a -> Dep a
unSE (SE () -> Dep ()) -> SE () -> Dep ()
forall a b. (a -> b) -> a -> b
$ 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, M)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Sig, Sig, M)]
notes
            D
aliveCount <- SE D -> Dep D
forall a. SE a -> Dep a
unSE (SE D -> Dep D) -> SE D -> Dep D
forall a b. (a -> b) -> a -> b
$ Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
aliveCountRef
            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 (ChnRef -> GE ChnRef
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return 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
            where
                notes :: [(Sig, Sig, M)]
notes = CsdEventList M -> [(Sig, Sig, M)]
forall a. CsdEventList a -> [(Sig, Sig, a)]
csdEventListNotes CsdEventList M
xs
                chnId :: ChnRef
chnId = ChnRef
outId

        onEvent :: Ref D -> ChnRef -> (Sig, Sig, M) -> Dep ()
        onEvent :: Ref D -> ChnRef -> (Sig, Sig, M) -> Dep ()
onEvent Ref D
aliveCountRef ChnRef
outId (Sig
start, Sig
dur, M
x) = case M
x of
            Snd InstrId
instrId CsdEventList [E]
es          -> Ref D -> InstrId -> ChnRef -> CsdEventList [E] -> Dep ()
forall {p}. p -> InstrId -> ChnRef -> CsdEventList [E] -> Dep ()
onSnd Ref D
aliveCountRef InstrId
instrId ChnRef
outId CsdEventList [E]
es
            MonoSnd InstrId
instr InstrId
arg CsdEventList [E]
es    -> InstrId
-> InstrId -> Sig -> Sig -> ChnRef -> CsdEventList [E] -> Dep ()
onMonoSnd InstrId
instr InstrId
arg Sig
start Sig
dur ChnRef
outId CsdEventList [E]
es
            Eff InstrId
instrId CsdEventList M
es Int
arityIn  -> Ref D
-> InstrId
-> Sig
-> Sig
-> ChnRef
-> CsdEventList M
-> Int
-> Dep ()
onEff Ref D
aliveCountRef InstrId
instrId Sig
start Sig
dur ChnRef
outId CsdEventList M
es Int
arityIn

        onSnd :: p -> InstrId -> ChnRef -> CsdEventList [E] -> Dep ()
onSnd p
_ InstrId
instrId ChnRef
outId CsdEventList [E]
es = [(Sig, Sig, [E])] -> ((Sig, Sig, [E]) -> Dep ()) -> Dep ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CsdEventList [E] -> [(Sig, Sig, [E])]
forall a. CsdEventList a -> [(Sig, Sig, a)]
csdEventListNotes CsdEventList [E]
es) (((Sig, Sig, [E]) -> Dep ()) -> Dep ())
-> ((Sig, Sig, [E]) -> Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ \(Sig
start, Sig
dur, [E]
args) ->
            InstrId -> Sig -> Sig -> [E] -> Dep ()
mkEvent InstrId
instrId Sig
start Sig
dur ([E]
args [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [ChnRef -> E
chnRefId ChnRef
outId])

        onEff :: Ref D
-> InstrId
-> Sig
-> Sig
-> ChnRef
-> CsdEventList M
-> Int
-> Dep ()
onEff Ref D
aliveCountRef InstrId
instrId Sig
start Sig
dur ChnRef
outId CsdEventList M
es Int
arityIn = do
            ChnRef
inId <- Int -> DepT GE ChnRef
forall (m :: * -> *). Monad m => Int -> DepT m ChnRef
chnRefAlloc Int
arityIn
            InstrId -> Sig -> Sig -> [E] -> Dep ()
mkEvent InstrId
instrId Sig
start Sig
dur [ChnRef -> E
chnRefId ChnRef
inId, ChnRef -> E
chnRefId ChnRef
outId]
            Ref D -> ChnRef -> CsdEventList M -> Dep ()
go Ref D
aliveCountRef ChnRef
inId CsdEventList M
es

        onMonoSnd :: InstrId
-> InstrId -> Sig -> Sig -> ChnRef -> CsdEventList [E] -> Dep ()
onMonoSnd InstrId
instrId InstrId
argId Sig
start Sig
dur ChnRef
outId CsdEventList [E]
es = do
            ChnRef
inId <- Int -> DepT GE ChnRef
forall (m :: * -> *). Monad m => Int -> DepT m ChnRef
chnRefAlloc Int
arityMonoIn

            [(Sig, Sig, [E])] -> ((Sig, Sig, [E]) -> Dep ()) -> Dep ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CsdEventList [E] -> [(Sig, Sig, [E])]
forall a. CsdEventList a -> [(Sig, Sig, a)]
csdEventListNotes CsdEventList [E]
es) (((Sig, Sig, [E]) -> Dep ()) -> Dep ())
-> ((Sig, Sig, [E]) -> Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ \(Sig
startLocal, Sig
durLocal, [E]
args) ->
                InstrId -> Sig -> Sig -> [E] -> Dep ()
mkEvent InstrId
argId Sig
startLocal Sig
durLocal ([E]
args [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [ChnRef -> E
chnRefId ChnRef
inId])

            InstrId -> Sig -> Sig -> [E] -> Dep ()
mkEvent InstrId
instrId Sig
start Sig
dur [ChnRef -> E
chnRefId ChnRef
inId, ChnRef -> E
chnRefId ChnRef
outId]
            where arityMonoIn :: Int
arityMonoIn = Int
3


renderMixSco_ :: CsdEventList M -> Dep ()
renderMixSco_ :: CsdEventList M -> Dep ()
renderMixSco_ CsdEventList M
evts = ((Sig, Sig, M) -> Dep ()) -> [(Sig, Sig, M)] -> Dep ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Sig, Sig, M) -> Dep ()
onEvent ([(Sig, Sig, M)] -> Dep ()) -> [(Sig, Sig, M)] -> Dep ()
forall a b. (a -> b) -> a -> b
$ CsdEventList M -> [(Sig, Sig, M)]
forall a. CsdEventList a -> [(Sig, Sig, a)]
csdEventListNotes CsdEventList M
evts
    where
        onEvent :: (Sig, Sig, M) -> Dep ()
        onEvent :: (Sig, Sig, M) -> Dep ()
onEvent (Sig
start, Sig
dur, M
x) = case M
x of
            Snd InstrId
instrId CsdEventList [E]
es       -> InstrId -> CsdEventList [E] -> Dep ()
onSnd InstrId
instrId CsdEventList [E]
es
            MonoSnd InstrId
instr InstrId
arg CsdEventList [E]
es -> InstrId -> InstrId -> CsdEventList [E] -> Dep ()
forall {a}. a
onMonoSnd InstrId
instr InstrId
arg CsdEventList [E]
es
            Eff InstrId
instrId CsdEventList M
es Int
_     -> InstrId -> Sig -> Sig -> CsdEventList M -> Dep ()
onEff InstrId
instrId Sig
start Sig
dur CsdEventList M
es

        onSnd :: InstrId -> CsdEventList [E] -> Dep ()
onSnd InstrId
instrId CsdEventList [E]
es = [(Sig, Sig, [E])] -> ((Sig, Sig, [E]) -> Dep ()) -> Dep ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CsdEventList [E] -> [(Sig, Sig, [E])]
forall a. CsdEventList a -> [(Sig, Sig, a)]
csdEventListNotes CsdEventList [E]
es) (((Sig, Sig, [E]) -> Dep ()) -> Dep ())
-> ((Sig, Sig, [E]) -> Dep ()) -> Dep ()
forall a b. (a -> b) -> a -> b
$ \(Sig
start, Sig
dur, [E]
args) ->
            InstrId -> Sig -> Sig -> [E] -> Dep ()
mkEvent InstrId
instrId Sig
start Sig
dur [E]
args

        onEff :: InstrId -> Sig -> Sig -> CsdEventList M -> Dep ()
onEff InstrId
instrId Sig
start Sig
dur CsdEventList M
es = do
            InstrId -> Sig -> Sig -> [E] -> Dep ()
mkEvent InstrId
instrId Sig
start Sig
dur []
            CsdEventList M -> Dep ()
renderMixSco_ CsdEventList M
es

        onMonoSnd :: a
onMonoSnd = a
forall a. HasCallStack => a
undefined


mkEvent :: InstrId -> Sig -> Sig -> [E] -> Dep ()
mkEvent :: InstrId -> Sig -> Sig -> [E] -> Dep ()
mkEvent InstrId
instrId Sig
startD Sig
durD [E]
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
$ do
        E
start <- Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
startD
        E
dur   <- Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
durD
        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
$ Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
event_i (Event -> Dep ()) -> Event -> Dep ()
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> [E] -> Event
Event (InstrId -> E
primInstrId InstrId
instrId) E
start E
dur [E]
args