Work on combine cursors

src/Dodge/Render/HUD.hs

@@ -4,6 +4,7 @@ module Dodge.Render.HUD (
     invDisplayParams,
 ) where
 
+import Dodge.Inventory
 import SelectionIntMap
 import Dodge.Data.Combine
 import Dodge.Default.SelectionList
@@ -19,9 +20,6 @@ import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Data.World
-import Dodge.Inventory
---import Dodge.Inventory.ItemSpace
---import Dodge.Item.Display
 import Dodge.Item.Info
 import Dodge.Render.Connectors
 import Dodge.Render.List
@@ -167,15 +165,20 @@ drawNoSubInventory cfig w =
         , rboptions
         ]
   where
-    equipcursor = case cr ^. crLeftInvSel . lisMPos of
-        Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
-        _ -> mempty
+    equipcursor = fromMaybe mempty $ do
+        invid <- cr ^. crLeftInvSel . lisMPos
+        sss <- w ^? hud . hudElement . diSections
+        pos <- selSecSelPos 0 invid sss
+        return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $_crInvEquipped cr IM.! invid
+    f col invid epos = fromMaybe mempty $ do
+        sss <- w ^? hud . hudElement . diSections
+        pos <- selSecSelPos 0 invid sss
+        return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos
     equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
     cr = you w
     rboptions
         | ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w)
         | otherwise = mempty
-    f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
 
 examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
 examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
@@ -199,9 +202,14 @@ combineInventoryExtra sm mi cfig w = fromMaybe mempty $ do
                 lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
                 return $
                     lnkMidPosInvSelsCol cfig w cpos col lnks
-                        <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
+                        -- <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
+                        <> foldMap invcursor lnks
                         <> combineCounts cfig w lnks
             ]
+  where
+    invcursor i = fromMaybe mempty $ do
+        sss <- w ^? hud . hudElement . diSections
+        return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i
 
 secondColumnParams :: ListDisplayParams
 secondColumnParams =
@@ -304,16 +312,21 @@ subInvX = 9 * fromIntegral topInvW + 50
 combineCounts :: Configuration -> World -> [Int] -> Picture
 combineCounts cfig w = winScale cfig . foldMap f . group
   where
-    f (i : is) = case yourInv w ^? ix i . itUse . useAmount of
-        Just _ -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
-        _ -> mempty
+    f (i : is) = fromMaybe mempty $ do
+        _ <- yourInv w ^? ix i . itUse . useAmount
+        sss <- w ^? hud . hudElement . diSections
+        p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
+        return $ color (selNumCol i w) $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
     f _ = mempty
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
-lnkMidPosInvSelsCol cfig w i col =
-    winScale cfig
-        . foldMap (\j -> zConnectCol rp (V2 18 0 + selNumMidHeight cfig w j) col white white (selNumCol j w))
+lnkMidPosInvSelsCol cfig w i col = winScale cfig
+        . foldMap f
   where
+    f j = fromMaybe mempty $ do
+        sss <- w ^? hud . hudElement . diSections
+        h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j
+        return $ zConnectCol rp (V2 18 0 + h) col white white (selNumCol j w)
     rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
     hh = halfHeight cfig
     hw = halfWidth cfig
@@ -326,7 +339,7 @@ topCursorTypeWidth ::
     Int ->
     Picture
 topCursorTypeWidth ctype width cfig w i =
-    ctype 0 0 cfig (selNumPos i w) 0 (selNumCol i w) width (invSelSize i w)
+    ctype 0 0 cfig (fromMaybe 0 (selNumPos (InInventory (SelItem i NoInvSelAction)) w)) 0 (selNumCol i w) width (invSelSize (InInventory (SelItem i NoInvSelAction)) w)
 
 determineInvSelCursorWidth :: World -> Int
 determineInvSelCursorWidth w = case _rbOptions w of

src/Dodge/Render/List.hs

@@ -1,6 +1,7 @@
 module Dodge.Render.List where
 
 --import Picture.Text
+import Dodge.Inventory
 import SelectionIntMap
 import qualified Data.IntMap.Strict as IM
 --import Data.Foldable
@@ -109,6 +110,13 @@ 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 ..]
 
+selSecDrawCursor :: Int -> [CardinalPoint] -> Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
+selSecDrawCursor xsize borders cfig ldp sss i j = fromMaybe mempty $ do
+    yint <- selSecSelPos i j sss
+    xint <- sss ^? sssSections . ix i . ssIndent
+    si <- sss ^? sssSections . ix i . ssItems . ix j
+    return $ listCursorDisplayParams ldp borders cfig yint xint (_siColor si) xsize (length $ _siPictures si)
+
 listCursorDisplayParams :: 
     ListDisplayParams ->
     [CardinalPoint] ->
@@ -153,7 +161,7 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsiz
   where
     x = 9
     wth = x * fromIntegral cursxsize + 9
-    hgt = 20 * fromIntegral cursysize
+    hgt = 20 * fromIntegral cursysize -- TODO this should be changed!
 
 -- displays a cursor that should match up to list text pictures
 -- the width of a character appears to be 9(?!)