module Graphics.UI.WX.Binding where
import Control.Monad
import Graphics.UI.WX
import Graphics.UI.WXCore
import Data.Binding.List as B
bindToControl :: Bindable b =>
b a
-> (a -> d)
-> c
-> Attr c d
-> IO ()
bindToControl source extract control attribute = bind source extract control (\c d -> set c [attribute := d])
bindFromControl :: (Bindable b, Reactive c) =>
c
-> Attr c d
-> (a -> d -> a)
-> b a
-> IO ()
bindFromControl control attribute apply source =
set control [on focus := \f -> unless f $ do d <- get control attribute
a <- readVar source
writeVar source (apply a d)
propagateEvent]
bindControl :: (Bindable b, Reactive c) =>
b a
-> (a -> d)
-> c
-> Attr c d
-> (a -> d -> a)
-> IO ()
bindControl source extract control attribute apply = do
bindToControl source extract control attribute
bindFromControl control attribute apply source
bindTextual :: (Show a, Read a, Bindable b, Textual c, Reactive c) =>
b a
-> c
-> IO ()
bindTextual source control = do
bindToControl source show control text
set control [on focus := \f -> unless f $ do d <- get control text
writeVar source (read d)
propagateEvent]
navigation :: Variable v =>
Window w
-> BindingList v a
-> a
-> IO Layout
navigation owner bl new = do spin <- spinCtrl owner 0 1 [on select ::= \s -> get s selection >>= seek bl >> return ()]
let setRange = B.length bl >>= spinCtrlSetRange spin 0 . pred
setRange
let go i = spin `set` [selection := i] >> seek bl i
buttons <- forM [("<<", go 0 >> return ())
,(">>", B.length bl >>= go . pred >> return ())
,("+", insert bl new >>= go >> setRange)
,("-", remove bl >>= go >> setRange)]
$ \(t,c) -> button owner [text := t, on command := c]
let del = last buttons
del `set` [on command :~ (>> do l <- B.length bl
del `set` [enabled := l > 1]) ]
(buttons !! 2) `set` [on command :~ (>> del `set` [enabled := True])]
return $ row 0 $ widget spin : map widget buttons