aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/Window.hs99
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
37import Data.Char (ord) 41import Data.Char (ord)
38import Control.Concurrent.MVar 42import Control.Concurrent.MVar
39import Control.Monad (when) 43import Control.Monad (when, foldM)
40import Control.Monad.IO.Class 44import Control.Monad.IO.Class
41import GHC.Float 45import GHC.Float
42import qualified Graphics.UI.GLFW as GLFW 46import 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.
246whenKeyDown :: Key -> Game s a -> Game s ()
247whenKeyDown = whenKey (==GLFW.Press)
248
249-- | Run the game action when the key is up.
250whenKeyUp :: Key -> Game s a -> Game s ()
251whenKeyUp = whenKey (==GLFW.Release)
252
253whenKey :: (GLFW.KeyButtonState -> Bool) -> Key -> Game s a -> Game s ()
254whenKey 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.
260processKeys :: [(Key,a)] -> Game s [a]
261processKeys = 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.
269processButtons :: [(MouseButton,a)] -> Game s [a]
270processButtons = 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
241data InputEvent 276data InputEvent
242 = Resize Width Height 277 = Resize Width Height
243 | KeyDown Key 278 | KeyDown Key
@@ -328,3 +363,65 @@ fromGLFWbutton :: GLFW.MouseButton -> MouseButton
328fromGLFWbutton GLFW.ButtonLeft = LMB 363fromGLFWbutton GLFW.ButtonLeft = LMB
329fromGLFWbutton GLFW.ButtonRight = RMB 364fromGLFWbutton GLFW.ButtonRight = RMB
330fromGLFWbutton GLFW.ButtonMiddle = MMB 365fromGLFWbutton GLFW.ButtonMiddle = MMB
366
367toGLFWkey :: Key -> GLFW.Key
368toGLFWkey KEY_A = GLFW.CharKey 'A'
369toGLFWkey KEY_B = GLFW.CharKey 'B'
370toGLFWkey KEY_C = GLFW.CharKey 'C'
371toGLFWkey KEY_D = GLFW.CharKey 'D'
372toGLFWkey KEY_E = GLFW.CharKey 'E'
373toGLFWkey KEY_F = GLFW.CharKey 'F'
374toGLFWkey KEY_G = GLFW.CharKey 'G'
375toGLFWkey KEY_H = GLFW.CharKey 'H'
376toGLFWkey KEY_I = GLFW.CharKey 'I'
377toGLFWkey KEY_J = GLFW.CharKey 'J'
378toGLFWkey KEY_K = GLFW.CharKey 'K'
379toGLFWkey KEY_L = GLFW.CharKey 'L'
380toGLFWkey KEY_M = GLFW.CharKey 'M'
381toGLFWkey KEY_N = GLFW.CharKey 'N'
382toGLFWkey KEY_O = GLFW.CharKey 'O'
383toGLFWkey KEY_P = GLFW.CharKey 'P'
384toGLFWkey KEY_Q = GLFW.CharKey 'Q'
385toGLFWkey KEY_R = GLFW.CharKey 'R'
386toGLFWkey KEY_S = GLFW.CharKey 'S'
387toGLFWkey KEY_T = GLFW.CharKey 'T'
388toGLFWkey KEY_U = GLFW.CharKey 'U'
389toGLFWkey KEY_V = GLFW.CharKey 'V'
390toGLFWkey KEY_W = GLFW.CharKey 'W'
391toGLFWkey KEY_X = GLFW.CharKey 'X'
392toGLFWkey KEY_Y = GLFW.CharKey 'Y'
393toGLFWkey KEY_Z = GLFW.CharKey 'Z'
394toGLFWkey KEY_0 = GLFW.CharKey '0'
395toGLFWkey KEY_1 = GLFW.CharKey '1'
396toGLFWkey KEY_2 = GLFW.CharKey '2'
397toGLFWkey KEY_3 = GLFW.CharKey '3'
398toGLFWkey KEY_4 = GLFW.CharKey '4'
399toGLFWkey KEY_5 = GLFW.CharKey '5'
400toGLFWkey KEY_6 = GLFW.CharKey '6'
401toGLFWkey KEY_7 = GLFW.CharKey '7'
402toGLFWkey KEY_8 = GLFW.CharKey '8'
403toGLFWkey KEY_9 = GLFW.CharKey '9'
404toGLFWkey KEY_SPACE = GLFW.CharKey ' '
405toGLFWkey KEY_F1 = GLFW.SpecialKey GLFW.F1
406toGLFWkey KEY_F2 = GLFW.SpecialKey GLFW.F2
407toGLFWkey KEY_F3 = GLFW.SpecialKey GLFW.F3
408toGLFWkey KEY_F4 = GLFW.SpecialKey GLFW.F4
409toGLFWkey KEY_F5 = GLFW.SpecialKey GLFW.F5
410toGLFWkey KEY_F6 = GLFW.SpecialKey GLFW.F6
411toGLFWkey KEY_F7 = GLFW.SpecialKey GLFW.F7
412toGLFWkey KEY_F8 = GLFW.SpecialKey GLFW.F8
413toGLFWkey KEY_F9 = GLFW.SpecialKey GLFW.F9
414toGLFWkey KEY_F10 = GLFW.SpecialKey GLFW.F10
415toGLFWkey KEY_F11 = GLFW.SpecialKey GLFW.F11
416toGLFWkey KEY_F12 = GLFW.SpecialKey GLFW.F12
417toGLFWkey KEY_ESC = GLFW.SpecialKey GLFW.ESC
418toGLFWkey KEY_UP = GLFW.SpecialKey GLFW.UP
419toGLFWkey KEY_DOWN = GLFW.SpecialKey GLFW.DOWN
420toGLFWkey KEY_LEFT = GLFW.SpecialKey GLFW.LEFT
421toGLFWkey KEY_RIGHT = GLFW.SpecialKey GLFW.RIGHT
422toGLFWkey KEY_UNKNOWN = GLFW.SpecialKey GLFW.UNKNOWN
423
424toGLFWbutton :: MouseButton -> GLFW.MouseButton
425toGLFWbutton LMB = GLFW.ButtonLeft
426toGLFWbutton RMB = GLFW.ButtonRight
427toGLFWbutton MMB = GLFW.ButtonMiddle