module Reactive.Banana.WX (
event1, event0, behavior,
Prop'(..), sink,
module Reactive.Banana.Frameworks,
eventText, behaviorText, eventSelection,
event1ToAddHandler, event0ToEvent1,
) where
import Reactive.Banana
import Reactive.Banana.Frameworks
import qualified Graphics.UI.WX as WX
import Graphics.UI.WX hiding (Event, Attr)
import qualified Graphics.UI.WXCore as WXCore
event1 :: Frameworks t =>
w -> WX.Event w (a -> IO ()) -> Moment t (Event t a)
event1 widget e = do
addHandler <- liftIO $ event1ToAddHandler widget e
fromAddHandler addHandler
event0 :: Frameworks t =>
w -> WX.Event w (IO ()) -> Moment t (Event t ())
event0 widget = event1 widget . event0ToEvent1
behavior :: Frameworks t =>
w -> WX.Attr w a -> Moment t (Behavior t a)
behavior widget attr = fromPoll $ get widget attr
data Prop' t w = forall a. (WX.Attr w a) :== Behavior t a
infixr 0 :==
sink :: Frameworks t =>
w -> [Prop' t w] -> Moment t ()
sink widget = mapM_ sink1
where
sink1 (attr :== b) = do
x <- initial b
liftIOLater $ set widget [attr := x]
e <- changes b
reactimate' $ (fmap $ \x -> set widget [attr := x]) <$> e
eventText :: Frameworks t =>
TextCtrl w -> Moment t (Event t String)
eventText w = do
addHandler <- liftIO $ event1ToAddHandler w (event0ToEvent1 onText)
fromAddHandler
$ filterIO (const $ WXCore.textCtrlIsModified w)
$ mapIO (const $ get w text) addHandler
onText :: WX.Event (WXCore.Control a) (IO ())
onText = WX.newEvent "onText" WXCore.controlGetOnText WXCore.controlOnText
behaviorText :: Frameworks t =>
TextCtrl w -> String -> Moment t (Behavior t String)
behaviorText w s = stepper s <$> eventText w
eventSelection :: Frameworks t =>
SingleListBox b -> Moment t (Event t Int)
eventSelection w = do
liftIO $ fixSelectionEvent w
addHandler <- liftIO $ event1ToAddHandler w (event0ToEvent1 select)
fromAddHandler $ mapIO (const $ get w selection) addHandler
fixSelectionEvent :: (Selecting w, Reactive w, Selection w) => w -> IO ()
fixSelectionEvent listbox =
set listbox [ on unclick := handler ]
where
handler _ = do
propagateEvent
s <- get listbox selection
when (s == 1) $ get listbox (on select) >>= id
event1ToAddHandler :: w -> WX.Event w (a -> IO ()) -> IO (AddHandler a)
event1ToAddHandler widget e = do
(addHandler, runHandlers) <- newAddHandler
set widget [on e :~ \h x -> h x >> runHandlers x]
return addHandler
event0ToEvent1 :: WX.Event w (IO ()) -> WX.Event w (() -> IO ())
event0ToEvent1 = mapEvent const (\_ e -> e ())