From: Matthijs Kooijman Date: Mon, 24 Aug 2009 20:09:08 +0000 (+0200) Subject: Make key events work. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;ds=sidebyside;h=eda52aa9eeffdf431637caafca573e3f1ef8d50d;p=matthijs%2Fprojects%2Ffpprac.git Make key events work. --- diff --git a/FPPrac.hs b/FPPrac.hs index 9f5ec9d..2a67b6e 100644 --- a/FPPrac.hs +++ b/FPPrac.hs @@ -162,20 +162,29 @@ runGUI w h (IS { .. }) = do buffer' <- Cairo.createImageSurface Cairo.FormatARGB32 w h buffer <- newIORef buffer' + -- Repack state + let state = IS { .. } + -- Register events Gtk.on window Gtk.exposeEvent $ onExpose buffer Gtk.on window Gtk.configureEvent $ onResize buffer + Gtk.on window Gtk.keyPressEvent $ onKeyDown state - -- Repack state - let state = IS { .. } - -- Process any initial requests processPostponed state -- Show the window and start the Gtk mainloop. Gtk.widgetShowAll window Gtk.mainGUI - + +-- | Called when a key is pressed. +onKeyDown :: IState -> EventM.EventM EventM.EKey Bool +onKeyDown s = do + keyval <- EventM.eventKeyVal + case Gtk.keyToChar keyval of + Just c -> liftIO $ post s (KeyIn c) + Nothing -> return () + return True -- No clue what this means -- | Called when (part of) the window should be redrawn. Copy the given surface -- to the exposed window on an expose event.