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

Fix dragging over items larger than the selection group

Browse Source 
There is still a further choice/improvement to be made here,
but at least dragging shouldn't glitch out as it currently stands
This commit is contained in:
justin
2024-11-25 11:09:58 +00:00
parent 905be15a33
commit 2c6037d852
6 changed files with 170 additions and 140 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Input.hs
+5 -1
View File
@@ -22,7 +22,11 @@ data MouseContext
| MouseInGame
| MouseMenuClick {_mcoMenuClick :: Int}
| MouseMenuCursor
| OverInvDrag {_mcoDragSection :: Int, _mcoMaybeSelect :: Maybe (Int,Int)}
| OverInvDrag {_mcoDragSection :: Int
, _mcoMaybeSelect :: Maybe (Int,Int)
, _mcoAboveSelect :: Maybe (Int,Int)
, _mcoBelowSelect :: Maybe (Int,Int)
}
| OverInvDragSelect { _mcoSelStart :: (Int,Int), _mcoSelEnd :: Maybe (Int,Int) }
| OverInvSelect { _mcoInvSelect :: (Int,Int)}
| OverInvFilt { _mcoInvFilt :: (Int,Int)}
src/Dodge/Render/Picture.hs
+7 -7
View File
@@ -84,14 +84,14 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
MouseMenuClick {} -> 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 0 (Just (3,_)) _ _ -> drawDragDrop 5
OverInvDrag 0 Nothing _ _ -> drawDragDrop 5
OverInvDrag 0 (Just (0,_)) _ _ -> drawDrag 5
OverInvDrag 0 _ _ _ -> drawEmptySet 5
-- OverInvDrag 0 _ -> drawDragDrop 5
OverInvDrag 3 (Just (3,_)) -> drawDrag 5
OverInvDrag 3 _ -> drawDragPickup 5
OverInvDrag _ _ -> drawEmptySet 5
OverInvDrag 3 (Just (3,_)) _ _ -> drawDrag 5
OverInvDrag 3 _ _ _ -> drawDragPickup 5
OverInvDrag {} -> drawEmptySet 5
OverInvDragSelect {} -> drawDragSelect 5
OverInvSelect {} -> drawSelect 5
OverInvFilt {} -> drawCombFilter 5
src/Dodge/Update.hs
+6 -3
View File
@@ -306,7 +306,7 @@ checkTermDist w = fromMaybe w $ do
updateMouseContext :: Configuration -> Universe -> Universe
updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
OverInvDrag i _ -> u & uvWorld . input . mouseContext .~ invdrag i
OverInvDrag i _ _ _ -> u & uvWorld . input . mouseContext .~ invdrag i
OverInvDragSelect{} -> u
_ -> u & uvWorld . input . mouseContext
.~ fromMaybe
@@ -335,10 +335,13 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| otherwise = MouseInGame
mpos = w ^. input . mousePos
invdrag i' = fromMaybe (OverInvDrag i' Nothing) $ do
invdrag i' = fromMaybe (OverInvDrag i' Nothing Nothing Nothing) $ do
sss <- w ^? hud . hudElement . diSections
let yint = posSelSecYint cfig (invDisplayParams w) (mpos ^. _y)
(i,j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
return $ OverInvDrag i' (Just (i,j))
let above = inverseSelSecYint (yint - 1) sss
bneath = inverseSelSecYint (yint + 1) sss
return $ OverInvDrag i' (Just (i,j)) above bneath
overinv = do
sss <- w ^? hud . hudElement . diSections
selpos <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
src/Dodge/Update/Input/InGame.hs
+26 -14
View File
@@ -93,12 +93,12 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
guard $ Just (fst sstart) == fmap fst msel || isNothing msel
return $ w & input . mouseContext . mcoSelEnd .~ msel
OverInvDrag k mmouseover -> fromMaybe w $ do
OverInvDrag k mmouseover ab bn -> fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelectionExtra
return $ if concurrentIS is
then shiftInvItems k x is ss w
then shiftInvItems k x ab bn is ss w
else collectInvItems is w
-- let mpos = w ^. input . mousePos
-- return $ w & dragInvItems k xs cfig mpos ldp sss
@@ -127,8 +127,7 @@ tryPickupSelected mpos w = do
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
--OverInvDrag i mpos ->
OverInvDrag _ mpos ->
OverInvDrag _ mpos _ _ ->
input . mouseContext .~ MouseInGame $
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected mpos w
-- OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
@@ -159,7 +158,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
return $
w & input . mouseContext
.~ OverInvDragSelect ysel Nothing
OverInvSelect x -> startDrag x w
OverInvSelect x -> startDrag x cfig w
OverTerminalReturn tmid -> terminalReturnEffect tmid w
OverTerminalEscape ->
w
@@ -198,17 +197,26 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
ldp = invDisplayParams w
mpos = w ^. input . mousePos
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
--(i, j) <- w ^? hud . hudElement . diSelection . _Just
startDrag :: (Int, Int) -> Configuration -> World -> World
startDrag (a, b) cfig w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
(i, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
guard $ i == a && b `IS.member` xs
return $ setmichosen xs w
where
setmichosen :: IS.IntSet -> World -> World
setmichosen x =
(input . mouseContext .~ OverInvDrag a (Just (a, b)))
(input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath)
. (hud . hudElement . diSelectionExtra .~ x)
above :: Maybe (Int,Int)
above = do
sss <- w ^? hud . hudElement . diSections
inverseSelSecYint (yint - 1) sss
bneath :: Maybe (Int,Int)
bneath = do
sss <- w ^? hud . hudElement . diSections
inverseSelSecYint (yint + 1) sss
yint = posSelSecYint cfig (invDisplayParams w) (w ^. input . mousePos . _y)
concurrentIS :: IS.IntSet -> Bool
concurrentIS = go . IS.minView
@@ -228,19 +236,23 @@ collectInvItems is w = fromMaybe w $ do
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
shiftInvItems ::
Int ->
(Int,Int) ->
Int -> -- section where drag started
(Int,Int) -> -- selection item mouse is over
Maybe (Int,Int) -> -- selection item "above" mouse position (can be same as over)
Maybe (Int,Int) -> -- selection item "below" mouse position (can be same as over)
IS.IntSet ->
IM.IntMap (SelectionItem a) ->
World ->
World
shiftInvItems k x xs ss w = fromMaybe w $ do
shiftInvItems k x ab bn xs ss w = fromMaybe w $ do
(maxi,_) <- IS.maxView xs
(mini,_) <- IS.minView xs
if x < (k,mini)
then do
minss <- IM.lookupMin ss
guard (mini > fst minss)
above <- ss ^? ix (mini - 1)
guard $ Just (k,mini-1) /= ab
-- minss <- IM.lookupMin ss
-- guard (mini > fst minss)
return $ shiftInvItemsUp k xs w
else do
guard $ x > (k,maxi)