Work towards fixing inventory space leak
This commit is contained in:
@@ -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) =
|
||||
@@ -66,7 +67,7 @@ updateCombineSections w cfig =
|
||||
"COMBINATIONS"
|
||||
$ w ^? hud . hudElement . subInventory . ciFilter . _Just
|
||||
--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 Item -> SelectionItem CombinableItem -> String -> Bool
|
||||
@@ -78,7 +79,8 @@ regexCombs inv ci = \case
|
||||
g str i = fromMaybe False $ do
|
||||
si <- inv ^? ix i
|
||||
return $ regexList str $ basicItemDisplay si
|
||||
--return $ regexList str $ _siPictures si
|
||||
|
||||
--return $ regexList str $ _siPictures si
|
||||
|
||||
andOrRegex :: (a -> String -> Bool) -> a -> String -> Bool
|
||||
andOrRegex f x = all (orRegex f x) . List.wordsBy '&'
|
||||
@@ -128,38 +130,40 @@ updateDisplaySections w cfig =
|
||||
displayIndents
|
||||
mselpos
|
||||
(getAvailableListLines invDP cfig)
|
||||
[ invhead
|
||||
, invx
|
||||
, youx
|
||||
, nearbyhead
|
||||
, closex
|
||||
, interfaceshead
|
||||
, interfaces
|
||||
]
|
||||
( IM.fromDistinctAscList $
|
||||
zip
|
||||
[-1 .. 5]
|
||||
[ invhead
|
||||
, sinv
|
||||
, youx
|
||||
, nearbyhead
|
||||
, 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
|
||||
else filtclose
|
||||
youx = (1, youitems)
|
||||
interfaceshead = if null btitems then (4, mempty) else makehead "NEARBY INTERFACES" 4
|
||||
interfaces = (5, btitems)
|
||||
then if null sclose then mempty else makehead "NEARBY ITEMS"
|
||||
else sfclose
|
||||
youx = youitems
|
||||
interfaceshead = if null btitems then mempty else makehead "NEARBY INTERFACES"
|
||||
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)
|
||||
invhead = if null sfinv then makehead "INVENTORY" (-1) else filtinv
|
||||
makehead str = IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0
|
||||
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) ->
|
||||
invSelectionItem
|
||||
indent
|
||||
w
|
||||
(x ^. locLDT . ldtValue)
|
||||
)
|
||||
(uncurry (invSelectionItem w))
|
||||
(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,37 +293,40 @@ updateSection indent mcsel sis availablelines oldoffset =
|
||||
, _ssIndent = indent
|
||||
}
|
||||
where
|
||||
shownitems =
|
||||
-- tweakfirst . tweaklast . map (^. _2) $ take availablelines shownstrings
|
||||
tweakfirst . tweaklast $ take availablelines shownstrings
|
||||
--shownitems = take availablelines allstrings
|
||||
--shownitems = tweakfirst $ allstrings
|
||||
--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
|
||||
(allstrings, Sum aslength) = foldMap listSelectionColorPicture sis
|
||||
shownstrings = drop offset allstrings
|
||||
|
||||
listSelectionColorPicture :: SelectionItem a -> ([Picture], Sum Int)
|
||||
@@ -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)
|
||||
|
||||
@@ -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 indent w ci =
|
||||
--invSelectionItem :: Int -> World -> ComposedItem -> SelectionItem ()
|
||||
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
|
||||
|
||||
@@ -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) ->
|
||||
|
||||
Reference in New Issue
Block a user