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/Data/SelectionList.hs
+2 -2
View File
@@ -18,8 +18,8 @@ data LDParams = LDP -- List display parameters
}
data CursorDisplay
= BoundaryCursor [CardinalPoint]
| BackdropCursor
= BoundCurs [CardinalPoint]
| BackdropCurs
data SectionCursor = SectionCursor
{ _scurPos :: Int
src/Dodge/Inventory/SelectionList.hs
+3 -9
View File
@@ -51,19 +51,13 @@ invSelectionItem w indent loc =
-- note the convoluted display of the hotkey/equipment, this was done to avoid a
-- space leak
itemDisplay :: World -> Creature -> CItem -> [String]
itemDisplay w cr ci = -- f
basicItemDisplay itm
-- (itemNumberDisplay w cr ci)
`g` anyextra
itemDisplay w cr ci = basicItemDisplay itm `g` anyextra
where
itm = ci ^. _1
NInt itid = itm ^. itID
--f (x:xs) (y:_) = itemDisplayPad x y : xs
--f xs _ = xs
--g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs
g (x:xs) (y:_) = (x ++ y) : xs
g (x:xs) (Just y) = (x <> y) : xs
g xs _ = xs
anyextra = maybeToList (anyscroll <> anyexternal <> anyhotkey <> anyequippos)
anyextra = anyscroll <> anyexternal <> anyhotkey <> anyequippos
anyhotkey = fmap hotkeyToString
(w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
anyequippos = do
src/Dodge/ListDisplayParams.hs
+7 -3
View File
@@ -17,7 +17,8 @@ import Linear
import SDL (MouseButton (..))
defaultLDP :: LDParams
defaultLDP = LDP
defaultLDP =
LDP
{ _ldpVerticalGap = 0
, _ldpScale = 1
, _ldpPos =
@@ -32,10 +33,13 @@ invDP :: LDParams
invDP = defaultLDP & ldpPos . spPixelOff .~ V2 16 (-20)
invCursorParams :: World -> CursorDisplay
invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
invCursorParams w = BoundCurs $ case w ^? hud . subInventory of
-- Just ExamineInventory{} -> [North, South, East, West]
Just CombineInventory{} -> []
_ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
_
| ButtonRight `M.member` _mouseButtons (_input w)
&& (null $ w ^? rbState . opSel) ->
[North, South, East, West]
_ -> [North, South, West]
secondColumnLDP :: LDParams
src/Dodge/Render/HUD.hs
+32 -26
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,6 +263,8 @@ 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
@@ -267,41 +273,41 @@ drawRBOptions cfig w = fold $ do
ReplaceEquipment{_allocRemoveID = rid} ->
" REMOVES " ++ otheritem rid
_ -> ""
return $
--toTopLeft cfig $
translateScreenPos cfig (invDP ^. ldpPos) $
--translate 290 (-1) (ytext midstr)
translate 290 0 (ytext midstr)
return
. translateScreenPos cfig (invDP ^. ldpPos)
. translate (10 * fromIntegral (ind + length itext)) 0
$ translate (290 - xt) 0 (ytext midstr)
<> translate
160
(120 - xt)
0
( listCursorChooseBorderScale
( listCursor
0
1
(BoundaryCursor [North, South])
(BoundCurs [North, South])
curpos
0
white
21
25
1
)
<> translate
380
(380 - xt)
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
<> 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 0 (ytext extrastr)
<> 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)
@@ -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)
)
src/Dodge/Render/InfoBox.hs
+2 -2
View File
@@ -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
src/Dodge/Render/List.hs
+7 -7
View File
@@ -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]
src/Dodge/Render/MenuScreen.hs
+1 -1
View File
@@ -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
src/Dodge/SelectionSections.hs
+5 -4
View File
@@ -10,17 +10,17 @@ module Dodge.SelectionSections (
inverseSelNumPos,
) where
import Dodge.Data.HUD
import Dodge.Data.CardinalPoint
import qualified Data.IntSet as IS
import Control.Applicative
import qualified Control.Foldl as L
import Control.Lens
import Control.Monad
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.HUD
import Dodge.Data.SelectionList
import Dodge.ScreenPos
import Geometry.Data
@@ -152,7 +152,8 @@ posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldp
selSecYint :: Int -> Int -> IMSS a -> Maybe Int
selSecYint i j sss = do
ss <- sss ^? ix i
return . (secpos +)
return
. (secpos +)
. subtract (ss ^. ssOffset)
. sum
. fmap _siHeight
src/Dodge/SelectionSections/Draw.hs
+1 -1
View File
@@ -55,7 +55,7 @@ drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^
maxxoff = maximum . fmap _siOffX $ selitms
minxoff = minimum . fmap _siOffX $ selitms
return $
listCursorChooseBorderScale
listCursor
(ldp ^. ldpVerticalGap)
(ldp ^. ldpScale)
curs