Make selection cursors use selection item width

This commit is contained in:
2024-11-26 22:49:54 +00:00
parent f12c390778
commit 2b969f6530
9 changed files with 128 additions and 126 deletions
+2 -2
View File
@@ -38,8 +38,8 @@ type IMSS a = IntMap (SelectionSection a)
data SelectionWidth
= FixedSelectionWidth Int
| VariableSelectionWidth (Int -> Int)
| UseMaxSelectionItemWidth
-- | UseMaxSelectionItemWidth
| UseItemWidth
data SelectionItem a
= SelectionItem
+1 -1
View File
@@ -207,7 +207,7 @@ filterSectionsPair infocus filtfn itms filtdescription mfilt = (filtsis, itms')
$ SelectionInfo
[filtdescription ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
2
15
(length (filtdescription ++ " FILTER/" ++ str ++ [filtcurs]))
True
white
0
+2 -2
View File
@@ -26,13 +26,13 @@ defaultListDisplayParams =
{ _spScreenOff = V2 (-0.5) 0.5 -- top left
, _spPixelOff = 0
}
, _ldpWidth = FixedSelectionWidth 15
, _ldpWidth = UseItemWidth
}
invDisplayParams :: World -> ListDisplayParams
invDisplayParams w =
defaultListDisplayParams
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
-- & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
& ldpPos . spPixelOff .~ V2 6 (-1)
invCursorParams :: World -> CursorDisplay
+4 -5
View File
@@ -117,7 +117,7 @@ drawMouseOver cfig w =
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.1 white)
-- . color white
$ selSecDrawCursorAt 15 idp curs sss (j, i)
$ selSecDrawCursorAt idp curs sss (j, i)
-- curs = BoundaryCursor [West]
curs = BackdropCursor
combinvsel = do
@@ -128,7 +128,7 @@ drawMouseOver cfig w =
let idp = secondColumnParams
return . translateScreenPos cfig (idp ^. ldpPos)
. color (withAlpha 0.2 white)
$ selSecDrawCursorAt 15 idp curs sss (j, i)
$ selSecDrawCursorAt idp curs sss (j, i)
drawDragSelected :: Configuration -> World -> Maybe Picture
drawDragSelected cfig w = do
@@ -142,7 +142,7 @@ drawDragSelected cfig w = do
(i, _, _) <- w ^? hud . hudElement . diSelection . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
let f x = (selSecDrawCursorAt 15 idp BackdropCursor sss (i, x) <>)
let f x = (selSecDrawCursorAt idp BackdropCursor sss (i, x) <>)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white)
. IS.foldr f mempty
@@ -154,7 +154,7 @@ drawDragSelecting cfig w = do
b <- mselend
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (i, x)
let f x = selSecDrawCursorAt idp BackdropCursor sss (i, x)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white)
. foldMap f
@@ -350,7 +350,6 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
return $
translateScreenPos cfig (idp ^. ldpPos) $
selSecDrawCursor
15
idp
(BoundaryCursor [North, South, East, West])
sss'
+15 -10
View File
@@ -67,14 +67,16 @@ makeSelectionListPictures = concatMap f
where
f si = map (color (_siColor si) . text) $ _siPictures si
-- note this does not take into account any selectionsection indent
-- note this does not take into account any selectionsection indent, nor the LDP
-- selection width
drawCursorAt ::
Maybe Int ->
[SelectionItem a] ->
ListDisplayParams ->
Int ->
CursorDisplay ->
Picture
drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
drawCursorAt mi lis ldps width curs = fromMaybe mempty $ do
i <- mi
selit <- lis !? i
return $
@@ -85,13 +87,14 @@ drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
(sum . map _siHeight $ take i lis)
(_siOffX selit)
(_siColor selit)
(getLDPWidth ldps)
width
(_siHeight selit)
getLDPWidth :: ListDisplayParams -> Int
getLDPWidth ldps = case _ldpWidth ldps of
getLDPWidth :: ListDisplayParams -> Int -> Int -> IM.IntMap (SelectionSection a) -> Int
getLDPWidth ldps i j sss = case _ldpWidth ldps of
FixedSelectionWidth x -> x
_ -> 1
-- UseMaxSelectionItemWidth -> a
UseItemWidth -> fromMaybe 0 $ sss ^? ix i . ssItems . ix j . siWidth
drawListYoff :: Int -> [Picture] -> Picture
drawListYoff = drawListYgapScaleYoff 0 1
@@ -106,16 +109,17 @@ stackPicturesAtOff :: Int -> [Picture] -> Picture
stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
selSecDrawCursorAt ::
Int ->
-- Int ->
ListDisplayParams ->
CursorDisplay ->
IM.IntMap (SelectionSection a) ->
(Int, Int) ->
Picture
selSecDrawCursorAt xsize ldp curs sss (i, j) = fold $ do
selSecDrawCursorAt ldp curs sss (i, j) = fold $ do
yint <- selSecYint i j sss
sindent <- sss ^? ix i . ssIndent
si <- sss ^? ix i . ssItems . ix j
let xsize = getLDPWidth ldp i j sss
return $
listCursorChooseBorderScale
(ldp ^. ldpVerticalGap)
@@ -128,13 +132,14 @@ selSecDrawCursorAt xsize ldp curs sss (i, j) = fold $ do
(_siHeight si)
selSecDrawCursor ::
Int ->
-- Int ->
ListDisplayParams ->
CursorDisplay ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Picture
selSecDrawCursor xsize ldp curs = maybe mempty . selSecDrawCursorAt xsize ldp curs
--selSecDrawCursor xsize ldp curs = maybe mempty . selSecDrawCursorAt xsize ldp curs
selSecDrawCursor ldp curs = maybe mempty . selSecDrawCursorAt ldp curs
-- displays a cursor that should match up to list text pictures
listCursorChooseBorderScale ::
+1
View File
@@ -48,6 +48,7 @@ drawOptions ldps cfig title msel sl =
msel
sl
ldps
50
(BoundaryCursor [North, South])
)
+1 -1
View File
@@ -37,7 +37,7 @@ drawSSCursor ::
Picture
drawSSCursor sss msel ldp curs cfig =
translateScreenPos cfig (ldp ^. ldpPos) $
selSecDrawCursor 15 ldp curs sss msel
selSecDrawCursor ldp curs sss msel
drawSSMultiCursor ::
IM.IntMap (SelectionSection a) ->
+1 -4
View File
@@ -25,10 +25,7 @@ import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u =
[show $ u ^? uvWorld . input . mouseContext . mcoDragSection
,show $ u ^? uvWorld . input . mouseContext . mcoMaybeSelect
,show $ u ^? uvWorld . input . mouseContext . mcoAboveSelect
,show $ u ^? uvWorld . input . mouseContext . mcoBelowSelect
[show $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems . ix 0 . siWidth
]
-- fromMaybe mempty $ do
-- cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0