-- |
-- Module      :  FRP.Yampa.Delays
-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003
-- 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,                -- :: SF a a
    iPre,               -- :: a -> SF a a
    fby,                -- :: b -> SF a b -> SF a b,    infixr 0

    -- * Timed delays
    delay,              -- :: Time -> a -> SF a a

) 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 :: 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
"AFRP" 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 :: 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 :: 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 :: Time -> a -> SF a a
delay Time
q a
a_init | 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
"AFRP" 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 :: forall a b. (a -> Transition a b) -> SF a b
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
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
_ = SF' b 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 = (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
t_diff' 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
t_diff' b
a_prev, b
a_prev)
                        | Bool
otherwise = [(Time, b)] -> [(Time, b)] -> Time -> b -> Transition b b
nextSmpl [(Time, b)]
rbuf' [(Time, b)]
buf' (Time
t_diff' Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
bdt) b
ba
                    where
                        t_diff' :: Time
t_diff' = Time
t_diff 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
t_diff 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
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 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
t_diff b
a, b
a)
                            | Bool
otherwise    = [(Time, b)] -> [(Time, b)] -> Time -> b -> Transition b b
nextSmpl [(Time, b)]
rbuf [(Time, b)]
buf' (Time
t_diffTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
bdt) b
ba

-- Vim modeline
-- vim:set tabstop=8 expandtab: