Implement filter on nearby objects

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

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

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
+    Just (InNearby SortNearby) -> sss
-        { _sssSections =  updateSections availablelines (2,i) [filtinv,closex, invx ,youx]
+        { _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'

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

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
+    Just (InNearby (SelCloseObject i)) -> w
-            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject 
+            & 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
 

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

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

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 ""