aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/App/Input.hs44
1 files changed, 29 insertions, 15 deletions
diff --git a/Spear/App/Input.hs b/Spear/App/Input.hs
index 3358744..ef678d6 100644
--- a/Spear/App/Input.hs
+++ b/Spear/App/Input.hs
@@ -7,6 +7,7 @@ module Spear.App.Input
7, Keyboard 7, Keyboard
8, Mouse(..) 8, Mouse(..)
9, Input(..) 9, Input(..)
10, ButtonDelay
10, DelayedMouseState 11, DelayedMouseState
11 -- * Input state querying 12 -- * Input state querying
12, newKeyboard 13, newKeyboard
@@ -50,6 +51,7 @@ data MouseButton = LMB | RMB | MMB
50 51
51 52
52data MouseProp = MouseX | MouseY | MouseDX | MouseDY 53data MouseProp = MouseX | MouseY | MouseDX | MouseDY
54 deriving Enum
53 55
54 56
55data Mouse = Mouse 57data Mouse = Mouse
@@ -104,24 +106,28 @@ getMouse :: Mouse -> IO Mouse
104getMouse oldMouse = 106getMouse oldMouse =
105 let getButton :: V.Vector Bool -> MouseButton -> Bool 107 let getButton :: V.Vector Bool -> MouseButton -> Bool
106 getButton mousestate button = mousestate V.! fromEnum button 108 getButton mousestate button = mousestate V.! fromEnum button
107 109
108 prop' :: Float -> Float -> MouseProp -> Float 110 getProp :: V.Vector Float -> MouseProp -> Float
109 prop' xpos _ MouseX = xpos 111 getProp props prop = props V.! fromEnum prop
110 prop' _ ypos MouseY = ypos 112
111 prop' xpos _ MouseDX = xpos - property oldMouse MouseX 113 props xpos ypos = V.fromList
112 prop' _ ypos MouseDY = ypos - property oldMouse MouseY 114 [ xpos, ypos
113 115 , xpos - property oldMouse MouseX
114 buttons = fmap toEnum [0..fromEnum (maxBound :: MouseButton)] 116 , ypos - property oldMouse MouseY
117 ]
118
115 getButtonState = 119 getButtonState =
116 fmap (V.fromList . fmap ((==) GLFW.Press)) . 120 fmap (V.fromList . fmap ((==) GLFW.Press)) .
117 mapM GLFW.getMouseButton . 121 mapM GLFW.getMouseButton .
118 fmap toGLFWbutton $ buttons 122 fmap toGLFWbutton $ buttons
123
124 buttons = fmap toEnum [0..fromEnum (maxBound :: MouseButton)]
119 in do 125 in do
120 Position xpos ypos <- get GLFW.mousePos 126 Position xpos ypos <- get GLFW.mousePos
121 buttonState <- getButtonState 127 buttonState <- getButtonState
122 return $ Mouse 128 return $ Mouse
123 { button = getButton buttonState 129 { button = getButton buttonState
124 , property = prop' (fromIntegral xpos) (fromIntegral ypos) 130 , property = getProp $ props (fromIntegral xpos) (fromIntegral ypos)
125 } 131 }
126 132
127 133
@@ -156,24 +162,32 @@ toggledKeyboard prev cur key = cur key && not (prev key)
156 162
157 163
158 164
165-- | Delay configuration for each mouse button.
166type ButtonDelay = MouseButton -> Float
167
168
159-- | Accumulated delays for each mouse button. 169-- | Accumulated delays for each mouse button.
160type DelayedMouseState = MouseButton -> Float 170newtype DelayedMouseState = DelayedMouseState (V.Vector Float)
161 171
162 172
163delayedMouse :: (MouseButton -> Float) -- ^ Delay configuration for each button. 173delayedMouse :: ButtonDelay -- ^ Delay configuration for each button.
164 -> Mouse -- ^ Current mouse state. 174 -> Mouse -- ^ Current mouse state.
165 -> Float -- ^ Time elapsed since last udpate. 175 -> Float -- ^ Time elapsed since last udpate.
166 -> DelayedMouseState 176 -> DelayedMouseState
167 -> (Mouse, DelayedMouseState) 177 -> (Mouse, DelayedMouseState)
168 178
169delayedMouse delay mouse dt dms = 179delayedMouse delay mouse dt (DelayedMouseState dms) =
170 let 180 let
171 accum x = dms x + dt 181 dms'
182 = V.fromList
183 . fmap ((+dt) . (V.!) dms)
184 $ [0 .. fromEnum (maxBound :: MouseButton)]
185
186 accum x = dms' V.! fromEnum x
172 active x = accum x >= delay x 187 active x = accum x >= delay x
173 button' x = active x && button mouse x 188 button' x = active x && button mouse x
174 accum' x = if button' x then 0 else accum x
175 in 189 in
176 (mouse { button = button' }, accum') 190 (mouse { button = button' }, DelayedMouseState dms')
177 191
178 192
179 193