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

Tweak drag pickup/drop

Browse Source
This commit is contained in:
justin
2026-04-06 18:18:41 +01:00
parent 9d7c9f1db2
commit 608de9f2ed
1 changed files with 10 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Input/InGame.hs
+10 -5
View File
@@ -155,9 +155,11 @@ tryDropSelected mpos w = do
guard $ maybe True (\(i, _) -> i == 3) mpos guard $ maybe True (\(i, _) -> i == 3) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0 cr <- w ^? cWorld . lWorld . creatures . ix 0
0 <- w ^? hud . diSelection . _Just . slSec 0 <- w ^? hud . diSelection . _Just . slSec
j <- w ^? hud . diSelection . _Just . slInt
xs <- selectionSet w xs <- selectionSet w
let xmin = IS.findMin xs
return return
. (hud . diSelection ?~ Sel 3 0 (IS.fromDistinctAscList [0..IS.size xs - 1])) . (hud . diSelection ?~ Sel 3 (j-xmin) (IS.fromDistinctAscList [0..IS.size xs - 1]))
. foldl' (flip $ dropItem cr) w . IS.toDescList $ xs . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
selectionSet :: World -> Maybe IS.IntSet selectionSet :: World -> Maybe IS.IntSet
@@ -172,17 +174,20 @@ tryPickupSelected k mpos w = do
guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0 cr <- w ^? cWorld . lWorld . creatures . ix 0
xs <- selectionSet w xs <- selectionSet w
sli <- w ^? hud . diSelection . _Just . slInt
let xmin = IS.findMin xs
joff = sli - xmin
let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr
itmstopickup = mapMaybe g $ IS.toList xs itmstopickup = mapMaybe g $ IS.toList xs
slotsneeded = alaf Sum foldMap itInvHeight itmstopickup slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
ispickup = map (_unNInt . _itID) itmstopickup ispickup = map (_unNInt . _itID) itmstopickup
guard $ nfreeslots >= slotsneeded guard $ nfreeslots >= slotsneeded
return $ case mpos of return $ case mpos of
Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j xs Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j joff xs
_ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs _ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) joff xs
where where
newdisel j xs = newdisel j joff xs =
hud . diSelection ?~ Sel 0 j (IS.fromDistinctAscList [j .. j + IS.size xs -1]) hud . diSelection ?~ Sel 0 (j+joff) (IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do g i = do
NInt j <- w ^? hud . closeItems . ix i NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . items . ix j w ^? cWorld . lWorld . items . ix j