Cleanup menu code, fix reloading crash for nonweapons

This commit is contained in:
2022-03-20 20:09:29 +00:00
parent 988a0de578
commit 2a5b6d3597
3 changed files with 39 additions and 37 deletions
+22 -25
View File
@@ -14,17 +14,15 @@ import Dodge.Inventory
import Dodge.Menu
import Dodge.Reloading
import Dodge.Save
import LensHelp
import Control.Lens
import Data.Maybe
import qualified Data.Set as S
import SDL
import Data.Text (unpack)
handleTextInputEvent :: TextInputEventData -> Universe -> IO (Maybe Universe)
handleTextInputEvent tev = handleTextInput text
where
text = unpack $ textInputEventText tev
handleTextInputEvent = handleTextInput . unpack . textInputEventText
handleTextInput :: String -> Universe -> IO (Maybe Universe)
handleTextInput text w
@@ -46,42 +44,41 @@ handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
handlePressedKey True _ w = return $ Just w
handlePressedKey _ ScancodeF5 w = return . Just $ doQuicksave w
handlePressedKey _ ScancodeF9 w = return . Just $ loadSaveSlot QuicksaveSlot w
handlePressedKey _ ScancodeSemicolon w = return . Just $ gotoTerminal w
handlePressedKey _ scode w
| null (_menuLayers w) = return $ uvWorld (handlePressedKeyInGame scode) w
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
-- | otherwise = return $ Just w
handlePressedKey _ scode w = case scode of
ScancodeF5 -> return . Just $ doQuicksave w
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot w
ScancodeSemicolon -> return . Just $ gotoTerminal w
_ | null (_menuLayers w) -> return $ uvWorld (handlePressedKeyInGame scode) w
_ -> handlePressedKeyInMenu (head $ _menuLayers w) scode w
handlePressedKeyInGame :: Scancode -> World -> Maybe World
handlePressedKeyInGame scode w = case scode of
ScancodeEscape -> Nothing
ScancodeSpace -> Just $ spaceAction w
ScancodeP -> Just $ pauseGame $ escapeMap w
ScancodeF -> Just $ youDropItem w
ScancodeM -> Just $ toggleMap w
ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w
ScancodeT -> Just $ testEvent w
ScancodeX -> Just $ w & hud . hudElement %~ toggleTweakInv
ScancodeC -> Just $ toggleCombineInv w
ScancodeI -> Just $ w & hud . hudElement %~ toggleInspectInv
_ -> Just w
ScancodeP -> Just $ pauseGame $ escapeMap w
ScancodeF -> Just $ youDropItem w
ScancodeM -> Just $ toggleMap w
ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w
ScancodeT -> Just $ testEvent w
ScancodeX -> Just $ w & hud . hudElement %~ toggleTweakInv
ScancodeC -> Just $ toggleCombineInv w
ScancodeI -> Just $ w & hud . hudElement %~ toggleInspectInv
_ -> Just w
toggleTweakInv :: HUDElement -> HUDElement
toggleTweakInv he = case he of
DisplayInventory TweakInventory -> DisplayInventory NoSubInventory
_ -> DisplayInventory TweakInventory
_ -> DisplayInventory TweakInventory
toggleInspectInv :: HUDElement -> HUDElement
toggleInspectInv he = case he of
DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
_ -> DisplayInventory InspectInventory
DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
_ -> DisplayInventory InspectInventory
gotoTerminal :: Universe -> Universe
gotoTerminal w = case _menuLayers w of
(InputScreen _ _ : _ ) -> w
_ -> w & menuLayers %~ (InputScreen [] "Enter command" :)
(InputScreen {} : _) -> w
_ -> w & menuLayers .:~ InputScreen [] "Enter command"
spaceAction :: World -> World
spaceAction w = case _hudElement $ _hud w of