Refactor section sizing

src/Dodge/Data/SelectionList.hs

@@ -29,7 +29,7 @@ data SectionCursor = SectionCursor
 
 data SelectionSection a = SelectionSection
     { _ssItems :: IntMap (SelectionItem a)
-    , _ssMinSize :: Int
+--    , _ssMinSize :: Int
     , _ssOffset :: Int
     , _ssShownItems :: [Picture]
     , _ssIndent :: Int

src/Dodge/Default/World.hs

@@ -1,5 +1,6 @@
 module Dodge.Default.World where
 
+import Color
 import NewInt
 import Control.Lens
 import Data.Graph.Inductive.Graph hiding ((&))
@@ -163,8 +164,6 @@ defaultDisplayInventory :: HUDElement
 defaultDisplayInventory =
     DisplayInventory
         { _subInventory = NoSubInventory 
---            {_nsSelected = MouseInvNothing
---            }
         , _diSections = defaultInvSections
         , _diSelection = Just (1,0)
         , _diSelectionExtra = mempty
@@ -175,8 +174,10 @@ defaultDisplayInventory =
 defaultInvSections :: IM.IntMap (SelectionSection ())
 defaultInvSections = IM.fromDistinctAscList $
                 zip
-                    [-1 ..]
-                    [ defaultFiltSection
+                    [-2 ..]
+                    [ defaultSS & ssDescriptor .~ "STATUS"
+                        & ssItems .~ IM.fromAscList [(0,SelectionItem ["STATUS"] 1 False white 0 ())]
+                    , defaultFiltSection
                     , defaultInvSection
                     , defaultYouSection
                     , defaultFiltSection & ssIndent .~ 2
@@ -188,7 +189,6 @@ defaultSS :: SelectionSection a
 defaultSS =
     SelectionSection
         { _ssItems = mempty
-        , _ssMinSize = 10
         , _ssOffset = 0
         , _ssShownItems = []
         , _ssIndent = 0
@@ -206,7 +206,6 @@ defaultFiltSection =
     defaultSS
         & ssIndent .~ 0
         & ssDescriptor .~ "INV"
-        & ssMinSize .~ 0
 
 defaultInvSection :: SelectionSection ()
 defaultInvSection =
@@ -217,5 +216,4 @@ defaultYouSection :: SelectionSection ()
 defaultYouSection =
     defaultSS
         & ssIndent .~ 2
-        & ssMinSize .~ 1
         & ssDescriptor .~ "YOUR STATUS"

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