AllEventsComposite.hs

{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
{-# OPTIONS -Wall #-}

module AllEventsComposite where

import Graphics.UI.WX
import Graphics.UI.WxGeneric.Composite

type AllEventsComposite = Composite (ComboBox (), TextCtrl ())

-- | Composite, which consists of a comboBox and a text-entry.
-- All events from the comboBox are propagated, none from the text-entry.
--
allEventsComposite :: Window w -> [Prop AllEventsComposite] -> IO AllEventsComposite
allEventsComposite = compose $ \p ->
    do intEn <- textEntry p [ processEnter := True
                            , on anyKey := handleInput
                            , text := "0"
                            ]
       ch <- comboBox p [ items := [ "One", "Two", "Three" ]
                        , selection := 0
                        ]
       propagate allEvents ch p
       return (column 10 [ widget intEn, glue, widget ch ], (ch, intEn))
    where
      handleInput (KeyChar c) =
          do if c `elem` ['0'..'9']
                then propagateEvent
                else return ()
      handleInput _ = propagateEvent

instance Commanding AllEventsComposite where
    command = mapEventF (snd . pickUser) command



{- Valued integer entry

type IntEntry = Composite () (IO Int, Int -> IO ())

-- | Entry for integers
intEntry :: Window w -> [Prop IntEntry] -> IO IntEntry
intEntry = compose $ \p ->
    do intEn <- textEntry p [ processEnter := True
                            , on anyKey := handleInput
                            , text := "0"
                            ]
       let getter = do val <- get intEn text
                       readIO val
           setter x = set intEn [ text := show x ]
       return (widget intEn, (), (getter, setter))
    where
      handleInput (KeyChar c) =
          do if c `elem` ['0'..'9']
                then propagateEvent
                else return ()
      handleInput _ = propagateEvent


instance ValuedWidget Int IntEntry where
    widgetValue = newAttr "Int attribute" getter setter
        where getter composite = fst (pickUser composite)
              setter composite = snd (pickUser composite)

-}