{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} module Main where import Graphics.UI.FLTK.LowLevel.FLTKHS import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import qualified Graphics.UI.FLTK.LowLevel.FL as FL windowCallback :: (Show a) => a -> Ref Window -> IO () windowCallback a _ = print a showOverride :: Ref Window -> IO () showOverride wptr = do print "showOverride" showWidgetSuper wptr drawOverride :: Ref Window -> IO () drawOverride wptr = do print "drawOverride" drawSuper wptr addButton :: Int -> Int -> T.Text -> IO (Ref Button) addButton x_pos y_pos label = do button <- buttonNew (Rectangle (Position (X x_pos) (Y y_pos)) (Size (Width 80) (Height 30)) ) (Just label) return button addWindow :: IO (Ref Window) addWindow = do window <- windowCustom (Size (Width 100) (Height 100)) Nothing (Just "Test") (Just drawOverride) defaultCustomWidgetFuncs defaultCustomWindowFuncs button1 <- addButton 10 30 "button 1" button2 <- addButton 10 70 "button 2" setCallback button1 (\btn -> setLabel btn "New Label") setCallback button2 (\_ -> FL.deleteWidget button1 >> redraw window) setCallback window (windowCallback "window's callback data") showWidget window return window runAwakeHandler :: IO () runAwakeHandler = do awakeHandler <- FL.getAwakeHandler_ awakeHandler eventIntercept :: Event -> Ref Window -> IO Int eventIntercept e _ = case e of NoEvent -> do { putStrLn "NoEvent"; return 0; } Push -> do { putStrLn "Push"; return 0; } Release -> do { putStrLn "Release"; return 0; } Enter -> do { putStrLn "Enter"; return 0; } Leave -> do { putStrLn "Leave"; return 0; } Drag -> do { putStrLn "Drag"; return 0; } Focus -> do { putStrLn "Focus"; return 0; } Unfocus -> do { putStrLn "Unfocus"; return 0; } Keydown -> do { putStrLn "Keydown"; return 0; } Keyup -> do { putStrLn "Keyup"; return 0; } Close -> do { putStrLn "Close"; return 0; } Move -> do { putStrLn "Move"; return 0; } Shortcut -> do { putStrLn "Shortcut"; return 0; } Deactivate -> do { putStrLn "Deactivate"; return 0; } Activate -> do { putStrLn "Activate"; return 0; } Hide -> do { putStrLn "Hide"; return 0; } Show -> do { putStrLn "Show"; return 0; } Paste -> do { putStrLn "Paste"; return 0; } Selectionclear -> do { putStrLn "Selectionclear"; return 0; } Mousewheel -> do { putStrLn "Mousewheel"; return 0; } DndEnter -> do { putStrLn "DndEnter"; return 0; } DndDrag -> do { putStrLn "DndDrag"; return 0; } DndLeave -> do { putStrLn "DndLeave"; return 0; } DndRelease -> do { putStrLn "DndRelease"; return 0; } ScreenConfigurationChanged -> do { putStrLn "ScreenConfigurationChanged"; return 0; } Fullscreen -> do { putStrLn "Fullscreen"; return 0; } globalEventHandler :: Event -> IO Int globalEventHandler e = case e of NoEvent -> do { putStrLn "Global NoEvent"; return 0; } Push -> do { putStrLn "Global Push"; return 0; } Release -> do { putStrLn "Global Release"; return 0; } Enter -> do { putStrLn "Global Enter"; return 0; } Leave -> do { putStrLn "Global Leave"; return 0; } Drag -> do { putStrLn "Global Drag"; return 0; } Focus -> do { putStrLn "Global Focus"; return 0; } Unfocus -> do { putStrLn "Global Unfocus"; return 0; } Keydown -> do { putStrLn "Global Keydown"; return 0; } Keyup -> do { putStrLn "Global Keyup"; return 0; } Close -> do { putStrLn "Global Close"; return 0; } Move -> do { putStrLn "Global Move"; return 0; } Shortcut -> do { putStrLn "Global Shortcut"; return 0; } Deactivate -> do { putStrLn "Global Deactivate"; return 0; } Activate -> do { putStrLn "Global Activate"; return 0; } Hide -> do { putStrLn "Global Hide"; return 0; } Show -> do { putStrLn "Global Show"; return 0; } Paste -> do { putStrLn "Global Paste"; return 0; } Selectionclear -> do { putStrLn "Global Selectionclear"; return 0; } Mousewheel -> do { putStrLn "Global Mousewheel"; return 0; } DndEnter -> do { putStrLn "Global DndEnter"; return 0; } DndDrag -> do { putStrLn "Global DndDrag"; return 0; } DndLeave -> do { putStrLn "Global DndLeave"; return 0; } DndRelease -> do { putStrLn "Global DndRelease"; return 0; } ScreenConfigurationChanged -> do { putStrLn "Global ScreenConfigurationChanged"; return 0; } Fullscreen -> do { putStrLn "Global Fullscreen"; return 0; } main :: IO () main = do _ <- addWindow print "added Window" _ <- FL.addAwakeHandler (print "awake handler's callback data") print "added awake handler" _ <- runAwakeHandler -- _ <- FL.setEventDispatch eventIntercept _ <- FL.setHandler globalEventHandler print "ran awake handler" _ <- FL.run return ()