{-# Language TypeFamilies #-}
{-# Language LambdaCase #-}
module Csound.Air.Seg (
  Seg, toSeg, runSeg,
  constLim, constDel, constRest, limSnd
) where

import Data.Maybe
import Data.Boolean

import Temporal.Class

import Csound.Typed
import Csound.Control

import Csound.Air.Wav hiding (Loop)

-- | A segment of the signal.
-- The signal segment is a limited span of signal in time.
-- The time can be measured in seconds or in events!
-- The time span which is measured in events is the first
-- occurence of the event in the event stream.
--
-- There are handy functions for scheduling the signal segments.
-- we can delay the segment or loop over it or limit it with tme interval
-- or play a sequence of segments. The main feature of the segments is the
-- ability to schedule the signals with event streams (like button clicks or midi-events).
data Seg a
  = Unlim a
  | Lim Tick (Seg a)
  | ConstLim Sig (Seg a)
  | Seq [Seg a]
  | Par [Seg a]
  | Loop (Seg a)

instance Functor Seg where
  fmap :: (a -> b) -> Seg a -> Seg b
fmap a -> b
f Seg a
x = case Seg a
x of
    Unlim a
a -> b -> Seg b
forall a. a -> Seg a
Unlim (b -> Seg b) -> b -> Seg b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
    Lim Tick
dt Seg a
a -> Tick -> Seg b -> Seg b
forall a. Tick -> Seg a -> Seg a
Lim Tick
dt (Seg b -> Seg b) -> Seg b -> Seg b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Seg a -> Seg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seg a
a
    ConstLim Sig
dt Seg a
a -> Sig -> Seg b -> Seg b
forall a. Sig -> Seg a -> Seg a
ConstLim Sig
dt (Seg b -> Seg b) -> Seg b -> Seg b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Seg a -> Seg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seg a
a
    Seq [Seg a]
as  -> [Seg b] -> Seg b
forall a. [Seg a] -> Seg a
Seq ([Seg b] -> Seg b) -> [Seg b] -> Seg b
forall a b. (a -> b) -> a -> b
$ (Seg a -> Seg b) -> [Seg a] -> [Seg b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Seg a -> Seg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Seg a]
as
    Par [Seg a]
as  -> [Seg b] -> Seg b
forall a. [Seg a] -> Seg a
Par ([Seg b] -> Seg b) -> [Seg b] -> Seg b
forall a b. (a -> b) -> a -> b
$ (Seg a -> Seg b) -> [Seg a] -> [Seg b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Seg a -> Seg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Seg a]
as
    Loop Seg a
a  -> Seg b -> Seg b
forall a. Seg a -> Seg a
Loop (Seg b -> Seg b) -> Seg b -> Seg b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Seg a -> Seg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seg a
a

instance SigSpace a => SigSpace (Seg a) where
  mapSig :: (Sig -> Sig) -> Seg a -> Seg a
mapSig Sig -> Sig
f Seg a
x = (a -> a) -> Seg a -> Seg a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f) Seg a
x

type instance DurOf (Seg a) = Tick

instance Sigs a => Melody (Seg a) where
  mel :: [Seg a] -> Seg a
mel = [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
sflow

instance Sigs a => Harmony (Seg a) where
  har :: [Seg a] -> Seg a
har = [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
spar

instance Sigs a => Compose (Seg a) where

instance Sigs a => Delay (Seg a) where
  del :: DurOf (Seg a) -> Seg a -> Seg a
del = DurOf (Seg a) -> Seg a -> Seg a
forall a. (Sigs a, Num a) => Tick -> Seg a -> Seg a
sdel

instance Sigs a => Loop (Seg a) where
  loop :: Seg a -> Seg a
loop = Seg a -> Seg a
forall a. Seg a -> Seg a
sloop

instance (Sigs a, Num a) => Rest (Seg a) where
  rest :: DurOf (Seg a) -> Seg a
rest = DurOf (Seg a) -> Seg a
forall a. Num a => Tick -> Seg a
srest

instance Sigs a => Limit (Seg a) where
  lim :: DurOf (Seg a) -> Seg a -> Seg a
lim = DurOf (Seg a) -> Seg a -> Seg a
forall a. Tick -> Seg a -> Seg a
slim

seq1 :: Tick -> a -> Seg a
seq1 :: Tick -> a -> Seg a
seq1 Tick
dt a
a = Tick -> Seg a -> Seg a
forall a. Tick -> Seg a -> Seg a
Lim Tick
dt (a -> Seg a
forall a. a -> Seg a
Unlim a
a)

-- | Converts signals to segments.
-- The segment is not limited in length.
toSeg :: a -> Seg a
toSeg :: a -> Seg a
toSeg a
a = a -> Seg a
forall a. a -> Seg a
Unlim a
a

-- | Limits the length of the segment with event stream.
slim :: Tick -> Seg a -> Seg a
slim :: Tick -> Seg a -> Seg a
slim Tick
da Seg a
x = case Seg a
x of
  Par [Seg a]
as   -> [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
Par ((Seg a -> Seg a) -> [Seg a] -> [Seg a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tick -> Seg a -> Seg a
forall a. Tick -> Seg a -> Seg a
slim Tick
da) [Seg a]
as)
  Seg a
_        -> Tick -> Seg a -> Seg a
forall a. Tick -> Seg a -> Seg a
Lim Tick
da Seg a
x

-- | Limits the length of the segment with constant length in seconds.
constLim :: Sig -> Seg a -> Seg a
constLim :: Sig -> Seg a -> Seg a
constLim Sig
da Seg a
x = case Seg a
x of
  Par [Seg a]
as   -> [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
Par ((Seg a -> Seg a) -> [Seg a] -> [Seg a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Seg a -> Seg a
forall a. Sig -> Seg a -> Seg a
constLim Sig
da) [Seg a]
as)
  Seg a
_        -> Sig -> Seg a -> Seg a
forall a. Sig -> Seg a -> Seg a
ConstLim Sig
da Seg a
x

-- | Plays the sequence of segments one ofter another.
sflow :: [Seg a] -> Seg a
sflow :: [Seg a] -> Seg a
sflow [Seg a]
as = [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
Seq ([Seg a] -> Seg a) -> [Seg a] -> Seg a
forall a b. (a -> b) -> a -> b
$ Seg a -> [Seg a]
forall a. Seg a -> [Seg a]
flatten (Seg a -> [Seg a]) -> [Seg a] -> [Seg a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Seg a]
as
  where
    flatten :: Seg a -> [Seg a]
flatten Seg a
x = case Seg a
x of
      Seq [Seg a]
xs -> [Seg a]
xs
      Seg a
_      -> [Seg a
x]

-- | Plays a list of segments at the same time.
-- the total length equals to the biggest length of all segments.
spar :: [Seg a] -> Seg a
spar :: [Seg a] -> Seg a
spar [Seg a]
as = [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
Par ([Seg a] -> Seg a) -> [Seg a] -> Seg a
forall a b. (a -> b) -> a -> b
$ Seg a -> [Seg a]
forall a. Seg a -> [Seg a]
flatten (Seg a -> [Seg a]) -> [Seg a] -> [Seg a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Seg a]
as
  where
    flatten :: Seg a -> [Seg a]
flatten Seg a
x = case Seg a
x of
      Par [Seg a]
xs -> [Seg a]
xs
      Seg a
_      -> [Seg a
x]

-- | Loops over a segment. The segment should be limited for loop to take effect.
sloop :: Seg a -> Seg a
sloop :: Seg a -> Seg a
sloop Seg a
x = case Seg a
x of
  Unlim a
a -> a -> Seg a
forall a. a -> Seg a
Unlim a
a
  Loop Seg a
a  -> Seg a -> Seg a
forall a. Seg a -> Seg a
Loop Seg a
a
  Par [Seg a]
as  -> [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
Par ((Seg a -> Seg a) -> [Seg a] -> [Seg a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seg a -> Seg a
forall a. Seg a -> Seg a
sloop [Seg a]
as)
  Seg a
_       -> Seg a -> Seg a
forall a. Seg a -> Seg a
Loop Seg a
x


-- | Limits a signal with an event stream and retriggers it after stop.
limSnd :: Sigs a => Tick -> a -> a
limSnd :: Tick -> a -> a
limSnd Tick
dt = Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg (Seg a -> a) -> (a -> Seg a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seg a -> Seg a
forall a. Seg a -> Seg a
sloop (Seg a -> Seg a) -> (a -> Seg a) -> a -> Seg a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tick -> Seg a -> Seg a
forall a. Tick -> Seg a -> Seg a
slim Tick
dt (Seg a -> Seg a) -> (a -> Seg a) -> a -> Seg a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Seg a
forall a. a -> Seg a
toSeg

------------------------------------------------

-- | Converts segments to signals.
runSeg :: (Sigs a) => Seg a -> a
runSeg :: Seg a -> a
runSeg Seg a
x = case Seg a
x of
  Unlim a
a -> a
a

  Lim Tick
dt (Unlim a
a) -> Tick -> a -> a
forall a. Sigs a => Tick -> a -> a
elim Tick
dt a
a
  Lim Tick
dt (Seq [Seg a]
as)  -> ([SE a] -> [Tick] -> a) -> ([SE a], [Tick]) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe Tick -> [SE a] -> [Tick] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Maybe Tick -> [SE a] -> [Tick] -> a
evtLoopOnce (Tick -> Maybe Tick
forall a. a -> Maybe a
Just Tick
dt)) ([Seg a] -> ([SE a], [Tick])
forall a. (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick])
getEvtAndSig ([Seg a] -> ([SE a], [Tick])) -> [Seg a] -> ([SE a], [Tick])
forall a b. (a -> b) -> a -> b
$ [Seg a] -> [Seg a]
forall a. [Seg a] -> [Seg a]
rmTailAfterUnlim [Seg a]
as)
  Lim Tick
dt (Loop (Seq [Seg a]
as)) -> ([SE a] -> [Tick] -> a) -> ([SE a], [Tick]) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe Tick -> [SE a] -> [Tick] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Maybe Tick -> [SE a] -> [Tick] -> a
evtLoop (Tick -> Maybe Tick
forall a. a -> Maybe a
Just Tick
dt)) ([Seg a] -> ([SE a], [Tick])
forall a. (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick])
getEvtAndSig ([Seg a] -> ([SE a], [Tick])) -> [Seg a] -> ([SE a], [Tick])
forall a b. (a -> b) -> a -> b
$ [Seg a] -> [Seg a]
forall a. [Seg a] -> [Seg a]
rmTailAfterUnlim [Seg a]
as)
  Lim Tick
dt (Loop Seg a
a) -> Tick -> a -> a
forall a. Sigs a => Tick -> a -> a
elim Tick
dt (Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg (Seg a -> Seg a
forall a. Seg a -> Seg a
Loop Seg a
a))
  Lim Tick
dt Seg a
a -> Tick -> a -> a
forall a. Sigs a => Tick -> a -> a
elim Tick
dt (Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg Seg a
a)


  ConstLim Sig
dt (Unlim a
a) -> Sig -> a -> a
forall a. Sigs a => Sig -> a -> a
takeSnd Sig
dt a
a
  ConstLim Sig
dt (Seq [Seg a]
as)  -> ([SE a] -> [Tick] -> a) -> ([SE a], [Tick]) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe Tick -> [SE a] -> [Tick] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Maybe Tick -> [SE a] -> [Tick] -> a
evtLoopOnce (Tick -> Maybe Tick
forall a. a -> Maybe a
Just (Tick -> Maybe Tick) -> Tick -> Maybe Tick
forall a b. (a -> b) -> a -> b
$ D -> Tick
impulseE (D -> Tick) -> D -> Tick
forall a b. (a -> b) -> a -> b
$ Sig -> D
ir Sig
dt)) ([Seg a] -> ([SE a], [Tick])
forall a. (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick])
getEvtAndSig ([Seg a] -> ([SE a], [Tick])) -> [Seg a] -> ([SE a], [Tick])
forall a b. (a -> b) -> a -> b
$ [Seg a] -> [Seg a]
forall a. [Seg a] -> [Seg a]
rmTailAfterUnlim [Seg a]
as)
  ConstLim Sig
dt (Loop (Seq [Seg a]
as)) -> ([SE a] -> [Tick] -> a) -> ([SE a], [Tick]) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe Tick -> [SE a] -> [Tick] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Maybe Tick -> [SE a] -> [Tick] -> a
evtLoop (Tick -> Maybe Tick
forall a. a -> Maybe a
Just (Tick -> Maybe Tick) -> Tick -> Maybe Tick
forall a b. (a -> b) -> a -> b
$ D -> Tick
impulseE (D -> Tick) -> D -> Tick
forall a b. (a -> b) -> a -> b
$ Sig -> D
ir Sig
dt)) ([Seg a] -> ([SE a], [Tick])
forall a. (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick])
getEvtAndSig ([Seg a] -> ([SE a], [Tick])) -> [Seg a] -> ([SE a], [Tick])
forall a b. (a -> b) -> a -> b
$ [Seg a] -> [Seg a]
forall a. [Seg a] -> [Seg a]
rmTailAfterUnlim [Seg a]
as)
  ConstLim Sig
dt (Loop Seg a
a) -> Sig -> a -> a
forall a. Sigs a => Sig -> a -> a
takeSnd Sig
dt (Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg (Seg a -> Seg a
forall a. Seg a -> Seg a
Loop Seg a
a))
  ConstLim Sig
dt Seg a
a -> Sig -> a -> a
forall a. Sigs a => Sig -> a -> a
takeSnd Sig
dt (Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg Seg a
a)

  Seq [Seg a]
as -> ([SE a] -> [Tick] -> a) -> ([SE a], [Tick]) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe Tick -> [SE a] -> [Tick] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Maybe Tick -> [SE a] -> [Tick] -> a
evtLoopOnce Maybe Tick
forall a. Maybe a
Nothing) ([Seg a] -> ([SE a], [Tick])
forall a. (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick])
getEvtAndSig ([Seg a] -> ([SE a], [Tick])) -> [Seg a] -> ([SE a], [Tick])
forall a b. (a -> b) -> a -> b
$ [Seg a] -> [Seg a]
forall a. [Seg a] -> [Seg a]
rmTailAfterUnlim [Seg a]
as)

  Loop (ConstLim Sig
dt Seg a
a) -> Sig -> a -> a
forall a. Sigs a => Sig -> a -> a
repeatSnd Sig
dt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg Seg a
a
  Loop (Lim Tick
dt Seg a
a)      -> Maybe Tick -> [SE a] -> [Tick] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Maybe Tick -> [SE a] -> [Tick] -> a
evtLoop Maybe Tick
forall a. Maybe a
Nothing [a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg Seg a
a] [Tick
dt]
  Loop (Seq [Seg a]
as)            -> ([SE a] -> [Tick] -> a) -> ([SE a], [Tick]) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe Tick -> [SE a] -> [Tick] -> a
forall a.
(Num a, Tuple a, Sigs a) =>
Maybe Tick -> [SE a] -> [Tick] -> a
evtLoop Maybe Tick
forall a. Maybe a
Nothing) ([Seg a] -> ([SE a], [Tick])
forall a. (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick])
getEvtAndSig [Seg a]
as)

  Par [Seg a]
as -> Maybe (Either Sig Tick) -> a -> a
forall a. (Num a, Sigs a) => Maybe (Either Sig Tick) -> a -> a
maybeElim (Seg a -> Maybe (Either Sig Tick)
forall a. Seg a -> Maybe (Either Sig Tick)
getDur Seg a
x) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (Seg a -> a) -> [Seg a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seg a
a -> Maybe (Either Sig Tick) -> a -> a
forall a. (Num a, Sigs a) => Maybe (Either Sig Tick) -> a -> a
maybeElim (Seg a -> Maybe (Either Sig Tick)
forall a. Seg a -> Maybe (Either Sig Tick)
getDur Seg a
a) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg Seg a
a) [Seg a]
as
  Loop (Unlim a
_) -> a
forall a. HasCallStack => a
undefined
  Loop (Par [Seg a]
_) -> a
forall a. HasCallStack => a
undefined
  Loop  (Loop Seg a
_) -> a
forall a. HasCallStack => a
undefined

getDur :: Seg a -> Maybe (Either Sig Tick)
getDur :: Seg a -> Maybe (Either Sig Tick)
getDur Seg a
x = case Seg a
x of
  Unlim a
_ -> Maybe (Either Sig Tick)
forall a. Maybe a
Nothing
  Loop  Seg a
_ -> Maybe (Either Sig Tick)
forall a. Maybe a
Nothing
  Lim Tick
dt Seg a
_ -> Either Sig Tick -> Maybe (Either Sig Tick)
forall a. a -> Maybe a
Just (Either Sig Tick -> Maybe (Either Sig Tick))
-> Either Sig Tick -> Maybe (Either Sig Tick)
forall a b. (a -> b) -> a -> b
$ Tick -> Either Sig Tick
forall a b. b -> Either a b
Right Tick
dt
  ConstLim Sig
dt Seg a
_ -> Either Sig Tick -> Maybe (Either Sig Tick)
forall a. a -> Maybe a
Just (Either Sig Tick -> Maybe (Either Sig Tick))
-> Either Sig Tick -> Maybe (Either Sig Tick)
forall a b. (a -> b) -> a -> b
$ Sig -> Either Sig Tick
forall a b. a -> Either a b
Left Sig
dt
  Seq [Seg a]
as -> ([Sig] -> Sig)
-> ([Tick] -> Tick) -> [Seg a] -> Maybe (Either Sig Tick)
forall (f :: * -> *) a b a.
(Functor f, Foldable f) =>
(f Sig -> a) -> (f Tick -> b) -> f (Seg a) -> Maybe (Either a b)
fromListT [Sig] -> Sig
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Tick] -> Tick
aftT' [Seg a]
as
  Par [Seg a]
as -> ([Sig] -> Sig)
-> ([Tick] -> Tick) -> [Seg a] -> Maybe (Either Sig Tick)
forall (f :: * -> *) a b a.
(Functor f, Foldable f) =>
(f Sig -> a) -> (f Tick -> b) -> f (Seg a) -> Maybe (Either a b)
fromListT ((Sig -> Sig -> Sig) -> [Sig] -> Sig
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Sig -> Sig -> Sig
forall a. (IfB a, OrdB a) => a -> a -> a
maxB) [Tick] -> Tick
simT' [Seg a]
as
  where
    fromListT :: (f Sig -> a) -> (f Tick -> b) -> f (Seg a) -> Maybe (Either a b)
fromListT f Sig -> a
g f Tick -> b
f f (Seg a)
as
      | (Maybe (Either Sig Tick) -> Bool)
-> f (Maybe (Either Sig Tick)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe (Either Sig Tick) -> Bool
forall a. Maybe a -> Bool
isJust f (Maybe (Either Sig Tick))
ds = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> Either a b -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ (f Sig -> a) -> (f Tick -> b) -> f (Either Sig Tick) -> Either a b
forall (f :: * -> *) a b.
(Functor f, Foldable f) =>
(f Sig -> a) -> (f Tick -> b) -> f (Either Sig Tick) -> Either a b
phi f Sig -> a
g f Tick -> b
f (f (Either Sig Tick) -> Either a b)
-> f (Either Sig Tick) -> Either a b
forall a b. (a -> b) -> a -> b
$ (Maybe (Either Sig Tick) -> Either Sig Tick)
-> f (Maybe (Either Sig Tick)) -> f (Either Sig Tick)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Either Sig Tick) -> Either Sig Tick
forall a. HasCallStack => Maybe a -> a
fromJust f (Maybe (Either Sig Tick))
ds
      | Bool
otherwise     = Maybe (Either a b)
forall a. Maybe a
Nothing
      where ds :: f (Maybe (Either Sig Tick))
ds = (Seg a -> Maybe (Either Sig Tick))
-> f (Seg a) -> f (Maybe (Either Sig Tick))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seg a -> Maybe (Either Sig Tick)
forall a. Seg a -> Maybe (Either Sig Tick)
getDur f (Seg a)
as

    phi :: (f Sig -> a) -> (f Tick -> b) -> f (Either Sig Tick) -> Either a b
phi f Sig -> a
g f Tick -> b
f f (Either Sig Tick)
xs
      | (Maybe Sig -> Bool) -> f (Maybe Sig) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Sig -> Bool
forall a. Maybe a -> Bool
isJust f (Maybe Sig)
as = a -> Either a b
forall a b. a -> Either a b
Left  (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ f Sig -> a
g (f Sig -> a) -> f Sig -> a
forall a b. (a -> b) -> a -> b
$ (Maybe Sig -> Sig) -> f (Maybe Sig) -> f Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Sig -> Sig
forall a. HasCallStack => Maybe a -> a
fromJust f (Maybe Sig)
as
      | Bool
otherwise     = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$ f Tick -> b
f (f Tick -> b) -> f Tick -> b
forall a b. (a -> b) -> a -> b
$ (Either Sig Tick -> Tick) -> f (Either Sig Tick) -> f Tick
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Sig Tick -> Tick
toEvt f (Either Sig Tick)
xs
      where as :: f (Maybe Sig)
as = (Either Sig Tick -> Maybe Sig)
-> f (Either Sig Tick) -> f (Maybe Sig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Sig Tick -> Maybe Sig
forall a b. Either a b -> Maybe a
getConstT f (Either Sig Tick)
xs

    getConstT :: Either a b -> Maybe a
getConstT = \case
      Left a
d -> a -> Maybe a
forall a. a -> Maybe a
Just a
d
      Either a b
_      -> Maybe a
forall a. Maybe a
Nothing

    toEvt :: Either Sig Tick -> Tick
toEvt = (Sig -> Tick) -> (Tick -> Tick) -> Either Sig Tick -> Tick
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (D -> Tick
impulseE (D -> Tick) -> (Sig -> D) -> Sig -> Tick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> D
ir) Tick -> Tick
forall a. a -> a
id

getEvtAndSig :: (Num a, Sigs a) => [Seg a] -> ([SE a], [Tick])
getEvtAndSig :: [Seg a] -> ([SE a], [Tick])
getEvtAndSig [Seg a]
as = [(SE a, Tick)] -> ([SE a], [Tick])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(SE a, Tick)] -> ([SE a], [Tick]))
-> [(SE a, Tick)] -> ([SE a], [Tick])
forall a b. (a -> b) -> a -> b
$ (Seg a -> (SE a, Tick)) -> [Seg a] -> [(SE a, Tick)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seg a
x -> (a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (Seg a -> a
forall a. Sigs a => Seg a -> a
runSeg Seg a
x), Maybe (Either Sig Tick) -> Tick
getTick (Maybe (Either Sig Tick) -> Tick)
-> Maybe (Either Sig Tick) -> Tick
forall a b. (a -> b) -> a -> b
$ Seg a -> Maybe (Either Sig Tick)
forall a. Seg a -> Maybe (Either Sig Tick)
getDur Seg a
x)) [Seg a]
as
  where getTick :: Maybe (Either Sig Tick) -> Tick
getTick = Tick
-> (Either Sig Tick -> Tick) -> Maybe (Either Sig Tick) -> Tick
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tick
forall a. Monoid a => a
mempty ((Sig -> Tick) -> (Tick -> Tick) -> Either Sig Tick -> Tick
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (D -> Tick
impulseE (D -> Tick) -> (Sig -> D) -> Sig -> Tick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> D
ir) Tick -> Tick
forall a. a -> a
id)


rmTailAfterUnlim :: [Seg a] -> [Seg a]
rmTailAfterUnlim :: [Seg a] -> [Seg a]
rmTailAfterUnlim = (Seg a -> Bool) -> [Seg a] -> [Seg a]
forall a. (a -> Bool) -> [a] -> [a]
takeByIncludeLast Seg a -> Bool
forall a. Seg a -> Bool
isUnlim
  where
    isUnlim :: Seg a -> Bool
isUnlim Seg a
x = case Seg a
x of
      Unlim a
_ -> Bool
True
      Loop  Seg a
_ -> Bool
True
      Par  [Seg a]
as -> (Seg a -> Bool) -> [Seg a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Seg a -> Bool
isUnlim [Seg a]
as
      Seg a
_       -> Bool
False

takeByIncludeLast :: (a -> Bool) -> [a] -> [a]
takeByIncludeLast :: (a -> Bool) -> [a] -> [a]
takeByIncludeLast a -> Bool
f [a]
xs = case [a]
xs of
  [] -> []
  a
a:[a]
as -> if a -> Bool
f a
a then [a
a] else a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeByIncludeLast a -> Bool
f [a]
as

-------------------------------------------------
-- aux

-- | A pause. Plays nothing until something happens on the event stream.
srest :: (Num a) => Tick -> Seg a
srest :: Tick -> Seg a
srest Tick
dt = Tick -> a -> Seg a
forall a. Tick -> a -> Seg a
seq1 Tick
dt a
0

-- | Delays a segment until something happens on the event stream.
sdel :: (Sigs a, Num a) => Tick -> Seg a -> Seg a
sdel :: Tick -> Seg a -> Seg a
sdel Tick
dt Seg a
a = [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
sflow [Tick -> Seg a
forall a. Num a => Tick -> Seg a
srest Tick
dt, Seg a
a]

-- | A pause. Plays nothing for the given time interval in seconds.
constRest :: Num a => Sig -> Seg a
constRest :: Sig -> Seg a
constRest Sig
dt = Sig -> Seg a -> Seg a
forall a. Sig -> Seg a -> Seg a
constLim Sig
dt (Seg a -> Seg a) -> Seg a -> Seg a
forall a b. (a -> b) -> a -> b
$ a -> Seg a
forall a. a -> Seg a
toSeg a
0

-- | Delays a segment by a given time interval in seconds.
constDel :: Num a => Sig -> Seg a -> Seg a
constDel :: Sig -> Seg a -> Seg a
constDel Sig
dt Seg a
a = [Seg a] -> Seg a
forall a. [Seg a] -> Seg a
sflow [Sig -> Seg a
forall a. Num a => Sig -> Seg a
constRest Sig
dt, Seg a
a]

-----------------------------------------------------------

elim :: Sigs a => Tick -> a -> a
elim :: Tick -> a -> a
elim Tick
dt a
asig = (Unit -> SE a) -> Tick -> Tick -> a
forall a b c. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> Evt c -> b
schedUntil (SE a -> Unit -> SE a
forall a b. a -> b -> a
const (SE a -> Unit -> SE a) -> SE a -> Unit -> SE a
forall a b. (a -> b) -> a -> b
$ a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SE a) -> a -> SE a
forall a b. (a -> b) -> a -> b
$ a
asig) (D -> Tick
impulseE D
0) Tick
dt

maybeElim :: (Num a, Sigs a) => Maybe (Either Sig Tick) -> a -> a
maybeElim :: Maybe (Either Sig Tick) -> a -> a
maybeElim Maybe (Either Sig Tick)
mdt a
a = case Maybe (Either Sig Tick)
mdt of
  Maybe (Either Sig Tick)
Nothing -> a
a
  Just Either Sig Tick
x  -> case Either Sig Tick
x of
    Left Sig
d  -> Sig -> a -> a
forall a. Sigs a => Sig -> a -> a
takeSnd Sig
d a
a
    Right Tick
t -> Tick -> a -> a
forall a. Sigs a => Tick -> a -> a
elim Tick
t a
a

-- | Takes the first event from the event stream and ignores the rest of the stream.
take1 :: Evt a -> Evt a
take1 :: Evt a -> Evt a
take1 = ((a, D) -> a) -> Evt (a, D) -> Evt a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, D) -> a
forall a b. (a, b) -> a
fst (Evt (a, D) -> Evt a) -> (Evt a -> Evt (a, D)) -> Evt a -> Evt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, D) -> BoolD) -> Evt (a, D) -> Evt (a, D)
forall a. (a -> BoolD) -> Evt a -> Evt a
filterE ((D -> D -> BoolD
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* D
0) (D -> BoolD) -> ((a, D) -> D) -> (a, D) -> BoolD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, D) -> D
forall a b. (a, b) -> b
snd) (Evt (a, D) -> Evt (a, D))
-> (Evt a -> Evt (a, D)) -> Evt a -> Evt (a, D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> (a -> D -> ((a, D), D)) -> Evt a -> Evt (a, D)
forall s a b. Tuple s => s -> (a -> s -> (b, s)) -> Evt a -> Evt b
accumE (D
0 :: D) (\a
a D
s -> ((a
a, D
s), D
s D -> D -> D
forall a. Num a => a -> a -> a
+ D
1) )

-----------------------------------------------------------
-- tick funs with less instrs

aftT' :: [Tick] -> Tick
aftT' :: [Tick] -> Tick
aftT' [Tick]
evts = Tick -> Tick
forall a. Evt a -> Evt a
take1 (Tick -> Tick) -> Tick -> Tick
forall a b. (a -> b) -> a -> b
$ Sig -> Tick
sigToEvt (Sig -> Tick) -> Sig -> Tick
forall a b. (a -> b) -> a -> b
$ Maybe Tick -> [SE Sig] -> [Tick] -> Sig
forall a.
(Num a, Tuple a, Sigs a) =>
Maybe Tick -> [SE a] -> [Tick] -> a
evtLoop Maybe Tick
forall a. Maybe a
Nothing [SE Sig]
asigs [Tick]
evts
  where
    asigs :: [SE Sig]
    asigs :: [SE Sig]
asigs = (D -> SE Sig) -> [D] -> [SE Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> SE Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig -> SE Sig) -> (D -> Sig) -> D -> SE Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> Sig
sig) ([D] -> [SE Sig]) -> [D] -> [SE Sig]
forall a b. (a -> b) -> a -> b
$ (Int -> D -> [D]
forall a. Int -> a -> [a]
replicate ([Tick] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tick]
evts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) D
0) [D] -> [D] -> [D]
forall a. [a] -> [a] -> [a]
++ [D
1]

simT' :: [Tick] -> Tick
simT' :: [Tick] -> Tick
simT' [Tick]
as = (Bam Unit -> SE ()) -> Tick
forall a. (Bam a -> SE ()) -> Evt a
Evt ((Bam Unit -> SE ()) -> Tick) -> (Bam Unit -> SE ()) -> Tick
forall a b. (a -> b) -> a -> b
$ \Bam Unit
bam -> do
  Ref D
isAwaitingRef <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
1 :: D)
  Ref D
countDownRef  <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (Int -> D
int ([Tick] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tick]
as) :: D)

  (Tick -> SE ()) -> [Tick] -> SE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ref D -> Tick -> SE ()
forall a a. (Tuple a, Num a) => Ref a -> Evt a -> SE ()
mkEvt Ref D
countDownRef) [Tick]
as

  D
countDown <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
countDownRef
  D
isAwaiting <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
isAwaitingRef
  BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
isAwaiting 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
countDown Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
0) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
    Bam Unit
bam Unit
unit
    Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
isAwaitingRef D
0
  where
    mkEvt :: Ref a -> Evt a -> SE ()
mkEvt Ref a
ref Evt a
e = do
      Ref D
notFiredRef <- D -> SE (Ref D)
forall a. Tuple a => a -> SE (Ref a)
newRef (D
1 :: D)
      D
notFired <- Ref D -> SE D
forall a. Tuple a => Ref a -> SE a
readRef Ref D
notFiredRef
      Evt a -> Bam a -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt a
e (Bam a -> SE ()) -> Bam a -> SE ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
        BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
notFired 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
          Ref D -> D -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref D
notFiredRef D
0
          Ref a -> (a -> a) -> SE ()
forall a. Tuple a => Ref a -> (a -> a) -> SE ()
modifyRef Ref a
ref (\a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
1)