WxGeneric-0.2.0: examples/AlarmSpecialized.hs

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

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 p = 
                  do changeVar <- varCreate (return ())
                     
                     hours   <- hslider p True 0 23 [ selection := fst $ minutes2Clock m' ]
                     minutes <- hslider p True 0 23 [ selection := snd $ minutes2Clock m' ]
                     
                     let setChangeVar x = do set hours   [ on command := x ]
                                             set minutes [ on command := x ]
                         lay = grid 10 10 [ [ label "Hours: ", fill $ widget hours ]
                                          , [ label "Minutes: ", fill $ widget minutes ] ]
                         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
                            )
              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 ]
          set f [ layout := container p $ row 10 [ fill $ widget en, widget b ]
                , size := Size 550 165 ]