module Graphics.UI.Gtk.Binding where
import Control.Monad
import Control.Monad.Trans
import Graphics.UI.Gtk
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 :: (WidgetClass c, Bindable b) =>
c
-> Attr c d
-> (a -> d -> a)
-> b a
-> IO (ConnectId c)
bindFromControl control attribute apply source =
control `on` focusOutEvent $ liftIO $ do d <- get control attribute
a <- readVar source
writeVar source (apply a d)
return False
bindControl :: (WidgetClass c, Bindable b) =>
b a
-> (a -> d)
-> c
-> Attr c d
-> (a -> d -> a)
-> IO (ConnectId c)
bindControl source extract control attribute apply = do
bindToControl source extract control attribute
bindFromControl control attribute apply source
bindTextEntry :: (Show a, Read a, EntryClass c, WidgetClass c, Bindable b) =>
b a
-> c
-> IO (ConnectId c)
bindTextEntry source control = do
bindToControl source show control entryText
control `on` focusOutEvent $ liftIO $ do d <- get control entryText
writeVar source (read d)
return False
navigation :: Variable v =>
BindingList v a
-> a
-> IO HButtonBox
navigation bl new = do spin <- spinButtonNewWithRange 0 1 1
let setRange = B.length bl >>= spinButtonSetRange spin 0 . fromIntegral . pred
setRange
afterValueSpinned spin $ spinButtonGetValueAsInt spin >>= seek bl >> return ()
buttons <- forM [("<<", spinButtonSetValue spin 0)
,(">>", spinButtonSpin spin SpinEnd 0)
,("+", insert bl new >>= spinButtonSetValue spin . fromIntegral >> setRange)
,("-", B.remove bl >>= spinButtonSetValue spin . fromIntegral >> setRange)]
$ \(l,c) -> do b <- buttonNewWithLabel l
on b buttonActivated c
return b
let del = last buttons
del `on` buttonActivated $ do l <- B.length bl
del `set` [widgetSensitive := l > 1]
(buttons !! 2) `on` buttonActivated $ del `set` [widgetSensitive := True]
box <- hButtonBoxNew
containerAdd box spin
mapM_ (containerAdd box) buttons
return box