Tweak drag pickup/drop

This commit is contained in:
2026-04-06 18:18:41 +01:00
parent 9d7c9f1db2
commit 608de9f2ed
+10 -5
View File
@@ -155,9 +155,11 @@ tryDropSelected mpos w = do
guard $ maybe True (\(i, _) -> i == 3) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
0 <- w ^? hud . diSelection . _Just . slSec
j <- w ^? hud . diSelection . _Just . slInt
xs <- selectionSet w
let xmin = IS.findMin xs
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
selectionSet :: World -> Maybe IS.IntSet
@@ -172,17 +174,20 @@ tryPickupSelected k mpos w = do
guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
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
itmstopickup = mapMaybe g $ IS.toList xs
slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
ispickup = map (_unNInt . _itID) itmstopickup
guard $ nfreeslots >= slotsneeded
return $ case mpos of
Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j xs
_ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs
Just (0, j) -> foldr (pickUpItemAt j 0) w ispickup & newdisel j joff xs
_ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) joff xs
where
newdisel j xs =
hud . diSelection ?~ Sel 0 j (IS.fromDistinctAscList [j .. j + IS.size xs -1])
newdisel j joff xs =
hud . diSelection ?~ Sel 0 (j+joff) (IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do
NInt j <- w ^? hud . closeItems . ix i
w ^? cWorld . lWorld . items . ix j