diff options
author | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-03-13 15:03:40 +0100 |
---|---|---|
committer | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-03-13 15:03:40 +0100 |
commit | fd9d8e0a6137700990cf2f96133c2fc65270c49a (patch) | |
tree | 33557bf7e25a588373808d8222bb2554b50b93d4 | |
parent | 9bdae139d41ada6ccfcedc30512bccee6db26a89 (diff) |
Added mouse wheel and repositioning
-rw-r--r-- | Spear/App/Input.hs | 26 |
1 files changed, 22 insertions, 4 deletions
diff --git a/Spear/App/Input.hs b/Spear/App/Input.hs index 9fa140a..779557d 100644 --- a/Spear/App/Input.hs +++ b/Spear/App/Input.hs | |||
@@ -24,6 +24,9 @@ module Spear.App.Input | |||
24 | , newDM | 24 | , newDM |
25 | , updateDM | 25 | , updateDM |
26 | , delayedMouse | 26 | , delayedMouse |
27 | -- * Input modifiers | ||
28 | , setMousePosition | ||
29 | , setMouseWheel | ||
27 | ) | 30 | ) |
28 | where | 31 | where |
29 | 32 | ||
@@ -49,7 +52,7 @@ type Keyboard = Key -> Bool | |||
49 | data MouseButton = LMB | RMB | MMB | 52 | data MouseButton = LMB | RMB | MMB |
50 | deriving (Enum, Bounded) | 53 | deriving (Enum, Bounded) |
51 | 54 | ||
52 | data MouseProp = MouseX | MouseY | MouseDX | MouseDY | 55 | data MouseProp = MouseX | MouseY | MouseDX | MouseDY | Wheel | WheelDelta |
53 | deriving Enum | 56 | deriving Enum |
54 | 57 | ||
55 | data Mouse = Mouse | 58 | data Mouse = Mouse |
@@ -103,10 +106,13 @@ getMouse oldMouse = | |||
103 | getProp :: V.Vector Float -> MouseProp -> Float | 106 | getProp :: V.Vector Float -> MouseProp -> Float |
104 | getProp props prop = props V.! fromEnum prop | 107 | getProp props prop = props V.! fromEnum prop |
105 | 108 | ||
106 | props xpos ypos = V.fromList | 109 | props xpos ypos wheel = V.fromList |
107 | [ xpos, ypos | 110 | [ xpos |
111 | , ypos | ||
108 | , xpos - property oldMouse MouseX | 112 | , xpos - property oldMouse MouseX |
109 | , ypos - property oldMouse MouseY | 113 | , ypos - property oldMouse MouseY |
114 | , wheel | ||
115 | , wheel - property oldMouse Wheel | ||
110 | ] | 116 | ] |
111 | 117 | ||
112 | getButtonState = | 118 | getButtonState = |
@@ -117,10 +123,11 @@ getMouse oldMouse = | |||
117 | buttons = fmap toEnum [0..fromEnum (maxBound :: MouseButton)] | 123 | buttons = fmap toEnum [0..fromEnum (maxBound :: MouseButton)] |
118 | in do | 124 | in do |
119 | Position xpos ypos <- get GLFW.mousePos | 125 | Position xpos ypos <- get GLFW.mousePos |
126 | wheel <- get GLFW.mouseWheel | ||
120 | buttonState <- getButtonState | 127 | buttonState <- getButtonState |
121 | return $ Mouse | 128 | return $ Mouse |
122 | { button = getButton buttonState | 129 | { button = getButton buttonState |
123 | , property = getProp $ props (fromIntegral xpos) (fromIntegral ypos) | 130 | , property = getProp $ props (fromIntegral xpos) (fromIntegral ypos) (fromIntegral wheel) |
124 | } | 131 | } |
125 | 132 | ||
126 | -- | Return a new dummy input. | 133 | -- | Return a new dummy input. |
@@ -183,6 +190,17 @@ updateDM (DelayedMouse mouse delay accum) dt = | |||
183 | in | 190 | in |
184 | DelayedMouse mouse { button = button' } delay accum' | 191 | DelayedMouse mouse { button = button' } delay accum' |
185 | 192 | ||
193 | -- | Set the mouse position. | ||
194 | setMousePosition :: Integral a => (a,a) -> Mouse -> IO Mouse | ||
195 | setMousePosition (x,y) mouse = do | ||
196 | GLFW.mousePos $= Position (fromIntegral x) (fromIntegral y) | ||
197 | getMouse mouse | ||
198 | |||
199 | -- | Set the mouse wheel. | ||
200 | setMouseWheel :: Integral a => a -> Mouse -> IO Mouse | ||
201 | setMouseWheel w mouse = do | ||
202 | GLFW.mouseWheel $= (fromIntegral w) | ||
203 | getMouse mouse | ||
186 | 204 | ||
187 | toGLFWkey :: Key -> Int | 205 | toGLFWkey :: Key -> Int |
188 | toGLFWkey KEY_A = ord 'A' | 206 | toGLFWkey KEY_A = ord 'A' |