WxEmbedded.hs

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

module WxEmbedded where

import Graphics.UI.WX
import Graphics.UI.AF.AFWx as AF   -- cannot do qualified as `derive` then complains


data Counter = Counter Int     deriving (Show, Eq)
$(derive [''Counter])

-- Should not be neccesary, but GHC 6.6 requires it. Remove when we stop support for GHC 6.6.
instance ECCreator Counter

main :: IO ()
main = start $
    do w <- frame [text := "Counter"]
       p <- panel w []
       
       wid <- AF.makeWidget (Counter 117) p []
       upButton            <- button p [ text := "Up", enabled := True
                                       , on command := set wid [ value :~ \(Counter val) -> Counter $ val + 1 ]
                                       ]
       downButton          <- button p [ text := "Down", enabled := True
                                       , on command := set wid [ value :~ \(Counter val) -> Counter $ val - 1 ]
                                       ]
       restoreButton       <- button p [ text := "Restore", enabled := True
                                       , on command := set wid [ value := Counter 117 ]
                                       ]
       disableButton       <- button p [ text := "Disable", enabled := True
                                       , on command := set wid [ enabled := False ]
                                       ]
       enableButton        <- button p [ text := "Enable", enabled := True
                                       , on command := set wid [ enabled := True ]
                                       ]
       set wid [ on command := do val <- get wid value
                                  putStr $ "Direct input by user: " ++ show val ++ "\n"
                 ]
       
       set p [ layout := column 10 [ widget wid
                                   , row 5 [glue, widget upButton, widget downButton]
                                   , row 5 [glue, widget restoreButton]
                                   , row 5 [glue, widget disableButton, widget enableButton]
                                   ]
             ]
       set w [ layout := fill $ widget p ]