Implement telescoping inventory selection

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
-    --undefined
+    0
     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