projects
/
matthijs
/
projects
/
fpprac.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
71612a0
)
Make key events work.
author
Matthijs Kooijman
<matthijs@stdin.nl>
Mon, 24 Aug 2009 20:09:08 +0000
(22:09 +0200)
committer
Matthijs Kooijman
<matthijs@stdin.nl>
Mon, 24 Aug 2009 20:09:08 +0000
(22:09 +0200)
FPPrac.hs
patch
|
blob
|
history
diff --git
a/FPPrac.hs
b/FPPrac.hs
index 9f5ec9d68eb5f5d4c7d523ed9745b51b7bbae8db..2a67b6e7d9a9f1904a2b0ff2e93d1357b57c3b5f 100644
(file)
--- 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'
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
-- 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
-- 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.
-- | Called when (part of) the window should be redrawn. Copy the given surface
-- to the exposed window on an expose event.