Work towards fixing inventory space leak

src/Dodge/DisplayInventory.hs

@@ -1,6 +1,7 @@
 -- {-# OPTIONS_GHC -fno-full-laziness #-}
 --{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE LambdaCase #-}
+
 --{-# LANGUAGE BangPatterns #-}
 
 module Dodge.DisplayInventory (
@@ -10,7 +11,7 @@ module Dodge.DisplayInventory (
 ) where
 
 --import StrictHelp
-import Dodge.Item.Display
+
 --import qualified Data.Strict.Tuple as STup
 import Control.Applicative
 import Control.Lens
@@ -26,11 +27,11 @@ import Dodge.CharacterEnums
 import Dodge.Combine
 import Dodge.Data.Combine
 import Dodge.Data.Config
-import Dodge.Data.DoubleTree
 import Dodge.Data.SelectionList
 import Dodge.Data.Universe
 import Dodge.Inventory
 import Dodge.Inventory.SelectionList
+import Dodge.Item.Display
 import Dodge.Item.Grammar
 import Dodge.ListDisplayParams
 import Dodge.SelectionList
@@ -55,7 +56,7 @@ updateCombineSections w cfig =
         (const 0)
         (w ^? hud . hudElement . subInventory . ciSelection . _Just)
         (getAvailableListLines secondColumnParams cfig)
-        [(0, sclose), (-1, sfclose)]
+        (IM.fromDistinctAscList [(0, sclose), (-1, sfclose)])
   where
     filtcurs = w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 == Just (-1)
     (sfclose, sclose) =
@@ -78,6 +79,7 @@ regexCombs inv ci = \case
     g str i = fromMaybe False $ do
         si <- inv ^? ix i
         return $ regexList str $ basicItemDisplay si
+
 --return $ regexList str $ _siPictures si
 
 andOrRegex :: (a -> String -> Bool) -> a -> String -> Bool
@@ -128,38 +130,40 @@ updateDisplaySections w cfig =
         displayIndents
         mselpos
         (getAvailableListLines invDP cfig)
+        ( IM.fromDistinctAscList $
+            zip
+                [-1 .. 5]
                 [ invhead
-        , invx
+                , sinv
                 , youx
                 , nearbyhead
-        , closex
+                , sclose
                 , interfaceshead
                 , interfaces
                 ]
+        )
   where
     mselpos = w ^? hud . hudElement . diSelection . _Just
     invfiltcurs = mselpos ^? _Just . _1 == Just (-1)
     (sfinv, sinv) =
         filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $
             w ^? hud . hudElement . diInvFilter . _Just
-    (filtinv, invx) = ((-1, sfinv), (0, sinv))
     closefiltcurs = mselpos ^? _Just . _1 == Just 2
     (sfclose, sclose) =
         filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $
             w ^? hud . hudElement . diCloseFilter . _Just
-    (filtclose, closex) = ((2, sfclose), (3, sclose))
     nearbyhead =
         if null sfclose
-            then if null sclose then (2, mempty) else makehead "NEARBY ITEMS" 2
+            then if null sclose then mempty else makehead "NEARBY ITEMS"
-            else filtclose
+            else sfclose
-    youx = (1, youitems)
+    youx = youitems
-    interfaceshead = if null btitems then (4, mempty) else makehead "NEARBY INTERFACES" 4
+    interfaceshead = if null btitems then mempty else makehead "NEARBY INTERFACES"
-    interfaces = (5, btitems)
+    interfaces = btitems
     btitems =
         IM.fromDistinctAscList . zip [0 ..] $
             mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
-    makehead str i = (i, IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0)
+    makehead str = IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0
-    invhead = if null sfinv then makehead "INVENTORY" (-1) else filtinv
+    invhead = if null sfinv then makehead "INVENTORY" else sfinv
     youitems = IM.singleton 0 $ SelectionItem [thetext] 1 15 True invDimColor 2 ()
     thetext = displayFreeSlots (crNumFreeSlots cr)
     closeitms =
@@ -167,12 +171,7 @@ updateDisplaySections w cfig =
             mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems)
     invitems =
         IM.map
-            ( \(indent, x) ->
+            (uncurry (invSelectionItem w))
-                invSelectionItem
-                    indent
-                    w
-                    (x ^. locLDT . ldtValue)
-            )
             (fmap (first removeindentiffiltering) . allInvLocs $ _crInv cr)
     removeindentiffiltering =
         if maybe False (not . null) (w ^? hud . hudElement . diInvFilter . _Just)
@@ -260,7 +259,8 @@ updateSectionsPositioning ::
     (Int -> Int) -> -- for determining each sections indent
     Maybe (Int, Int, IntSet) ->
     Int ->
-    [(Int, IM.IntMap (SelectionItem a))] ->
+    --[(Int, IM.IntMap (SelectionItem a))] ->
+    IM.IntMap (IM.IntMap (SelectionItem a)) ->
     IM.IntMap (SelectionSection a) ->
     IM.IntMap (SelectionSection a)
 updateSectionsPositioning h mselpos allavailablelines lsss sss =
@@ -271,7 +271,7 @@ updateSectionsPositioning h mselpos allavailablelines lsss sss =
         (k', i, _) <- mselpos
         guard $ k == k'
         return i
-    ls = IM.fromList lsss
+    ls = lsss
     -- defaults non-existing offsets to 0
     g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($)))
     lk = mselpos ^.. _Just . _1
@@ -293,36 +293,39 @@ updateSection indent mcsel sis availablelines oldoffset =
         , _ssIndent = indent
         }
   where
-    shownitems = 
+    --shownitems = take availablelines allstrings
---            tweakfirst . tweaklast . map (^. _2) $ take availablelines shownstrings
+    --shownitems = tweakfirst $ allstrings
-            tweakfirst . tweaklast $ take availablelines shownstrings
+    --shownitems = tweakfirst $ allstrings
+    shownitems'' = tweakfirst $ take availablelines shownstrings
+    shownitems = tweakfirst . tweaklast $ take availablelines shownstrings
     oldoffsetbounded = max 0 . min oldoffset $ aslength - availablelines
     offset = fromMaybe oldoffsetbounded $ do
         csel <- mcsel
         maxcsel <- fst <$> IM.lookupMax sis
---        xselsize <- fmap length $ sis ^? ix csel . siPictures
         xselsize <- sis ^? ix csel . siHeight
         return $ case sum $ fmap _siHeight . fst . IM.split csel $ sis of
             pos | pos == 0 || aslength <= availablelines -> 0
             pos | pos - 1 < oldoffset -> pos - 1
             pos | maxcsel == csel -> pos - availablelines + xselsize
-            pos | pos + 1 + xselsize - availablelines > oldoffset ->
+            pos
+                | pos + 1 + xselsize - availablelines > oldoffset ->
                     pos - availablelines + 1 + xselsize
-            _   | aslength - availablelines < oldoffset ->
+            _
+                | aslength - availablelines < oldoffset ->
                     aslength - availablelines
             _ -> oldoffsetbounded
     tweakfirst
---        | offset > 0 = ix 0 .~ color moreupcolor (text (replicate 15 (toEnum 30)))
         | offset > 0 = ix 0 .~ color white (text (replicate 15 (toEnum 30)))
         | otherwise = id
---    moreupcolor = fromMaybe white $ allstrings ^? ix offset . _1
+    --    tweakfirst (x:xs)
+    --        | offset > 0 = color white (text (replicate 15 (toEnum 30))) : xs
+    --        | otherwise = (x:xs)
+    --    tweakfirst [] = []
     tweaklast
-        | length shownstrings > availablelines =
+        | aslength - offset > availablelines =
             ix (availablelines - 1)
                 .~ color white (text . replicate 15 $ toEnum 31)
---                .~ color moredowncolor (text . replicate 15 $ toEnum 31)
         | otherwise = id
---    moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
     (allstrings, Sum aslength) = foldMap listSelectionColorPicture sis
     shownstrings = drop offset allstrings
 
@@ -331,14 +334,6 @@ listSelectionColorPicture si = (g <$> _siPictures si, Sum $ _siHeight si)
   where
     g = translate lindent 0 . color (_siColor si) . text
     lindent = 100 * fromIntegral (_siOffX si)
---listSelectionColorPicture :: SelectionItem a -> ([(Color,Picture)], Sum Int)
---listSelectionColorPicture si = (g <$> _siPictures si, Sum $ _siHeight si)
---  where
---    g str = (
---        _siColor si 
---        , translate lindent 0 (color (_siColor si) $ text str)
---        )
---    lindent = 100 * fromIntegral (_siOffX si)
 
 regexList :: String -> [String] -> Bool
 regexList x = any (List.isInfixOf x)

src/Dodge/Inventory/SelectionList.hs

@@ -6,6 +6,7 @@ module Dodge.Inventory.SelectionList (
     closeButtonToSelectionItem,
 ) where
 
+import Dodge.Data.DoubleTree
 import Dodge.Item.InvSize
 import Dodge.Data.ComposedItem
 import Dodge.Data.SelectionList
@@ -19,8 +20,9 @@ import NewInt
 import Padding
 import Picture.Base
 
-invSelectionItem :: Int -> World -> ComposedItem -> SelectionItem ()
+--invSelectionItem :: Int -> World -> ComposedItem -> SelectionItem ()
-invSelectionItem indent w ci =
+invSelectionItem :: World -> Int -> LocationLDT ItemLink ComposedItem -> SelectionItem ()
+invSelectionItem w indent loc =
     SelectionItem
         { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
         , _siHeight = itInvHeight $ ci ^. _1
@@ -31,6 +33,7 @@ invSelectionItem indent w ci =
         , _siPayload = ()
         }
   where
+    ci = loc ^. locLDT . ldtValue
     lw = w ^. cWorld . lWorld
     cr = lw ^?! creatures . ix 0
     itid = ci ^. _1 . itID . unNInt

src/Dodge/SelectionSections/Draw.hs

@@ -27,7 +27,9 @@ drawSelectionSections sss ldp cfig =
             0
             (foldMap 
                 (\ss -> translate (100*fromIntegral (_ssIndent ss)) 0 <$> 
-                (_ssShownItems ss)) sss)
+                --(take (_ssShownLength ss) $ _ssShownItems ss)) sss)
+                    (_ssShownItems ss)
+                ) sss)
 
 drawSSCursor ::
     IM.IntMap (SelectionSection a) ->