diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Ivan Perez + +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 Ivan Perez 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Calc.hs b/examples/Calc.hs new file mode 100644 --- /dev/null +++ b/examples/Calc.hs @@ -0,0 +1,37 @@ +module Main where + +import Control.Applicative +import Control.Concurrent +import Control.Concurrent.MVar +import Control.GFunctor +import Data.ReactiveValue +import Graphics.UI.WX as WX +import Graphics.UI.WXCore as WXCore +import Graphics.UI.WX.Reactive + +main :: IO () +main = start $ do + -- View + f <- frameLoadRes "test.xrc" "frame_1" [] + + -- Entry text + txtT <- entryText =<< textCtrlRes f "text_ctrl_1" [] + nBtns <- mapM (\x -> buttonRes f ("btn" ++ show x) [] >>= buttonClick) [0..9] + btnDot <- buttonClick =<< buttonRes f "btnDot" [] + + -- Controller + + -- Numbers + let addX :: String -> ReactiveFieldWrite IO () + addX x = modRW (\s _ -> s ++ x) txtT + mapM_ (\(b,n) -> b =:> addX n -- Rule + ) $ zip nBtns $ map show [0..9] + + -- Dot + let addDot :: ReactiveFieldWrite IO () + addDot = modRW (\s () -> if '.' `elem` s then s else s ++ ".") txtT + btnDot =:> addDot + + windowShow f + return () + diff --git a/examples/Minimal.hs b/examples/Minimal.hs new file mode 100644 --- /dev/null +++ b/examples/Minimal.hs @@ -0,0 +1,28 @@ +module Main where + +import Control.Applicative +import Control.Concurrent +import Control.Concurrent.MVar +import Control.GFunctor +import Data.ReactiveValue +import Graphics.UI.WX as WX +import Graphics.UI.WXCore as WXCore +import Graphics.UI.WX.Reactive + +main :: IO () +main = start $ do + -- View + f <- frame [text := "Hello!"] + btn <- button f [text := "Quit"] + txt1 <- entry f [text := ""] + txt2 <- entry f [text := ""] + txt1T <- entryText txt1 + txt2T <- entryText txt2 + btnC <- buttonClick btn + set f [layout := margin 20 $ + floatCentre $ + column 3 [widget txt1, widget txt2, widget btn]] + + -- Controller + (involution reverse <$$> txt1T) =:= txt2T + btnC =:> modRW (\x -> x ++ "a") txt2T diff --git a/examples/calc.wxg b/examples/calc.wxg new file mode 100644 --- /dev/null +++ b/examples/calc.wxg @@ -0,0 +1,169 @@ + + + + + + + frame_1 + + wxVERTICAL + + 0 + + + + + + wxEXPAND + 0 + + + 0 + 4 + 5 + 0 + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + 0 + + + + + + + + + + diff --git a/examples/test.xrc b/examples/test.xrc new file mode 100644 --- /dev/null +++ b/examples/test.xrc @@ -0,0 +1,126 @@ + + + + + + + frame_1 + + wxVERTICAL + + + + + + + wxEXPAND + + 0 + 4 + 5 + 0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/keera-hails-reactive-wx.cabal b/keera-hails-reactive-wx.cabal new file mode 100644 --- /dev/null +++ b/keera-hails-reactive-wx.cabal @@ -0,0 +1,65 @@ +-- hails.cabal auto-generated by cabal init. For additional options, +-- see +-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. +-- The name of the package. +Name: keera-hails-reactive-wx + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.0.3.3 + +-- A short (one-line) description of the package. +Synopsis: Haskell on Rails - Reactive Fields for WX widgets + +-- A longer description of the package. +Description: This package contains (incomplete) bindings to WX widget properties, + turning them into Reactive Values that can be combined with and + connected to others with Reactive Rules. + +-- URL for the project homepage or repository. +Homepage: http://www.keera.es/blog/community/ + +-- The license under which the package is released. +License: BSD3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: Ivan Perez + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: ivan.perez@keera.es + +-- A copyright notice. +-- Copyright: + +Category: Development + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +Extra-source-files: + examples/*.hs + examples/*.wxg + examples/*.xrc + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + +Library + hs-source-dirs: src/ + + ghc-options: -Wall -fno-warn-unused-do-bind + + -- Modules exported by the library. + Exposed-modules: Graphics.UI.WX.Reactive + + -- Packages needed in order to build this package. + Build-depends: base >= 4 && < 5 + , wxcore + , wx + , keera-hails-reactivevalues diff --git a/src/Graphics/UI/WX/Reactive.hs b/src/Graphics/UI/WX/Reactive.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/WX/Reactive.hs @@ -0,0 +1,42 @@ +module Graphics.UI.WX.Reactive where + +import Control.Concurrent +import Data.ReactiveValue +import Graphics.UI.WX as WX +import Graphics.UI.WXCore as WXCore + +buttonClick :: Button () -> IO (ReactiveFieldRead IO ()) +buttonClick btn = do + notifiers <- newMVar [] + set btn [ on command := readMVar notifiers >>= sequence_ ] + let getter = return () + notifier p = modifyMVar_ notifiers (\x -> return (x ++ [p])) + return $ ReactiveFieldRead getter notifier + +entryText :: TextCtrl () -> IO (ReactiveFieldReadWrite IO String) +entryText entry = do + notifiers <- notifiersNew + + set entry [ on onText :~ \kbd -> kbd >> runNotifiers notifiers ] + + let getter = get entry text + setter v = do t <- get entry text + when (t /= v) $ do set entry [ text := v ] + runNotifiers notifiers + notifier = addNotifier notifiers + return $ ReactiveFieldReadWrite setter getter notifier + +-- Literally taken from Reactive Banana +onText :: WX.Event (WXCore.Control a) (IO ()) +onText = WX.newEvent "onText" WXCore.controlGetOnText WXCore.controlOnText + +type Notifiers = MVar [IO ()] + +notifiersNew :: IO Notifiers +notifiersNew = newMVar [] + +runNotifiers :: Notifiers -> IO() +runNotifiers ntfs = readMVar ntfs >>= sequence_ + +addNotifier :: Notifiers -> IO () -> IO() +addNotifier ntfs p = modifyMVar_ ntfs (\x -> return (x ++ [p]))