This commit is contained in:
2024-11-26 22:55:55 +00:00
parent 2b969f6530
commit f64dc86a30
5 changed files with 29 additions and 52 deletions
+1 -1
View File
@@ -137,7 +137,7 @@ updateDisplaySections w cfig =
displaySectionsSizes displaySectionsSizes
displayIndents displayIndents
mselpos mselpos
(getAvailableListLines (invDisplayParams w) cfig) (getAvailableListLines invDP cfig)
[ statushead [ statushead
, statusdisplay , statusdisplay
, invhead , invhead
+5 -18
View File
@@ -1,5 +1,5 @@
module Dodge.ListDisplayParams ( module Dodge.ListDisplayParams (
invDisplayParams, invDP,
invCursorParams, invCursorParams,
secondColumnParams, secondColumnParams,
subInvX, subInvX,
@@ -29,11 +29,11 @@ defaultListDisplayParams =
, _ldpWidth = UseItemWidth , _ldpWidth = UseItemWidth
} }
invDisplayParams :: World -> ListDisplayParams invDP :: ListDisplayParams
invDisplayParams w = invDP =
defaultListDisplayParams defaultListDisplayParams
-- & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w) -- & ldpPos . spPixelOff .~ V2 6 (-1)
& ldpPos . spPixelOff .~ V2 6 (-1) & ldpPos . spPixelOff .~ V2 6 0
invCursorParams :: World -> CursorDisplay invCursorParams :: World -> CursorDisplay
invCursorParams w = BoundaryCursor $ case w ^? hud . hudElement . subInventory of invCursorParams w = BoundaryCursor $ case w ^? hud . hudElement . subInventory of
@@ -53,19 +53,6 @@ subInvX = 10 * fromIntegral topInvW + 70
topInvW :: Int topInvW :: Int
topInvW = 15 topInvW = 15
determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of
NoRightButtonOptions -> topInvW
EquipOptions{}
| ButtonRight `M.member` _mouseButtons (_input w)
&& hasnosubinv ->
47
| otherwise -> topInvW
where
hasnosubinv = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{} -> True
_ -> False
optionListDisplayParams :: ListDisplayParams optionListDisplayParams :: ListDisplayParams
optionListDisplayParams = optionListDisplayParams =
defaultListDisplayParams defaultListDisplayParams
+17 -24
View File
@@ -53,20 +53,19 @@ drawHUD cfig w = case w ^. hud . hudElement of
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
drawInventory sss w cfig = drawInventory sss w cfig =
drawSelectionSections sss ldp cfig drawSelectionSections sss invDP cfig
<> drawSSCursor sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp curs cfig <> drawSSCursor sss (f $ w ^? hud . hudElement . diSelection . _Just) invDP curs cfig
<> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp cfig <> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) invDP cfig
<> itemconnections <> itemconnections
<> drawMouseOver cfig w <> drawMouseOver cfig w
where where
f = fmap (\(x, y, _) -> (x, y)) f = fmap (\(x, y, _) -> (x, y))
ldp = invDisplayParams w
curs = invCursorParams w curs = invCursorParams w
itemconnections = fromMaybe mempty $ do itemconnections = fromMaybe mempty $ do
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
case w ^? hud . hudElement . diInvFilter . _Just of case w ^? hud . hudElement . diInvFilter . _Just of
Just (_ : _) -> Nothing Just (_ : _) -> Nothing
_ -> return . drawItemConnections sss cfig w $ invAdj inv _ -> return . drawItemConnections sss cfig $ invAdj inv
drawRootCursor :: drawRootCursor ::
World -> World ->
@@ -113,11 +112,10 @@ drawMouseOver cfig w =
w ^? input . mouseContext . mcoInvSelect w ^? input . mouseContext . mcoInvSelect
<|> w ^? input . mouseContext . mcoInvFilt <|> w ^? input . mouseContext . mcoInvFilt
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w return . translateScreenPos cfig (invDP ^. ldpPos)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.1 white) . color (withAlpha 0.1 white)
-- . color white -- . color white
$ selSecDrawCursorAt idp curs sss (j, i) $ selSecDrawCursorAt invDP curs sss (j, i)
-- curs = BoundaryCursor [West] -- curs = BoundaryCursor [West]
curs = BackdropCursor curs = BackdropCursor
combinvsel = do combinvsel = do
@@ -141,9 +139,8 @@ drawDragSelected cfig w = do
) )
(i, _, _) <- w ^? hud . hudElement . diSelection . _Just (i, _, _) <- w ^? hud . hudElement . diSelection . _Just
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w let f x = (selSecDrawCursorAt invDP BackdropCursor sss (i, x) <>)
let f x = (selSecDrawCursorAt idp BackdropCursor sss (i, x) <>) return . translateScreenPos cfig (invDP ^. ldpPos)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white) . color (withAlpha 0.2 white)
. IS.foldr f mempty . IS.foldr f mempty
$ ys $ ys
@@ -153,9 +150,8 @@ drawDragSelecting cfig w = do
OverInvDragSelect (i, j) mselend <- w ^? input . mouseContext OverInvDragSelect (i, j) mselend <- w ^? input . mouseContext
b <- mselend b <- mselend
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w let f x = selSecDrawCursorAt invDP BackdropCursor sss (i, x)
let f x = selSecDrawCursorAt idp BackdropCursor sss (i, x) return . translateScreenPos cfig (invDP ^. ldpPos)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white) . color (withAlpha 0.2 white)
. foldMap f . foldMap f
$ [min j b .. max j b] $ [min j b .. max j b]
@@ -308,27 +304,25 @@ equipAllocString = \case
drawItemConnections :: drawItemConnections ::
IM.IntMap (SelectionSection ()) -> IM.IntMap (SelectionSection ()) ->
Configuration -> Configuration ->
World ->
IM.IntMap (Maybe (Int, Int), [Int], [Int]) -> IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
Picture Picture
drawItemConnections sss cfig w = drawItemConnections sss cfig =
translate (negate 5) 0 translate (negate 5) 0
. IM.foldMapWithKey (drawItemChildrenConnect sss cfig w) . IM.foldMapWithKey (drawItemChildrenConnect sss cfig)
. fmap (\(_, a, b) -> a <> b) . fmap (\(_, a, b) -> a <> b)
drawItemChildrenConnect :: drawItemChildrenConnect ::
IM.IntMap (SelectionSection ()) -> IM.IntMap (SelectionSection ()) ->
Configuration -> Configuration ->
World ->
Int -> Int ->
[Int] -> [Int] ->
Picture Picture
drawItemChildrenConnect sss cfig w i is = fromMaybe mempty $ do drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
p <- snum i p <- snum i
let ps = mapMaybe snum is let ps = mapMaybe snum is
return $ color white $ lConnectMulti ps p return $ color white $ lConnectMulti ps p
where where
snum = selNumPos cfig (invDisplayParams w) sss 0 snum = selNumPos cfig invDP sss 0
combineInventoryExtra :: combineInventoryExtra ::
IM.IntMap (SelectionSection CombinableItem) -> IM.IntMap (SelectionSection CombinableItem) ->
@@ -346,11 +340,10 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
where where
invcursor i = do invcursor i = do
sss' <- w ^? hud . hudElement . diSections sss' <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return $ return $
translateScreenPos cfig (idp ^. ldpPos) $ translateScreenPos cfig (invDP ^. ldpPos) $
selSecDrawCursor selSecDrawCursor
idp invDP
(BoundaryCursor [North, South, East, West]) (BoundaryCursor [North, South, East, West])
sss' sss'
(Just (0, i)) (Just (0, i))
@@ -390,7 +383,7 @@ lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
f j = do f j = do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
combinesss <- w ^? hud . hudElement . subInventory . ciSections combinesss <- w ^? hud . hudElement . subInventory . ciSections
lp <- selNumPos cfig (invDisplayParams w) sss 0 j lp <- selNumPos cfig invDP sss 0 j
rp <- selNumPos cfig secondColumnParams combinesss 0 i rp <- selNumPos cfig secondColumnParams combinesss 0 i
invcol <- selSecSelCol 0 j sss invcol <- selSecSelCol 0 j sss
return $ zConnectColMidX (rp - V2 5 0) (lp + V2 155 0) (rp ^. _1 - 20) col col col invcol return $ zConnectColMidX (rp - V2 5 0) (lp + V2 155 0) (rp ^. _1 - 20) col col col invcol
+3 -3
View File
@@ -327,14 +327,14 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
mpos = w ^. input . mousePos mpos = w ^. input . mousePos
invdrag i' = fromMaybe (OverInvDrag i' Nothing Nothing Nothing) $ do invdrag i' = fromMaybe (OverInvDrag i' Nothing Nothing Nothing) $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
let yint = posSelSecYint cfig (invDisplayParams w) (mpos ^. _y) let yint = posSelSecYint cfig invDP (mpos ^. _y)
(i, j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos (i, j) <- inverseSelNumPos cfig invDP sss mpos
let above = inverseSelSecYint (yint - 1) sss let above = inverseSelSecYint (yint - 1) sss
bneath = inverseSelSecYint (yint + 1) sss bneath = inverseSelSecYint (yint + 1) sss
return $ OverInvDrag i' (Just (i, j)) above bneath return $ OverInvDrag i' (Just (i, j)) above bneath
overinv = do overinv = do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
selpos@(i, j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos selpos@(i, j) <- inverseSelNumPos cfig invDP sss mpos
case w ^? hud . hudElement . subInventory . ciSelection of case w ^? hud . hudElement . subInventory . ciSelection of
Just _ -> do Just _ -> do
guard (i == 0) guard (i == 0)
+3 -6
View File
@@ -87,13 +87,11 @@ updateMouseHeldInGame :: Configuration -> World -> World
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDragSelect sstart _ -> fromMaybe w $ do OverInvDragSelect sstart _ -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos) let msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos)
guard $ Just (fst sstart) == fmap fst msel || isNothing msel guard $ Just (fst sstart) == fmap fst msel || isNothing msel
return $ w & input . mouseContext . mcoSelEnd .~ fmap snd msel return $ w & input . mouseContext . mcoSelEnd .~ fmap snd msel
OverInvDrag k mmouseover ab bn -> doDrag 30 k mmouseover ab bn w OverInvDrag k mmouseover ab bn -> doDrag 30 k mmouseover ab bn w
_ -> w _ -> w
where
ldp = invDisplayParams w
doDrag :: Int doDrag :: Int
@@ -177,7 +175,7 @@ updateMouseClickInGame :: Configuration -> World -> World
updateMouseClickInGame cfig w = case w ^. input . mouseContext of updateMouseClickInGame cfig w = case w ^. input . mouseContext of
MouseInGame -> fromMaybe w $ do MouseInGame -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss ysel <- inverseSelSecYint (posSelSecYint cfig invDP (mpos ^. _y)) sss
guard (isGroupSelectableSection $ fst ysel) guard (isGroupSelectableSection $ fst ysel)
return $ return $
w & input . mouseContext w & input . mouseContext
@@ -228,7 +226,6 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str) _ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str)
_ -> w _ -> w
where where
ldp = invDisplayParams w
mpos = w ^. input . mousePos mpos = w ^. input . mousePos
f (x,y) = (x,y,mempty) f (x,y) = (x,y,mempty)
selsec = w ^? hud . hudElement . diSelection . _Just . _1 selsec = w ^? hud . hudElement . diSelection . _Just . _1
@@ -269,7 +266,7 @@ startDrag (a, b) cfig w = setcontext
bneath = do bneath = do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
inverseSelSecYint (yint + 1) sss inverseSelSecYint (yint + 1) sss
yint = posSelSecYint cfig (invDisplayParams w) (w ^. input . mousePos . _y) yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
concurrentIS :: IS.IntSet -> Bool concurrentIS :: IS.IntSet -> Bool
concurrentIS = go . IS.minView concurrentIS = go . IS.minView