justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Improve drawRBOptions positioning

Browse Source
This commit is contained in:
justin
2026-01-02 18:36:35 +00:00
parent 71f56c0638
commit 376ce4462c
9 changed files with 86 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+48 -42
View File
@@ -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)
)