Implement telescoping inventory selection

2023-02-10 10:57:00 +00:00
parent c354949ca9
commit a8e00ac025
10 changed files with 172 additions and 64 deletions
@@ -1,5 +1,9 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.DisplayInventory where

+import Data.Maybe
+import Picture.Text
+import Dodge.Inventory.ItemSpace
 import Picture.Base
 import Dodge.Render.HUD
 import Dodge.SelectionList
@@ -14,60 +18,128 @@ import Dodge.Default.World
 import Dodge.Data.SelectionList
 import Dodge.Data.World

-makeDisplayInventory :: World -> Configuration -> SelectionSections ()
-makeDisplayInventory w cfig = defaultDisplaySections
+updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
+updateDisplayInventory w cfig sss = sss
    { _sssSections = restrictsections    
-    , _sssSelPos = Just 0
+    , _sssSelPos = mspos
    , _sssMaxSize = availablelines
    }
  where
-    initialsections =  IM.fromList
-        [ (0, inventorysection)
-        , (1, makeYouSection w)
-        , (2, closesection)
-        ]
-    inventorysection = makeInventorySection w
-    closesection = makeCloseObjectsSection w
-    itotallength = length . foldMap _siPictures $ _ssItems inventorysection
-    ctotallength = length . foldMap _siPictures $ _ssItems closesection
+    mspos = do 
+        cr <- w ^? cWorld . lWorld . creatures . ix 0
+        mo <- cr ^? crInvSel . isel
+        case mo of
+            SelItem {} -> Just 0
+            SelNothing -> Just 1
+            SelCloseObject {} -> Just 2
    availablelines = getAvailableListLines (invDisplayParams w) cfig
    iavailablelines = availablelines - 6
-    minlengths = sum $ fmap _ssMinSize initialsections
-    sections | itotallength + 1 + ctotallength > availablelines = restrictsections
-        | otherwise = initialsections
-    ioffset = 1
+    oldoffset = sss ^? sssSections . ix 0 . ssOffset
    restrictsections = IM.fromList
-        [ (0, makeInventorySection w & ssShownItems %~ (take iavailablelines . drop ioffset))
+        [ (0, makeInventorySection iavailablelines oldoffset w )
        , (1, makeYouSection w)
        , (2, makeCloseObjectsSection w)
        ]

+makeDisplayInventory :: World -> Configuration -> SelectionSections ()
+makeDisplayInventory w cfig = defaultDisplaySections
+    { _sssSections = restrictsections    
+    , _sssSelPos = mspos
+    , _sssMaxSize = availablelines
+    }
+  where
+    mspos = do 
+        cr <- w ^? cWorld . lWorld . creatures . ix 0
+        mo <- cr ^? crInvSel . isel
+        case mo of
+            SelItem {} -> Just 0
+            SelNothing -> Just 1
+            SelCloseObject {} -> Just 2
+    availablelines = getAvailableListLines (invDisplayParams w) cfig
+    iavailablelines = availablelines - 6
+    restrictsections = IM.fromList
+        [ (0, makeInventorySection iavailablelines (Just 0) w )
+        , (1, makeYouSection w)
+        , (2, makeCloseObjectsSection w)
+        ]

-makeInventorySection :: World -> SelectionSection ()
-makeInventorySection w = SelectionSection
+makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection ()
+makeInventorySection iavailablelines moldoffset w = SelectionSection
    { _ssItems = map (invSelectionItem cr ) (IM.toList inv)
-    , _ssSelPos = Just 0
+    , _ssSelPos = fmap (subtract offset) selpos
+    , _ssSelSize = selsize
+    , _ssSelColor = selcolor
    , _ssRestriction = NoSSRestriction
    , _ssPriority = 0
-    , _ssOffset = 0
+    , _ssOffset = offset
+    , _ssIndent = 0
 --    , _ssRegex = ""
 --    , _ssRegexInput = False
    , _ssMinSize = 5
 --    , _ssOffset = 0
-    , _ssShownItems = foldMap (f . invSelectionItem cr ) (IM.toList inv)
+    , _ssShownItems = shownitems
    }
  where
+    jselpos = fromMaybe 0 selpos
+    oldoffset = fromMaybe 0 moldoffset
+    xselsize = fromMaybe 1 selsize
+    offset
+        | jselpos == 0 || not mustrestrict = 0
+        | jselpos - 1 < oldoffset = jselpos - 1
+        | islastitm = jselpos - iavailablelines + xselsize
+        | jselpos + 1 + xselsize - iavailablelines > oldoffset = jselpos - iavailablelines + 1 + xselsize
+        | length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines
+        | otherwise = oldoffset
+    tweakfirst (x:xs)
+        | offset > 0 = hup x : map h xs
+        | otherwise = map h (x:xs)
+    tweakfirst [] =  []
+    shownitems
+        | length shownstrings > iavailablelines
+            = tweakfirst (take (iavailablelines - 1) shownstrings) 
+                ++ [hdown $ shownstrings !! (iavailablelines -1)]
+        | otherwise = tweakfirst shownstrings
+    allstrings :: [(Color,String)]
+    allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv)
+    mustrestrict = length allstrings > iavailablelines
+    shownstrings :: [(Color,String)]
+    shownstrings = drop offset allstrings
    cr = you w
    inv = _crInv cr
+    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
+    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
+    selpos = do
+        i <- cr ^? crInvSel . isel . ispItem
+        return . sum . fmap itSlotsTaken . fst . IM.split i $ inv
+    selsize = do
+        i <- cr ^? crInvSel . isel . ispItem
+        itm <- inv ^? ix i 
+        return $ itSlotsTaken itm
+    selcolor = do
+        i <- cr ^? crInvSel . isel . ispItem
+        itm <- inv ^? ix i 
+        return $ _itInvColor itm
+        

 makeYouSection :: World -> SelectionSection ()
 makeYouSection w = SelectionSection
    { _ssItems = [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
-    , _ssSelPos = Nothing
+    , _ssSelPos = Just 0
+    , _ssSelSize = Just 1
+    , _ssSelColor = Just invDimColor
    , _ssOffset = 0
    , _ssPriority = 1
    , _ssRestriction = NoSSRestriction
+    , _ssIndent = 2
 --    , _ssRegex = ""
 --    , _ssRegexInput = False
    , _ssMinSize = 1
@@ -85,9 +157,12 @@ makeYouSection w = SelectionSection
 makeCloseObjectsSection :: World -> SelectionSection ()
 makeCloseObjectsSection w = SelectionSection
    { _ssItems = map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-    , _ssSelPos = Just 0
+    , _ssSelPos = selpos
+    , _ssSelSize = selsize
+    , _ssSelColor = selcolor
    , _ssPriority = 1
    , _ssOffset = 0
+    , _ssIndent = 2
    , _ssRestriction = NoSSRestriction
 --    , _ssRegex = ""
 --    , _ssRegexInput = False
@@ -99,4 +174,19 @@ makeCloseObjectsSection w = SelectionSection
    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
+