From 387709271b6eaaec76c79143838a25432cc3ba64 Mon Sep 17 00:00:00 2001
From: Marc Sunet <jeannekamikaze@gmail.com>
Date: Mon, 27 Aug 2012 20:04:58 +0200
Subject: Fixed mouse state memoisation
---
Spear/App/Input.hs | 44 +++++++++++++++++++++++++++++---------------
1 file 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
, Keyboard
, Mouse(..)
, Input(..)
+, ButtonDelay
, DelayedMouseState
-- * Input state querying
, newKeyboard
@@ -50,6 +51,7 @@ data MouseButton = LMB | RMB | MMB
data MouseProp = MouseX | MouseY | MouseDX | MouseDY
+ deriving Enum
data Mouse = Mouse
@@ -104,24 +106,28 @@ getMouse :: Mouse -> IO Mouse
getMouse oldMouse =
let getButton :: V.Vector Bool -> MouseButton -> Bool
getButton mousestate button = mousestate V.! fromEnum button
-
- prop' :: Float -> Float -> MouseProp -> Float
- prop' xpos _ MouseX = xpos
- prop' _ ypos MouseY = ypos
- prop' xpos _ MouseDX = xpos - property oldMouse MouseX
- prop' _ ypos MouseDY = ypos - property oldMouse MouseY
-
- buttons = fmap toEnum [0..fromEnum (maxBound :: MouseButton)]
+
+ getProp :: V.Vector Float -> MouseProp -> Float
+ getProp props prop = props V.! fromEnum prop
+
+ props xpos ypos = V.fromList
+ [ xpos, ypos
+ , xpos - property oldMouse MouseX
+ , ypos - property oldMouse MouseY
+ ]
+
getButtonState =
fmap (V.fromList . fmap ((==) GLFW.Press)) .
mapM GLFW.getMouseButton .
fmap toGLFWbutton $ buttons
+
+ buttons = fmap toEnum [0..fromEnum (maxBound :: MouseButton)]
in do
Position xpos ypos <- get GLFW.mousePos
buttonState <- getButtonState
return $ Mouse
{ button = getButton buttonState
- , property = prop' (fromIntegral xpos) (fromIntegral ypos)
+ , property = getProp $ props (fromIntegral xpos) (fromIntegral ypos)
}
@@ -156,24 +162,32 @@ toggledKeyboard prev cur key = cur key && not (prev key)
+-- | Delay configuration for each mouse button.
+type ButtonDelay = MouseButton -> Float
+
+
-- | Accumulated delays for each mouse button.
-type DelayedMouseState = MouseButton -> Float
+newtype DelayedMouseState = DelayedMouseState (V.Vector Float)
-delayedMouse :: (MouseButton -> Float) -- ^ Delay configuration for each button.
+delayedMouse :: ButtonDelay -- ^ Delay configuration for each button.
-> Mouse -- ^ Current mouse state.
-> Float -- ^ Time elapsed since last udpate.
-> DelayedMouseState
-> (Mouse, DelayedMouseState)
-delayedMouse delay mouse dt dms =
+delayedMouse delay mouse dt (DelayedMouseState dms) =
let
- accum x = dms x + dt
+ dms'
+ = V.fromList
+ . fmap ((+dt) . (V.!) dms)
+ $ [0 .. fromEnum (maxBound :: MouseButton)]
+
+ accum x = dms' V.! fromEnum x
active x = accum x >= delay x
button' x = active x && button mouse x
- accum' x = if button' x then 0 else accum x
in
- (mouse { button = button' }, accum')
+ (mouse { button = button' }, DelayedMouseState dms')
--
cgit v1.2.3