From 46ee29f6460757a1122e0718213e6d84f35cc317 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 25 Oct 2024 22:42:23 +0100 Subject: [PATCH] Remove intmap over filters --- ghcidOutput | 8 +++- src/Dodge/Data/HUD.hs | 11 ++---- src/Dodge/Data/SelectionList.hs | 2 + src/Dodge/Default/World.hs | 4 +- src/Dodge/DisplayInventory.hs | 8 ++-- src/Dodge/InputFocus.hs | 7 ++-- src/Dodge/Update/Input/InGame.hs | 64 ++++++++++++++++++++------------ 7 files changed, 65 insertions(+), 39 deletions(-) diff --git a/ghcidOutput b/ghcidOutput index 179966296..0d11fd430 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -1 +1,7 @@ -All good (595 modules, at 22:15:48) +/home/justin/Haskell/loop/src/Dodge/DisplayInventory.hs:(134,16)-(136,62): warning: [GHC-62161] [-Wincomplete-patterns] + Pattern match(es) are non-exhaustive + In a case alternative: + Patterns of type ‘a’ not matched: p where p is not one of {(-1), 2} + | +134 | mstr = case i of + | ^^^^^^^^^... diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index b75c19f5f..763070492 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -16,9 +16,10 @@ import Geometry.Data data HUDElement = DisplayInventory { _subInventory :: SubInventory - , _diSections :: IntMap (SelectionSection ()) + , _diSections :: IMSS () , _diSelection :: Maybe (Int, Int) - , _diFilters :: IntMap (Maybe String) + , _diInvFilter :: Maybe String + , _diCloseFilter :: Maybe String , _diSelectionExtra :: Int } | DisplayCarte @@ -38,13 +39,11 @@ data SubInventory | CombineInventory { _ciSections :: IntMap (SelectionSection CombinableItem) , _ciSelection :: Maybe (Int, Int) - , _ciFilters :: IntMap (Maybe String) + , _ciFilter :: Maybe String } | LockedInventory | DisplayTerminal {_termID :: Int} --- deriving (Eq, Ord, Show, Read) --Generic, Flat) - data HUD = HUD { _hudElement :: HUDElement , _carteCenter :: Point2 @@ -53,8 +52,6 @@ data HUD = HUD , _closeObjects :: [Either FloorItem Button] } --- deriving (Eq, Ord, Show, Read) --Generic, Flat) - makeLenses ''HUD makeLenses ''HUDElement makeLenses ''SubInventory diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index c89c15892..d6bffe17b 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -53,6 +53,8 @@ data SelectionSection a = SelectionSection , _ssDescriptor :: String } +type IMSS a = IntMap (SelectionSection a) + data SelectionWidth = FixedSelectionWidth Int | VariableSelectionWidth (Int -> Int) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index cc9a30580..2c9b51633 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -168,7 +168,9 @@ defaultDisplayInventory = , _diSections = defaultInvSections , _diSelection = Just (1,0) , _diSelectionExtra = 0 - , _diFilters = IM.fromList [(-1, mempty), (2, mempty)] +-- , _diFilters = IM.fromList [(-1, mempty), (2, mempty)] + , _diInvFilter = mempty + , _diCloseFilter = mempty } --defaultSSSExtra :: SSSExtra diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index df7037c84..538672de3 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -65,7 +65,7 @@ updateCombineSections w cfig = IM.singleton 0 (SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0) - mstr = w ^? hud . hudElement . subInventory . ciFilters . ix (-1) . _Just + mstr = w ^? hud . hudElement . subInventory . ciFilter . _Just numfiltitems = " " ++ show (length allcombs - length filtcombs) ++ " FILTERED" regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool @@ -131,7 +131,9 @@ updateDisplaySections w cfig sss = , (i + 1, itms') ) where - mstr = w ^? hud . hudElement . diFilters . ix i . _Just + mstr = case i of + (-1) -> w ^? hud . hudElement . diInvFilter . _Just + 2 -> w ^? hud . hudElement . diCloseFilter . _Just filtsis = fromMaybe mempty $ do str <- mstr return $ @@ -255,7 +257,7 @@ enterCombineInv cfig w = .~ CombineInventory sss selpos - (IM.singleton (-1) Nothing) + Nothing where cm' = IM.fromDistinctAscList . zip [0 ..] $ combineList w cm diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index 337656eba..25d4f11db 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -68,11 +68,11 @@ inputFocus :: Maybe ((String -> f String) -> World -> f World) inputFocus w = case w ^? hud . hudElement . subInventory of Just NoSubInventory{} -> case he ^? diSelection . _Just of - Just (-1, _) -> di (-1) - Just (2, _) -> di 2 + Just (-1, _) -> Just $ hud . hudElement . diInvFilter . _Just + Just (2, _) -> Just $ hud . hudElement . diCloseFilter . _Just _ -> Nothing Just CombineInventory{} -> case he ^? subInventory . ciSelection . _Just of - Just (-1, _) -> Just $ hud . hudElement . subInventory . ciFilters . ix (-1) . _Just + Just (-1, _) -> Just $ hud . hudElement . subInventory . ciFilter . _Just _ -> Nothing Just DisplayTerminal{_termID = tmid} -> do hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus @@ -81,7 +81,6 @@ inputFocus w = case w ^? hud . hudElement . subInventory of return $ cWorld . lWorld . terminals . ix tmid . tmInput . tiText _ -> Nothing where - di x = Just $ hud . hudElement . diFilters . ix x . _Just he = w ^. hud . hudElement inTopRegex :: Int -> World -> Bool diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 3d8db1986..9c9944a0d 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -58,7 +58,7 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of _ | inCloseRegex (u ^. uvWorld) -> --u & uvWorld . hud . hudElement . diSections %~ doRegexInput (u ^. uvWorld . input) 2 - u & uvWorld . hud . hudElement %~ dodisplayregexinput 2 + u & uvWorld . hud . hudElement %~ dodisplayregexinput' 2 & uvWorld . worldEventFlags . at InventoryChange ?~ () & uvWorld %~ setInvPosFromSS _ -> M.foldlWithKey' updateKeyInGame u pkeys @@ -69,21 +69,30 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of docombineregexinput ci = fromMaybe ci $ do sss <- ci ^? ciSections msel <- ci ^? ciSelection - filts <- ci ^? ciFilters + filts <- ci ^? ciFilter let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts return $ ci & ciSections .~ sss' & ciSelection .~ msel' - & ciFilters .~ filts' + & ciFilter .~ filts' dodisplayregexinput x di = fromMaybe di $ do sss <- di ^? diSections msel <- di ^? diSelection - filts <- di ^? diFilters + filts <- di ^? diInvFilter let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts return $ di & diSections .~ sss' & diSelection .~ msel' - & diFilters .~ filts' + & diInvFilter .~ filts' + dodisplayregexinput' x di = fromMaybe di $ do + sss <- di ^? diSections + msel <- di ^? diSelection + filts <- di ^? diCloseFilter + let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts + return $ + di & diSections .~ sss' + & diSelection .~ msel' + & diCloseFilter .~ filts' updatePressedButtonsCarte :: World -> World updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w @@ -158,21 +167,21 @@ doRegexInput :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int) -> - IM.IntMap (Maybe String) -> - (IM.IntMap (SelectionSection a), Maybe (Int, Int), IM.IntMap (Maybe String)) + Maybe String -> + (IM.IntMap (SelectionSection a), Maybe (Int, Int), Maybe String) doRegexInput inp i sss msel filts | backspacetonothing || escapekey = endregex i 0 | endkeys || endmouse = endregex (i + 1) (j -1) | otherwise = ( sss , msel - , filts & doTextInputOver inp (ix i . _Just) + , filts & doTextInputOver inp _Just ) where endregex a b = ( sss & ix i . ssItems .~ mempty , msel & ssSetCursor (ssLookupDown a b) sss - , filts & ix i .~ Nothing + , Nothing ) j = fromMaybe 0 $ do itms <- sss ^? ix (i + 1) . ssItems @@ -184,7 +193,7 @@ doRegexInput inp i sss msel filts [ScancodeReturn, ScancodeSlash] endmouse = (Just 0 ==) $ inp ^? mouseButtons . ix ButtonLeft backspacetonothing = - filts ^? ix i . _Just == Just "" + filts == Just "" && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = inp ^. pressedKeys @@ -196,7 +205,7 @@ updateBackspaceRegex w = case di ^? subInventory of & worldEventFlags . at InventoryChange ?~ () Just NoSubInventory{} | secfocus 2 3 -> - w & hud . hudElement %~ trybackspace 2 + w & hud . hudElement %~ trybackspace'' 2 & worldEventFlags . at InventoryChange ?~ () Just CombineInventory{} -> w & hud . hudElement . subInventory %~ trybackspace' (-1) @@ -207,19 +216,26 @@ updateBackspaceRegex w = case di ^? subInventory of i <- di ^? diSelection . _Just . _1 return $ i == a || i == b trybackspace x he = fromMaybe he $ do - str <- he ^? diFilters . ix x . _Just + str <- he ^? diInvFilter . _Just return $ case str of (_ : _) -> - he & diFilters . ix x . _Just %~ init + he & diInvFilter . _Just %~ init & diSelection ?~ (x, 0) - [] -> he & diFilters . ix x .~ Nothing - trybackspace' x ci = fromMaybe ci $ do - str <- ci ^? ciFilters . ix x . _Just + [] -> he & diInvFilter .~ Nothing + trybackspace'' x he = fromMaybe he $ do + str <- he ^? diCloseFilter . _Just return $ case str of (_ : _) -> - ci & ciFilters . ix x . _Just %~ init + he & diCloseFilter . _Just %~ init + & diSelection ?~ (x, 0) + [] -> he & diCloseFilter .~ Nothing + trybackspace' x ci = fromMaybe ci $ do + str <- ci ^? ciFilter . _Just + return $ case str of + (_ : _) -> + ci & ciFilter . _Just %~ init & ciSelection ?~ (x, 0) - [] -> ci & ciFilters . ix x .~ Nothing + [] -> ci & ciFilter .~ Nothing di = w ^. hud . hudElement updateEnterRegex :: World -> World @@ -227,13 +243,13 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of Just NoSubInventory{} | secfocus (-1) 0 -> w & hud . hudElement . diSelection ?~ (-1, 0) - & hud . hudElement . diFilters %~ enterregex (-1) + & hud . hudElement . diInvFilter %~ enterregex Just NoSubInventory{} | secfocus 2 3 -> w & hud . hudElement . diSelection ?~ (2, 0) - & hud . hudElement . diFilters %~ enterregex 2 + & hud . hudElement . diCloseFilter %~ enterregex Just CombineInventory{} -> - w & hud . hudElement . subInventory . ciFilters %~ enterregex (-1) + w & hud . hudElement . subInventory . ciFilter %~ enterregex & hud . hudElement . subInventory . ciSelection ?~ (-1, 0) _ -> w where @@ -241,7 +257,7 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of secfocus a b = fromMaybe False $ do i <- di ^? diSelection . _Just . _1 return $ i == a || i == b - enterregex x = ix x %~ (<|> Just "") + enterregex = (<|> Just "") pauseGame :: Universe -> Universe pauseGame u = u & uvScreenLayers .~ [pauseMenu u] @@ -279,7 +295,9 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of , _diSections = defaultInvSections , _diSelection = Nothing , _diSelectionExtra = 0 - , _diFilters = IM.fromList [(-1, mempty), (2, mempty)] +-- , _diFilters = IM.fromList [(-1, mempty), (2, mempty)] + , _diInvFilter = mempty + , _diCloseFilter = mempty } _ -> u & uvWorld . hud . hudElement .~ DisplayCarte