Refactor event handling. Allow mouse movement in menus

This commit is contained in:
2021-04-07 21:59:44 +02:00
parent d42cb89dd2
commit 294f2509d0
12 changed files with 319 additions and 317 deletions
+23 -18
View File
@@ -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)