Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
reactive-banana throttling events
{-----------------------------------------------------------------------------
------------------------------------------------------------------------------}
{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"
import Graphics.UI.WX hiding (Event)
import Reactive.Banana
import Reactive.Banana.WX
{-----------------------------------------------------------------------------
Main
------------------------------------------------------------------------------}
data ThrottledValue a = FireStoredValue a | FireNowAndStartTimer a| HoldIt a | Stopped deriving Show
data ThrottledEvent a = TimerEvent | RealEvent a deriving Show
main :: IO ()
main = start $ do
f <- frame [text := "Countercesss"]
sl1 <- hslider f False 0 100 []
sl2 <- hslider f False 0 100 []
set f [ layout := column 0 [widget sl1, widget sl2] ]
t <- timer f []
set t [ enabled := False ]
let networkDescription :: forall t. NetworkDescription t ()
networkDescription = do
slEv <- event0 sl1 command
tick <- event0 t command
slB <- behavior sl1 selection
throttledEv <- throttle (slB <@ slEv) tick t 100
reactimate $ fmap (\x -> set sl2 [selection := x]) throttledEv
net <- compile networkDescription
actuate net
throttle::Event t a -> Event t () -> Timer -> Int -> NetworkDescription t (Event t a)
throttle ev tick timer dt = do
reactimate $ filterJust $ fmap stop result
reactimate $ filterJust $ fmap start result
return throttledEv
where
all = fmap RealEvent ev `union` fmap (const TimerEvent) tick
result = accumE Stopped $ fmap h all
where
h (RealEvent x) Stopped = FireNowAndStartTimer x
h TimerEvent Stopped = Stopped
h (RealEvent x) (FireNowAndStartTimer _) = HoldIt x
h TimerEvent (FireNowAndStartTimer _) = Stopped
h (RealEvent x) (HoldIt _) = HoldIt x
h (TimerEvent) (HoldIt y) = FireStoredValue y
h (RealEvent x) (FireStoredValue _) = HoldIt x
h (TimerEvent) (FireStoredValue _) = Stopped
start (FireStoredValue _) = Just $ resetTimer timer dt
start (FireNowAndStartTimer _) = Just $ resetTimer timer dt
start _ = Nothing
stop Stopped = Just $ stopTimer timer
stop _ = Nothing
filterFired (FireStoredValue a) = Just a
filterFired (FireNowAndStartTimer a) = Just a
filterFired _ = Nothing
throttledEv = filterJust $ fmap filterFired result
startTimer :: Timer -> Int -> IO ()
startTimer t dt = set t [ enabled := True, interval := dt ]
stopTimer :: Timer -> IO ()
stopTimer t = set t [ enabled := False ]
resetTimer t dt = stopTimer t >> startTimer t dt
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.