WxGeneric-0.6.0: examples/Examples.hs

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

-- Why is UndecidableInstances neccesary? as derive requires it. 
-- Otherwise we get "Constraint is no smaller than the instance head"-error.
-- This is a general problem with using SYB.

module Examples where

import Graphics.UI.WxGeneric

import Graphics.UI.XTC
import Graphics.UI.WX
import Graphics.UI.WXCore
import Graphics.UI.SybWidget.PriLabel

import Graphics.UI.SybWidget.MySYB

data MyTree = Branch { left :: MyTree, right :: MyTree }
            | Leaf Int Double
              deriving Show

$(derive [''MyTree])
instance WxGen MyTree

data Age = Age { unAge :: Int } deriving Show
data Person = Person { name :: String, age :: Age, children :: [Person] } deriving Show

aPerson :: Person
aPerson = Person "Bob" (Age 17) []

$(derive [''Person,''Age])
instance WxGen Person
instance WxGen Age where
    mkWid x = mapValue Age (const unAge) $
              setOuterLabel (userDefinedLabel "Line one\nLine two\nLine Three") $
              mkWid (unAge x)

main :: IO ()
main = setOuterLabelTest

someTree :: MyTree
someTree = Leaf 5 5.2

someInt :: Int
someInt = 17

tree :: IO ()
tree = start $
       do f <- frame []
          p <- panel f []
          en <- genericWidget p someTree
          set en [ on change := get en widgetValue >>= print ]
          b1 <- button p [ text := "&Make simple tree"
                         , on command := set en [ widgetValue := someTree ] ]
          b2 <- button p [ text := "&Show tree"
                         , on command := get en widgetValue >>= print ]
          set f [ layout := container p $ column 10 [ fill $ widget en
                                                    , row 10 [ glue, widget b1, widget b2 ]
                                                    ] ]
       

tree' :: IO ()
tree' = start $
        do f <- frame []
           -- p <- panel f []
           scWin <- scrolledWindow f [ scrollRate := sz 10 10, virtualSize := sz 500 500, fullRepaintOnResize := False ]
           scrolledWindowEnableScrolling scWin True True
           b1 <- button f [ text := "&Do stuff"
                          , on command := set scWin [ virtualSize := sz 1000 1000 ] ]
           en <- genericWidget scWin someTree
           set scWin [ layout := fill $ widget en ]
           set f [ layout := column 1 [ hfill $ hrule 1
                                      , fill (widget scWin)
                                      , widget b1
                                      ] ]
           
person :: IO ()
person = start $
         do f <- frame []
            p <- panel f []
            -- en <- genericWidget p aPerson
            en <- genericWidget p aPerson
            set f [ layout := container p $ fill $ widget en ]
          

anyInt :: IO ()
anyInt = start $
         do f <- frame []
            intEntry <- genericWidget f someInt
            set intEntry [ on change := get intEntry widgetValue >>= print ]
            set f [ layout := widget intEntry ]

mai3 :: IO ()
mai3 = start $
       do f <- frame []
          p <- panel f []
          en <- textEntry p []
          set f [ layout := widget p ] -- must also have fill
          set p [ layout := fill $ widget en ]

enum :: IO ()
enum = start $
       do f <- frame []
          myEnum <- genericWidget f Enum1
          set myEnum [ on change := get myEnum widgetValue >>= print ]
          set f [ layout := widget myEnum ]

listTest :: IO ()
listTest = start $
           do f <- frame []
              p <- panel f []
              listWid <- genericWidget p [1::Int, 2, 8]
              set listWid [ on change := get listWid widgetValue >>= print ]
              set f [ layout := container p $ fill $ widget listWid ]

setOuterLabelTest :: IO ()
setOuterLabelTest = start $
    do f <- frame []
       p <- panel f []
       en <- genericWidgetEx id (setOuterLabel (userDefinedLabel "User-set label")) p aPerson
       set f [ layout := container p $ fill $ widget en ]
          
          
data MyEnum = Enum1 | Enum2 | Enum3 deriving Show
$(derive [''MyEnum])
instance WxGen MyEnum