Move inventory filter to different section of selection list

2023-02-17 10:35:59 +00:00
parent 4afc216b25
commit 93dfc2a67c
8 changed files with 111 additions and 102 deletions
@@ -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
@@ -100,7 +94,7 @@ data SelectionItem a = SelectionItem
    , _siOffX   :: Int
    }
    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
-    
+
 makeLenses ''ListDisplayParams
 makeLenses ''SelectionList
 makeLenses ''SelectionItem
@@ -108,6 +102,5 @@ makeLenses ''SelectionIntMap
 makeLenses ''SelectionSection
 makeLenses ''SelectionSections
 makeLenses ''SectionCursor
-makeLenses ''Regex
 --deriveJSON defaultOptions ''SelectionItem
 --deriveJSON defaultOptions ''SelectionList
@@ -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
-    filtinvitems = undefined
+    filtinvsec = fromMaybe defaultFiltSection  $ sss ^? sssSections . ix (-1)
+    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
-        Regex str -> IM.insert (-1) (f str) $ IM.filter (regexList str . _siPictures) sis'
-        _ -> sis'
-    f str = SelectionRegex
-        { _siPictures = ["FILTER: " ++ str]
-        , _siHeight = 1
-        , _siIsSelectable = True
-        , _siColor = white
-        , _siOffX = 0
-        }
+    sis = sis' 
+    -- case _ssRegex ss of
+    --    Regex str -> IM.insert (-1) (f str) $ IM.filter (regexList str . _siPictures) sis'
+    --    _ -> sis'
+--    f str = SelectionRegex
+--        { _siPictures = ["FILTER: " ++ str]
+--        , _siHeight = 1
+--        , _siIsSelectable = True
+--        , _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"
@@ -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
-        j <- ss ^? ssCursor . _Just . scurSel
-        si <- ss ^? ssItems . ix j
-        return $ case si of
-            SelectionRegex {} -> True
-            _ -> False
+        return $ i == (-1)

 inSubInvRegex  :: World -> Bool
 inSubInvRegex w = fromMaybe False $ do
@@ -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)
@@ -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
@@ -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
@@ -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
@@ -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' u p x = x & p %~ (++ map toUpper thetext)
-    & checkBackspace
-  where
-    thetext = u ^. uvWorld . input . textInput
-    checkBackspace 
-        | backspaceInputted u = p %~ doBackspace
-        | otherwise = id
+--doTextInputOver' :: Universe -> ASetter' a String -> a -> a
+--doTextInputOver' u p x = x & p %~ (++ map toUpper thetext)
+--    & checkBackspace
+--  where
+--    thetext = u ^. uvWorld . input . textInput
+--    checkBackspace 
+--        | backspaceInputted u = p %~ doBackspace
+--        | 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
-                ( ( ssRegex .~ EmptyRegex )
-                . ( ssItems . at (-1) .~ Nothing)
+            = u 
+        & uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . invRegex .~ 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 %~ 
-        overSection (doTextInputOver' u (ssRegex . regexString))
--    | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just)
+--    | otherwise = u & uvWorld . hud . hudElement . diSections %~ 
+--        --overSection (doTextInputOver' u (ssRegex . regexString))
+--        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
-    ScancodeBackspace -> uv & uvWorld . hud . hudElement %~ updateBackspaceRegex
+    ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
+    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 di = case di ^?  subInventory of
-    Just NoSubInventory -> di & diSections %~ overSection 
-            ( (ssRegex %~ backssregex)
-            . (ssCursor ?~ SectionCursor (-1) 0 1 white)
-            )
-    Just CombineInventory {} -> di
-        & subInventory . subInvMap . smRegex %~ enternonzeroregex
-        & subInventory . subInvMap . smSelPos ?~ 0 
-        & subInventory . subInvMap %~ setShownIntMap
-    _ -> di
+updateBackspaceRegex :: World -> World
+updateBackspaceRegex w = case di ^?  subInventory of
+    Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
+    Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~
+        ( ( smRegex %~ enternonzeroregex )
+        . ( smSelPos ?~ 0  )
+        . ( setShownIntMap )
+        )
+    _ -> w
  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 di = case di ^?  subInventory of
-    Just NoSubInventory -> di & diSections %~ overSection 
-        ( (ssRegex %~ enterssregex)
+updateEnterRegex :: World -> World
+updateEnterRegex w = case w ^? hud . hudElement . subInventory of
+    Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~
+        ( ( invRegex %~ startregex )
+        . ( manObject .~ InInventory SortInventory)
        )
-    Just CombineInventory {} -> di
-        & subInventory . subInvMap . smRegex %~ enterregex
-        & subInventory . subInvMap . smSelPos ?~ 0 
-        & subInventory . subInvMap %~ setShownIntMap
-    _ -> di
+    Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~
+        ( setShownIntMap
+        . (smSelPos ?~ 0 )
+        . ( smRegex %~ enterregex)
+        )
+    _ -> w
  where
-    enterssregex EmptyRegex = Regex ""
-    enterssregex x = x
+    startregex Nothing = Just ""
+    startregex x = x
    enterregex Nothing = Just ""
    enterregex (Just str)  = Just str