binding-wx (empty) → 0.2
raw patch · 7 files changed
+182/−0 lines, 7 filesdep +basedep +binding-coredep +stmsetup-changed
Dependencies added: base, binding-core, stm, wx, wxcore
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- binding-wx.cabal +24/−0
- demo/in.txt +1/−0
- demo/lists.hs +29/−0
- demo/simple.hs +16/−0
- src/Graphics/UI/WX/Binding.hs +80/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Gideon Sireling + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Gideon Sireling nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ binding-wx.cabal view
@@ -0,0 +1,24 @@+name: binding-wx +version: 0.2 +cabal-version: >= 1.6 +license: BSD3 +license-file: LICENSE +author: Gideon Sireling +maintainer: haskell@accursoft.org +homepage: http://code.accursoft.com/binding +bug-reports: http://code.accursoft.com/binding/issues +synopsis: binding-core wrapper for WxHaskell +build-type: Simple +category: GUI, User Interfaces +extra-source-files: demo/simple.hs demo/lists.hs, demo/in.txt +description: Bind mutable data and lists to WxHaskell widgets. + Examples are provided by the included demo programs. + +library + build-depends: base <5, wxcore, wx, binding-core, stm + hs-source-dirs: src + exposed-modules: Graphics.UI.WX.Binding + +source-repository head + type: hg + location: https://bitbucket.org/accursoft/binding
+ demo/in.txt view
@@ -0,0 +1,1 @@+[Person {name = "Joe", age = 32, active = True},Person {name = "Fred", age = 50, active = False},Person {name = "Alice", age = 43, active = True}]
+ demo/lists.hs view
@@ -0,0 +1,29 @@+import Control.Monad +import Data.IORef +import Data.List +import Graphics.UI.WX + +import Data.Binding.List +import Graphics.UI.WX.Binding + +data Person = Person {name::String, age::Int, active::Bool} deriving (Read, Show) + +main = do --read the input + f <- readFile "in.txt" + bl <- toBindingList $ read f :: IO (BindingList IORef Person) + start $ do --create widgits + window <- frame [text := "Data Binding with WxHaskell"] + name' <- entry window [] + age' <- spinCtrl window 0 120 [] + active' <- checkBox window [] + --bind them + nav <- navigation window bl $ Person "" 0 False + bindControl bl name name' text (\p n -> p {name = n}) + bindControl bl (fromIntegral . age) age' selection (\p a -> p {age = a}) + bindControl bl active active' checked (\p a -> p {active = a}) + --arrange the widgits + let labels = map (floatRight . label) ["Name:", "Age:", "Active:"] + let widgets = map floatLeft [widget name', widget age', widget active'] + --start the application + set window [layout := column 10 [grid 10 10 $ transpose [labels, widgets], nav] + ,on closing := fromBindingList bl >>= \l -> writeFile "out.txt" (show l) >> propagateEvent]
+ demo/simple.hs view
@@ -0,0 +1,16 @@+import Data.IORef +import Graphics.UI.WX + +import Data.Binding.Simple +import Graphics.UI.WX.Binding + +main = start $ do --create widgits + window <- frame [text := "Data Binding with WxHaskell"] + text1 <- entry window [] + text2 <- entry window [] + --bind them + source <- newVar 0 :: IO (Source IORef Double) + bindTextual source text1 + bindTextual source text2 + --start the application + set window [layout := row 0 [widget text1, widget text2]]
+ src/Graphics/UI/WX/Binding.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE RankNTypes #-} +module Graphics.UI.WX.Binding where + +import Control.Monad +import Graphics.UI.WX +import Graphics.UI.WXCore + +import Data.Binding.List as B + +-- | Bind a 'Source' to a control. +bindToControl :: Bindable b => + b a -- ^ the binding source + -> (a -> d) -- ^ a function that extracts data from the source + -> c -- ^ the target control + -> Attr c d -- ^ the attribute of the control to bind to + -> IO () +bindToControl source extract control attribute = bind source extract control (\c d -> set c [attribute := d]) + +-- | Bind from a control to a 'Source'. +-- The source is updated when the control loses focus. +bindFromControl :: (Bindable b, Reactive c) => + c -- ^ the control + -> Attr c d -- ^ the attribute of the control to bind from + -> (a -> d -> a) -- ^ a function that applies data from the control to the source + -> b a -- ^ the binding source + -> 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] + +-- | Create a two-way data binding. +bindControl :: (Bindable b, Reactive c) => + b a -- ^ the binding source + -> (a -> d) -- ^ a function that extracts data from the source + -> c -- ^ the control + -> Attr c d -- ^ the attribute of the control to bind to + -> (a -> d -> a) -- ^ a function that applies data from the control to the source + -> IO () +bindControl source extract control attribute apply = do + bindToControl source extract control attribute + bindFromControl control attribute apply source + +-- | Create a simple two-way data binding for a 'Textual' control. +bindTextual :: (Show a, Read a, Bindable b, Textual c, Reactive c) => + b a -- ^ the binding source + -> c -- ^ the control + -> 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] + +-- | Create a set of navigation buttons for a binding list. +navigation :: Variable v => + Window w -- ^ the buttons' owner + -> BindingList v a -- ^ the binding list + -> a -- ^ the default value for inserts + -> 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] + + --disable the delete button when there's only one element + let del = last buttons + del `set` [on command :~ (>> do l <- B.length bl + del `set` [enabled := l > 1]) ] + + --inserting enables the delete button + (buttons !! 2) `set` [on command :~ (>> del `set` [enabled := True])] + + return $ row 0 $ widget spin : map widget buttons