{-# Language TypeFamilies, FlexibleContexts, CPP #-}
module Csound.Typed.Types.Evt(
    Evt(..), Bam, sync,
    boolToEvt, evtToBool, sigToEvt, stepper,
    filterE, filterSE, accumSE, accumE, filterAccumE, filterAccumSE,
    Snap, snapshot, snaps, readSnap
) where

import Data.Default
import Data.Boolean

import Csound.Typed.Types.Prim
import Csound.Typed.Types.Tuple
import Csound.Typed.GlobalState
import Csound.Typed.Control.Ref

import qualified Csound.Typed.GlobalState.Opcodes as C

-- | A stream of events. We can convert a stream of events to
-- the procedure with the function @runEvt@. It waits for events
-- and invokes the given procedure when the event happens.
data Evt a = Evt { Evt a -> Bam a -> SE ()
runEvt :: Bam a -> SE () }

-- | A procedure. Something that takes a value and suddenly bams with it.
type Bam a = a -> SE ()

instance Functor Evt where
    fmap :: (a -> b) -> Evt a -> Evt b
fmap a -> b
f Evt a
a = (Bam b -> SE ()) -> Evt b
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam b -> SE ()) -> Evt b) -> (Bam b -> SE ()) -> Evt b
forall a b. (a -> b) -> a -> b
$ \Bam b
bam -> Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
a (Bam b
bam Bam b -> (a -> b) -> Bam a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Default (Evt a) where
    def :: Evt a
def = (Bam a -> SE ()) -> Evt a
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam a -> SE ()) -> Evt a) -> (Bam a -> SE ()) -> Evt a
forall a b. (a -> b) -> a -> b
$ SE () -> Bam a -> SE ()
forall a b. a -> b -> a
const (SE () -> Bam a -> SE ()) -> SE () -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ () -> SE ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if MIN_VERSION_base(4,11,0)
instance Semigroup (Evt a) where
    <> :: Evt a -> Evt a -> Evt a
(<>) = Evt a -> Evt a -> Evt a
forall a. Evt a -> Evt a -> Evt a
mappendEvt

instance Monoid (Evt a) where
    mempty :: Evt a
mempty  = Evt a
forall a. Default a => a
def

#else

instance Monoid (Evt a) where
    mempty  = def
    mappend = mappendEvt

#endif

mappendEvt :: Evt a -> Evt a -> Evt a
mappendEvt :: Evt a -> Evt a -> Evt a
mappendEvt Evt a
a Evt a
b = (Bam a -> SE ()) -> Evt a
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam a -> SE ()) -> Evt a) -> (Bam a -> SE ()) -> Evt a
forall a b. (a -> b) -> a -> b
$ \Bam a
bam -> Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
a Bam a
bam SE () -> SE () -> SE ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
b Bam a
bam

-- | Converts booleans to events.
boolToEvt :: BoolSig -> Evt Unit
boolToEvt :: BoolSig -> Evt Unit
boolToEvt BoolSig
b = (Bam Unit -> SE ()) -> Evt Unit
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam Unit -> SE ()) -> Evt Unit)
-> (Bam Unit -> SE ()) -> Evt Unit
forall a b. (a -> b) -> a -> b
$ \Bam Unit
bam -> BoolSig -> SE () -> SE ()
when1 BoolSig
b (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Bam Unit
bam Unit
unit

-- | Triggers an event when signal equals to 1.
sigToEvt :: Sig -> Evt Unit
sigToEvt :: Sig -> Evt Unit
sigToEvt = BoolSig -> Evt Unit
boolToEvt (BoolSig -> Evt Unit) -> (Sig -> BoolSig) -> Sig -> Evt Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (Sig -> BoolSig) -> (Sig -> Sig) -> Sig -> BoolSig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig
kr

-- | Filters events with predicate.
filterE :: (a -> BoolD) -> Evt a -> Evt a
filterE :: (a -> BoolD) -> Evt a -> Evt a
filterE a -> BoolD
pr Evt a
evt = (Bam a -> SE ()) -> Evt a
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam a -> SE ()) -> Evt a) -> (Bam a -> SE ()) -> Evt a
forall a b. (a -> b) -> a -> b
$ \Bam a
bam -> Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evt (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a ->
    BoolSig -> SE () -> SE ()
when1 (BoolD -> BoolSig
boolSig (BoolD -> BoolSig) -> BoolD -> BoolSig
forall a b. (a -> b) -> a -> b
$ a -> BoolD
pr a
a) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Bam a
bam a
a

-- | Filters events with effectful predicate.
filterSE :: (a -> SE BoolD) -> Evt a -> Evt a
filterSE :: (a -> SE BoolD) -> Evt a -> Evt a
filterSE a -> SE BoolD
mpr Evt a
evt = (Bam a -> SE ()) -> Evt a
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam a -> SE ()) -> Evt a) -> (Bam a -> SE ()) -> Evt a
forall a b. (a -> b) -> a -> b
$ \Bam a
bam -> Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evt (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    BoolD
pr <- a -> SE BoolD
mpr a
a
    BoolSig -> SE () -> SE ()
when1 (BoolD -> BoolSig
boolSig BoolD
pr) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Bam a
bam a
a

-- | Accumulator for events with side effects.
accumSE :: (Tuple s) => s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
accumSE :: s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
accumSE s
s0 a -> s -> SE (b, s)
update Evt a
evt = (Bam b -> SE ()) -> Evt b
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam b -> SE ()) -> Evt b) -> (Bam b -> SE ()) -> Evt b
forall a b. (a -> b) -> a -> b
$ \Bam b
bam -> do
    (SE s
readSt, s -> SE ()
writeSt) <- s -> SE (SE s, s -> SE ())
forall a. Tuple a => a -> SE (SE a, a -> SE ())
sensorsSE s
s0
    Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evt (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a -> do
        s
s1 <- SE s
readSt
        (b
b, s
s2) <- a -> s -> SE (b, s)
update a
a s
s1
        Bam b
bam b
b
        s -> SE ()
writeSt s
s2

-- | Accumulator for events.
accumE :: (Tuple s) => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE :: s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE s
s0 a -> s -> (b, s)
update = s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
forall s a b.
Tuple s =>
s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b
accumSE s
s0 (\a
a s
s -> (b, s) -> SE (b, s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, s) -> SE (b, s)) -> (b, s) -> SE (b, s)
forall a b. (a -> b) -> a -> b
$ a -> s -> (b, s)
update a
a s
s)

-- | Accumulator for events with side effects and filtering. Event triggers
-- only if the first element in the tripplet is true.
filterAccumSE :: (Tuple s) => s -> (a -> s -> SE (BoolD, b, s)) -> Evt a -> Evt b
filterAccumSE :: s -> (a -> s -> SE (BoolD, b, s)) -> Evt a -> Evt b
filterAccumSE s
s0 a -> s -> SE (BoolD, b, s)
update Evt a
evt = (Bam b -> SE ()) -> Evt b
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam b -> SE ()) -> Evt b) -> (Bam b -> SE ()) -> Evt b
forall a b. (a -> b) -> a -> b
$ \Bam b
bam -> do
    (SE s
readSt, s -> SE ()
writeSt) <- s -> SE (SE s, s -> SE ())
forall a. Tuple a => a -> SE (SE a, a -> SE ())
sensorsSE s
s0
    Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evt (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a -> do
        s
s1 <- SE s
readSt
        (BoolD
isOn, b
b, s
s2) <- a -> s -> SE (BoolD, b, s)
update a
a s
s1
        BoolSig -> SE () -> SE ()
when1 (BoolD -> BoolSig
boolSig BoolD
isOn) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Bam b
bam b
b
        s -> SE ()
writeSt s
s2

-- | Accumulator with filtering. It can skip the events from the event stream.
-- If the third element of the triple equals to 1 then we should include the
-- event in the resulting stream. If the element equals to 0 we skip the event.
filterAccumE :: (Tuple s) => s -> (a -> s -> (BoolD, b, s)) -> Evt a -> Evt b
filterAccumE :: s -> (a -> s -> (BoolD, b, s)) -> Evt a -> Evt b
filterAccumE s
s0 a -> s -> (BoolD, b, s)
update = s -> (a -> s -> SE (BoolD, b, s)) -> Evt a -> Evt b
forall s a b.
Tuple s =>
s -> (a -> s -> SE (BoolD, b, s)) -> Evt a -> Evt b
filterAccumSE s
s0 ((a -> s -> SE (BoolD, b, s)) -> Evt a -> Evt b)
-> (a -> s -> SE (BoolD, b, s)) -> Evt a -> Evt b
forall a b. (a -> b) -> a -> b
$ \a
a s
s -> (BoolD, b, s) -> SE (BoolD, b, s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((BoolD, b, s) -> SE (BoolD, b, s))
-> (BoolD, b, s) -> SE (BoolD, b, s)
forall a b. (a -> b) -> a -> b
$ a -> s -> (BoolD, b, s)
update a
a s
s

-- | Get values of some signal at the given events.
snapshot :: (Tuple a, Tuple (Snap a)) => (Snap a -> b -> c) -> a -> Evt b -> Evt c
snapshot :: (Snap a -> b -> c) -> a -> Evt b -> Evt c
snapshot Snap a -> b -> c
f a
asig Evt b
evt = (Bam c -> SE ()) -> Evt c
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam c -> SE ()) -> Evt c) -> (Bam c -> SE ()) -> Evt c
forall a b. (a -> b) -> a -> b
$ \Bam c
bam -> Evt b -> Bam b -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt b
evt (Bam b -> SE ()) -> Bam b -> SE ()
forall a b. (a -> b) -> a -> b
$ \b
a ->
    Bam c
bam (Snap a -> b -> c
f (a -> Snap a
forall a. (Tuple (Snap a), Tuple a) => a -> Snap a
readSnap a
asig) b
a)

readSnap :: (Tuple (Snap a), Tuple a) => a -> Snap a
readSnap :: a -> Snap a
readSnap = GE [E] -> Snap a
forall a. Tuple a => GE [E] -> a
toTuple (GE [E] -> Snap a) -> (a -> GE [E]) -> a -> Snap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GE [E]
forall a. Tuple a => a -> GE [E]
fromTuple

-- | Constructs an event stream that contains values from the
-- given signal. Events happens only when the signal changes.
snaps :: Sig -> Evt D
snaps :: Sig -> Evt D
snaps Sig
asig = (Snap Sig -> Unit -> D) -> Sig -> Evt Unit -> Evt D
forall a b c.
(Tuple a, Tuple (Snap a)) =>
(Snap a -> b -> c) -> a -> Evt b -> Evt c
snapshot Snap Sig -> Unit -> D
forall a b. a -> b -> a
const Sig
asig Evt Unit
trigger
    where
        trigger :: Evt Unit
trigger = Sig -> Evt Unit
sigToEvt (Sig -> Evt Unit) -> Sig -> Evt Unit
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
C.changed (GE E -> GE E) -> GE E -> GE E
forall a b. (a -> b) -> a -> b
$ Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
asig

-------------------------------------------------------------------
-- snap

-- | A snapshot of the signal. It converts a type of the signal to the
-- type of the value in the given moment. Instances:
--
--
-- > type instance Snap D   = D
-- > type instance Snap Str = Str
-- > type instance Snap Tab = Tab
-- >
-- > type instance Snap Sig = D
-- >
-- > type instance Snap (a, b) = (Snap a, Snap b)
-- > type instance Snap (a, b, c) = (Snap a, Snap b, Snap c)
-- > type instance Snap (a, b, c, d) = (Snap a, Snap b, Snap c, Snap d)
-- > type instance Snap (a, b, c, d, e) = (Snap a, Snap b, Snap c, Snap d, Snap e)
-- > type instance Snap (a, b, c, d, e, f) = (Snap a, Snap b, Snap c, Snap d, Snap e, Snap f)
type family Snap a :: *

type instance Snap D   = D
type instance Snap Str = Str
type instance Snap Tab = Tab

type instance Snap Sig = D

type instance Snap (a, b) = (Snap a, Snap b)
type instance Snap (a, b, c) = (Snap a, Snap b, Snap c)
type instance Snap (a, b, c, d) = (Snap a, Snap b, Snap c, Snap d)
type instance Snap (a, b, c, d, e) = (Snap a, Snap b, Snap c, Snap d, Snap e)
type instance Snap (a, b, c, d, e, f) = (Snap a, Snap b, Snap c, Snap d, Snap e, Snap f)

-- | Converts an event to boolean signal. It forgets
-- everything about the event values. Signal equals to one when
-- an event happens and zero otherwise.
evtToBool :: Evt a -> SE BoolSig
evtToBool :: Evt a -> SE BoolSig
evtToBool Evt a
evt = do
    Ref D
var <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (Double -> D
double Double
0)
    Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
var (Double -> D
double Double
0)
    Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evt (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ SE () -> Bam a
forall a b. a -> b -> a
const (SE () -> Bam a) -> SE () -> Bam a
forall a b. (a -> b) -> a -> b
$ Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
var (Double -> D
double Double
1)
    D
asig <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
var
    BoolSig -> SE BoolSig
forall (m :: * -> *) a. Monad m => a -> m a
return (BoolSig -> SE BoolSig) -> BoolSig -> SE BoolSig
forall a b. (a -> b) -> a -> b
$ BoolD -> BoolSig
boolSig (BoolD -> BoolSig) -> BoolD -> BoolSig
forall a b. (a -> b) -> a -> b
$ D
asig D -> D -> BoolD
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* (Double -> D
double Double
1)

-- | Converts events to signals.
stepper :: Tuple a => a -> Evt a -> SE a
stepper :: a -> Evt a -> SE a
stepper a
v0 Evt a
evt = do
    Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newGlobalRef a
v0
    Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evt (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a -> Ref a -> Bam a
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
a
    Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref

-------------------------------------------------------------
-- synchronization

-- | Executes actions synchronized with global tempo (in Hz).
--
-- > runEvtSync tempoCps evt proc
sync :: (Default a, Tuple a) => Sig -> Evt a -> Evt a
sync :: Sig -> Evt a -> Evt a
sync Sig
dt Evt a
evt = (Bam a -> SE ()) -> Evt a
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam a -> SE ()) -> Evt a) -> (Bam a -> SE ()) -> Evt a
forall a b. (a -> b) -> a -> b
$ \Bam a
bam -> do
    Ref a
refVal     <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
forall a. Default a => a
def
    Ref D
refFire    <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
0 :: D)

    Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
evt (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
a -> do
        Ref a -> Bam a
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
refVal  a
a
        Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
refFire D
1

    D
fire    <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
refFire
    BoolSig -> SE () -> SE ()
when1 (Sig -> Sig
metro Sig
dt  Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1 BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* D -> Sig
sig D
fire Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
        a
val <- Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
refVal
        Bam a
bam a
val
        Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
refFire D
0
    where
        metro :: Sig -> Sig
        metro :: Sig -> Sig
metro Sig
asig = 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
C.metro (GE E -> GE E) -> GE E -> GE E
forall a b. (a -> b) -> a -> b
$ Sig -> GE E
forall a. Val a => a -> GE E
toGE Sig
asig