From 596880f76a190538f1df79c5bc902415b3397d9a Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 26 Aug 2025 16:19:49 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Update/Input/InGame.hs | 194 +++++++++++++++---------------- 1 file changed, 91 insertions(+), 103 deletions(-) diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index ed51e2b2c..b0893d7a1 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -5,11 +5,6 @@ module Dodge.Update.Input.InGame ( updateMouseInGame, ) where -import Dodge.Data.CardinalPoint -import Dodge.Inventory.CheckSlots -import Dodge.Base.Collide -import Geometry.Vector -import Dodge.Data.Terminal.Status import Control.Applicative import Control.Monad import Data.Foldable @@ -19,14 +14,18 @@ import Data.List (sort) import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid +import Dodge.Base.Collide import Dodge.Camera import Dodge.Creature.Action +import Dodge.Data.CardinalPoint import Dodge.Data.Combine +import Dodge.Data.Terminal.Status import Dodge.Data.Universe import Dodge.DisplayInventory import Dodge.Event.Test import Dodge.Inventory import Dodge.Inventory.Add +import Dodge.Inventory.CheckSlots import Dodge.Item.Display import Dodge.Item.InvSize import Dodge.ListDisplayParams @@ -38,8 +37,7 @@ import Dodge.SoundLogic import Dodge.Terminal import Dodge.Update.Input.DebugTest import Dodge.Update.Input.Text ---import Dodge.WorldPos ---import Geometry +import Geometry.Vector import LensHelp import NewInt import SDL @@ -50,25 +48,23 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme DisplayTerminal tmid -> updateKeysInTerminal tmid u CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} -> u - & uvWorld . hud . hudElement . subInventory - %~ docombineregexinput sss msel + & tohud . subInventory %~ docombineregexinput sss msel & uvWorld . worldEventFlags . at CombineInventoryChange ?~ () _ | disel ^? _Just . _1 == Just (-1) -> u - & uvWorld . hud . hudElement - %~ dodisplayregexinput diInvFilter diInvFilter (-1) + & tohud %~ dodisplayregexinput diInvFilter diInvFilter (-1) & uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld %~ setInvPosFromSS _ | disel ^? _Just . _1 == Just 2 -> u - & uvWorld . hud . hudElement - %~ dodisplayregexinput diCloseFilter diCloseFilter 2 + & tohud %~ dodisplayregexinput diCloseFilter diCloseFilter 2 & uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld %~ setInvPosFromSS _ -> M.foldlWithKey' updateKeyInGame u pkeys where + tohud = uvWorld . hud . hudElement pkeys = u ^. uvWorld . input . pressedKeys dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do sss <- di ^? diSections @@ -99,21 +95,28 @@ updateMouseInGame cfig w updateMouseHeldInGame :: Configuration -> World -> World updateMouseHeldInGame cfig w = case w ^. input . mouseContext of - OverInvDragSelect {} | ButtonRight `M.member` (w ^. input . mouseButtons) - -> w & input . mouseContext .~ MouseGameRotate - OverInvDragSelect (Just sstart) _ -> fromMaybe w $ do - sss <- w ^? hud . hudElement . diSections - let msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos) - return $ case msel of + OverInvDragSelect{} | ButtonRight `M.member` (w ^. input . mouseButtons) -> + w & input . mouseContext .~ MouseGameRotate + OverInvDragSelect (Just sstart) _ -> + let sss = w ^. hud . hudElement . diSections + msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos) + in case msel of Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing - Just (i,j) | i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j + Just (i, j) + | i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j | i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0 - | otherwise -> w & input . mouseContext . mcoSelEnd .~ fmap fst - (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems) + | otherwise -> + w & input . mouseContext . mcoSelEnd + .~ fmap + fst + (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems) + -- not sure how the above performs when filtering... OverInvDragSelect Nothing _ -> fromMaybe w $ do sss <- w ^? hud . hudElement . diSections - ysel <- inverseSelSecYint - (posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss + ysel <- + inverseSelSecYint + (posSelSecYint cfig invDP (w ^. input . mousePos . _y)) + sss ^? nonInf guard (isGroupSelectableSection $ fst ysel) return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing @@ -122,7 +125,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of doDrag :: Configuration -> Int -> Int -> Maybe (Int, Int) -> World -> World doDrag cfig n k mmouseover w = fromMaybe w $ do - guard (n /= 0) -- > 0 ? + guard (n /= 0) ss <- w ^? hud . hudElement . diSections . ix k . ssItems x <- mmouseover is <- w ^? hud . hudElement . diSelection . _Just . _3 @@ -150,15 +153,12 @@ tryPickupSelected k mpos w = do ispickup = map (_unNInt . _itID) itmstopickup guard $ nfreeslots >= slotsneeded return $ case mpos of - Just (0, j) -> - foldr (pickUpItemAt j 0) w ispickup - & newdisel j xs - _ -> - foldl' (flip $ pickUpItem 0) w ispickup - & newdisel (length (cr ^. crInv)) xs + Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j xs + _ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs where - newdisel j xs = hud . hudElement . diSelection ?~ - (0 , j , IS.fromDistinctAscList [j .. j + IS.size xs -1]) + newdisel j xs = + hud . hudElement . diSelection + ?~ (0, j, IS.fromDistinctAscList [j .. j + IS.size xs -1]) g i = do NInt j <- w ^? hud . closeItems . ix i w ^? cWorld . lWorld . items . ix j @@ -176,17 +176,12 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of ( maybe mempty (h ssel) - ( guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1) - >> mesel ^? _Just - ) + (guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1) >> mesel ^? _Just) ) - OverInvDragSelect _ Nothing -> - w & input . mouseContext .~ MouseInGame - & hud . hudElement . diSelection . _Just . _3 %~ const mempty OverInvDragSelect (Just ssel) (Just esel) -> w & input . mouseContext .~ MouseInGame & invSetSelection (f (fst ssel, esel) (h ssel esel)) - OverInvDragSelect Nothing _ -> + OverInvDragSelect{} -> w & input . mouseContext .~ MouseInGame & hud . hudElement . diSelection . _Just . _3 %~ const mempty _ -> w @@ -208,20 +203,21 @@ isGroupSelectableSection = \case updateMouseClickInGame :: Configuration -> World -> World updateMouseClickInGame cfig w = case w ^. input . mouseContext of MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do - sss <- w ^? hud . hudElement . diSections - ysel <- inverseSelSecYint - (posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss ^? nonInf + let sss = w ^. hud . hudElement . diSections + ysel <- + inverseSelSecYint + (posSelSecYint cfig invDP (w ^. input . mousePos . _y)) + sss + ^? nonInf guard (isGroupSelectableSection $ fst ysel) return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing OverInvSelect (-1, _) | selsec == Just (-1) -> - w - & hud . hudElement . diSelection %~ endRegex (-1) w + w & hud . hudElement . diSelection %~ endRegex (-1) w & hud . hudElement . diInvFilter .~ Nothing OverInvSelect (2, _) | selsec == Just 2 -> - w - & hud . hudElement . diSelection %~ endRegex 2 w + w & hud . hudElement . diSelection %~ endRegex 2 w & hud . hudElement . diCloseFilter .~ Nothing OverInvSelect x | ScancodeLShift `M.member` (w ^. input . pressedKeys) @@ -252,11 +248,13 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of str <- fmap (take 5) $ w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (NInt j) - >>= \k -> w ^? cWorld . lWorld . items . ix k - >>= (listToMaybe . basicItemDisplay) + >>= \k -> + w ^? cWorld . lWorld . items . ix k + >>= (listToMaybe . basicItemDisplay) return . (worldEventFlags . at CombineInventoryChange ?~ ()) $ case w ^? hud . hudElement . subInventory . ciFilter . _Just of - Just ('#' : xs) | str == xs -> + Just ('#' : xs) + | str == xs -> w & hud . hudElement . subInventory . ciFilter .~ Nothing _ -> w & hud . hudElement . subInventory . ciFilter ?~ ("#" ++ str) _ -> w @@ -265,28 +263,24 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of selsec = w ^? hud . hudElement . diSelection . _Just . _1 endRegex :: Int -> World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet) -endRegex i w = fromMaybe id $ do - sss <- w ^? hud . hudElement . diSections - let j = fromMaybe 0 $ do - itms <- sss ^? ix i . ssItems - (k, _) <- IM.lookupMin itms - return k - return $ ssSetCursor (ssLookupDown i j) sss +endRegex i w = ssSetCursor (ssLookupDown i j) sss + where + sss = w ^. hud . hudElement . diSections + j = maybe 0 fst $ IM.lookupMin =<< sss ^? ix i . ssItems endCombineRegex :: World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet) -endCombineRegex w = fromMaybe id $ do - sss <- w ^? hud . hudElement . subInventory . ciSections - let j = fromMaybe 0 $ do +endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss + where + sss = w ^. hud . hudElement . subInventory . ciSections + j = fromMaybe 0 $ do itms <- sss ^? ix 0 . ssItems (k, _) <- IM.lookupMin itms return (k -1) - return $ ssSetCursor (ssLookupDown 0 j) sss startDrag :: (Int, Int) -> World -> World -startDrag (a, b) w = setcontext - $ case w ^? hud . hudElement . diSelection . _Just of - Just (i,_,xs) | i == a && b `IS.member` xs -> w - _ -> invSetSelection (a, b, IS.singleton b) w +startDrag (a, b) w = setcontext $ case w ^? hud . hudElement . diSelection . _Just of + Just (i, _, xs) | i == a && b `IS.member` xs -> w + _ -> invSetSelection (a, b, IS.singleton b) w where setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b)) @@ -294,7 +288,7 @@ concurrentIS :: IS.IntSet -> Bool concurrentIS = go . IS.minView where go x = fromMaybe True $ do - (i,is) <- x + (i, is) <- x (j, js) <- IS.minView is return $ i + 1 == j && go (Just (j, js)) @@ -320,9 +314,11 @@ shiftInvItems :: shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do let xk = fst x let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y) - bn = (\v -> inverseSelSecYint (yint + 1) v ^? nonInf) + bn = + (\v -> inverseSelSecYint (yint + 1) v ^? nonInf) =<< w ^? hud . hudElement . diSections - ab = (\v -> inverseSelSecYint (yint - 1) v ^? nonInf) + ab = + (\v -> inverseSelSecYint (yint - 1) v ^? nonInf) =<< w ^? hud . hudElement . diSections guard $ xk == k || xk + 1 == k || xk -1 == k (maxi, _) <- IS.maxView xs @@ -354,8 +350,7 @@ shiftInvItemsUp j is w = IS.foldl' f w is shiftInvItemsDown :: Int -> IS.IntSet -> World -> World shiftInvItemsDown j is w = fromMaybe w $ do let i = IS.findMax is - guard . isJust $ - w ^? hud . hudElement . diSections . ix j . ssItems . ix i + guard . isJust $ w ^? hud . hudElement . diSections . ix j . ssItems . ix i return $ IS.foldr f w is where f i' w' = swapItemWith g (j, i') w' @@ -363,10 +358,7 @@ shiftInvItemsDown j is w = fromMaybe w $ do updateFunctionKeys :: Universe -> Universe updateFunctionKeys u = - M.foldlWithKey' - updateFunctionKey - u - (u ^. uvWorld . input . pressedKeys) + M.foldlWithKey' updateFunctionKey u (u ^. uvWorld . input . pressedKeys) updateFunctionKey :: Universe -> Scancode -> Int -> Universe updateFunctionKey uv sc 0 = case sc of @@ -392,8 +384,9 @@ updateKeysInTerminal tmid u = fromMaybe u $ do x <- u ^? uvWorld . cWorld . lWorld . buttons . ix (tm ^. tmButtonID) . btPos y <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos return $ case tm ^. tmStatus of - _ | dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) - -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory + _ + | dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) -> + u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory TerminalTextInput{} -> updateKeysTextInputTerminal tmid u TerminalPressTo{} -> updateKeyContinueTerminal tmid u @@ -401,8 +394,7 @@ updateKeysInTerminal tmid u = fromMaybe u $ do updateKeyContinueTerminal :: Int -> Universe -> Universe updateKeyContinueTerminal tmid u - | elem 0 $ u ^. uvWorld . input . pressedKeys = - u & uvWorld %~ continueTerminal tmid + | elem 0 $ u ^. uvWorld . input . pressedKeys = u & uvWorld %~ continueTerminal tmid | otherwise = u continueTerminal :: Int -> World -> World @@ -421,7 +413,8 @@ updateKeysTextInputTerminal tmid u = uvWorld %~ terminalReturnEffect tmid | otherwise = id tryTabComplete - | u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 = uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete (u ^. uvWorld) + | u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 = + uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete (u ^. uvWorld) | otherwise = id updateKeyInGame :: Universe -> Scancode -> Int -> Universe @@ -452,10 +445,10 @@ updateLongPressInGame uv = \case doRegexInput :: Input -> Int -> - IM.IntMap (SelectionSection a) -> + IMSS a -> Maybe (Int, Int, IS.IntSet) -> Maybe String -> - (IM.IntMap (SelectionSection a), Maybe (Int, Int, IS.IntSet), Maybe String) + (IMSS a, Maybe (Int, Int, IS.IntSet), Maybe String) doRegexInput inp i sss msel filts | backspacetonothing || escapekey = endregex i 0 | endkeys = endregex (i + 1) (j -1) @@ -474,10 +467,7 @@ doRegexInput inp i sss msel filts itms <- sss ^? ix (i + 1) . ssItems fst <$> IM.lookupMin itms escapekey = ScancodeEscape `M.lookup` pkeys == Just 0 - endkeys = - any - ((== Just 0) . (`M.lookup` pkeys)) - [ScancodeReturn, ScancodeSlash] + endkeys = any ((== Just 0) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash] backspacetonothing = filts == Just "" && ScancodeBackspace `M.lookup` pkeys == Just 0 @@ -485,10 +475,12 @@ doRegexInput inp i sss msel filts updateBackspaceRegex :: World -> World updateBackspaceRegex w = case di ^? subInventory of - Just NoSubInventory{} | secfocus (-1) 0 -> + Just NoSubInventory{} + | secfocus (-1) 0 -> w & hud . hudElement %~ trybackspace (-1) diInvFilter diInvFilter diSelection & worldEventFlags . at InventoryChange ?~ () - Just NoSubInventory{} | secfocus 2 3 -> + Just NoSubInventory{} + | secfocus 2 3 -> w & hud . hudElement %~ trybackspace 2 diCloseFilter diCloseFilter diSelection & worldEventFlags . at InventoryChange ?~ () Just CombineInventory{} -> @@ -510,10 +502,12 @@ updateBackspaceRegex w = case di ^? subInventory of updateEnterRegex :: World -> World updateEnterRegex w = case w ^? hud . hudElement . subInventory of - Just NoSubInventory{} | secfocus [-1, 0, 1] -> + Just NoSubInventory{} + | secfocus [-1, 0, 1] -> w & hud . hudElement . diSelection ?~ (-1, 0, mempty) & hud . hudElement . diInvFilter %~ enterregex - Just NoSubInventory{} | secfocus [2, 3] -> + Just NoSubInventory{} + | secfocus [2, 3] -> w & hud . hudElement . diSelection ?~ (2, 0, mempty) & hud . hudElement . diCloseFilter %~ enterregex Just CombineInventory{} -> @@ -527,34 +521,28 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of enterregex = (<|> Just "") pauseGame :: Universe -> Universe -pauseGame u = u & uvScreenLayers .~ [pauseMenu u] - & pauseSound +pauseGame u = u & uvScreenLayers .~ [pauseMenu u] & pauseSound spaceAction :: World -> World -spaceAction w = case w ^. hud . hudElement of - DisplayInventory{_subInventory = NoSubInventory{}} -> - maybe id interactWithCloseObj (getCloseObj w) w - DisplayInventory{_subInventory = DisplayTerminal{}} -> - w - & hud . hudElement . subInventory .~ NoSubInventory - & worldEventFlags . at InventoryChange ?~ () +spaceAction w = case w ^. hud . hudElement . subInventory of + NoSubInventory -> maybe id interactWithCloseObj (getCloseObj w) w _ -> w & hud . hudElement . subInventory .~ NoSubInventory getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button) getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut where topcitem = do - k' <- (w ^? hud . hudElement . diSections . ix 3 . ssItems) - >>= (fmap fst . IM.lookupMin) - Left <$> w ^? hud . closeItems . ix k' + k <- (w ^? hud . hudElement . diSections . ix 3 . ssItems) + >>= (fmap fst . IM.lookupMin) + Left <$> w ^? hud . closeItems . ix k topcbut = do k <- w ^? hud . closeButtons . ix 0 Right <$> w ^? cWorld . lWorld . buttons . ix k tryCombine :: (Int, Int) -> World -> World tryCombine (i, j) w = fromMaybe w $ do - sss <- w ^? hud . hudElement . subInventory . ciSections - CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just + CombinableItem is it <- w ^? hud . hudElement . subInventory + . ciSections . ix i . ssItems . ix j . siPayload . _Just p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos return $ (createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is)))