Browse files

Fix constructors for EB

Init events must be added to it. Otherwise it wouldn't properly initialize
  • Loading branch information...
1 parent 3600511 commit 41a6533c7cf7f9eb8f2d72ee41b08cb02773d4b6 @Shimuuar committed Sep 22, 2012
Showing with 18 additions and 2 deletions.
  1. +2 −2 Reactive/Banana/Extra.hs
  2. +2 −0 UI/TclTk.hs
  3. +14 −0 UI/TclTk/Builder.hs
View
4 Reactive/Banana/Extra.hs
@@ -36,14 +36,14 @@ scanE2 fb fc a0 eb ec = scanE go a0 $ joinE ec eb
go a (Left c) = fc a c
+
----------------------------------------------------------------
--- Zips
+-- EB
----------------------------------------------------------------
-- | Event and its corresponding behaviour.
data EB t a = EB (Event t a) (Behavior t a)
-
instance Functor (EB t) where
fmap f (EB e b) = EB (fmap f e) (fmap f b)
View
2 UI/TclTk.hs
@@ -40,6 +40,8 @@ module UI.TclTk (
, closure
, initEvent
, addTclEvent
+ , pureEB
+ , eventEB
, actimateTcl
, actimateTclB
, actimateIO
View
14 UI/TclTk/Builder.hs
@@ -27,6 +27,8 @@ module UI.TclTk.Builder (
, addTclEvent
, initEvent
, eventChanges
+ , pureEB
+ , eventEB
-- ** Actimate events
, actimateTcl
, actimateTclB
@@ -249,6 +251,18 @@ eventChanges bhv = do
return $ (bhv <@ initEvt) `union` evt
+pureEB :: a -> GUI t p (EB t a)
+pureEB x = do
+ e <- initEvent
+ let bhv = pure x
+ return $ EB (bhv <@ e) bhv
+
+eventEB :: a -> Event t a -> GUI t p (EB t a)
+eventEB x0 evt = do
+ e <- initEvent
+ let bhv = stepper x0 evt
+ return $ EB ((bhv <@ e) `union` evt) bhv
+
-- | Send Tcl commands in responce to event which changes GUI state.
--

0 comments on commit 41a6533

Please sign in to comment.