diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 7b4b6e6b7..fef47cec5 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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 diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 327d31c53..bb7904c74 100644 --- a/src/Dodge/Event/Menu.hs +++ b/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)] diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index 2045a43fb..b84f7c53a 100644 --- a/src/Dodge/Reloading.hs +++ b/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'