Improve drawRBOptions positioning

2026-01-02 18:36:35 +00:00
parent 71f56c0638
commit 376ce4462c
9 changed files with 86 additions and 81 deletions
@@ -79,8 +79,8 @@ drawInventory sss w cfig = \case
            Just (_ : _) -> Nothing
            _ -> return . drawItemConnections sss cfig $ invAdj inv

-drawRootCursor
-    :: World -> IMSS () -> Maybe Selection -> LDParams -> Config -> Picture
+drawRootCursor ::
+    World -> IMSS () -> Maybe Selection -> LDParams -> Config -> Picture
 drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
    cr <- w ^? cWorld . lWorld . creatures . ix 0
    guard $ crIsAiming cr
@@ -90,13 +90,17 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
    inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
    let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
    (x, y) <- getRootItemBounds j $ _unNIntMap inv
+    let curs =
+            if null (w ^? rbState . opSel)
+                then BoundCurs [minBound ..]
+                else BoundCurs [North, South, West]
    return $
        drawSSMultiCursor
            sss
            (Just (0, x))
            (Just (y - x))
            ldp
-            (BoundaryCursor [minBound ..])
+            curs
            cfig

 getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
@@ -125,7 +129,7 @@ drawMouseOver cfig w =
            --            . color white
            $ selSecDrawCursor invDP curs sss (Sel j i mempty)
    --    curs = BoundaryCursor [West]
-    curs = BackdropCursor
+    curs = BackdropCurs
    combinvsel = do
        (j, i) <-
            (w ^? input . mouseContext . mcoCombSelect)
@@ -148,7 +152,7 @@ drawDragSelected cfig w = do
               )
    Sel i _ _ <- w ^? hud . diSelection . _Just
    sss <- w ^? hud . diSections
-    let f x = (selSecDrawCursor invDP BackdropCursor sss (Sel i x mempty) <>)
+    let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>)
    return
        . translateScreenPos cfig (invDP ^. ldpPos)
        . color (0.2 *^ white)
@@ -159,7 +163,7 @@ drawDragSelecting :: Config -> World -> Maybe Picture
 drawDragSelecting cfig w = do
    OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
    sss <- w ^? hud . diSections
-    let f x = selSecDrawCursor invDP BackdropCursor sss (Sel i x mempty)
+    let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty)
    return
        . translateScreenPos cfig (invDP ^. ldpPos)
        . color (0.2 *^ white)
@@ -189,7 +193,7 @@ drawCombineInventory cfig sss w =
        <> foldMap (drawSSCursor sss secondColumnLDP curs cfig) msel
        <> combineInventoryExtra sss msel cfig w
  where
-    curs = BoundaryCursor [North, South, West]
+    curs = BoundCurs [North, South, West]
    msel = w ^? hud . subInventory . ciSelection . _Just

 drawExamineInventory :: Config -> World -> Picture
@@ -259,49 +263,51 @@ drawRBOptions cfig w = fold $ do
    sss <- w ^? hud . diSections
    Sel i' j _ <- w ^? hud . diSelection . _Just
    curpos <- selSecYint i' j sss
+    itext <- sss ^? ix i' . ssItems . ix j . siPictures . ix 0
+    ind <- sss ^? ix i' . ssItems . ix j . siOffX
    let ytext = drawListElement 0 1 0 curpos . text
        midstr = equipAllocString ae
        extrastr = case ae of
            SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
-                "SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
+                " SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
            ReplaceEquipment{_allocRemoveID = rid} ->
-                "REMOVES " ++ otheritem rid
+                " REMOVES " ++ otheritem rid
            _ -> ""
-    return $
-        --toTopLeft cfig $
-        translateScreenPos cfig (invDP ^. ldpPos) $
-            --translate 290 (-1) (ytext midstr)
-            translate 290 0 (ytext midstr)
-                <> translate
-                    160
+    return
+        . translateScreenPos cfig (invDP ^. ldpPos)
+        . translate (10 * fromIntegral (ind + length itext)) 0
+        $ translate (290 - xt) 0 (ytext midstr)
+            <> translate
+                (120 - xt)
+                0
+                ( listCursor
                    0
-                    ( listCursorChooseBorderScale
-                        0
-                        1
-                        (BoundaryCursor [North, South])
-                        curpos
-                        0
-                        white
-                        21
-                        1
-                    )
-                <> translate
-                    380
+                    1
+                    (BoundCurs [North, South])
+                    curpos
                    0
-                    ( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
-                        <> listCursorChooseBorderScale 0 1 (bc East) (curpos - i) 0 white 7 (length eslist)
-                        <> listCursorChooseBorderScale 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1))
-                        <> listCursorChooseBorderScale 0 1 (bc West) (curpos - i) 0 white 7 i
-                        <> maybetopborder i curpos
-                        <> maybebottomborder i (length eslist) curpos
-                    )
-                <> translate 460 0 (ytext extrastr)
+                    white
+                    25
+                    1
+                )
+            <> translate
+                (380 - xt)
+                0
+                ( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
+                    <> listCursor 0 1 (bc East) (curpos - i) 0 white 7 (length eslist)
+                    <> listCursor 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1))
+                    <> listCursor 0 1 (bc West) (curpos - i) 0 white 7 i
+                    <> maybetopborder i curpos
+                    <> maybebottomborder i (length eslist) curpos
+                )
+            <> translate (460 - xt) 0 (ytext extrastr)
  where
-    bc x = BoundaryCursor [x]
-    maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 (bc North) curpos 0 white 7 1
+    xt = 260
+    bc x = BoundCurs [x]
+    maybetopborder 0 curpos = listCursor 0 1 (bc North) curpos 0 white 7 1
    maybetopborder _ _ = mempty
    maybebottomborder a b curpos
-        | a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1
+        | a == b - 1 = listCursor 0 1 (bc South) curpos 0 white 7 1
        | otherwise = mempty
    otheritem (NInt j) = fromMaybe "" $ do
        itype <- w ^? cWorld . lWorld . items . ix j . itType
@@ -344,7 +350,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
        translateScreenPos cfig (invDP ^. ldpPos) $
            selSecDrawCursor
                invDP
-                (BoundaryCursor [North, South, East, West])
+                (BoundCurs [North, South, East, West])
                (w ^. hud . diSections)
                (Sel 0 i mempty)

@@ -353,7 +359,7 @@ drawTerminalDisplay w cfig tid = fold $ do
    tm <- w ^? cWorld . lWorld . terminals . ix tid
    let toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod
        f =
-            --toselitm ("TERMINAL " ++ show tid, white)
+            -- toselitm ("TERMINAL " ++ show tid, white)
            toselitm ("", white)
                : ( map (toselitm . (_1 %~ ("  " <>)))
                        . displayTermInput
@@ -395,7 +401,7 @@ drawTerminalCursorLink w cfig tm = fold $ do
            (invDP ^. ldpPos)
            ( selSecDrawCursor
                invDP
-                (BoundaryCursor [North, South, East, West])
+                (BoundCurs [North, South, East, West])
                (w ^. hud . diSections)
                (Sel 5 j mempty)
            )
@@ -28,10 +28,10 @@ renderInfoListAt x y cfig cam (p, ss) =
        <> toTopLeft
            cfig
            ( translate x (- y) $
-                listCursorChooseBorderScale
+                listCursor
                    0
                    1
-                    (BoundaryCursor [North, South])
+                    (BoundCurs [North, South])
                    0
                    0
                    white
@@ -10,7 +10,7 @@ module Dodge.Render.List (
    drawListYoff,
    stackPicturesAt,
    toTopLeft,
-    listCursorChooseBorderScale,
+    listCursor,
    selSecDrawCursor,
    drawTitleBackground, -- should be renamed, made sensible
    drawCursorAt,
@@ -76,7 +76,7 @@ drawCursorAt mi lis ldps width curs = fromMaybe mempty $ do
    i <- mi
    selit <- lis !? i
    return $
-        listCursorChooseBorderScale
+        listCursor
            (_ldpVerticalGap ldps)
            (_ldpScale ldps)
            curs
@@ -106,7 +106,7 @@ selSecDrawCursor ldp curs sss sel = fold $ do
    sindent <- sss ^? ix i . ssIndent
    si <- sss ^? ix i . ssItems . ix j
    return $
-        listCursorChooseBorderScale
+        listCursor
            (ldp ^. ldpVerticalGap)
            (ldp ^. ldpScale)
            curs
@@ -117,7 +117,7 @@ selSecDrawCursor ldp curs sss sel = fold $ do
            (_siHeight si)

 -- displays a cursor that should match up to list text pictures
-listCursorChooseBorderScale ::
+listCursor ::
    Float ->
    Float ->
    CursorDisplay ->
@@ -127,7 +127,7 @@ listCursorChooseBorderScale ::
    Int ->
    Int ->
    Picture
-listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize =
+listCursor ygap s curs yint xint col cursxsize cursysize =
    translate
        ((10 * fromIntegral xint - 5) * s)
        (-(ygap + (s * 20 + ygap) * fromIntegral yint))
@@ -140,8 +140,8 @@ listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize =
 -- note we cannot simply scale lines because they are drawn as solid rectangles
 chooseCursorBorders :: Float -> Float -> CursorDisplay -> Picture
 chooseCursorBorders w h = \case
-    BoundaryCursor ps -> foldMap (line . toLine) ps
-    BackdropCursor -> polygon $ rectNSWE 0 h' 0 w
+    BoundCurs ps -> foldMap (line . toLine) ps
+    BackdropCurs -> polygon $ rectNSWE 0 h' 0 w
  where
    h' = negate h
    toLine North = [V2 0 0, V2 w 0]
@@ -41,7 +41,7 @@ drawOptions title msel sl cf =
        <> translateScreenPos
            cf
            (menuLDP ^. ldpPos)
-            (drawCursorAt msel sl menuLDP 50 (BoundaryCursor [North, South]))
+            (drawCursorAt msel sl menuLDP 50 (BoundCurs [North, South]))

 darkenBackground :: Config -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox