Work on collapsing close item list

2023-02-11 09:09:23 +00:00
parent a8e00ac025
commit 10f732d489
6 changed files with 183 additions and 63 deletions
@@ -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
@@ -20,7 +20,7 @@ import Dodge.Data.World

 updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
 updateDisplayInventory w cfig sss = sss
-    { _sssSections = restrictsections    
+    { _sssSections = restrictsections
    , _sssSelPos = mspos
    , _sssMaxSize = availablelines
    }
@@ -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 ()
-makeInventorySection iavailablelines moldoffset w = SelectionSection
-    { _ssItems = map (invSelectionItem cr ) (IM.toList inv)
-    , _ssSelPos = fmap (subtract offset) selpos
-    , _ssSelSize = selsize
-    , _ssSelColor = selcolor
+updateSection :: Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World 
+    -> SelectionSection ()
+    -> SelectionSection ()
+updateSection mspos sis availablelines w ss = ss
+    { _ssItems = sis
+    , _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"
-    hup (col,str) = color white $ text "<<< MORE INV ITEMS"
-    f si = map (color (_siColor si) . text) $ _siPictures si
+    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
@@ -132,10 +224,8 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection

 makeYouSection :: World -> SelectionSection ()
 makeYouSection w = SelectionSection
-    { _ssItems = [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
-    , _ssSelPos = Just 0
-    , _ssSelSize = Just 1
-    , _ssSelColor = Just invDimColor
+    { _ssItems = IM.singleton 0 $ SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()
+    , _ssCursor = Just $ SectionCursor 0 1 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 w = SelectionSection
-    { _ssItems = map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-    , _ssSelPos = selpos
-    , _ssSelSize = selsize
-    , _ssSelColor = selcolor
-    , _ssPriority = 1
-    , _ssOffset = 0
-    , _ssIndent = 2
-    , _ssRestriction = NoSSRestriction
--    , _ssRegex = ""
--    , _ssRegexInput = False
-    , _ssMinSize = 5
+--makeCloseObjectsSection :: Int -> World -> SelectionSection ()
+--makeCloseObjectsSection cavailablelines w = SelectionSection
+--    { _ssItems = IM.fromDistinctAscList . zip [0..] 
+--        $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
+--    , _ssCursor = scurs
+--    , _ssPriority = 1
 --    , _ssOffset = 0
-    , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-    }
-  where
-    f si = map (color (_siColor si) . text) $ _siPictures si
-    cr = you w
-    nfreeslots = crNumFreeSlots cr
-    selpos = do
-        i <- cr ^? crInvSel . isel . ispCloseObject
-        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
+--    , _ssIndent = 2
+--    , _ssRestriction = NoSSRestriction
+----    , _ssRegex = ""
+----    , _ssRegexInput = False
+--    , _ssMinSize = 5
+----    , _ssOffset = 0
+--    , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
+--    }
+--  where
+--    scurs = do
+--        cpos <- selpos
+--        csize <- selsize
+--        ccolor <- selcolor
+--        return $ SectionCursor cpos csize ccolor
+--    f si = map (color (_siColor si) . text) $ _siPictures si
+--    cr = you w
+--    nfreeslots = crNumFreeSlots cr
+--    selpos = do
+--        i <- cr ^? crInvSel . isel . ispCloseObject
+--        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