Replace length . _siPictures with _siHeight

src/Dodge/DisplayInventory.hs

@@ -1,7 +1,7 @@
 -- {-# OPTIONS_GHC -fno-full-laziness #-}
 --{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE LambdaCase #-}
---{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns #-}
 
 module Dodge.DisplayInventory (
     updateInventoryPositioning,
@@ -9,7 +9,7 @@ module Dodge.DisplayInventory (
     toggleCombineInv,
 ) where
 
---import StrictHelp
+import StrictHelp
 import Dodge.Item.Display
 import qualified Data.Strict.Tuple as STup
 import Control.Applicative
@@ -52,7 +52,6 @@ updateCombineSections ::
     IM.IntMap (SelectionSection CombinableItem)
 updateCombineSections w cfig =
     updateSectionsPositioning
-        (const 5)
         (const 0)
         (w ^? hud . hudElement . subInventory . ciSelection . _Just)
         (getAvailableListLines secondColumnParams cfig)
@@ -113,11 +112,6 @@ checkCombineSelectionExists si
             %~ scrollSelectionSections (-1) sss
     | otherwise = si
 
-displaySectionsSizes :: Int -> Int
-displaySectionsSizes 0 = 10
-displaySectionsSizes 3 = 10
-displaySectionsSizes _ = 3
-
 displayIndents :: Int -> Int
 displayIndents 0 = 2
 displayIndents 3 = 2
@@ -131,7 +125,6 @@ updateDisplaySections ::
     IM.IntMap (SelectionSection ())
 updateDisplaySections w cfig =
     updateSectionsPositioning
-        displaySectionsSizes
         displayIndents
         mselpos
         (getAvailableListLines invDP cfig)
@@ -224,20 +217,17 @@ displayFreeSlots x = case x of
     1 -> "1 FREE SLOT"
     _ -> show x ++ " FREE SLOTS"
 
-sectionsDesiredLines ::
-    IM.IntMap (IM.IntMap (SelectionItem a)) ->
-    IM.IntMap Int
+sectionsDesiredLines :: IM.IntMap (IM.IntMap (SelectionItem a)) -> IM.IntMap Int
 sectionsDesiredLines = fmap $ alaf Sum foldMap _siHeight
 
 sectionsSizes ::
     Int -> -- total available lines
-    (Int -> Int) -> -- minimum line bounds for each section
     [Int] -> -- ordering in which to consider sections (others to be done lowest to highest)
     IM.IntMap Int -> -- desired lines
     IM.IntMap Int
-sectionsSizes x f is sss = doSectionSize extraavailable mintaken is sss mempty
+sectionsSizes x is sss = doSectionSize extraavailable mintaken is sss mempty
   where
-    mintaken = IM.mapWithKey (min . f) sss
+    mintaken = IM.mapWithKey (min . const 10) sss
     extraavailable = x - sum mintaken
 
 doSectionSize ::
@@ -267,18 +257,16 @@ doSectionSize extraavailable mintaken is sss done = fromMaybe done $ do
         return (v, s', k, [])
 
 updateSectionsPositioning ::
-    (Int -> Int) -> -- for determining each sections minimum size
     (Int -> Int) -> -- for determining each sections indent
     Maybe (Int, Int, IntSet) ->
     Int ->
     [(Int, IM.IntMap (SelectionItem a))] ->
     IM.IntMap (SelectionSection a) ->
     IM.IntMap (SelectionSection a)
-updateSectionsPositioning f h mselpos allavailablelines lsss sss =
+updateSectionsPositioning h mselpos allavailablelines lsss sss =
     IM.intersectionWithKey (\k -> updateSection (h k) (m k)) ls ssizes `g` offsets
   where
     offsets = fmap _ssOffset sss
-    --offsets = mempty
     m k = do
         (k', i, _) <- mselpos
         guard $ k == k'
@@ -287,7 +275,7 @@ updateSectionsPositioning f h mselpos allavailablelines lsss sss =
     -- defaults non-existing offsets to 0
     g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($)))
     lk = mselpos ^.. _Just . _1
-    ssizes = sectionsSizes allavailablelines f lk $ sectionsDesiredLines ls
+    ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines ls
 
 updateSection ::
     Int ->
@@ -312,8 +300,9 @@ updateSection indent mcsel sis availablelines oldoffset =
     offset = fromMaybe oldoffsetbounded $ do
         csel <- mcsel
         maxcsel <- fst <$> IM.lookupMax sis
-        xselsize <- fmap length $ sis ^? ix csel . siPictures
-        return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
+--        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
@@ -338,7 +327,7 @@ updateSection indent mcsel sis availablelines oldoffset =
 listSelectionColorPicture :: SelectionItem a -> ([STup.Pair Color Picture], Sum Int)
 listSelectionColorPicture si = (g <$> _siPictures si, Sum $ _siHeight si)
   where
-    g str = 
+    g !str = 
         _siColor si STup.:!: 
         translate lindent 0 (color (_siColor si) $ text str)
     lindent = 100 * fromIntegral (_siOffX si)

src/Dodge/SelectionSections.hs

@@ -178,7 +178,7 @@ ssLookupGE' i sss = do
         Nothing -> ssLookupGT' i' sss
 
 selSecSelSize :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
-selSecSelSize i j = fmap length . (^? ix i . ssItems . ix j . siPictures)
+selSecSelSize i j = (^? ix i . ssItems . ix j . siHeight)
 
 -- need to check that the vertical gap is correctly put in here
 posSelSecYint :: Configuration -> ListDisplayParams -> Float -> Int

src/Dodge/Update/Input/InGame.hs

@@ -5,6 +5,7 @@ module Dodge.Update.Input.InGame (
     updateMouseInGame,
 ) where
 
+import Dodge.Item.Display
 import Control.Applicative
 import Control.Monad
 import Data.Foldable
@@ -240,8 +241,9 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
         guard $ i == 0
         str <-
             fmap (take 5) $
-                w
-                    ^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0
+                w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j
+                    >>= (listToMaybe . basicItemDisplay)
+--                    ^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0
         return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
             case w ^? hud . hudElement . subInventory . ciFilter . _Just of
                 Just (_ : xs)