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
| MouseInGame
| 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)) }
| OverInvSelect { _mcoInvSelect :: (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
import Dodge.ListDisplayParams
import Dodge.SelectionSections
import Dodge.Data.CardinalPoint
import Linear hiding (rotate)
import qualified SDL
import Control.Lens
@@ -95,15 +98,15 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
MouseMenu{} -> drawMenuClick 5
-- MouseMenuCursor -> drawMenuCursor 5
MouseInGame -> drawPlus 5
OverInvDrag 0 (Just (3, _)) -> drawDragDrop 5
OverInvDrag 0 Nothing -> drawDragDrop 5
OverInvDrag 0 (Just (0, _)) -> drawDrag 5
OverInvDrag 0 _ -> drawEmptySet 5
OverInvDrag 3 (Just (3, _)) -> drawDrag 5
OverInvDrag 3 (Just (0, _)) -> drawDragPickup 5
OverInvDrag 3 (Just (1, _)) -> drawDragPickup 5
OverInvDrag 3 Nothing -> drawDragPickup 5
OverInvDrag 3 _ -> drawEmptySet 5
OverInvDrag 0 | Just 3 <- mover ^? _Just.nonInf._1 -> drawDragDrop 5
OverInvDrag 0 | Nothing <- mover ^?_Just.nonInf -> drawDragDrop 5
OverInvDrag 0 | Just 0 <- mover ^? _Just.nonInf._1 -> drawDrag 5
OverInvDrag 0 -> drawEmptySet 5
OverInvDrag 3 | Just 3 <- mover ^?_Just.nonInf._1 -> drawDrag 5
OverInvDrag 3 | Just 0 <- mover ^?_Just.nonInf._1 -> drawDragPickup 5
OverInvDrag 3 | Just 1 <- mover ^?_Just.nonInf._1 -> drawDragPickup 5
OverInvDrag 3 | Nothing <-mover^?_Just.nonInf -> drawDragPickup 5
OverInvDrag 3 -> drawEmptySet 5
OverInvDrag{} -> drawEmptySet 5
OverInvDragSelect{} -> drawDragSelect 5
OverInvSelect (-1, _) | selsec == Just (-1) -> drawJumpDown 5
@@ -128,6 +131,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
return . toClosestMultiple (pi / 32) $
argV (w ^. cWorld . lWorld . lAimPos -.- cpos)
- w ^. wCam . camRot
mover = inverseSelNumPos (u^.uvConfig) invDP (w^.input.mousePos) (w^.hud.diSections)
drawAnySelectionBox :: Universe -> Picture
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 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
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
-- guard (isGroupSelectableSection $ fst ysel)
-- 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)
_ -> w
-- 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
V2 a b = ldp ^. ldpPos . spScreenOff
doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do
--doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World
--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)
ss <- w ^? hud . diSections . ix k . ssItems
x <- mmouseover
x <- mouseover
is <- selectionSet w
return $
if concurrentIS is
then shiftInvItems cfig n k x is ss 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 mpos w = do
@@ -198,7 +205,8 @@ tryPickupSelected k mpos w = do
updateMouseReleaseInGame :: Config -> World -> World
updateMouseReleaseInGame cfig w = case w ^. input . mouseContext of
OverInvDrag k mpos ->
--OverInvDrag k mpos ->
OverInvDrag k ->
input . mouseContext .~ MouseInGame $
fromMaybe 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
& doDragSelect cfig ssel
_ -> 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 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
return w
where
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
--setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
setcontext = input . mouseContext .~ OverInvDrag a
shiftInvItems ::
Config ->
@@ -318,7 +331,7 @@ shiftInvItems ::
IM.IntMap (SelectionItem a) ->
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 yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
bn =
@@ -334,18 +347,21 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
_ | x < (k, mini) -> do
guard $ not . null . fst $ IM.split mini ss
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
guard $ not . null . snd $ IM.split maxi ss
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
setSelWhileDragging :: World -> World
setSelWhileDragging w = fromMaybe w $ do
setSelWhileDragging :: Config -> World -> World
setSelWhileDragging cfig w = fromMaybe w $ do
Sel i _ <- w ^? hud . diSelection . _Just
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
return $ w & hud . diSelection . _Just . slInt .~ j