xfconf-4.8.0.0: Demo/Demo.hs

-- A simple demo program for xfconf.
-- Required gtk >= 0.12.
--
module Main where

import Control.Monad      (forM_)

import Graphics.UI.Gtk

import System.XFCE.Xfconf

main :: IO ()
main = createWindow

createWindow :: IO ()
createWindow = do
        -- normally returns the remaining command line arguments
        initGUI

        -- Our special xfconf channel
        chan <- channelGet "Demo"

        -- Create window and main container
        window <- windowNew
        grid   <- tableNew 4 3 False -- rows, columns, homogenous
        set grid   [ tableRowSpacing      := 10 ]
        set window [ windowTitle          := "Xfconf Binding demo"
                   , containerBorderWidth := 10
                   , containerChild       := grid ]
        onDestroy window $ do
                mainQuit
                putStrLn "ByeBye"

        -- * Create container content
        -- ** First line: instruction
        instruction <- labelNew (Just
          "This window demonstrates the binding between Gtk\
          \ CheckButtons, the xfconf backend and Gtk Labels. Every time\
          \ you (un)check one of the button, xfconf is updated\
          \ accordingly and its state is mirrored in both the label and\
          \ the other button.")
        labelSetJustify instruction JustifyCenter
        set instruction [ labelWrap           := True
                        , labelWidthChars     := 80
                        , labelSingleLineMode := False ]
        tableAttachDefaults grid instruction 0 3 0 1

        -- ** Second line: titles
        title0 <- labelNew (Just "<b>Ur button</b>")
        title1 <- labelNew (Just "<b>Xfconf value</b>")
        title2 <- labelNew (Just "<b>Mirror button</b>")
        forM_ [(title0,0,1), (title1,1,2), (title2,2,3)] $ \(w,l,r) -> do
                labelSetUseMarkup w True
                tableAttachDefaults grid w l r 1 2

        -- ** Third line: check/label
        check0 <- checkButtonNewWithLabel "Check me !"
        label0 <- labelNew (Just "<null>")
        check1 <- checkButtonNewWithLabel "Check me !"
        tableAttachDefaults grid check0 0 1 2 3
        tableAttachDefaults grid label0 1 2 2 3
        tableAttachDefaults grid check1 2 3 2 3
        set grid [ tableChildXOptions check0 := []
                 , tableChildXOptions label0 := []
                 , tableChildXOptions check1 := [] ]

        -- Signals voodoo \o/
        -- * xfconf binding
        xfsig0 <- xfconfBind chan "/check" bool check0 "active"
        xfsig1 <- xfconfBind chan "/check" bool check1 "active"
        -- * xfconf monitoring
        onPropertyChanged chan $ \key maybeValue -> do
          if key /= "/check"
           then return ()
           else case maybeValue of
             Just (XfconfBool True) -> labelSetText label0 "checked !"
             Just (XfconfBool False) -> labelSetText label0 "unchecked !"
             _ -> labelSetText label0 "UNKNOWN"


        -- ** Fourth line: test unbind(s)
        breakMe0 <- buttonNewWithLabel "Unbind"
        breakMe1 <- buttonNewWithLabel "Unbind all"
        breakMe2 <- buttonNewWithLabel "Unbind property"
        tableAttachDefaults grid breakMe0 0 1 3 4
        tableAttachDefaults grid breakMe1 1 2 3 4
        tableAttachDefaults grid breakMe2 2 3 3 4
        onClicked breakMe0 $ do
                xfconfUnbind xfsig0
                xfconfUnbind xfsig1
        onClicked breakMe1 $ do
                xfconfUnbindAll check0
                xfconfUnbindAll chan
        onClicked breakMe2 $ do
                xfconfUnbindByProperty chan "/check" check0 "active"
                xfconfUnbindByProperty chan "/check" check1 "active"

        -- END
        widgetShowAll window

        mainGUI