Cleanup menu code, fix reloading crash for nonweapons

src/Dodge/Event/Keyboard.hs

@@ -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

src/Dodge/Event/Menu.hs

@@ -1,8 +1,7 @@
 module Dodge.Event.Menu
     ( handlePressedKeyInMenu
     , handleTextInMenu
-    )
-  where
+    ) where
 import Dodge.Data
 import Dodge.Debug.Terminal
 --import Dodge.Menu
@@ -25,7 +24,7 @@ handleTextInMenu mState text = return . Just . case mState of
 handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> IO (Maybe Universe)
 handlePressedKeyInMenu mState scode = case mState of
     OptionScreen { _scOptions = mos, _scDefaultEff = defeff}
-                        -> optionListToEffects mos defeff scode
+                        -> optionListToEffects defeff scode mos
     DisplayScreen {}    -> popScreen
     ColumnsScreen {}    -> popScreen
     WaitScreen {}       -> return . Just
@@ -41,11 +40,15 @@ handlePressedKeyInMenu mState scode = case mState of
     doBackspace (x:xs)  = init (x:xs)
     doBackspace _       = ['>']
 
-optionListToEffects :: [MenuOption] -> (Universe -> IO (Maybe Universe)) -> Scancode
+optionListToEffects 
+    :: (Universe -> IO (Maybe Universe)) 
+    -> Scancode
+    -> [MenuOption]
     -> Universe -> IO (Maybe Universe)
-optionListToEffects mos defaulteff sc = fromMaybe defaulteff 
+optionListToEffects defaulteff sc
+    = fromMaybe defaulteff 
     . lookup sc 
-    $ concatMap menuOptionToEffects mos
+    . concatMap menuOptionToEffects
 
 menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> IO (Maybe Universe))]
 menuOptionToEffects Toggle          {_moKey = k, _moEff = eff} = [(k,eff)]

src/Dodge/Reloading.hs

@@ -15,13 +15,15 @@ startReloadingWeapon cr = (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr)
     icTryStartReloading
 
 icTryStartReloading :: Item -> Maybe Item
-icTryStartReloading it
-    | _ammoLoaded am < _ammoBaseMax (_itConsumption it) && _reloadState am == Nothing'
-                = Just $ it & itConsumption . reloadState .~ Just' (_reloadTime am)
+icTryStartReloading it = do
+    am <- it ^? itConsumption
+    amloaded <- am ^? ammoLoaded
+    ammax <- am ^? ammoBaseMax
+    rstate <- am ^? reloadState
+    if amloaded < ammax && rstate == Nothing'
+        then Just $ it & itConsumption . reloadState .~ Just' (_reloadTime am)
                     & if _reloadType am == ActiveClear then itConsumption . ammoLoaded .~ 0 else id
-    | otherwise = Nothing
-  where
-    am = _itConsumption it
+        else Nothing
 
 crStopReloading :: Creature -> Creature
 crStopReloading cr = cr & crInv . ix (_crInvSel cr) . itConsumption . reloadState .~ Nothing'