Work on collapsing close item list

src/Dodge/Data/SelectionList.hs

@@ -42,11 +42,18 @@ data SSRestriction = NoSSRestriction
         , _ssrOffset :: Int
         }
 
+data SectionCursor = SectionCursor
+    { _scurPos :: Int
+    , _scurSize :: Int
+    , _scurColor :: Color
+    }
+
 data SelectionSection a = SelectionSection
-    { _ssItems :: [SelectionItem a]
+    { _ssItems :: IntMap (SelectionItem a)
-    , _ssSelPos :: Maybe Int
+    , _ssCursor :: Maybe SectionCursor
-    , _ssSelSize :: Maybe Int
+--    , _ssSelPos :: Maybe Int
-    , _ssSelColor :: Maybe Color
+--    , _ssSelSize :: Maybe Int
+--    , _ssSelColor :: Maybe Color
     , _ssMinSize :: Int
     , _ssPriority :: Int
     , _ssOffset :: Int
@@ -97,6 +104,7 @@ makeLenses ''SelectionItem
 makeLenses ''SelectionIntMap
 makeLenses ''SelectionSection
 makeLenses ''SelectionSections
+makeLenses ''SectionCursor
 makeLenses ''SSRestriction
 --deriveJSON defaultOptions ''SelectionItem
 --deriveJSON defaultOptions ''SelectionList

src/Dodge/Default/SelectionList.hs

@@ -4,7 +4,7 @@ import Dodge.Data.SelectionList
 
 defaultSelectionList :: SelectionList a
 defaultSelectionList = SelectionList
-    {_slItems = []
+    {_slItems = mempty
     , _slSelPos = Nothing
 --    , _slLength = 0
     , _slRegex = ""

src/Dodge/DisplayInventory.hs

@@ -2,7 +2,7 @@
 module Dodge.DisplayInventory where
 
 import Data.Maybe
-import Picture.Text
+--import Picture.Text
 import Dodge.Inventory.ItemSpace
 import Picture.Base
 import Dodge.Render.HUD
@@ -34,12 +34,31 @@ updateDisplayInventory w cfig sss = sss
             SelCloseObject {} -> Just 2
     availablelines = getAvailableListLines (invDisplayParams w) cfig
     iavailablelines = availablelines - 6
+    invsection = makeInventorySection iavailablelines oldoffset w
+    invsectionlines = length $ _ssShownItems invsection
     oldoffset = sss ^? sssSections . ix 0 . ssOffset
     restrictsections = IM.fromList
-        [ (0, makeInventorySection iavailablelines oldoffset w )
+        [ (0, invsection )
         , (1, makeYouSection w)
-        , (2, makeCloseObjectsSection w)
+        --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
+        , (2, updateSection copos coitems (availablelines - invsectionlines - 1) w cosec)
         ]
+    cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2
+    coitems = IM.fromDistinctAscList . zip [0..] 
+        $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
+    nfreeslots = fromMaybe 0 $ do
+        cr <- w ^? cWorld . lWorld . creatures . ix 0
+        return $ crNumFreeSlots cr
+    copos = do 
+        cr <- w ^? cWorld . lWorld . creatures . ix 0
+        mo <- cr ^? crInvSel . isel
+        case mo of
+            SelItem {} -> Nothing
+            SelNothing -> Nothing
+            SelCloseObject i -> Just i
+
+defaultCOSection :: SelectionSection ()
+defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2
 
 makeDisplayInventory :: World -> Configuration -> SelectionSections ()
 makeDisplayInventory w cfig = defaultDisplaySections
@@ -57,18 +76,21 @@ makeDisplayInventory w cfig = defaultDisplaySections
             SelCloseObject {} -> Just 2
     availablelines = getAvailableListLines (invDisplayParams w) cfig
     iavailablelines = availablelines - 6
+    invsection = makeInventorySection iavailablelines (Just 0) w
+    --invsectionlines = length $ _ssShownItems invsection
     restrictsections = IM.fromList
-        [ (0, makeInventorySection iavailablelines (Just 0) w )
+        [ (0, invsection )
         , (1, makeYouSection w)
-        , (2, makeCloseObjectsSection w)
+        --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w)
+        , (2, defaultCOSection)
         ]
 
-makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
+updateSection :: Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World 
-makeInventorySection iavailablelines moldoffset w = SelectionSection
+    -> SelectionSection ()
-    { _ssItems = map (invSelectionItem cr ) (IM.toList inv)
+    -> SelectionSection ()
-    , _ssSelPos = fmap (subtract offset) selpos
+updateSection mspos sis availablelines w ss = ss
-    , _ssSelSize = selsize
+    { _ssItems = sis
-    , _ssSelColor = selcolor
+    , _ssCursor = scurs
     , _ssRestriction = NoSSRestriction
     , _ssPriority = 0
     , _ssOffset = offset
@@ -80,6 +102,77 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection
     , _ssShownItems = shownitems
     }
   where
+    moldoffset = ss ^? ssOffset
+    scurs = do
+        csel <- mspos
+        let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
+        csize <- selsize
+        ccolor <- selcolor
+        return $ SectionCursor cpos csize ccolor
+    oldoffset = fromMaybe 0 moldoffset
+    xselsize = fromMaybe 1 selsize
+    offset = maybe 0 offset' mspos
+    offset' jselpos
+        | jselpos == 0 || not mustrestrict = 0
+        | jselpos - 1 < oldoffset = jselpos - 1
+        | islastitm = jselpos - availablelines + xselsize
+        | jselpos + 1 + xselsize - availablelines > oldoffset = jselpos - availablelines + 1 + xselsize
+        | length allstrings - oldoffset < availablelines = length allstrings - availablelines
+        | otherwise = oldoffset
+    tweakfirst (x:xs)
+        | offset > 0 = hup : map h xs
+        | otherwise = map h (x:xs)
+    tweakfirst [] =  []
+    shownitems
+        | length shownstrings > availablelines
+            = tweakfirst (take (availablelines - 1) shownstrings) 
+                ++ [hdown]
+        | otherwise = tweakfirst shownstrings
+    allstrings :: [(Color,String)]
+    allstrings = foldMap g sis
+    mustrestrict = length allstrings > availablelines
+    shownstrings :: [(Color,String)]
+    shownstrings = drop offset allstrings
+    cr = you w
+    h (col,str) = color col . text $ str
+    --hdown (col,str) = textGrad col (withAlpha 0 col) str
+    --hup (col,str) = textGrad (withAlpha 0 col) col str
+    hdown = color white $ text ">>> MORE INV ITEMS"
+    hup = color white $ text "<<< MORE INV ITEMS"
+    g si = map (_siColor si ,) $ _siPictures si
+    islastitm = fromMaybe False $ do
+        i <- cr ^? crInvSel . isel . ispItem
+        k <- fmap fst $ IM.lookupMax (_crInv cr)
+        return $ k == i
+    selsize = do
+        i <- mspos
+        si <- sis ^? ix i
+        return . length $ _siPictures si
+    selcolor = do
+        i <- mspos
+        si <- sis ^? ix i
+        return $ _siColor si
+
+makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
+makeInventorySection iavailablelines moldoffset w = SelectionSection
+    { _ssItems = IM.mapWithKey (invSelectionItem' cr) inv
+    , _ssCursor = scurs
+    , _ssRestriction = NoSSRestriction
+    , _ssPriority = 0
+    , _ssOffset = offset
+    , _ssIndent = 0
+--    , _ssRegex = ""
+--    , _ssRegexInput = False
+    , _ssMinSize = 5
+--    , _ssOffset = 0
+    , _ssShownItems = shownitems
+    }
+  where
+    scurs = do
+        cpos <- fmap (subtract offset) selpos
+        csize <- selsize
+        ccolor <- selcolor
+        return $ SectionCursor cpos csize ccolor
     jselpos = fromMaybe 0 selpos
     oldoffset = fromMaybe 0 moldoffset
     xselsize = fromMaybe 1 selsize
@@ -91,13 +184,13 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection
         | length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines
         | otherwise = oldoffset
     tweakfirst (x:xs)
-        | offset > 0 = hup x : map h xs
+        | offset > 0 = hup : map h xs
         | otherwise = map h (x:xs)
     tweakfirst [] =  []
     shownitems
         | length shownstrings > iavailablelines
             = tweakfirst (take (iavailablelines - 1) shownstrings) 
-                ++ [hdown $ shownstrings !! (iavailablelines -1)]
+                ++ [hdown]
         | otherwise = tweakfirst shownstrings
     allstrings :: [(Color,String)]
     allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv)
@@ -109,9 +202,8 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection
     h (col,str) = color col . text $ str
     --hdown (col,str) = textGrad col (withAlpha 0 col) str
     --hup (col,str) = textGrad (withAlpha 0 col) col str
-    hdown (col,str) = color white $ text ">>> MORE INV ITEMS"
+    hdown = color white $ text ">>> MORE INV ITEMS"
-    hup (col,str) = color white $ text "<<< MORE INV ITEMS"
+    hup = color white $ text "<<< MORE INV ITEMS"
-    f si = map (color (_siColor si) . text) $ _siPictures si
     g si = map (_siColor si ,) $ _siPictures si
     islastitm = fromMaybe False $ do
         i <- cr ^? crInvSel . isel . ispItem
@@ -132,10 +224,8 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection
 
 makeYouSection :: World -> SelectionSection ()
 makeYouSection w = SelectionSection
-    { _ssItems = [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
+    { _ssItems = IM.singleton 0 $ SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()
-    , _ssSelPos = Just 0
+    , _ssCursor = Just $ SectionCursor 0 1 invDimColor
-    , _ssSelSize = Just 1
-    , _ssSelColor = Just invDimColor
     , _ssOffset = 0
     , _ssPriority = 1
     , _ssRestriction = NoSSRestriction
@@ -154,39 +244,43 @@ makeYouSection w = SelectionSection
         1 -> "  +1 FREE SLOT"
         x -> "  +" ++ show x ++ " FREE SLOTS"
 
-makeCloseObjectsSection :: World -> SelectionSection ()
+--makeCloseObjectsSection :: Int -> World -> SelectionSection ()
-makeCloseObjectsSection w = SelectionSection
+--makeCloseObjectsSection cavailablelines w = SelectionSection
-    { _ssItems = map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
+--    { _ssItems = IM.fromDistinctAscList . zip [0..] 
-    , _ssSelPos = selpos
+--        $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-    , _ssSelSize = selsize
+--    , _ssCursor = scurs
-    , _ssSelColor = selcolor
+--    , _ssPriority = 1
-    , _ssPriority = 1
-    , _ssOffset = 0
-    , _ssIndent = 2
-    , _ssRestriction = NoSSRestriction
---    , _ssRegex = ""
---    , _ssRegexInput = False
-    , _ssMinSize = 5
 --    , _ssOffset = 0
-    , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
+--    , _ssIndent = 2
-    }
+--    , _ssRestriction = NoSSRestriction
-  where
+----    , _ssRegex = ""
-    f si = map (color (_siColor si) . text) $ _siPictures si
+----    , _ssRegexInput = False
-    cr = you w
+--    , _ssMinSize = 5
-    nfreeslots = crNumFreeSlots cr
+----    , _ssOffset = 0
-    selpos = do
+--    , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-        i <- cr ^? crInvSel . isel . ispCloseObject
+--    }
-        return . sum . map closeobjectsize . take i $ w ^. hud . closeObjects
+--  where
-    selsize = do
+--    scurs = do
-        i <- cr ^? crInvSel . isel . ispCloseObject
+--        cpos <- selpos
-        obj <- w ^? hud . closeObjects . ix i
+--        csize <- selsize
-        return $ closeobjectsize obj
+--        ccolor <- selcolor
-    closeobjectsize co = maybe 1 itSlotsTaken (co ^? _Left . flIt)
+--        return $ SectionCursor cpos csize ccolor
-    selcolor = do
+--    f si = map (color (_siColor si) . text) $ _siPictures si
-        i <- cr ^? crInvSel . isel . ispCloseObject
+--    cr = you w
-        obj <- w ^? hud . closeObjects . ix i
+--    nfreeslots = crNumFreeSlots cr
-        Just $ case obj of
+--    selpos = do
-            Left flit -> _itInvColor $ _flIt flit
+--        i <- cr ^? crInvSel . isel . ispCloseObject
-            Right bt -> _btColor bt
+--        return . sum . map closeobjectsize . take i $ w ^. hud . closeObjects
+--    selsize = do
+--        i <- cr ^? crInvSel . isel . ispCloseObject
+--        obj <- w ^? hud . closeObjects . ix i
+--        return $ closeobjectsize obj
+--    closeobjectsize co = maybe 1 itSlotsTaken (co ^? _Left . flIt)
+--    selcolor = do
+--        i <- cr ^? crInvSel . isel . ispCloseObject
+--        obj <- w ^? hud . closeObjects . ix i
+--        Just $ case obj of
+--            Left flit -> _itInvColor $ _flIt flit
+--            Right bt -> _btColor bt
         
 

src/Dodge/Inventory/SelectionList.hs

@@ -1,5 +1,6 @@
 module Dodge.Inventory.SelectionList 
     ( invSelectionItem
+    , invSelectionItem'
     , closeObjectToSelectionItem
     )
     where
@@ -24,6 +25,22 @@ import LensHelp
 --    Just CombineInventory{} -> Nothing
 --    _ -> Just $ yourInvSel w
 --
+invSelectionItem' :: Creature ->  Int -> Item -> SelectionItem ()
+invSelectionItem' cr i it = SelectionItem
+    { _siPictures = pics
+    , _siHeight = length pics
+    , _siIsSelectable = True
+    , _siWidth = 15
+    , _siColor = col
+    , _siOffX = 0
+    , _siPayload = ()
+    }
+  where
+    col = _itInvColor it
+    pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
+        UndroppableIdentified -> itemDisplay it
+        _ | cr ^? crInvSel . isel . ispItem == Just i -> selectedItemDisplay cr it
+        _ -> itemDisplay it
 invSelectionItem :: Creature -> (Int,Item) -> SelectionItem ()
 invSelectionItem cr (i,it) = SelectionItem
     { _siPictures = pics

src/Dodge/Render/HUD.hs

@@ -84,7 +84,7 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
   where
     thecolor = fromMaybe white   $ do
         spos <- _sssSelPos sss
-        sss ^? sssSections . ix spos . ssSelColor . _Just
+        sss ^? sssSections . ix spos . ssCursor . _Just . scurColor
     thecursor = fromMaybe mempty $ do
         sectype <- you w ^? crInvSel . isel
         let secnum = case sectype of
@@ -94,8 +94,8 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
         xint <- sss ^? sssSections . ix secnum . ssIndent
         spos <- _sssSelPos sss
         let y = sum . fmap (length . _ssShownItems) . fst . IM.split spos $ _sssSections sss
-        yint <- sss ^? sssSections . ix spos . ssSelPos . _Just
+        yint <- sss ^? sssSections . ix spos . ssCursor . _Just . scurPos
-        csize <- sss ^? sssSections . ix spos . ssSelSize . _Just
+        csize <- sss ^? sssSections . ix spos . ssCursor . _Just . scurSize
         return $ listCursorDisplayParams ldps [North,South,West] cfig (yint + y) xint white 15 csize
     ldps = invDisplayParams w
     pics = foldMap (_ssShownItems) (_sssSections sss)

src/Dodge/SelectionList.hs

@@ -5,6 +5,7 @@ import Regex
 import Dodge.Data.Universe
 import LensHelp
 import Data.Maybe
+--import Data.IntMap.Strict (IntMap)
 
 getAvailableListLines :: ListDisplayParams -> Configuration -> Int
 getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
@@ -17,7 +18,7 @@ getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
 getShownItems :: SelectionList a -> [SelectionItem a]
 getShownItems sl = case sl ^. slRegexList of
     [] -> sl ^. slItems
-    xs -> map fst xs
+    xs -> fmap fst xs
 
 makeRegexList :: SelectionList a -> [(SelectionItem a, Maybe Int)]
 makeRegexList sl = case sl ^. slRegex of