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

Separate selected item from extra selected items

Browse Source
This commit is contained in:
justin
2024-11-22 15:34:14 +00:00
parent bc2c9c9369
commit 13f5dd09c8
6 changed files with 154 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Input/InGame.hs
+61 -18
View File
@@ -101,13 +101,14 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
guard $ Just (fst sstart) == fmap fst msel || isNothing msel
return $ w & input . mouseContext . mcoSelEnd .~ msel
OverInvDrag k mmouseover -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
_ <- mmouseover
let mpos = w ^. input . mousePos
(j, i) <- w ^? hud . hudElement . diSelection . _Just
guard $ j == k -- this should always be the case?
x <- w ^? hud . hudElement . diSelectionExtra
return $ w & dragInvItems k (IS.insert i x) cfig mpos ldp sss
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
else collectInvItems is w
-- let mpos = w ^. input . mousePos
-- return $ w & dragInvItems k xs cfig mpos ldp sss
_ -> w
where
ldp = invDisplayParams w
@@ -115,24 +116,24 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
dropSelected :: World -> World
dropSelected w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, j) <- w ^? hud . hudElement . diSelection . _Just
(0, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
return $ IS.foldr (dropItem cr) w (IS.insert j xs)
return $ IS.foldr (dropItem cr) w xs
tryDropSelected :: World -> Maybe World
tryDropSelected w = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, j) <- w ^? hud . hudElement . diSelection . _Just
(0, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
return $ IS.foldr (dropItem cr) w (IS.insert j xs)
return $ IS.foldr (dropItem cr) w xs
tryPickupSelected :: World -> Maybe World
tryPickupSelected w = do
cr <- w ^? cWorld . lWorld . creatures . ix 0
(3, j) <- w ^? hud . hudElement . diSelection . _Just
(3, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
OverInvDrag 3 x <- w ^? input . mouseContext
return $ IS.foldr (dropItem cr) w (IS.insert j xs)
return $ IS.foldr (dropItem cr) w xs
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
@@ -207,7 +208,7 @@ startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
(i, j) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
guard $ i == a && b `IS.member` IS.insert j xs
guard $ i == a && b `IS.member` xs
return $ setmichosen xs w
where
setmichosen x =
@@ -246,6 +247,44 @@ collectInvItems is w = fromMaybe w $ do
(k, ks) <- IS.minView js
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
shiftInvItems' ::
Int ->
(Int,Int) ->
IS.IntSet ->
IM.IntMap (SelectionItem a) ->
World ->
World
shiftInvItems' k x 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)
return $ shiftInvItemsUp k xs w
else do
guard $ x > (k,maxi)
maxss <- IM.lookupMax ss
guard (maxi < fst maxss)
return $ shiftInvItemsDown k xs w
-- if
-- Just p -> fromMaybe w $ do
-- (k,_) <- IS.minView xs
-- guard $ p < (j,k)
-- ss <- sss ^? ix j . ssItems
-- minsss <- IM.lookupMin ss
-- guard (k > fst minsss)
-- return $ shiftInvItemsUp j xs w
-- _ -> case inverseSelBoundaryDown cfig ldp sss mpos of
-- Just p -> fromMaybe w $ do
-- (k,_) <- IS.maxView xs
-- guard $ p > (j,k)
-- ss <- sss ^? ix j . ssItems
-- maxsss <- IM.lookupMax ss
-- guard (k < fst maxsss)
-- return $ shiftInvItemsDown j xs w
-- _ -> w
shiftInvItems ::
Int ->
IS.IntSet ->
@@ -256,16 +295,20 @@ shiftInvItems ::
World ->
World
shiftInvItems j xs cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
Just p | p < (j, IS.findMin xs) -> fromMaybe w $ do
Just p -> fromMaybe w $ do
(k,_) <- IS.minView xs
guard $ p < (j,k)
ss <- sss ^? ix j . ssItems
minsss <- IM.lookupMin ss
guard (IS.findMin xs > fst minsss)
guard (k > fst minsss)
return $ shiftInvItemsUp j xs w
_ -> case inverseSelBoundaryDown cfig ldp sss mpos of
Just p | p > (j, IS.findMax xs) -> fromMaybe w $ do
Just p -> fromMaybe w $ do
(k,_) <- IS.maxView xs
guard $ p > (j,k)
ss <- sss ^? ix j . ssItems
maxsss <- IM.lookupMax ss
guard (IS.findMax xs < fst maxsss)
guard (k < fst maxsss)
return $ shiftInvItemsDown j xs w
_ -> w