diff options
-rw-r--r-- | Spear/Window.hs | 99 |
1 files changed, 98 insertions, 1 deletions
diff --git a/Spear/Window.hs b/Spear/Window.hs index b3e838c..2e06d72 100644 --- a/Spear/Window.hs +++ b/Spear/Window.hs | |||
@@ -22,6 +22,10 @@ module Spear.Window | |||
22 | , loop | 22 | , loop |
23 | , GLFW.swapBuffers | 23 | , GLFW.swapBuffers |
24 | -- * Input | 24 | -- * Input |
25 | , whenKeyDown | ||
26 | , whenKeyUp | ||
27 | , processKeys | ||
28 | , processButtons | ||
25 | , InputEvent(..) | 29 | , InputEvent(..) |
26 | , Key(..) | 30 | , Key(..) |
27 | , MouseButton(..) | 31 | , MouseButton(..) |
@@ -36,7 +40,7 @@ import Spear.Sys.Timer as Timer | |||
36 | 40 | ||
37 | import Data.Char (ord) | 41 | import Data.Char (ord) |
38 | import Control.Concurrent.MVar | 42 | import Control.Concurrent.MVar |
39 | import Control.Monad (when) | 43 | import Control.Monad (when, foldM) |
40 | import Control.Monad.IO.Class | 44 | import Control.Monad.IO.Class |
41 | import GHC.Float | 45 | import GHC.Float |
42 | import qualified Graphics.UI.GLFW as GLFW | 46 | import qualified Graphics.UI.GLFW as GLFW |
@@ -238,6 +242,37 @@ addEvent mvar val = tryTakeMVar mvar >>= \xs -> case xs of | |||
238 | 242 | ||
239 | -- Input | 243 | -- Input |
240 | 244 | ||
245 | -- | Run the game action when the key is down. | ||
246 | whenKeyDown :: Key -> Game s a -> Game s () | ||
247 | whenKeyDown = whenKey (==GLFW.Press) | ||
248 | |||
249 | -- | Run the game action when the key is up. | ||
250 | whenKeyUp :: Key -> Game s a -> Game s () | ||
251 | whenKeyUp = whenKey (==GLFW.Release) | ||
252 | |||
253 | whenKey :: (GLFW.KeyButtonState -> Bool) -> Key -> Game s a -> Game s () | ||
254 | whenKey pred key game = do | ||
255 | isDown <- fmap pred $ gameIO . GLFW.getKey . toGLFWkey $ key | ||
256 | when isDown $ game >> return () | ||
257 | |||
258 | -- | Process the keyboard keys, returning those values for which their | ||
259 | -- corresponding key is pressed. | ||
260 | processKeys :: [(Key,a)] -> Game s [a] | ||
261 | processKeys = foldM f [] | ||
262 | where f acc (key,res) = do | ||
263 | isDown <- fmap (==GLFW.Press) $ gameIO . GLFW.getKey | ||
264 | . toGLFWkey $ key | ||
265 | return $ if isDown then (res:acc) else acc | ||
266 | |||
267 | -- | Process the mouse buttons, returning those values for which their | ||
268 | -- corresponding button is pressed. | ||
269 | processButtons :: [(MouseButton,a)] -> Game s [a] | ||
270 | processButtons = foldM f [] | ||
271 | where f acc (bt,res) = do | ||
272 | isDown <- fmap (==GLFW.Press) $ gameIO . GLFW.getMouseButton | ||
273 | . toGLFWbutton $ bt | ||
274 | return $ if isDown then (res:acc) else acc | ||
275 | |||
241 | data InputEvent | 276 | data InputEvent |
242 | = Resize Width Height | 277 | = Resize Width Height |
243 | | KeyDown Key | 278 | | KeyDown Key |
@@ -328,3 +363,65 @@ fromGLFWbutton :: GLFW.MouseButton -> MouseButton | |||
328 | fromGLFWbutton GLFW.ButtonLeft = LMB | 363 | fromGLFWbutton GLFW.ButtonLeft = LMB |
329 | fromGLFWbutton GLFW.ButtonRight = RMB | 364 | fromGLFWbutton GLFW.ButtonRight = RMB |
330 | fromGLFWbutton GLFW.ButtonMiddle = MMB | 365 | fromGLFWbutton GLFW.ButtonMiddle = MMB |
366 | |||
367 | toGLFWkey :: Key -> GLFW.Key | ||
368 | toGLFWkey KEY_A = GLFW.CharKey 'A' | ||
369 | toGLFWkey KEY_B = GLFW.CharKey 'B' | ||
370 | toGLFWkey KEY_C = GLFW.CharKey 'C' | ||
371 | toGLFWkey KEY_D = GLFW.CharKey 'D' | ||
372 | toGLFWkey KEY_E = GLFW.CharKey 'E' | ||
373 | toGLFWkey KEY_F = GLFW.CharKey 'F' | ||
374 | toGLFWkey KEY_G = GLFW.CharKey 'G' | ||
375 | toGLFWkey KEY_H = GLFW.CharKey 'H' | ||
376 | toGLFWkey KEY_I = GLFW.CharKey 'I' | ||
377 | toGLFWkey KEY_J = GLFW.CharKey 'J' | ||
378 | toGLFWkey KEY_K = GLFW.CharKey 'K' | ||
379 | toGLFWkey KEY_L = GLFW.CharKey 'L' | ||
380 | toGLFWkey KEY_M = GLFW.CharKey 'M' | ||
381 | toGLFWkey KEY_N = GLFW.CharKey 'N' | ||
382 | toGLFWkey KEY_O = GLFW.CharKey 'O' | ||
383 | toGLFWkey KEY_P = GLFW.CharKey 'P' | ||
384 | toGLFWkey KEY_Q = GLFW.CharKey 'Q' | ||
385 | toGLFWkey KEY_R = GLFW.CharKey 'R' | ||
386 | toGLFWkey KEY_S = GLFW.CharKey 'S' | ||
387 | toGLFWkey KEY_T = GLFW.CharKey 'T' | ||
388 | toGLFWkey KEY_U = GLFW.CharKey 'U' | ||
389 | toGLFWkey KEY_V = GLFW.CharKey 'V' | ||
390 | toGLFWkey KEY_W = GLFW.CharKey 'W' | ||
391 | toGLFWkey KEY_X = GLFW.CharKey 'X' | ||
392 | toGLFWkey KEY_Y = GLFW.CharKey 'Y' | ||
393 | toGLFWkey KEY_Z = GLFW.CharKey 'Z' | ||
394 | toGLFWkey KEY_0 = GLFW.CharKey '0' | ||
395 | toGLFWkey KEY_1 = GLFW.CharKey '1' | ||
396 | toGLFWkey KEY_2 = GLFW.CharKey '2' | ||
397 | toGLFWkey KEY_3 = GLFW.CharKey '3' | ||
398 | toGLFWkey KEY_4 = GLFW.CharKey '4' | ||
399 | toGLFWkey KEY_5 = GLFW.CharKey '5' | ||
400 | toGLFWkey KEY_6 = GLFW.CharKey '6' | ||
401 | toGLFWkey KEY_7 = GLFW.CharKey '7' | ||
402 | toGLFWkey KEY_8 = GLFW.CharKey '8' | ||
403 | toGLFWkey KEY_9 = GLFW.CharKey '9' | ||
404 | toGLFWkey KEY_SPACE = GLFW.CharKey ' ' | ||
405 | toGLFWkey KEY_F1 = GLFW.SpecialKey GLFW.F1 | ||
406 | toGLFWkey KEY_F2 = GLFW.SpecialKey GLFW.F2 | ||
407 | toGLFWkey KEY_F3 = GLFW.SpecialKey GLFW.F3 | ||
408 | toGLFWkey KEY_F4 = GLFW.SpecialKey GLFW.F4 | ||
409 | toGLFWkey KEY_F5 = GLFW.SpecialKey GLFW.F5 | ||
410 | toGLFWkey KEY_F6 = GLFW.SpecialKey GLFW.F6 | ||
411 | toGLFWkey KEY_F7 = GLFW.SpecialKey GLFW.F7 | ||
412 | toGLFWkey KEY_F8 = GLFW.SpecialKey GLFW.F8 | ||
413 | toGLFWkey KEY_F9 = GLFW.SpecialKey GLFW.F9 | ||
414 | toGLFWkey KEY_F10 = GLFW.SpecialKey GLFW.F10 | ||
415 | toGLFWkey KEY_F11 = GLFW.SpecialKey GLFW.F11 | ||
416 | toGLFWkey KEY_F12 = GLFW.SpecialKey GLFW.F12 | ||
417 | toGLFWkey KEY_ESC = GLFW.SpecialKey GLFW.ESC | ||
418 | toGLFWkey KEY_UP = GLFW.SpecialKey GLFW.UP | ||
419 | toGLFWkey KEY_DOWN = GLFW.SpecialKey GLFW.DOWN | ||
420 | toGLFWkey KEY_LEFT = GLFW.SpecialKey GLFW.LEFT | ||
421 | toGLFWkey KEY_RIGHT = GLFW.SpecialKey GLFW.RIGHT | ||
422 | toGLFWkey KEY_UNKNOWN = GLFW.SpecialKey GLFW.UNKNOWN | ||
423 | |||
424 | toGLFWbutton :: MouseButton -> GLFW.MouseButton | ||
425 | toGLFWbutton LMB = GLFW.ButtonLeft | ||
426 | toGLFWbutton RMB = GLFW.ButtonRight | ||
427 | toGLFWbutton MMB = GLFW.ButtonMiddle | ||