justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work towards fixing inventory space leak

Browse Source
This commit is contained in:
justin
2025-01-05 20:54:07 +00:00
parent 7175a96249
commit 9769480d0b
3 changed files with 53 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/DisplayInventory.hs
+45 -50
View File
@@ -1,6 +1,7 @@
-- {-# OPTIONS_GHC -fno-full-laziness #-} -- {-# OPTIONS_GHC -fno-full-laziness #-}
--{-# LANGUAGE TupleSections #-} --{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
--{-# LANGUAGE BangPatterns #-} --{-# LANGUAGE BangPatterns #-}
module Dodge.DisplayInventory ( module Dodge.DisplayInventory (
@@ -10,7 +11,7 @@ module Dodge.DisplayInventory (
) where ) where
--import StrictHelp --import StrictHelp
import Dodge.Item.Display
--import qualified Data.Strict.Tuple as STup --import qualified Data.Strict.Tuple as STup
import Control.Applicative import Control.Applicative
import Control.Lens import Control.Lens
@@ -26,11 +27,11 @@ import Dodge.CharacterEnums
import Dodge.Combine import Dodge.Combine
import Dodge.Data.Combine import Dodge.Data.Combine
import Dodge.Data.Config import Dodge.Data.Config
import Dodge.Data.DoubleTree
import Dodge.Data.SelectionList import Dodge.Data.SelectionList
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Inventory import Dodge.Inventory
import Dodge.Inventory.SelectionList import Dodge.Inventory.SelectionList
import Dodge.Item.Display
import Dodge.Item.Grammar import Dodge.Item.Grammar
import Dodge.ListDisplayParams import Dodge.ListDisplayParams
import Dodge.SelectionList import Dodge.SelectionList
@@ -55,7 +56,7 @@ updateCombineSections w cfig =
(const 0) (const 0)
(w ^? hud . hudElement . subInventory . ciSelection . _Just) (w ^? hud . hudElement . subInventory . ciSelection . _Just)
(getAvailableListLines secondColumnParams cfig) (getAvailableListLines secondColumnParams cfig)
[(0, sclose), (-1, sfclose)] (IM.fromDistinctAscList [(0, sclose), (-1, sfclose)])
where where
filtcurs = w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 == Just (-1) filtcurs = w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 == Just (-1)
(sfclose, sclose) = (sfclose, sclose) =
@@ -66,7 +67,7 @@ updateCombineSections w cfig =
"COMBINATIONS" "COMBINATIONS"
$ w ^? hud . hudElement . subInventory . ciFilter . _Just $ w ^? hud . hudElement . subInventory . ciFilter . _Just
--invitms = fold $ w ^? hud . hudElement . diSections . ix 0 . ssItems --invitms = fold $ w ^? hud . hudElement . diSections . ix 0 . ssItems
invitms = fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv invitms = fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
--regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool --regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool
regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
@@ -78,7 +79,8 @@ regexCombs inv ci = \case
g str i = fromMaybe False $ do g str i = fromMaybe False $ do
si <- inv ^? ix i si <- inv ^? ix i
return $ regexList str $ basicItemDisplay si return $ regexList str $ basicItemDisplay si
--return $ regexList str $ _siPictures si
--return $ regexList str $ _siPictures si
andOrRegex :: (a -> String -> Bool) -> a -> String -> Bool andOrRegex :: (a -> String -> Bool) -> a -> String -> Bool
andOrRegex f x = all (orRegex f x) . List.wordsBy '&' andOrRegex f x = all (orRegex f x) . List.wordsBy '&'
@@ -128,38 +130,40 @@ updateDisplaySections w cfig =
displayIndents displayIndents
mselpos mselpos
(getAvailableListLines invDP cfig) (getAvailableListLines invDP cfig)
[ invhead ( IM.fromDistinctAscList $
, invx zip
, youx [-1 .. 5]
, nearbyhead [ invhead
, closex , sinv
, interfaceshead , youx
, interfaces , nearbyhead
] , sclose
, interfaceshead
, interfaces
]
)
where where
mselpos = w ^? hud . hudElement . diSelection . _Just mselpos = w ^? hud . hudElement . diSelection . _Just
invfiltcurs = mselpos ^? _Just . _1 == Just (-1) invfiltcurs = mselpos ^? _Just . _1 == Just (-1)
(sfinv, sinv) = (sfinv, sinv) =
filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $ filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $
w ^? hud . hudElement . diInvFilter . _Just w ^? hud . hudElement . diInvFilter . _Just
(filtinv, invx) = ((-1, sfinv), (0, sinv))
closefiltcurs = mselpos ^? _Just . _1 == Just 2 closefiltcurs = mselpos ^? _Just . _1 == Just 2
(sfclose, sclose) = (sfclose, sclose) =
filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $ filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $
w ^? hud . hudElement . diCloseFilter . _Just w ^? hud . hudElement . diCloseFilter . _Just
(filtclose, closex) = ((2, sfclose), (3, sclose))
nearbyhead = nearbyhead =
if null sfclose 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 = btitems =
IM.fromDistinctAscList . zip [0 ..] $ IM.fromDistinctAscList . zip [0 ..] $
mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons) 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 () youitems = IM.singleton 0 $ SelectionItem [thetext] 1 15 True invDimColor 2 ()
thetext = displayFreeSlots (crNumFreeSlots cr) thetext = displayFreeSlots (crNumFreeSlots cr)
closeitms = closeitms =
@@ -167,12 +171,7 @@ updateDisplaySections w cfig =
mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems) mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems)
invitems = invitems =
IM.map IM.map
( \(indent, x) -> (uncurry (invSelectionItem w))
invSelectionItem
indent
w
(x ^. locLDT . ldtValue)
)
(fmap (first removeindentiffiltering) . allInvLocs $ _crInv cr) (fmap (first removeindentiffiltering) . allInvLocs $ _crInv cr)
removeindentiffiltering = removeindentiffiltering =
if maybe False (not . null) (w ^? hud . hudElement . diInvFilter . _Just) if maybe False (not . null) (w ^? hud . hudElement . diInvFilter . _Just)
@@ -260,7 +259,8 @@ updateSectionsPositioning ::
(Int -> Int) -> -- for determining each sections indent (Int -> Int) -> -- for determining each sections indent
Maybe (Int, Int, IntSet) -> Maybe (Int, Int, IntSet) ->
Int -> 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) ->
IM.IntMap (SelectionSection a) IM.IntMap (SelectionSection a)
updateSectionsPositioning h mselpos allavailablelines lsss sss = updateSectionsPositioning h mselpos allavailablelines lsss sss =
@@ -271,7 +271,7 @@ updateSectionsPositioning h mselpos allavailablelines lsss sss =
(k', i, _) <- mselpos (k', i, _) <- mselpos
guard $ k == k' guard $ k == k'
return i return i
ls = IM.fromList lsss ls = lsss
-- defaults non-existing offsets to 0 -- defaults non-existing offsets to 0
g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($))) g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($)))
lk = mselpos ^.. _Just . _1 lk = mselpos ^.. _Just . _1
@@ -293,37 +293,40 @@ updateSection indent mcsel sis availablelines oldoffset =
, _ssIndent = indent , _ssIndent = indent
} }
where 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 oldoffsetbounded = max 0 . min oldoffset $ aslength - availablelines
offset = fromMaybe oldoffsetbounded $ do offset = fromMaybe oldoffsetbounded $ do
csel <- mcsel csel <- mcsel
maxcsel <- fst <$> IM.lookupMax sis maxcsel <- fst <$> IM.lookupMax sis
-- xselsize <- fmap length $ sis ^? ix csel . siPictures
xselsize <- sis ^? ix csel . siHeight xselsize <- sis ^? ix csel . siHeight
return $ case sum $ fmap _siHeight . fst . IM.split csel $ sis of return $ case sum $ fmap _siHeight . fst . IM.split csel $ sis of
pos | pos == 0 || aslength <= availablelines -> 0 pos | pos == 0 || aslength <= availablelines -> 0
pos | pos - 1 < oldoffset -> pos - 1 pos | pos - 1 < oldoffset -> pos - 1
pos | maxcsel == csel -> pos - availablelines + xselsize pos | maxcsel == csel -> pos - availablelines + xselsize
pos | pos + 1 + xselsize - availablelines > oldoffset -> pos
| pos + 1 + xselsize - availablelines > oldoffset ->
pos - availablelines + 1 + xselsize pos - availablelines + 1 + xselsize
_ | aslength - availablelines < oldoffset -> _
| aslength - availablelines < oldoffset ->
aslength - availablelines aslength - availablelines
_ -> oldoffsetbounded _ -> oldoffsetbounded
tweakfirst tweakfirst
-- | offset > 0 = ix 0 .~ color moreupcolor (text (replicate 15 (toEnum 30)))
| offset > 0 = ix 0 .~ color white (text (replicate 15 (toEnum 30))) | offset > 0 = ix 0 .~ color white (text (replicate 15 (toEnum 30)))
| otherwise = id | 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 tweaklast
| length shownstrings > availablelines = | aslength - offset > availablelines =
ix (availablelines - 1) ix (availablelines - 1)
.~ color white (text . replicate 15 $ toEnum 31) .~ color white (text . replicate 15 $ toEnum 31)
-- .~ color moredowncolor (text . replicate 15 $ toEnum 31)
| otherwise = id | otherwise = id
-- moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1 (allstrings, Sum aslength) = foldMap listSelectionColorPicture sis
(allstrings,Sum aslength) = foldMap listSelectionColorPicture sis
shownstrings = drop offset allstrings shownstrings = drop offset allstrings
listSelectionColorPicture :: SelectionItem a -> ([Picture], Sum Int) listSelectionColorPicture :: SelectionItem a -> ([Picture], Sum Int)
@@ -331,14 +334,6 @@ listSelectionColorPicture si = (g <$> _siPictures si, Sum $ _siHeight si)
where where
g = translate lindent 0 . color (_siColor si) . text g = translate lindent 0 . color (_siColor si) . text
lindent = 100 * fromIntegral (_siOffX si) 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 :: String -> [String] -> Bool
regexList x = any (List.isInfixOf x) regexList x = any (List.isInfixOf x)
src/Dodge/Inventory/SelectionList.hs
+5 -2
View File
@@ -6,6 +6,7 @@ module Dodge.Inventory.SelectionList (
closeButtonToSelectionItem, closeButtonToSelectionItem,
) where ) where
import Dodge.Data.DoubleTree
import Dodge.Item.InvSize import Dodge.Item.InvSize
import Dodge.Data.ComposedItem import Dodge.Data.ComposedItem
import Dodge.Data.SelectionList import Dodge.Data.SelectionList
@@ -19,8 +20,9 @@ import NewInt
import Padding import Padding
import Picture.Base 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 SelectionItem
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey) { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
, _siHeight = itInvHeight $ ci ^. _1 , _siHeight = itInvHeight $ ci ^. _1
@@ -31,6 +33,7 @@ invSelectionItem indent w ci =
, _siPayload = () , _siPayload = ()
} }
where where
ci = loc ^. locLDT . ldtValue
lw = w ^. cWorld . lWorld lw = w ^. cWorld . lWorld
cr = lw ^?! creatures . ix 0 cr = lw ^?! creatures . ix 0
itid = ci ^. _1 . itID . unNInt itid = ci ^. _1 . itID . unNInt
src/Dodge/SelectionSections/Draw.hs
+3 -1
View File
@@ -27,7 +27,9 @@ drawSelectionSections sss ldp cfig =
0 0
(foldMap (foldMap
(\ss -> translate (100*fromIntegral (_ssIndent ss)) 0 <$> (\ss -> translate (100*fromIntegral (_ssIndent ss)) 0 <$>
(_ssShownItems ss)) sss) --(take (_ssShownLength ss) $ _ssShownItems ss)) sss)
(_ssShownItems ss)
) sss)
drawSSCursor :: drawSSCursor ::
IM.IntMap (SelectionSection a) -> IM.IntMap (SelectionSection a) ->