module FRP.Yampa.Delays
(
pre
, iPre
, fby
, 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`
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."
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)
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
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)
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
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