From 2e46123a921effc9e98f4ede869e10f13e14a709 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 20 Feb 2023 11:19:25 +0000 Subject: [PATCH] Prevent selection of unselectable items when scrolling --- src/Dodge/Combine.hs | 15 ++++---- src/Dodge/DisplayInventory.hs | 65 +++++++++------------------------- src/Dodge/Inventory.hs | 1 - src/Dodge/Render/List.hs | 1 - src/Dodge/SelectionSections.hs | 53 +++++++++++++++------------ src/Dodge/Update/Input.hs | 4 +-- 6 files changed, 58 insertions(+), 81 deletions(-) diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 9d55c9f86..e648254e7 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -6,7 +6,7 @@ module Dodge.Combine ( ) where import Dodge.Data.Universe -import Regex +--import Regex import Dodge.DisplayInventory import Dodge.Render.HUD import Dodge.SelectionList @@ -53,7 +53,6 @@ combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv combineList :: World -> [SelectionItem CombinableItem] combineList w = case combineList' w of - -- [] -> [SelectionInfo ["No possible combinations"] 1 False 0 white 0] [] -> [SelectionInfo ["No possible combinations"] 1 False white 0] xs -> xs @@ -140,22 +139,26 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of enterCombineInv :: Configuration -> World -> World enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory - cm + cm' Nothing sss --(updateCombineSelections w cfig sss) where - cm = IM.fromAscList $ zip [0..] $ combineList w + cm' = IM.fromAscList $ zip [0..] $ combineList' w + cm | null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0 + | otherwise = cm' sss = SelectionSections { _sssSections = IM.singleton 0 combsection - , _sssSelPos = Just (0,0) + , _sssSelPos = selpos } + selpos | null cm' = Nothing + | otherwise = Just (0,0) availablelines = getAvailableListLines secondColumnParams cfig combsection = updateSection cm (Just 0) availablelines combinationssection' combinationssection' = SelectionSection { _ssItems = cm , _ssCursor = do - (i,si) <- IM.lookupMin cm + (_,si) <- IM.lookupMin cm return $ SectionCursor 0 (length (_siPictures si)) (_siColor si) , _ssMinSize = 5 , _ssOffset = 0 diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index af00e49e3..550015871 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -4,7 +4,6 @@ module Dodge.DisplayInventory , defaultSS , defaultFiltSection , defaultDisplaySections --- , updateSections , updateSection ) where @@ -39,36 +38,32 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex] InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx] InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx] - filtinv = (-1,filtinvitems) - filtinvitems = case cr ^? crManipulation . invRegex . _Just of - Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0) - Nothing -> mempty - filtclose = (2,filtcloseitems) - filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of - Just str -> IM.singleton 0 (SelectionRegex ["NEARBY FILTER: " ++ str,numfiltclose] 2 True white 0) - Nothing -> mempty - numfiltitems = " " ++ show numfiltitems' ++ " FILTERED" - numfiltitems' = length invitems' - length invitems - numfiltclose = " " ++ show numfiltclose' ++ " FILTERED" - numfiltclose' = length coitems' - length coitems - invx = (0, invitems) + (filtinv,invx) = filtpair (-1) (crManipulation . invRegex . _Just) invitems' "INV. " + (filtclose,closex) = filtpair 2 (crManipulation . closeRegex . _Just) coitems' "NEARBY " youx = (1, youitems) - closex = (3, coitems) youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 () thetext = displayFreeSlots nfreeslots availablelines = getAvailableListLines (invDisplayParams w) cfig coitems' = IM.fromDistinctAscList . zip [0..] $ map closeObjectToSelectionItem (w ^. hud . closeObjects) - coitems = case cr ^? crManipulation . closeRegex . _Just of - Just str -> IM.filter (regexList str . _siPictures) coitems' - Nothing -> coitems' invitems' = IM.mapWithKey (invSelectionItem' cr) inv - invitems = case cr ^? crManipulation . invRegex . _Just of - Just str -> IM.filter (regexList str . _siPictures) invitems' - Nothing -> invitems' cr = you w inv = _crInv (you w) nfreeslots = crNumFreeSlots cr + filtpair i regpointer itms filtdescription = + ( ( i, filtsis) + , ( i+1, itms') + ) + where + mstr = cr ^? regpointer + filtsis = fromMaybe mempty $ do + str <- mstr + return $ IM.singleton 0 + (SelectionRegex [filtdescription ++ "FILTER: "++str,numfiltitems] 2 True white 0) + itms' = fromMaybe itms $ do + str <- mstr + return $ IM.filter (regexList str . _siPictures) itms + numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED" displayFreeSlots :: Int -> String displayFreeSlots x = case x of @@ -76,7 +71,6 @@ displayFreeSlots x = case x of 1 -> "1 FREE SLOT" _ -> show x ++ " FREE SLOTS" - updateSectionsPositioning :: SelectionSections a -> Int -> [(Int,IM.IntMap (SelectionItem a))] @@ -96,33 +90,6 @@ updateSectionsPositioning sss allavailablelines ((k,y) : xs) linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss') previoussections = updateSectionsPositioning sss availablelines xs ---updateSectionsPositioning --- :: SelectionSections a --- -> Int -> (Int, Int) -> [(Int,IM.IntMap (SelectionItem a))] --- -> SelectionSections a ---updateSectionsPositioning sss _ _ [] = sss & sssSections .~ mempty ---updateSectionsPositioning sss allavailablelines (i,j) ((k,y) : xs) --- = previoussections & sssSections %~ IM.insert k ss --- where --- ss | i == k = updateSection (Just j) y linesleft x --- | otherwise = updateSection Nothing y linesleft x --- x = sss ^?! sssSections . ix k --- availablelines = allavailablelines - _ssMinSize x --- linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ _sssSections previoussections) --- previoussections = updateSectionsPositioning sss availablelines (i,j) xs - ---updateSections :: Int -> (Int, Int) -> [(Int,(SelectionSection a,IM.IntMap (SelectionItem a)))] --- -> IM.IntMap (SelectionSection a) ---updateSections _ _ [] = mempty ---updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss previoussections --- where --- ss | i == k = updateSection y linesleft x --- | otherwise = updateSection y linesleft x --- availablelines = allavailablelines - _ssMinSize x --- linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ previoussections) --- previoussections = updateSections availablelines (i,j) xs - - manObjIndex :: ManipulatedObject -> (Int,Int) manObjIndex mo = case mo of InInventory SortInventory -> (-1, 0) diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 18c9fafb4..301e9ff90 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -2,7 +2,6 @@ module Dodge.Inventory ( selSecSelPos, - firstPosSelectionSections, checkInvSlotsYou, rmSelectedInvItem, selNumPos, diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 5b5acc999..056114bd5 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -2,7 +2,6 @@ module Dodge.Render.List where --import Picture.Text import Dodge.Inventory -import qualified Data.IntMap.Strict as IM --import Data.Foldable import Dodge.SelectionList import Data.Maybe diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs index 50ae087fa..63b17953e 100644 --- a/src/Dodge/SelectionSections.hs +++ b/src/Dodge/SelectionSections.hs @@ -3,9 +3,10 @@ module Dodge.SelectionSections ( ssLookupDown, ssLookupGT, ssSetCursor, - firstPosSelectionSections, + setFirstPosSelectionSections, ) where +import Control.Applicative import Control.Lens import qualified Data.IntMap.Strict as IM import Data.Maybe @@ -17,33 +18,41 @@ scrollSelectionSections yi sss | yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections | otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections --- when is this used? it needs to correctly set the cursor -firstPosSelectionSections :: SelectionSections a -> SelectionSections a -firstPosSelectionSections sss = fromMaybe sss $ do +setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a +setFirstPosSelectionSections sss = fromMaybe sss $ do (i, j, _) <- ssLookupMin sss - return $ - sss - & sssSelPos ?~ (i, j) - --- & sssSetCursor --- & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) - ---sssSetCursor :: SelectionSections a -> SelectionSections a ---sssSetCursor sss = sss + return $ sss & sssSelPos ?~ (i, j) +--scrollUpSelectionSections :: SelectionSections a -> SelectionSections a +--scrollUpSelectionSections sss = fromMaybe (setFirstPosSelectionSections sss) $ do +-- (i, j) <- sss ^? sssSelPos . _Just +-- (i', j', _) <- ssLookupUp i j sss +-- return $ sss & sssSelPos ?~ (i', j') scrollUpSelectionSections :: SelectionSections a -> SelectionSections a -scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do - (i, j) <- sss ^? sssSelPos . _Just - (i', j', _) <- ssLookupUp i j sss - return $ sss & sssSelPos ?~ (i', j') +scrollUpSelectionSections sss = sss & sssSelPos .~ + fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) + where + f (i,j,_) = (i,j) --- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) +ssScrollUp :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssScrollUp sss = l <|> ssLookupMin sss + where + l = do + (i,j) <- sss ^? sssSelPos . _Just + ssLookupUp i j sss + +ssScrollDown :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssScrollDown sss = l <|> ssLookupMin sss + where + l = do + (i,j) <- sss ^? sssSelPos . _Just + ssLookupDown i j sss scrollDownSelectionSections :: SelectionSections a -> SelectionSections a -scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do - (i, j) <- sss ^? sssSelPos . _Just - (i', j', _) <- ssLookupDown i j sss - return $ sss & sssSelPos ?~ (i', j') +scrollDownSelectionSections sss = sss & sssSelPos .~ + fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) + where + f (i,j,_) = (i,j) -- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index ce6dc9927..e66e1a329 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -57,7 +57,7 @@ updateUseInputInGame h u = case h of u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True CombineInventory _ _ sss | inSubInvRegex (u ^. uvWorld) -> doSubInvRegexInput u - | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u -- maybeexitcombine (maybe id doCombine mi w) + | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u _ | inInvRegex (u ^. uvWorld) -> doRegexInput (-1) invRegex invRegex u _ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u _ -> M.foldlWithKey' updateKeyInGame u pkeys @@ -76,7 +76,7 @@ tryCombine sss w = fromMaybe w $ do maybeExitCombine :: Universe -> Universe maybeExitCombine u | ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) - = u + = u & uvWorld %~ enterCombineInv (u ^. uvConfig) | otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory doTextInputOver :: ASetter' Universe String -> Universe -> Universe