Move inventory filter to different section of selection list

src/Dodge/Data/SelectionList.hs

@@ -45,7 +45,6 @@ data SectionCursor = SectionCursor
 data SelectionSection a = SelectionSection
     { _ssItems :: IntMap (SelectionItem a)
     , _ssCursor :: Maybe SectionCursor
-    , _ssRegex :: Regex
 --    , _ssSelPos :: Maybe Int
 --    , _ssSelSize :: Maybe Int
 --    , _ssSelColor :: Maybe Color
@@ -57,11 +56,6 @@ data SelectionSection a = SelectionSection
     , _ssDescriptor :: String
     }
     
-data Regex = UnavailableRegex
-    | EmptyRegex
-    | Regex {_regexString :: String}
-  deriving (Show)
-
 data SelectionIntMap a = SelectionIntMap
     { _smItems :: [SelectionItem a]
     , _smSelPos :: Maybe Int
@@ -108,6 +102,5 @@ makeLenses ''SelectionIntMap
 makeLenses ''SelectionSection
 makeLenses ''SelectionSections
 makeLenses ''SectionCursor
-makeLenses ''Regex
 --deriveJSON defaultOptions ''SelectionItem
 --deriveJSON defaultOptions ''SelectionList

src/Dodge/DisplayInventory.hs

@@ -23,23 +23,30 @@ 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]
+        , _sssSelPos = Just (-1)
+        }
     Just (InInventory (SelItem i _)) -> sss
-        { _sssSections = updateSections availablelines (0,i) [invx ,youx, closex]
+        { _sssSections = updateSections availablelines (0,i) [filtinv,invx ,youx, closex]
         , _sssSelPos = Just 0
         }
     Just SelNothing -> sss
-        { _sssSections = updateSections availablelines (1,0) [invx ,youx, closex]
+        { _sssSections = updateSections availablelines (1,0) [filtinv,invx ,youx, closex]
         , _sssSelPos = Just 1
         }
     Just (SelCloseObject i) -> sss
-        { _sssSections =  updateSections availablelines (2,i) [closex, invx ,youx]
+        { _sssSections =  updateSections availablelines (2,i) [filtinv,closex, invx ,youx]
         , _sssSelPos = Just 2
         }
     _ -> error "error when getting cr inv sel"
   where
     filtinv = (-1,(filtinvsec,filtinvitems))
-    filtinvsec = undefined
+    filtinvsec = fromMaybe defaultFiltSection  $ sss ^? sssSections . ix (-1)
-    filtinvitems = undefined
+    filtinvitems = case cr ^? crManipulation . invRegex . _Just of
+        Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0)
+        Nothing -> mempty
+    numfiltitems = "  " ++ show numfiltitems' ++ " FILTERED"
+    numfiltitems' = length invitems' - length invitems
     invx = (0,(invsec, invitems))
     youx = (1,(yousec, youitems))
     closex = (2,(cosec, coitems))
@@ -50,7 +57,10 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
     invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
     coitems = IM.fromDistinctAscList . zip [0..] 
         $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-    invitems = IM.mapWithKey (invSelectionItem' cr) inv
+    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
@@ -75,7 +85,6 @@ defaultSS :: SelectionSection ()
 defaultSS = SelectionSection 
     { _ssItems = mempty 
     , _ssCursor = Nothing 
-    , _ssRegex = EmptyRegex
     , _ssMinSize = 5 
     , _ssOffset = 0 
     , _ssShownItems = [] 
@@ -89,6 +98,12 @@ defaultCOSection = defaultSS
     & ssIndent .~ 2 
     & ssDescriptor .~ "CLOSE OBJECTS"
 
+defaultFiltSection :: SelectionSection ()
+defaultFiltSection = defaultSS 
+    & ssIndent .~ 0
+    & ssDescriptor .~ "INV"
+    & ssMinSize .~ 0
+
 defaultInvSection :: SelectionSection ()
 defaultInvSection = defaultSS
     & ssDescriptor .~ "INVENTORY ITEMS"
@@ -103,20 +118,20 @@ updateSection mspos sis' availablelines ss = ss
     { _ssItems = sis
     , _ssCursor = scurs
     , _ssOffset = offset
-    , _ssMinSize = 5
     , _ssShownItems = shownitems
     }
   where
-    sis = case _ssRegex ss of
+    sis = sis' 
-        Regex str -> IM.insert (-1) (f str) $ IM.filter (regexList str . _siPictures) sis'
+    -- case _ssRegex ss of
-        _ -> sis'
+    --    Regex str -> IM.insert (-1) (f str) $ IM.filter (regexList str . _siPictures) sis'
-    f str = SelectionRegex
+    --    _ -> sis'
-        { _siPictures = ["FILTER: " ++ str]
+--    f str = SelectionRegex
-        , _siHeight = 1
+--        { _siPictures = ["FILTER: " ++ str]
-        , _siIsSelectable = True
+--        , _siHeight = 1
-        , _siColor = white
+--        , _siIsSelectable = True
-        , _siOffX = 0
+--        , _siColor = white
-        }
+--        , _siOffX = 0
+--        }
     oldoffset = ss ^. ssOffset
     scurs = do
         csel <- mspos
@@ -167,7 +182,7 @@ updateSection mspos sis' availablelines ss = ss
 yousec :: SelectionSection ()
 yousec = defaultSS
     & ssCursor ?~ SectionCursor 0 0 1 invDimColor
-    & ssRegex .~ UnavailableRegex
+--    & ssRegex .~ UnavailableRegex
     & ssIndent .~ 2
     & ssMinSize .~ 1
     & ssDescriptor .~ "YOUR STATUS"

src/Dodge/InputFocus.hs

@@ -21,12 +21,7 @@ inInvRegex  :: World -> Bool
 inInvRegex w = fromMaybe False $ do
         sss <- w ^? hud . hudElement . diSections
         i <- sss ^? sssSelPos . _Just
-        ss <- sss ^? sssSections . ix i
+        return $ i == (-1)
-        j <- ss ^? ssCursor . _Just . scurSel
-        si <- ss ^? ssItems . ix j
-        return $ case si of
-            SelectionRegex {} -> True
-            _ -> False
 
 inSubInvRegex  :: World -> Bool
 inSubInvRegex w = fromMaybe False $ do

src/Dodge/Inventory.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE TupleSections #-}
 
 module Dodge.Inventory (
+    ssLookupGT,
+    ssSetCursor,
+    firstPosSelectionSections,
     checkInvSlotsYou,
     rmSelectedInvItem,
-    --invSelPos,
     invSelSize,
     selNumPos,
     selNumTextPos,
@@ -23,6 +25,7 @@ module Dodge.Inventory (
     selectedCloseObject,
     invDimColor,
     trimapAugmentInv,
+    setInvPosFromSS,
 ) where
 
 import Dodge.Data.SelectionList
@@ -366,20 +369,13 @@ setInvPosFromSS w = w
         i <- sss ^? sssSelPos . _Just
         j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
         case i of
+            (-1) -> Just $ InInventory SortInventory
             0 -> Just $ InInventory (SelItem j NoInvSelAction)
+            1 -> Just SelNothing
             2 -> Just $ SelCloseObject j
-            _ -> Just SelNothing
+            _ -> error "selection out of bounds"
-            
---changeAugInvSel :: Int -> World -> World
---changeAugInvSel yi w
---    | yi == 0 = w
---    | otherwise =
---        w & cWorld . lWorld . creatures . ix 0 . crInvSel . isel %~ f
---  where
---    f = fromAugSelPos w . (`mod` (ninv + nclose + 1)) . subtract yi . toAugSelPos w
---    ninv = length (yourInv w)
---    nclose = length (w ^. hud . closeObjects)
             
+-- this should be in a separate module
 firstPosSelectionSections :: SelectionSections a -> SelectionSections a
 firstPosSelectionSections sss = fromMaybe sss $ do
     (i,j,si) <- ssLookupMin sss
@@ -409,6 +405,14 @@ scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
     return $ sss & sssSelPos ?~ i'
         & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
 
+ssSetCursor :: (SelectionSections a -> Maybe (Int,Int,SelectionItem a)) 
+    -> SelectionSections a -> SelectionSections a
+ssSetCursor f sss = fromMaybe sss $ do
+    (i,j,si) <- f sss
+    return $ sss
+        & sssSelPos ?~ i
+        & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
+
 ssLookupMax :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
 ssLookupMax sss = do
     (i,_) <- IM.lookupMax (sss ^. sssSections)

src/Dodge/Inventory/SelectionList.hs

@@ -36,6 +36,7 @@ invSelectionItem' cr i it = SelectionItem
         UndroppableIdentified -> itemDisplay it
         _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it
         _ -> itemDisplay it
+
 invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
 invSelectionItem cr (i,it) = SelectionItem
     { _siPictures = pics

src/Dodge/Render/HUD.hs

@@ -161,20 +161,11 @@ yourAugmentedItem  f x g w = case you w ^? crManipulation . manObject of
 drawNoSubInventory :: Configuration -> World -> Picture
 drawNoSubInventory cfig w =
     pictures
-        [ --closeobjectcursor
+        [ equipcursors
-         equipcursors
         , equipcursor -- the order is important, this should go on top of the other equipcursors
         , rboptions
         ]
   where
---    closeobjectcursor = case selectedCloseObject w of
---        Nothing -> mempty
---        Just (i, _) ->
---            drawCursorAt
---                (invDisplayParams w & ldpCursorType .~ BorderCursor [North, South])
---                cfig
---                (Just i)
---                (inventorySelectionList w)
     equipcursor = case cr ^. crLeftInvSel . lisMPos of
         Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
         _ -> mempty

src/Dodge/TestString.hs

@@ -1,15 +1,18 @@
 module Dodge.TestString where
 
+import Data.ByteString.Lazy.Char8 (unpack)
+import qualified Data.Aeson.Encode.Pretty as AEP
 import Control.Lens
 import Dodge.Data.Universe
 --import Data.Maybe
 --import ShortShow
 --import qualified Data.Map.Strict as M
---import qualified IntMapHelp as IM
+import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
 testStringInit u = 
-    [ show $ u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just
+    [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . sssSections]
-    ]
+    --[ show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation
+     ++ lines (unpack $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation)
 
 showTimeFlow :: TimeFlowStatus -> String
 showTimeFlow tfs = case tfs of

src/Dodge/Update/Input.hs

@@ -6,7 +6,7 @@ module Dodge.Update.Input (
     doInvRegexInput,
 ) where
 
-import Color
+import Dodge.Inventory
 import Data.Maybe
 import Dodge.DisplayInventory
 import SelectionIntMap
@@ -19,7 +19,6 @@ import Dodge.Creature.Action
 import Dodge.Data.Universe
 import Dodge.Debug.Terminal
 import Dodge.Event.Test
-import Dodge.Inventory
 import Dodge.Menu
 import Dodge.Reloading
 import Dodge.Save
@@ -28,14 +27,14 @@ import Dodge.WorldPos
 import LensHelp
 import SDL
 
-doTextInputOver' :: Universe -> ASetter' a String -> a -> a
+--doTextInputOver' :: Universe -> ASetter' a String -> a -> a
-doTextInputOver' u p x = x & p %~ (++ map toUpper thetext)
+--doTextInputOver' u p x = x & p %~ (++ map toUpper thetext)
-    & checkBackspace
+--    & checkBackspace
-  where
+--  where
-    thetext = u ^. uvWorld . input . textInput
+--    thetext = u ^. uvWorld . input . textInput
-    checkBackspace 
+--    checkBackspace 
-        | backspaceInputted u = p %~ doBackspace
+--        | backspaceInputted u = p %~ doBackspace
-        | otherwise = id
+--        | otherwise = id
 
 doTextInputOver :: ASetter' Universe String -> Universe -> Universe
 doTextInputOver p u = u & p %~ (++ map toUpper thetext)
@@ -78,24 +77,28 @@ doSubInvRegexInput u
 doInvRegexInput :: Universe -> Universe
 doInvRegexInput u
     | backspacetonothing
-            = u & uvWorld . hud . hudElement . diSections %~ overSection
+            = u 
-                ( ( ssRegex .~ EmptyRegex )
+        & uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . invRegex .~ Nothing
-                . ( ssItems . at (-1) .~ Nothing)
+        & uvWorld . hud . hudElement . diSections %~ 
+                ( ssSetCursor (ssLookupGT 0 (-1))
+                . (overSection (ssItems . at (-1) .~ Nothing))
                 )
---                . initialSelPos )
+        & uvWorld %~ setInvPosFromSS
 --                & uvWorld . hud . hudElement . diSections %~ setShownIntMap
     | endkeys || endmouse = u
 --            = u & uvWorld . hud . hudElement . diSections %~ initialSelPos
-    | otherwise = u & uvWorld . hud . hudElement . diSections %~ 
+--    | otherwise = u & uvWorld . hud . hudElement . diSections %~ 
-        overSection (doTextInputOver' u (ssRegex . regexString))
+--        --overSection (doTextInputOver' u (ssRegex . regexString))
---    | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just)
+--        overSection (id)
+    | otherwise = u & doTextInputOver 
+        (uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . invRegex . _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 . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just ""
+    backspacetonothing = u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . invRegex . _Just == Just ""
       && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
     pkeys = u ^. uvWorld . input . pressedKeys
 
@@ -143,8 +146,8 @@ updateInitialPressInGame uv sc = case sc of
     ScancodeX -> uv & uvWorld %~ toggleTweakInv
     ScancodeC -> over uvWorld toggleCombineInv uv
     -- the following should be put in a more sensible place
-    ScancodeSlash -> uv & uvWorld . hud . hudElement %~ updateEnterRegex
+    ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
-    ScancodeBackspace -> uv & uvWorld . hud . hudElement %~ updateBackspaceRegex
+    ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
     _ -> uv
 
 updateLongPressInGame :: Universe -> Scancode -> Universe
@@ -153,36 +156,40 @@ updateLongPressInGame uv sc = case sc of
     ScancodeSpace -> over uvWorld spaceAction uv
     _ -> uv
 
-updateBackspaceRegex :: HUDElement -> HUDElement
+updateBackspaceRegex :: World -> World
-updateBackspaceRegex di = case di ^?  subInventory of
+updateBackspaceRegex w = case di ^?  subInventory of
-    Just NoSubInventory -> di & diSections %~ overSection 
+    Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
-            ( (ssRegex %~ backssregex)
+    Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~
-            . (ssCursor ?~ SectionCursor (-1) 0 1 white)
+        ( ( smRegex %~ enternonzeroregex )
-            )
+        . ( smSelPos ?~ 0  )
-    Just CombineInventory {} -> di
+        . ( setShownIntMap )
-        & subInventory . subInvMap . smRegex %~ enternonzeroregex
+        )
-        & subInventory . subInvMap . smSelPos ?~ 0 
+    _ -> w
-        & subInventory . subInvMap %~ setShownIntMap
-    _ -> di
   where
+    trybackspace cm = case cm ^? invRegex . _Just of
+        Just (_:_) -> cm & invRegex . _Just %~ init
+            & manObject .~ InInventory SortInventory
+        Just [] -> cm & invRegex .~ Nothing
+        Nothing -> cm
+    di = w ^. hud . hudElement
     enternonzeroregex (Just (x:xs)) = Just (init (x:xs))
     enternonzeroregex smr = smr
-    backssregex (Regex (x:xs)) = Regex (init (x:xs))
-    backssregex x = x
 
-updateEnterRegex :: HUDElement -> HUDElement
+updateEnterRegex :: World -> World
-updateEnterRegex di = case di ^?  subInventory of
+updateEnterRegex w = case w ^? hud . hudElement . subInventory of
-    Just NoSubInventory -> di & diSections %~ overSection 
+    Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~
-        ( (ssRegex %~ enterssregex)
+        ( ( invRegex %~ startregex )
+        . ( manObject .~ InInventory SortInventory)
         )
-    Just CombineInventory {} -> di
+    Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~
-        & subInventory . subInvMap . smRegex %~ enterregex
+        ( setShownIntMap
-        & subInventory . subInvMap . smSelPos ?~ 0 
+        . (smSelPos ?~ 0 )
-        & subInventory . subInvMap %~ setShownIntMap
+        . ( smRegex %~ enterregex)
-    _ -> di
+        )
+    _ -> w
   where
-    enterssregex EmptyRegex = Regex ""
+    startregex Nothing = Just ""
-    enterssregex x = x
+    startregex x = x
     enterregex Nothing = Just ""
     enterregex (Just str)  = Just str