-- |
-- 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

-- External imports
import Control.Arrow ((>>>))

-- Internal imports
import FRP.Yampa.Basic        (identity, (-->))
import FRP.Yampa.Diagnostics  (usrErr)
import FRP.Yampa.InternalCore (SF (..), SF' (..), Time)
import FRP.Yampa.Scan         (sscanPrim)

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 = (a -> a -> Maybe (a, a)) -> a -> a -> SF a a
forall c a b. (c -> a -> Maybe (c, b)) -> c -> b -> SF a b
sscanPrim a -> a -> Maybe (a, a)
forall {b} {a}. b -> a -> Maybe (a, b)
f a
forall {a}. a
uninit a
forall {a}. a
uninit
  where
    f :: b -> a -> Maybe (a, b)
f b
c a
a = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
c)
    uninit :: a
uninit = String -> String -> String -> a
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 = (a -> SF a a -> SF a a
forall b a. b -> SF a b -> SF a b
--> SF a a
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 b -> SF a b -> SF a b
forall b a. b -> SF a b -> SF a b
--> SF a b
sf SF a b -> SF b b -> SF a b
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SF b b
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
aInit | Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0     = String -> String -> String -> SF a a
forall a. String -> String -> String -> a
usrErr String
"Yampa" String
"delay" String
"Negative delay."
              | Time
q Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
0    = SF a a
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 = ([(Time, a)] -> [(Time, a)] -> Time -> a -> SF' a a
forall {b}. [(Time, b)] -> [(Time, b)] -> Time -> b -> SF' b b
delayAux [] [(Time
q, a
a0)] Time
0 a
aInit, a
aInit)

    -- Invariants:
    -- tDiff 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 <= tDiff < 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
_ = SF' b b
forall a. HasCallStack => a
undefined
    delayAux [(Time, b)]
rbuf buf :: [(Time, b)]
buf@((Time
bdt, b
ba) : [(Time, b)]
buf') Time
tDiff b
aPrev = (Time -> b -> Transition b b) -> SF' b b
forall a b. (Time -> a -> Transition a b) -> SF' a b
SF' Time -> b -> Transition b b
tf -- True
      where
        tf :: Time -> b -> Transition b b
tf Time
dt b
a | Time
tDiff' Time -> Time -> Bool
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
tDiff' b
aPrev, b
aPrev)
                | Bool
otherwise    = [(Time, b)] -> [(Time, b)] -> Time -> b -> Transition b b
nextSmpl [(Time, b)]
rbuf' [(Time, b)]
buf' (Time
tDiff' Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
bdt) b
ba
          where
            tDiff' :: Time
tDiff' = Time
tDiff Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dt
            rbuf' :: [(Time, b)]
rbuf'  = (Time
dt, b
a) (Time, b) -> [(Time, b)] -> [(Time, b)]
forall a. a -> [a] -> [a]
: [(Time, b)]
rbuf

            nextSmpl :: [(Time, b)] -> [(Time, b)] -> Time -> b -> Transition b b
nextSmpl [(Time, b)]
rbuf [] Time
tDiff b
a =
              [(Time, b)] -> [(Time, b)] -> Time -> b -> Transition b b
nextSmpl [] ([(Time, b)] -> [(Time, b)]
forall a. [a] -> [a]
reverse [(Time, b)]
rbuf) Time
tDiff b
a
            nextSmpl [(Time, b)]
rbuf buf :: [(Time, b)]
buf@((Time
bdt, b
ba) : [(Time, b)]
buf') Time
tDiff b
a
              | Time
tDiff Time -> Time -> Bool
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
tDiff b
a, b
a)
              | Bool
otherwise   = [(Time, b)] -> [(Time, b)] -> Time -> b -> Transition b b
nextSmpl [(Time, b)]
rbuf [(Time, b)]
buf' (Time
tDiff Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
bdt) b
ba