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 :: 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."
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)
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
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)
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
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