diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 041f5a1b6..d3addbeac 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/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) = @@ -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) diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 82919a892..84f22f7fe 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/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 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 diff --git a/src/Dodge/SelectionSections/Draw.hs b/src/Dodge/SelectionSections/Draw.hs index 338b72ac4..3c5f5e70e 100644 --- a/src/Dodge/SelectionSections/Draw.hs +++ b/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) ->