Implement telescoping inventory selection

src/Dodge/Data/SelectionList.hs

@@ -45,11 +45,14 @@ data SSRestriction = NoSSRestriction
 data SelectionSection a = SelectionSection
     { _ssItems :: [SelectionItem a]
     , _ssSelPos :: Maybe Int
+    , _ssSelSize :: Maybe Int
+    , _ssSelColor :: Maybe Color
     , _ssMinSize :: Int
     , _ssPriority :: Int
     , _ssOffset :: Int
     , _ssRestriction :: SSRestriction
     , _ssShownItems :: [Picture]
+    , _ssIndent :: Int
     }
     
 

src/Dodge/DisplayInventory.hs

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

src/Dodge/HeldScroll.hs

@@ -2,7 +2,7 @@ module Dodge.HeldScroll (
     doHeldScroll,
 ) where
 
-import Dodge.Base.You
+--import Dodge.Base.You
 import Control.Lens hiding ((<|), (|>))
 import Data.Sequence
 import Dodge.Data.Creature

src/Dodge/Inventory/SelectionList.hs

@@ -9,11 +9,8 @@ import Dodge.Inventory.Color
 import Dodge.Item.Display
 import Dodge.Inventory.ItemSpace
 import Picture.Base
-import Dodge.Inventory.CheckSlots
-import Dodge.Base.You
 import Dodge.Data.SelectionList
 import Dodge.Data.World
-import qualified Data.IntMap.Strict as IM
 import LensHelp
 
 --makeInventorySelectionList :: World -> SelectionList ()
@@ -21,18 +18,6 @@ import LensHelp
 --    & slItems .~ inventorySelectionList w
 --    & slSelPos .~ inventoryCursorPos w
 --
-inventorySelectionList :: World -> [SelectionItem ()]
-inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
-    ++ [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()]
-            ++ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
-  where
-    cr = you w
-    inv = _crInv cr
-    nfreeslots = crNumFreeSlots cr
-    thetext = case nfreeslots of
-        0 -> "  INVENTORY FULL"
-        1 -> "  +1 FREE SLOT"
-        x -> "  +" ++ show x ++ " FREE SLOTS"
 --
 --inventoryCursorPos :: World -> Maybe Int
 --inventoryCursorPos w = case w ^? hud . hudElement . subInventory of

src/Dodge/Item/Display.hs

@@ -21,7 +21,7 @@ itemDisplayWithNumber numberstr it =
         (midPadL 15 ' ' thename (' ' : numberstr) ++ theparam) :
         catMaybes [maybeWarmupStatus it, maybeRateStatus it]
             ++ moduleStrings it
-            ++ repeat "*"
+            ++ repeat "\\"
   where
     thename = itemBaseName it
     theparam =

src/Dodge/Render/HUD.hs

@@ -21,7 +21,6 @@ import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.Inventory
 --import Dodge.Inventory.ItemSpace
-import Dodge.Inventory.SelectionList
 --import Dodge.Item.Display
 import Dodge.Item.Info
 import Dodge.Render.Connectors
@@ -79,13 +78,26 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
     (_ldpPosX ldps)
     (_ldpPosY ldps)
     cfig
-    0 -- offset
+    0
-    --undefined
     pics
+    <> color thecolor thecursor
   where
+    thecolor = fromMaybe white   $ do
+        spos <- _sssSelPos sss
+        sss ^? sssSections . ix spos . ssSelColor . _Just
+    thecursor = fromMaybe mempty $ do
+        sectype <- you w ^? crInvSel . isel
+        let secnum = case sectype of
+                SelItem{} -> 0
+                SelNothing{} -> 1
+                SelCloseObject{} -> 2
+        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
+        csize <- sss ^? sssSections . ix spos . ssSelSize . _Just
+        return $ listCursorDisplayParams ldps [North,South,West] cfig (yint + y) xint white 15 csize
     ldps = invDisplayParams w
---    pics' = take (_sssMaxSize sss) pics
---    totallength = length pics'
     pics = foldMap (_ssShownItems) (_sssSections sss)
     
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
@@ -187,7 +199,7 @@ examineInventoryExtra mtweaki mitm cfig =
             tweaki <- mtweaki
             -- consider moving this functionality out into a tweaks module
             tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
-            return $ listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 15
+            return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15
             --        , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
         ]
 
@@ -327,14 +339,14 @@ lnkMidPosInvSelsCol cfig w i col =
     hw = halfWidth cfig
 
 topCursorTypeWidth ::
-    (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture) ->
+    (Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture) ->
     Int ->
     Configuration ->
     World ->
     Int ->
     Picture
 topCursorTypeWidth ctype width cfig w i =
-    ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (invSelSize i w)
+    ctype 0 0 cfig (selNumPos i w) 0 (selNumCol i w) width (invSelSize i w)
 
 determineInvSelCursorWidth :: World -> Int
 determineInvSelCursorWidth w = case _rbOptions w of

src/Dodge/Render/InfoBox.hs

@@ -15,7 +15,7 @@ renderInfoListAt :: Float -> Float -> Configuration -> CamPos -> (Point2, [Strin
 renderInfoListAt x y cfig cam (p, ss) =
     renderListAt x y cfig (zip ss (repeat white))
         <> winScale cfig (color white $ lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p))
-        <> listCursorNSW x y cfig 0 white 19 (length ss)
+        <> listCursorNSW x y cfig 0 0 white 19 (length ss)
   where
     hw = halfWidth cfig
     hh = halfHeight cfig

src/Dodge/Render/List.hs

@@ -60,7 +60,7 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
         NoCursor -> Nothing
     let j = sum . map _siHeight $ take i lis
         col = _siColor selit
-    return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit)
+    return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j 0 col wdth (_siHeight selit)
   where
     wdth = case _ldpWidth ldps of
         FixedSelectionWidth x -> x
@@ -74,7 +74,7 @@ drawCursorAt' ldps cfig i lis = fromMaybe mempty $ do
         NoCursor -> Nothing
     let j = getIthPos i lis
         col = _siColor selit
-    return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit)
+    return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j 0 col wdth (_siHeight selit)
   where
     wdth = case _ldpWidth ldps of
         FixedSelectionWidth x -> x
@@ -109,6 +109,24 @@ stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0
 stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
 stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i, i -1 ..]
 
+listCursorDisplayParams :: 
+    ListDisplayParams ->
+    [CardinalPoint] ->
+    Configuration ->
+    Int ->
+    Int ->
+    Color ->
+    Int ->
+    Int ->
+    Picture
+listCursorDisplayParams ldp borders cfig yint xint col cursxsize cursysize =
+    listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize
+  where
+    ygap = _ldpVerticalGap ldp
+    s = _ldpScale ldp
+    xoff = _ldpPosX ldp
+    yoff = _ldpPosY ldp
+
 -- displays a cursor that should match up to list text pictures
 -- the width of a character appears to be 9(?!)
 -- this is probably because it is 8 pixels plus one for the border
@@ -120,14 +138,15 @@ listCursorChooseBorderScale ::
     Float ->
     Configuration ->
     Int ->
+    Int ->
     Color ->
     Int ->
     Int ->
     Picture
-listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cursysize =
+listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
     winScale cfig
         . translate
-            (15 - (9 * s) + xoff - halfWidth cfig)
+            (15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
             (halfHeight cfig + s * 12.5 - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
         . color col
         $ chooseCursorBorders (s * wth) (s * hgt) borders
@@ -140,7 +159,7 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cur
 -- the width of a character appears to be 9(?!)
 -- this is probably because it is 8 pixels plus one for the border
 listCursorChooseBorder ::
-    [CardinalPoint] -> Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
+    [CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
 listCursorChooseBorder = listCursorChooseBorderScale 10 1
 
 -- note we cannot simply scale lines because they are drawn as solid rectangles
@@ -155,16 +174,16 @@ chooseCursorBorders wth hgt = foldMap (line . toLine)
     toLine South = [V2 wth bot, V2 lef bot]
     toLine West = [V2 lef bot, V2 lef top]
 
-listCursorNS :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
+listCursorNS :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
 listCursorNS = listCursorChooseBorder [North, South]
 
-listCursorNES :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
+listCursorNES :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
 listCursorNES = listCursorChooseBorder [North, South, East]
 
-listCursorNESW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
+listCursorNESW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
 listCursorNESW = listCursorChooseBorder [North, South, East, West]
 
-listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
+listCursorNSW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
 listCursorNSW = listCursorChooseBorder [North, South, West]
 
 fillScreenText :: Configuration -> String -> Picture

src/Dodge/Update.hs

@@ -82,9 +82,8 @@ updateUniverse u =
     cfig = u ^. uvConfig
 
 updateInventoryDisplay :: Universe -> Universe
-updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections %~ const di
+updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections 
-  where
+    %~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
-    di = makeDisplayInventory (_uvWorld u) (_uvConfig u)
 
 maybeOpenTerminal :: Universe -> Universe
 maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of

src/SelectionIntMap.hs

@@ -56,5 +56,5 @@ getIthYOffset ygap scale sm i = (scale * 10 + ygap) * (fromIntegral yint + 1)
   where
     yint = getIthPos i (sm ^. smShownItems)
     
-selectionSectionsToIntMap :: SelectionSections a -> SelectionIntMap a
+--selectionSectionsToIntMap :: SelectionSections a -> SelectionIntMap a
-selectionSectionsToIntMap ss = undefined
+--selectionSectionsToIntMap ss = undefined