Refactor event handling. Allow mouse movement in menus

src/Dodge/Event.hs

@@ -1,6 +1,20 @@
-module Dodge.Event where
-import Dodge.Event.Keyboard
+module Dodge.Event 
+{- |
+Module      : Dodge.Event
+Description : Direct event handling
 
+Deals with direct events.
+This includes individual key/mouse presses, but /not/ continuous held down input.
+We cannot handle multiple keys held down at once here,
+(eg left mouse button + right mouse button)
+because these are separate events.
+Instead we store the events in a set, and deal with the combinations in
+"Dodge.Update".
+-}
+    ( handleEvent
+    ) where
+import Dodge.Event.Keyboard
+import Dodge.Event.Menu
 import Dodge.Data
 import Dodge.Base
 import Dodge.CreatureAction
@@ -15,16 +29,12 @@ import Data.Function (on)
 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
 import SDL
--- Deals with direct events
--- This includes individual key/mouse presses, but /not/ continuous held down input
--- We cannot handle multiple keys held down at once here,
--- (eg left mouse button + right mouse button)
--- because these are separate events
--- Instead we store the events in a set, and deal with the combinations in
--- Update
 
-handleEvent :: Event -> World -> Maybe World
-handleEvent e = case eventPayload e of
+handleEvent :: World -> Event -> Maybe World
+handleEvent = flip handleEvent'
+
+handleEvent' :: Event -> World -> Maybe World
+handleEvent' e = case eventPayload e of
     KeyboardEvent kev           -> handleKeyboardEvent kev
     MouseMotionEvent mmev       -> handleMouseMotionEvent mmev
     MouseButtonEvent mbev       -> handleMouseButtonEvent mbev
@@ -47,11 +57,12 @@ handleMouseButtonEvent mbev w = case mouseButtonEventMotion mbev of
     where but = mouseButtonEventButton mbev
 
 handleMouseWheelEvent :: MouseWheelEventData -> World -> Maybe World
-handleMouseWheelEvent mwev = 
-    case mouseWheelEventPos mwev of
-        V2 x y | y > 0      -> Just . wheelUpEvent
-               | y < 0      -> Just . wheelDownEvent
-               | otherwise  -> Just
+handleMouseWheelEvent mwev w = case _menuState w of
+   InGame -> case mouseWheelEventPos mwev of
+        V2 x y | y > 0      -> Just (wheelUpEvent w)
+               | y < 0      -> Just (wheelDownEvent w)
+               | otherwise  -> Just w
+   _ -> Just w
 
 handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
 handleResizeEvent sev = Just . set windowX (fromIntegral x)
@@ -113,12 +124,3 @@ before y (x:z:ys) | y == z    = x
 after y (x:z:ys)  | y == x    = z
                   | otherwise = after y (z:ys)
 
-mouseActionsCr :: S.Set MouseButton -> Creature -> Creature
-mouseActionsCr keys cr 
-    | rbPressed 
-        = set ( crState . stance . posture) Aiming cr
-    | otherwise
-        = set ( crState . stance . posture) AtEase cr
-    where lbPressed = ButtonLeft `S.member` keys
-          rbPressed = ButtonRight `S.member` keys
-