PropagateEvents.hs

{- |

Shows event propagation for a "allEventsComposite". We also show a dialog, so
that we can recieve focus events.

The "allEventsComposite" propagates which consists of a comboBox and a
text-entry. All events from the comboBox are propagated, none from
the text-entry.

-}
module PropagateEvents where

import IntEntry
import AllEventsComposite
import Graphics.UI.WX

import System.IO

main :: IO ()
main = start $
       do w  <- frame [ on activate := \active -> putStrLn ("Frame active: " ++ show active)]
          p <- panel w [ on activate := \active -> putStrLn ("Panel active: " ++ show active)]
          en <- allEventsComposite p []
          setOnEvent en mouse "Mouse"
          setOnEvent en keyboard "Keyboard"
          set en [ on closing := putStrLn "Closing" ]
          -- set en [ on idle :=    putStr "Idle" >> hFlush stdout >> return False ]
          set en [ on resize :=  putStrLn "Resize" ]
          setOnEvent en focus "Focus"
          setOnEvent en activate "Activate"
          --
          set en [ on command := putStrLn "Command" ]
          --
          dialog p [ text := "subwindow" 
                   , visible := True
                   , on activate := \active -> putStrLn ("Subwindow active: " ++ show active)
                   ]
          let lay = column 10 [ glue
                              , row 10 [ glue, widget en, glue ]
                              , glue
                              ]
          set w [ layout := container p lay 
                , size := Size 300 300
                ]

setOnEvent :: (Show a) => w -> Event w (a -> IO ()) -> [Char] -> IO ()
setOnEvent w evt name = set w [ on evt := \e -> putStrLn (name ++ ": " ++ show e) >> propagateEvent ]

-- We also need to handle selecting events 
-- http://wxhaskell.sourceforge.net/doc/Graphics-UI-WX-Events.html#t%3ASelecting


propagateClick :: IO ()
propagateClick = start $
       do w  <- frame []
          p <- panel w []
          en <- intEntry p []
          set en [ on click := \_ -> putStrLn "Clicked" ]
          let lay = column 10 [ glue
                              , row 10 [ glue, widget en, glue ]
                              , glue
                              ]
          set w [ layout := container p lay 
                , size := Size 300 300
                ]