-- |
-- Module      :  FRP.Yampa.Delays
-- Copyright   :  (c) Ivan Perez, 2014-2022
--                (c) George Giorgidze, 2007-2012
--                (c) Henrik Nilsson, 2005-2006
--                (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  ivan.perez@keera.co.uk
-- Stability   :  provisional
-- Portability :  non-portable (GHC extensions)
--
-- SF primitives and combinators to delay signals, introducing new values in
-- them.
module FRP.Yampa.Delays
    (
      -- * Basic delays
      pre
    , iPre
    , fby

      -- * Timed delays
    , delay
    )
  where

import Control.Arrow

import FRP.Yampa.Basic
import FRP.Yampa.Diagnostics
import FRP.Yampa.InternalCore (SF (..), SF' (..), Time)
import FRP.Yampa.Scan

infixr 0 `fby`

-- * Delays

-- | Uninitialized delay operator.
--
-- The output has an infinitesimal delay (1 sample), and the value at time
-- zero is undefined.
pre :: SF a a
pre :: forall a. SF a a
pre = forall c a b. (c -> a -> Maybe (c, b)) -> c -> b -> SF a b
sscanPrim forall {b} {a}. b -> a -> Maybe (a, b)
f forall {a}. a
uninit forall {a}. a
uninit
  where
    f :: b -> a -> Maybe (a, b)
f b
c a
a = forall a. a -> Maybe a
Just (a
a, b
c)
    uninit :: a
uninit = forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"pre" String
"Uninitialized pre operator."

-- | Initialized delay operator.
--
-- Creates an SF that delays the input signal, introducing an infinitesimal
-- delay (one sample), using the given argument to fill in the initial output
-- at time zero.

iPre :: a -> SF a a
iPre :: forall a. a -> SF a a
iPre = (forall b a. b -> SF a b -> SF a b
--> forall a. SF a a
pre)

-- | Lucid-Synchrone-like initialized delay (read "followed by").
--
-- Initialized delay combinator, introducing an infinitesimal delay (one
-- sample) in given 'SF', using the given argument to fill in the initial
-- output at time zero.
--
-- The difference with 'iPre' is that 'fby' takes an 'SF' as argument.
fby :: b -> SF a b -> SF a b
b
b0 fby :: forall b a. b -> SF a b -> SF a b
`fby` SF a b
sf = b
b0 forall b a. b -> SF a b -> SF a b
--> SF a b
sf forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. SF a a
pre

-- * Timed delays

-- | Delay a signal by a fixed time 't', using the second parameter
-- to fill in the initial 't' seconds.
delay :: Time -> a -> SF a a
delay :: forall a. Time -> a -> SF a a
delay Time
q a
a_init | Time
q forall a. Ord a => a -> a -> Bool
< Time
0     = forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"delay" String
"Negative delay."
               | Time
q forall a. Eq a => a -> a -> Bool
== Time
0    = forall a. SF a a
identity
               | Bool
otherwise = SF {sfTF :: a -> Transition a a
sfTF = a -> Transition a a
tf0}
  where
    tf0 :: a -> Transition a a
tf0 a
a0 = (forall {b}. [(Time, b)] -> [(Time, b)] -> Time -> b -> SF' b b
delayAux [] [(Time
q, a
a0)] Time
0 a
a_init, a
a_init)

    -- Invariants:
    -- t_diff measure the time since the latest output sample ideally
    -- should have been output. Whenever that equals or exceeds the
    -- time delta for the next buffered sample, it is time to output a
    -- new sample (although not necessarily the one first in the queue:
    -- it might be necessary to "catch up" by discarding samples.
    -- 0 <= t_diff < bdt, where bdt is the buffered time delta for the
    -- sample on the front of the buffer queue.
    --
    -- Sum of time deltas in the queue >= q.
    delayAux :: [(Time, b)] -> [(Time, b)] -> Time -> b -> SF' b b
delayAux [(Time, b)]
_ [] Time
_ b
_ = forall a. HasCallStack => a
undefined
    delayAux [(Time, b)]
rbuf buf :: [(Time, b)]
buf@((Time
bdt, b
ba) : [(Time, b)]
buf') Time
t_diff b
a_prev = forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' Time -> b -> (SF' b b, b)
tf -- True
      where
        tf :: Time -> b -> (SF' b b, b)
tf Time
dt b
a | Time
t_diff' forall a. Ord a => a -> a -> Bool
< Time
bdt =
                    ([(Time, b)] -> [(Time, b)] -> Time -> b -> SF' b b
delayAux [(Time, b)]
rbuf' [(Time, b)]
buf Time
t_diff' b
a_prev, b
a_prev)
                | Bool
otherwise = [(Time, b)] -> [(Time, b)] -> Time -> b -> (SF' b b, b)
nextSmpl [(Time, b)]
rbuf' [(Time, b)]
buf' (Time
t_diff' forall a. Num a => a -> a -> a
- Time
bdt) b
ba
          where
            t_diff' :: Time
t_diff' = Time
t_diff forall a. Num a => a -> a -> a
+ Time
dt
            rbuf' :: [(Time, b)]
rbuf'   = (Time
dt, b
a) forall a. a -> [a] -> [a]
: [(Time, b)]
rbuf

            nextSmpl :: [(Time, b)] -> [(Time, b)] -> Time -> b -> (SF' b b, b)
nextSmpl [(Time, b)]
rbuf [] Time
t_diff b
a =
              [(Time, b)] -> [(Time, b)] -> Time -> b -> (SF' b b, b)
nextSmpl [] (forall a. [a] -> [a]
reverse [(Time, b)]
rbuf) Time
t_diff b
a
            nextSmpl [(Time, b)]
rbuf buf :: [(Time, b)]
buf@((Time
bdt, b
ba) : [(Time, b)]
buf') Time
t_diff b
a
              | Time
t_diff forall a. Ord a => a -> a -> Bool
< Time
bdt = ([(Time, b)] -> [(Time, b)] -> Time -> b -> SF' b b
delayAux [(Time, b)]
rbuf [(Time, b)]
buf Time
t_diff b
a, b
a)
              | Bool
otherwise    = [(Time, b)] -> [(Time, b)] -> Time -> b -> (SF' b b, b)
nextSmpl [(Time, b)]
rbuf [(Time, b)]
buf' (Time
t_diffforall a. Num a => a -> a -> a
-Time
bdt) b
ba