WxGeneric-0.6.0: examples/AlarmSpecialized.hs

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses
  , TemplateHaskell, UndecidableInstances #-}

{- | The example shows two things.

1) How to specialize a widget. See instance WxGen Minutes.

2) Show that WxGeneric (and Composite) behaves nicely with respect to
   enabledness.  That is it remembers the enabledness of the
   minutes-widget, even if we disable/enbale of the hole generic
   widget. But of cause, 'minutes' is only enabled when both the hole
   generic widget is enbaled and when the minutes-widget itself is
   enabled.
-}
module AlarmSpecialized where

import Graphics.UI.WxGeneric
import Graphics.UI.SybWidget.MySYB

import Graphics.UI.WX
import Graphics.UI.WXCore

import Control.Monad

data Minutes = Minutes Int deriving (Show, Eq)
data Alarm = Alarm { name :: String
                   , timeOfDay :: Minutes
                   } deriving (Show, Eq)
$(derive [''Minutes,''Alarm])

instance WxGen Alarm

instance WxGen Minutes where
    mkWid m' = toOuter (valuedCompose helper)
        where helper genWidParms = 
                  do let p = getParent genWidParms
                     changeVar <- varCreate (return ())
                     
                     hours   <- hslider p True 0 23 [ selection := fst $ minutes2Clock m' ]
                     minutes <- hslider p True 0 59 [ selection := snd $ minutes2Clock m' ]
                     ableMinutes <- button p 
                                      [ text := "(Dis/En)able minutes"
                                      , on command := set minutes [ enabled :~ not ]
                                      ]
                     
                     let setChangeVar x = do set hours   [ on command := x ]
                                             set minutes [ on command := x ]
                         lay = column 5 [ grid 10 10 [ [ label "Hours: ", fill $ widget hours ]
                                                     , [ label "Minutes: ", fill $ widget minutes ]
                                                     ]
                                        , hfloatCenter $ widget ableMinutes
                                        ]
                         getVal = liftM2 clock2Minutes (get hours selection) (get minutes selection)
                         setVal ys = do let (h, m) = minutes2Clock ys
                                        set hours [selection := h]
                                        set minutes [selection := m]
                     return ( lay, getVal, setVal
                            , varGet changeVar, setChangeVar
                            , leafWidTree [WxWindow hours, WxWindow minutes]
                            )
              minutes2Clock (Minutes m) = (m `div` 60, m `mod` 60)
              clock2Minutes h m         = Minutes (60*h + m)

main :: IO ()
main = start $
       do f <- frame [ text := "Alarm Specialized Example" ]
          p <- panel f []
          en <- genericWidget p (Alarm "My alarm" $ Minutes 117)
          b <- button p [ text := "&Print alarm"
                        , on command := get en widgetValue >>= print ]
          ableAll <- button p 
                        [ text := "(Dis/En)able all"
                        , on command := set en [ enabled :~ not ]
                        ]
          let lay = row 10 [ fill $ widget en
                           , vfloatCenter $ column 10 [ widget b, widget ableAll ]
                           ]
          set f [ layout := container p lay 
                , size := Size 550 165 ]