Refactor section sizing

src/Dodge/DisplayInventory.hs

@@ -1,10 +1,13 @@
 -- {-# OPTIONS_GHC -fno-full-laziness #-}
+{-# LANGUAGE TupleSections #-}
 module Dodge.DisplayInventory (
     toggleCombineInv,
     updateInventoryPositioning,
     updateCombinePositioning,
 ) where
 
+import Data.Monoid
+import qualified Data.List as List
 import Dodge.CharacterEnums
 import Control.Applicative
 import Control.Lens
@@ -48,6 +51,7 @@ updateCombineSections ::
     IM.IntMap (SelectionSection CombinableItem)
 updateCombineSections w cfig =
     updateSectionsPositioning
+        (const 0)
         (w ^? hud . hudElement . subInventory . ciSelection . _Just)
         (getAvailableListLines secondColumnParams cfig)
         [(0, sclose), (-1, sfclose)]
@@ -109,6 +113,10 @@ checkCombineSelectionExists u = fromMaybe u $ do
                 %~ scrollSelectionSections (-1) sss
         _ -> u
 
+displaySectionsSizes 0 = 10
+displaySectionsSizes 3 = 10
+displaySectionsSizes _ = 2
+
 updateDisplaySections ::
     World ->
     Configuration ->
@@ -116,6 +124,7 @@ updateDisplaySections ::
     IM.IntMap (SelectionSection ())
 updateDisplaySections w cfig =
     updateSectionsPositioning
+        displaySectionsSizes
         mselpos
         (getAvailableListLines (invDisplayParams w) cfig)
         addorder
@@ -200,26 +209,91 @@ displayFreeSlots x = case x of
     1 -> "1 FREE SLOT"
     _ -> show x ++ " FREE SLOTS"
 
+sectionsDesiredLines ::
+    IM.IntMap (SelectionSection a) ->
+    IM.IntMap Int
+sectionsDesiredLines = fmap $ alaf Sum foldMap _siHeight . _ssItems
+
+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
+  where
+    mintaken = IM.mapWithKey (\k y -> min (f k) y) sss
+    --mintaken = IM.mapWithKey (\k y -> f k) sss
+    extraavailable = x - sum mintaken
+
+doSectionSize ::
+    Int -> -- extra available lines
+    IM.IntMap 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 in sections not yet considered
+    IM.IntMap Int -> -- sections already sized
+    IM.IntMap Int
+doSectionSize extraavailable mintaken is sss done = fromMaybe done $ do
+    (v,others,k,ks) <- getsecusingis <|> getminsec
+    minv <- mintaken ^? ix k
+    let extradesired = v - minv
+        linesgiven = min extraavailable extradesired
+    return $ doSectionSize (extraavailable - linesgiven) mintaken ks others $ done
+        & at k ?~ linesgiven + minv
+  where
+    getsecusingis = do
+        (k,ks) <- List.uncons is
+        let (my,s') = IM.updateLookupWithKey (\_ _ -> Nothing) k sss
+        y <- my
+        return (y,s',k,ks)
+    getminsec = do
+        ((k,v),s') <- IM.minViewWithKey sss
+        return (v,s',k,[])
+    
 updateSectionsPositioning ::
+    (Int -> Int) -> -- for determining each sections minimum size
     Maybe (Int, Int) ->
     Int ->
     [(Int, IM.IntMap (SelectionItem a))] ->
     IM.IntMap (SelectionSection a) ->
     IM.IntMap (SelectionSection a)
-updateSectionsPositioning _ _ [] _ = mempty
-updateSectionsPositioning mselpos allavailablelines ((k, y) : xs) sss =
-    IM.insert k ss previoussections
+updateSectionsPositioning f mselpos allavailablelines lsss sss =
+    IM.intersectionWith updateSection ls mss `h` ssizes `h` sss
   where
-    mscel = do
-        (i, j) <- mselpos
-        guard $ i == k
-        return j
-    ss = updateSection y mscel linesleft x
-    x = sss ^?! ix k
-    availablelines = allavailablelines - _ssMinSize x
-    linesleft = allavailablelines - sum (linestaken <$> previoussections)
-    linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
-    previoussections = updateSectionsPositioning mselpos availablelines xs sss
+    mss = IM.mapWithKey m sss
+    m k _ = do
+        (k',i) <- mselpos
+        guard $ k == k'
+        return i
+    ls = IM.fromList lsss
+    h = IM.intersectionWith ($)
+    g k x z = x
+    lk = fromMaybe [] $ fmap ((:[]) . fst) mselpos
+    ssizes = sectionsSizes allavailablelines displaySectionsSizes 
+        lk $ sectionsDesiredLines $ IM.intersectionWith (set ssItems) ls sss
+
+updateSectionsPositioning' ::
+    (Int -> Int) -> -- for determining each sections minimum size
+    Maybe (Int, Int) ->
+    Int ->
+    [(Int, IM.IntMap (SelectionItem a))] ->
+    IM.IntMap (SelectionSection a) ->
+    IM.IntMap (SelectionSection a)
+updateSectionsPositioning' f mselpos allavailablelines lsss sss = fromMaybe mempty $ do
+    ((k, y) , xs) <- List.uncons lsss
+    x <- sss ^? ix k
+    let mscel = do
+            (i, j) <- mselpos
+            guard $ i == k
+            return j
+    let availablelines = allavailablelines - min (f k) (length $ _ssShownItems x)
+    let previoussections = updateSectionsPositioning f mselpos availablelines xs sss
+--    let linestaken (k',ss') = max (length $ _ssShownItems ss') (f k')
+--    let linesleft = allavailablelines - sum (linestaken <$> IM.toList $ previoussections)
+    let linestaken = length . _ssShownItems
+    let linesleft = allavailablelines - sum (linestaken <$> previoussections)
+    let ss = updateSection y mscel linesleft x
+    return $ IM.insert k ss previoussections
 
 updateSection ::
     IM.IntMap (SelectionItem a) ->
@@ -301,7 +375,7 @@ enterCombineInv cfig w =
     filtsection =
         SelectionSection
             { _ssItems = mempty
-            , _ssMinSize = 0
+--            , _ssMinSize = 0
             , _ssOffset = 0
             , _ssShownItems = mempty
             , _ssIndent = 0
@@ -314,7 +388,7 @@ enterCombineInv cfig w =
             availablelines
             SelectionSection
                 { _ssItems = cm
-                , _ssMinSize = 5
+--                , _ssMinSize = 5
                 , _ssOffset = 0
                 , _ssShownItems = mempty
                 , _ssIndent = 0