Refactor event handling. Allow mouse movement in menus

src/Dodge/Event/Keyboard.hs

@@ -12,6 +12,7 @@ import Dodge.LevelGen
 import Dodge.Creature.Inanimate
 import qualified Data.IntMap.Strict as IM
 import Dodge.Event.Test
+import Dodge.Event.Menu
 
 import SDL
 import Data.Maybe
@@ -30,25 +31,28 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
   where
     kcode = (keysymScancode . keyboardEventKeysym) kev
 
+handlePressedKeyInGame :: Scancode -> World -> Maybe World
+handlePressedKeyInGame scode w
+    |  scode == escapeKey (_keyConfig w) = Nothing
+    |  scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
+    |  scode == dropItemKey (_keyConfig w) = Just $ dropItem w
+    |  scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
+    |  scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ reloadWeapon (_yourID w) w
+    |  scode == testEventKey (_keyConfig w) = Just $ testEvent w
+    |  scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
+    -- Rotation seems to be duplicated here and in Camera.hs ? why
+    |  scode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01}
+    |  scode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01}
+    |  scode ==   ScancodeF11      = Just $ w {_debugMode = not $ _debugMode w} 
+    | _debugMode w = debugKey scode w
+handlePressedKeyInGame _ w = Just w
+
 handlePressedKey :: Bool -> Scancode -> World -> Maybe World
 handlePressedKey True _       w = Just w
-handlePressedKey _    scancode w 
-    |  scancode == escapeKey (_keyConfig w) = Nothing
-    |  scancode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w
-    |  scancode == dropItemKey (_keyConfig w) = Just $ dropItem w
-    |  scancode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
-    |  scancode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ reloadWeapon (_yourID w) w
-    |  scancode == testEventKey (_keyConfig w) = Just $ testEvent w
-    |  scancode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
-    -- Rotation seems to be duplicated here and in Camera.hs ? why
-    |  scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01}
-    |  scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01}
-    |  scancode ==   ScancodeF11      = Just $ w {_debugMode = not $ _debugMode w} 
-    | _debugMode w = debugKey scancode w
-    -- |  _debugMode w && scancode ==   ScancodeF7      = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1}
-    -- |   _debugMode w && scancode ==   ScancodeF8      = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1}
-    -- |   _debugMode w && scancode ==   ScancodeF5      = Just $ dropLight w 
-    -- |   _debugMode w && scancode ==   ScancodeF6      = Just $ dropLight' w 
+handlePressedKey _    scode w
+    | _menuState w == InGame 
+                = handlePressedKeyInGame scode w
+    | otherwise = handlePressedKeyInMenu (_menuState w) scode w
 handlePressedKey _ _ w = Just w
 
 debugKey :: Scancode -> World -> Maybe World 
@@ -59,6 +63,7 @@ debugKey scancode w
     | scancode ==   ScancodeF6      = Just $ dropLight' w 
 debugKey _ w = Just w
 
+
 spaceAction :: World -> World
 spaceAction w = case listToMaybe $ _closeActiveObjects w of
     Just (Left flit) -> pickUpItem' flit w
@@ -90,4 +95,4 @@ dropLight w = placeLS ls dec pos 0
 dropLight' :: World -> World
 dropLight' w = placeCr lamp pos 0 w
         where
-            pos = _crPos(you w)
+            pos = _crPos(you w)

src/Dodge/Event/Menu.hs

@@ -0,0 +1,45 @@
+module Dodge.Event.Menu
+    ( handlePressedKeyInMenu
+    )
+    where
+import Dodge.Data
+import Dodge.Rooms
+import Dodge.Floor
+import Dodge.Initialisation
+import Dodge.SoundLogic
+
+import Data.Maybe
+import qualified Data.Set as S
+
+import Control.Lens
+
+import SDL
+
+handlePressedKeyInMenu :: MenuState -> Scancode -> World -> Maybe World
+handlePressedKeyInMenu mState scode w = case mState of
+    LevelMenu _ -> case scode of
+            ScancodeEscape -> Nothing
+            _               -> startLevel w
+    PauseMenu   -> case scode of
+            ScancodeEscape -> Nothing
+            ScancodeR      -> return $ fromMaybe w $ _storedLevel w
+            ScancodeN      -> Just $ putSound $ generateLevel 1 
+                                      $ initialWorld {_randGen = _randGen w}
+            _              -> unpause w
+    GameOverMenu -> case scode of
+            ScancodeEscape -> Nothing
+            ScancodeR      -> Just $ fromMaybe w $ _storedLevel w
+            ScancodeN      -> Just $ putSound $ generateLevel 1 
+                                                       $ initialWorld
+                                                           {_randGen = _randGen w}
+    _ -> Just w
+  where 
+    unpause w' = Just . resumeSound $
+                        w' {_menuState = InGame}
+    startLevel = unpause . storeLevel
+    putSound = id -- set loadedSounds (_loadedSounds w)
+
+storeLevel :: World -> World
+storeLevel w = case _storedLevel w of
+                 Nothing -> w & storedLevel ?~ w
+                 _       -> w