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

Simplify drag mouse context

Browse Source
This commit is contained in:
justin
2026-05-15 22:17:16 +01:00
parent 3a2e92169b
commit d5ed27f57c
4 changed files with 44 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Input.hs
+2 -1
View File
@@ -16,7 +16,8 @@ data MouseContext
| MouseAiming | MouseAiming
| MouseInGame | MouseInGame
| MouseMenu {_mcoMenuClick :: Maybe Int} | MouseMenu {_mcoMenuClick :: Maybe Int}
| OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) } | OverInvDrag {_mcoDragSection :: Int }
-- | OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) }
| OverInvDragSelect { _mcoSecSelStart :: XInfinity (Int,Int) } --, _mcoSelEnd :: Maybe (XInfinity (Int,Int)) } | OverInvDragSelect { _mcoSecSelStart :: XInfinity (Int,Int) } --, _mcoSelEnd :: Maybe (XInfinity (Int,Int)) }
| OverInvSelect { _mcoInvSelect :: (Int,Int)} | OverInvSelect { _mcoInvSelect :: (Int,Int)}
| OverCombFiltInv { _mcoInvFilt :: (Int,Int)} | OverCombFiltInv { _mcoInvFilt :: (Int,Int)}
src/Dodge/Render/Picture.hs
+13 -9
View File
@@ -2,6 +2,9 @@
module Dodge.Render.Picture (fixedCoordPictures) where module Dodge.Render.Picture (fixedCoordPictures) where
import Dodge.ListDisplayParams
import Dodge.SelectionSections
import Dodge.Data.CardinalPoint
import Linear hiding (rotate) import Linear hiding (rotate)
import qualified SDL import qualified SDL
import Control.Lens import Control.Lens
@@ -95,15 +98,15 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
MouseMenu{} -> drawMenuClick 5 MouseMenu{} -> drawMenuClick 5
-- MouseMenuCursor -> drawMenuCursor 5 -- MouseMenuCursor -> drawMenuCursor 5
MouseInGame -> drawPlus 5 MouseInGame -> drawPlus 5
OverInvDrag 0 (Just (3, _)) -> drawDragDrop 5 OverInvDrag 0 | Just 3 <- mover ^? _Just.nonInf._1 -> drawDragDrop 5
OverInvDrag 0 Nothing -> drawDragDrop 5 OverInvDrag 0 | Nothing <- mover ^?_Just.nonInf -> drawDragDrop 5
OverInvDrag 0 (Just (0, _)) -> drawDrag 5 OverInvDrag 0 | Just 0 <- mover ^? _Just.nonInf._1 -> drawDrag 5
OverInvDrag 0 _ -> drawEmptySet 5 OverInvDrag 0 -> drawEmptySet 5
OverInvDrag 3 (Just (3, _)) -> drawDrag 5 OverInvDrag 3 | Just 3 <- mover ^?_Just.nonInf._1 -> drawDrag 5
OverInvDrag 3 (Just (0, _)) -> drawDragPickup 5 OverInvDrag 3 | Just 0 <- mover ^?_Just.nonInf._1 -> drawDragPickup 5
OverInvDrag 3 (Just (1, _)) -> drawDragPickup 5 OverInvDrag 3 | Just 1 <- mover ^?_Just.nonInf._1 -> drawDragPickup 5
OverInvDrag 3 Nothing -> drawDragPickup 5 OverInvDrag 3 | Nothing <-mover^?_Just.nonInf -> drawDragPickup 5
OverInvDrag 3 _ -> drawEmptySet 5 OverInvDrag 3 -> drawEmptySet 5
OverInvDrag{} -> drawEmptySet 5 OverInvDrag{} -> drawEmptySet 5
OverInvDragSelect{} -> drawDragSelect 5 OverInvDragSelect{} -> drawDragSelect 5
OverInvSelect (-1, _) | selsec == Just (-1) -> drawJumpDown 5 OverInvSelect (-1, _) | selsec == Just (-1) -> drawJumpDown 5
@@ -128,6 +131,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
return . toClosestMultiple (pi / 32) $ return . toClosestMultiple (pi / 32) $
argV (w ^. cWorld . lWorld . lAimPos -.- cpos) argV (w ^. cWorld . lWorld . lAimPos -.- cpos)
- w ^. wCam . camRot - w ^. wCam . camRot
mover = inverseSelNumPos (u^.uvConfig) invDP (w^.input.mousePos) (w^.hud.diSections)
drawAnySelectionBox :: Universe -> Picture drawAnySelectionBox :: Universe -> Picture
drawAnySelectionBox u = case u ^. uvWorld . input . mouseContext of drawAnySelectionBox u = case u ^. uvWorld . input . mouseContext of
src/Dodge/Update.hs
+1 -1
View File
@@ -426,7 +426,7 @@ updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
updateMouseContextGame cfig u = \case updateMouseContextGame cfig u = \case
OverInvDrag i _ -> OverInvDrag i (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf) OverInvDrag i -> OverInvDrag i -- (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf)
x@OverInvDragSelect{} -> x x@OverInvDragSelect{} -> x
MouseGameRotate x MouseGameRotate x
| ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x | ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x
src/Dodge/Update/Input/InGame.hs
+28 -12
View File
@@ -114,7 +114,8 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
-- ^? nonInf -- ^? nonInf
-- guard (isGroupSelectableSection $ fst ysel) -- guard (isGroupSelectableSection $ fst ysel)
-- return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing -- return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w -- OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w
OverInvDrag k -> doDrag cfig 30 k w
OverTerminalBar p -> w & tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos) OverTerminalBar p -> w & tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos)
_ -> w _ -> w
-- where -- where
@@ -133,16 +134,22 @@ setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
max (1 + 20 * (ldp ^. ldpVerticalGap + ldp ^?! ldpSize . _Just . _y . to fromIntegral) - h * b) y max (1 + 20 * (ldp ^. ldpVerticalGap + ldp ^?! ldpSize . _Just . _y . to fromIntegral) - h * b) y
V2 a b = ldp ^. ldpPos . spScreenOff V2 a b = ldp ^. ldpPos . spScreenOff
doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World --doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do --doDrag cfig n k mmouseover w = fromMaybe w $ do
doDrag :: Config -> Int -> Int -> World -> World
doDrag cfig n k w = fromMaybe w $ do
guard (n /= 0) guard (n /= 0)
ss <- w ^? hud . diSections . ix k . ssItems ss <- w ^? hud . diSections . ix k . ssItems
x <- mmouseover x <- mouseover
is <- selectionSet w is <- selectionSet w
return $ return $
if concurrentIS is if concurrentIS is
then shiftInvItems cfig n k x is ss w then shiftInvItems cfig n k x is ss w
else collectInvItems k is w else collectInvItems k is w
where
mouseover = inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf
mpos = w ^. input . mousePos
disss = w ^. hud . diSections
tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
tryDropSelected mpos w = do tryDropSelected mpos w = do
@@ -198,7 +205,8 @@ tryPickupSelected k mpos w = do
updateMouseReleaseInGame :: Config -> World -> World updateMouseReleaseInGame :: Config -> World -> World
updateMouseReleaseInGame cfig w = case w ^. input . mouseContext of updateMouseReleaseInGame cfig w = case w ^. input . mouseContext of
OverInvDrag k mpos -> --OverInvDrag k mpos ->
OverInvDrag k ->
input . mouseContext .~ MouseInGame $ input . mouseContext .~ MouseInGame $
fromMaybe w $ fromMaybe w $
tryDropSelected mpos w <|> tryPickupSelected k mpos w tryDropSelected mpos w <|> tryPickupSelected k mpos w
@@ -211,6 +219,10 @@ updateMouseReleaseInGame cfig w = case w ^. input . mouseContext of
& hud . diSections . ix 3 . ssSet .~ mempty & hud . diSections . ix 3 . ssSet .~ mempty
& doDragSelect cfig ssel & doDragSelect cfig ssel
_ -> w _ -> w
where
mpos = inverseSelNumPos cfig invDP mpos' disss ^? _Just . nonInf
mpos' = w ^. input . mousePos
disss = w ^. hud . diSections
doDragSelect :: Config -> XInfinity (Int,Int) -> World -> World doDragSelect :: Config -> XInfinity (Int,Int) -> World -> World
doDragSelect cfig x w = fromMaybe w $ do doDragSelect cfig x w = fromMaybe w $ do
@@ -307,7 +319,8 @@ startDrag (a, b) w = setcontext $ fromMaybe (invSetSelection (Sel a b) w & hud.d
guard $ i == a && b `IS.member` xs guard $ i == a && b `IS.member` xs
return w return w
where where
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b)) --setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
setcontext = input . mouseContext .~ OverInvDrag a
shiftInvItems :: shiftInvItems ::
Config -> Config ->
@@ -318,7 +331,7 @@ shiftInvItems ::
IM.IntMap (SelectionItem a) -> IM.IntMap (SelectionItem a) ->
World -> World ->
World World
shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do shiftInvItems cfig n k x xs ss w = setSelWhileDragging cfig . fromMaybe w $ do
let xk = fst x let xk = fst x
let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y) let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
bn = bn =
@@ -334,18 +347,21 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
_ | x < (k, mini) -> do _ | x < (k, mini) -> do
guard $ not . null . fst $ IM.split mini ss guard $ not . null . fst $ IM.split mini ss
guard $ Just (k, mini - 1) /= ab guard $ Just (k, mini - 1) /= ab
return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsUp k xs w --return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsUp k xs w
return . doDrag cfig (n - 1) k $ shiftInvItemsUp k xs w
_ | x > (k, maxi) -> do _ | x > (k, maxi) -> do
guard $ not . null . snd $ IM.split maxi ss guard $ not . null . snd $ IM.split maxi ss
guard $ Just (k, maxi + 1) /= bn guard $ Just (k, maxi + 1) /= bn
return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsDown k xs w --return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsDown k xs w
return . doDrag cfig (n - 1) k $ shiftInvItemsDown k xs w
_ -> Nothing _ -> Nothing
setSelWhileDragging :: World -> World setSelWhileDragging :: Config -> World -> World
setSelWhileDragging w = fromMaybe w $ do setSelWhileDragging cfig w = fromMaybe w $ do
Sel i _ <- w ^? hud . diSelection . _Just Sel i _ <- w ^? hud . diSelection . _Just
xs <- w ^? hud . diSections . ix i . ssSet xs <- w ^? hud . diSections . ix i . ssSet
(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just --(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
(k, j) <- inverseSelNumPos cfig invDP (w^.input.mousePos) (w^.hud.diSections) ^? _Just . nonInf
guard $ i == k && j `IS.member` xs guard $ i == k && j `IS.member` xs
return $ w & hud . diSelection . _Just . slInt .~ j return $ w & hud . diSelection . _Just . slInt .~ j