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
+8 -4
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
-- Just ExamineInventory{} -> [North, South, East, West]
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
+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)
)
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
+14 -13
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
@@ -86,14 +86,14 @@ ssLookupDown i j sss = case ssLookupGT i j sss of
ssLookupNextMax :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupNextMax i j sss = case ssLookupGT i j sss of
Just x@(i',j',_) | i' == i && j' > j -> Just x
Just x@(i', j', _) | i' == i && j' > j -> Just x
_ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss
ssLookupMaxInSection :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMaxInSection i sss = do
ss <- sss ^? ix i . ssItems
(j,s) <- IM.lookupMax ss
return (i,j,s)
(j, s) <- IM.lookupMax ss
return (i, j, s)
ssLookupLT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
@@ -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
@@ -162,7 +163,7 @@ selSecYint i j sss = do
secpos = sum . fmap _ssShownLength . fst $ IM.split i sss
inverseSelSecYint :: Int -> IMSS a -> XInfinity (Int, Int)
inverseSelSecYint yint sss
inverseSelSecYint yint sss
| yint < 0 = NegInf
| otherwise = fromMaybe PosInf $ do
((i, ss), othersss) <- IM.minViewWithKey sss
@@ -171,19 +172,19 @@ inverseSelSecYint yint sss
then return $ inverseSelSecYint (yint - l) othersss
else do
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
(j,_) <- L.fold (L.find (\(_,x) -> x - _ssOffset ss > yint)) $ IM.toList ls
(j, _) <- L.fold (L.find (\(_, x) -> x - _ssOffset ss > yint)) $ IM.toList ls
return $ NonInf (i, j)
inverseSelSecYintXPosCheck ::
Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (Int,Int)
inverseSelSecYintXPosCheck ::
Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (Int, Int)
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
(i,j) <- inverseSelSecYint yint sss ^? nonInf
(i, j) <- inverseSelSecYint yint sss ^? nonInf
let V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
sindent <- sss ^? ix i . ssIndent
itindent <- sss ^? ix i . ssItems . ix j . siOffX
let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent + itindent) - 0.5)
guard $ x - x1 < 160 && x > x1
return (i,j)
return (i, j)
inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (Int, Int)
inverseSelNumPos cfig ldp (V2 x y) =
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