From c0ef36426a0644fb74e28af1bd1a363caff485d6 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 17 Feb 2023 11:19:07 +0000 Subject: [PATCH] Implement filter on nearby objects --- .../Data/Item/Use/Consumption/LoadAction.hs | 9 +++ src/Dodge/Default/Creature.hs | 2 +- src/Dodge/DisplayInventory.hs | 28 +++++++--- src/Dodge/InputFocus.hs | 9 ++- src/Dodge/Inventory.hs | 11 ++-- src/Dodge/Render/HUD.hs | 5 +- src/Dodge/Update.hs | 1 + src/Dodge/Update/Input.hs | 56 ++++++++++++++++++- 8 files changed, 103 insertions(+), 18 deletions(-) diff --git a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs index 6151e70d4..c4c743df6 100644 --- a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs +++ b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs @@ -21,6 +21,7 @@ data Manipulation -- should be ManipulatedObject? -- = InvSel {_isel :: SelPos} = Manipulator {_manObject :: ManipulatedObject , _invRegex :: Maybe String + , _closeRegex :: Maybe String } | Brute deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -28,6 +29,12 @@ data Manipulation -- should be ManipulatedObject? data ManipulatedObject = InInventory {_inInventory :: InventoryManipulation} | SelNothing +-- | SelCloseObject {_ispCloseObject :: Int} + | InNearby {_inNearby :: NearbyManipulation} + deriving (Eq, Ord, Show, Read) --Generic, Flat) + +data NearbyManipulation + = SortNearby | SelCloseObject {_ispCloseObject :: Int} deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -50,11 +57,13 @@ makeLenses ''LoadAction makeLenses ''ManipulatedObject makeLenses ''Manipulation makeLenses ''InventoryManipulation +makeLenses ''NearbyManipulation makeLenses ''LeftInvSel makeLenses ''InvSelAction deriveJSON defaultOptions ''LoadAction deriveJSON defaultOptions ''InvSelAction deriveJSON defaultOptions ''InventoryManipulation +deriveJSON defaultOptions ''NearbyManipulation deriveJSON defaultOptions ''ManipulatedObject deriveJSON defaultOptions ''Manipulation deriveJSON defaultOptions ''LeftInvSel diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index 1defee31b..954326c55 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -26,7 +26,7 @@ defaultCreature = , _crHP = 100 , _crMaxHP = 150 , _crInv = IM.empty - , _crManipulation = Manipulator SelNothing Nothing + , _crManipulation = Manipulator SelNothing Nothing Nothing , _crInvCapacity = 25 , _crInvLock = False , _crInvEquipped = mempty diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index dd0cf34ae..09c453f12 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -23,21 +23,25 @@ import Dodge.Data.World updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of Just (InInventory SortInventory) -> sss - { _sssSections = updateSections availablelines ((-1),0) [filtinv,invx ,youx, closex] + { _sssSections = updateSections availablelines ((-1),0) [filtinv,filtclose,invx ,youx, closex] , _sssSelPos = Just (-1) } Just (InInventory (SelItem i _)) -> sss - { _sssSections = updateSections availablelines (0,i) [filtinv,invx ,youx, closex] + { _sssSections = updateSections availablelines (0,i) [filtinv,filtclose,invx ,youx, closex] , _sssSelPos = Just 0 } Just SelNothing -> sss - { _sssSections = updateSections availablelines (1,0) [filtinv,invx ,youx, closex] + { _sssSections = updateSections availablelines (1,0) [filtinv,filtclose,invx ,youx, closex] , _sssSelPos = Just 1 } - Just (SelCloseObject i) -> sss - { _sssSections = updateSections availablelines (2,i) [filtinv,closex, invx ,youx] + Just (InNearby SortNearby) -> sss + { _sssSections = updateSections availablelines (2,0) [filtinv,filtclose,closex, invx ,youx] , _sssSelPos = Just 2 } + Just (InNearby (SelCloseObject i)) -> sss + { _sssSections = updateSections availablelines (3,i) [filtinv,filtclose,closex, invx ,youx] + , _sssSelPos = Just 3 + } _ -> error "error when getting cr inv sel" where filtinv = (-1,(filtinvsec,filtinvitems)) @@ -45,18 +49,28 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of 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,(filtclosesec,filtcloseitems)) + filtclosesec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix 2 + 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,(invsec, invitems)) youx = (1,(yousec, youitems)) - closex = (2,(cosec, coitems)) + closex = (3,(cosec, coitems)) youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 () thetext = displayFreeSlots nfreeslots availablelines = getAvailableListLines (invDisplayParams w) cfig cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2 invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0 - coitems = IM.fromDistinctAscList . zip [0..] + coitems' = IM.fromDistinctAscList . zip [0..] $ map (closeObjectToSelectionItem nfreeslots) (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' diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index 52163889d..d172106e9 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -1,6 +1,7 @@ module Dodge.InputFocus ( inTermFocus , inInvRegex + , inCloseRegex , inSubInvRegex , inputFocus ) where @@ -23,6 +24,12 @@ inInvRegex w = fromMaybe False $ do i <- sss ^? sssSelPos . _Just return $ i == (-1) +inCloseRegex :: World -> Bool +inCloseRegex w = fromMaybe False $ do + sss <- w ^? hud . hudElement . diSections + i <- sss ^? sssSelPos . _Just + return $ i == 2 + inSubInvRegex :: World -> Bool inSubInvRegex w = fromMaybe False $ do sm <- w ^? hud . hudElement . subInventory . subInvMap @@ -33,4 +40,4 @@ inSubInvRegex w = fromMaybe False $ do _ -> return False inputFocus :: World -> Bool -inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w +inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 3ec813a16..957e95729 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -175,7 +175,7 @@ updateCloseObjects w = where newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose updatecursorposifnecessary - = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. ispCloseObject of + = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of Just i | i >= length newcloseobjects -> changeAugInvSel 1 _ -> id filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w @@ -328,8 +328,8 @@ closeObjScrollDir x changeSwapInvSel :: Int -> World -> World changeSwapInvSel k w = case you w ^? crManipulation . manObject of Just (InInventory (SelItem i _)) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i - Just (SelCloseObject i) -> w - & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject + Just (InNearby (SelCloseObject i)) -> w + & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject .~ ((i - k) `mod` numCO) & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO) _ -> w @@ -372,7 +372,8 @@ setInvPosFromSS w = w (-1) -> Just $ InInventory SortInventory 0 -> Just $ InInventory (SelItem j NoInvSelAction) 1 -> Just SelNothing - 2 -> Just $ SelCloseObject j + 2 -> Just $ InNearby SortNearby + 3 -> Just $ InNearby $ SelCloseObject j _ -> error "selection out of bounds" -- this should be in a separate module @@ -497,7 +498,7 @@ bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects ycr = you w selectedCloseObject :: World -> Maybe (Int, Either FloorItem Button) -selectedCloseObject w = case you w ^? crManipulation . manObject . ispCloseObject of +selectedCloseObject w = case you w ^? crManipulation . manObject . inNearby . ispCloseObject of Just i -> selectNthCloseObject w i Nothing -> selectNthCloseObject w =<< bestCloseObjectIndex w diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index ca193b0bf..eec3dfb2c 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -90,7 +90,8 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff InInventory SortInventory -> negate 1 InInventory {} -> 0 SelNothing{} -> 1 - SelCloseObject{} -> 2 + InNearby SortNearby -> 2 + InNearby{} -> 3 xint <- sss ^? sssSections . ix secnum . ssIndent spos <- _sssSelPos sss let y = sum . fmap (length . _ssShownItems) . fst . IM.split spos $ _sssSections sss @@ -155,7 +156,7 @@ floorItemPickupInfo n itm yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of Just (InInventory (SelItem i _)) -> f $ yourInv w ^?! ix i - Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix i + Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i _ -> x drawNoSubInventory :: Configuration -> World -> Picture diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 1857d25fb..2395c4358 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -147,6 +147,7 @@ updateUseInput u = case u ^? uvScreenLayers . _head of Just (CombineInventory sm) | inregex sm -> doSubInvRegexInput u _ | inInvRegex (u ^. uvWorld) -> doInvRegexInput u + _ | inCloseRegex (u ^. uvWorld) -> doCloseRegexInput u _ -> M.foldlWithKey' updateKeyInGame u pkeys where inregex sm = fromMaybe False $ do diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 8c885d8a2..ab6f86827 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -4,6 +4,7 @@ module Dodge.Update.Input ( doInputScreenInput, doSubInvRegexInput, doInvRegexInput, + doCloseRegexInput, ) where import Dodge.Inventory @@ -74,6 +75,34 @@ doSubInvRegexInput u && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = u ^. uvWorld . input . pressedKeys +doCloseRegexInput :: Universe -> Universe +doCloseRegexInput u + | backspacetonothing + = u + & uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . closeRegex .~ Nothing + & uvWorld . hud . hudElement . diSections %~ + ( ssSetCursor (ssLookupGT 0 2) + . (overSection (ssItems . at 2 .~ Nothing)) + ) + & uvWorld %~ setInvPosFromSS +-- & uvWorld . hud . hudElement . diSections %~ setShownIntMap + | endkeys || endmouse = u +-- = u & uvWorld . hud . hudElement . diSections %~ initialSelPos +-- | otherwise = u & uvWorld . hud . hudElement . diSections %~ +-- --overSection (doTextInputOver' u (ssRegex . regexString)) +-- overSection (id) + | otherwise = u & doTextInputOver + (uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . closeRegex . _Just) +-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap + where + endkeys = any + ( (== Just InitialPress) . (`M.lookup` pkeys)) + [ScancodeReturn,ScancodeEscape,ScancodeSlash] + endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) + backspacetonothing = u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . closeRegex . _Just == Just "" + && ScancodeBackspace `M.lookup` pkeys == Just InitialPress + pkeys = u ^. uvWorld . input . pressedKeys + doInvRegexInput :: Universe -> Universe doInvRegexInput u | backspacetonothing @@ -158,7 +187,8 @@ updateLongPressInGame uv sc = case sc of updateBackspaceRegex :: World -> World updateBackspaceRegex w = case di ^? subInventory of - Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace + Just NoSubInventory | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace + Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~ ( ( smRegex %~ enternonzeroregex ) . ( smSelPos ?~ 0 ) @@ -166,21 +196,36 @@ updateBackspaceRegex w = case di ^? subInventory of ) _ -> w where + invfocus = fromMaybe False $ do + i <- di ^? diSections . sssSelPos . _Just + return $ i == (-1) || i == 0 + closefocus = fromMaybe False $ do + i <- di ^? diSections . sssSelPos . _Just + return $ i == 2 || i == 3 trybackspace cm = case cm ^? invRegex . _Just of Just (_:_) -> cm & invRegex . _Just %~ init & manObject .~ InInventory SortInventory Just [] -> cm & invRegex .~ Nothing Nothing -> cm + trybackspaceclose cm = case cm ^? closeRegex . _Just of + Just (_:_) -> cm & closeRegex . _Just %~ init + & manObject .~ InNearby SortNearby + Just [] -> cm & closeRegex .~ Nothing + Nothing -> cm di = w ^. hud . hudElement enternonzeroregex (Just (x:xs)) = Just (init (x:xs)) enternonzeroregex smr = smr updateEnterRegex :: World -> World updateEnterRegex w = case w ^? hud . hudElement . subInventory of - Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ + Just NoSubInventory | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ ( ( invRegex %~ startregex ) . ( manObject .~ InInventory SortInventory) ) + Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ + ( ( closeRegex %~ startregex ) + . ( manObject .~ InNearby SortNearby) + ) Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~ ( setShownIntMap . (smSelPos ?~ 0 ) @@ -188,6 +233,13 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of ) _ -> w where + di = w ^. hud . hudElement + invfocus = fromMaybe False $ do + i <- di ^? diSections . sssSelPos . _Just + return $ i == (-1) || i == 0 + closefocus = fromMaybe False $ do + i <- di ^? diSections . sssSelPos . _Just + return $ i == 2 || i == 3 startregex Nothing = Just "" startregex x = x enterregex Nothing = Just ""