Allow dropping items by dragging off inventory

This commit is contained in:
2024-11-19 22:24:03 +00:00
parent 13339c9a12
commit 2dc5d35744
11 changed files with 145 additions and 123 deletions
+13 -2
View File
@@ -103,7 +103,8 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
sss <- w ^? hud . hudElement . diSections
let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
return $ w & input . mouseContext . mcoSelEnd .~ msel
OverInvDrag -> fromMaybe w $ do
OverInvDrag Nothing -> w
OverInvDrag {} -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
let mpos = w ^. input . mousePos
sel <- w ^? hud . hudElement . diSelection . _Just
@@ -113,8 +114,18 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
where
ldp = invDisplayParams w
dropSelected :: World -> World
dropSelected w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0,j) <- w ^? hud . hudElement . diSelection . _Just
x <- w ^? hud . hudElement . diSelectionExtra
return $ foldl' (flip $ dropItem cr) w (reverse [j .. j+x])
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDrag mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
j <- mpos
return $ w & input . mouseContext .~ OverInvSelect (0,j)
OverInvDragSelect ssel (Just esel) ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelectionExtra
@@ -174,7 +185,7 @@ startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen 0 w) $ d
return $ setmichosen x w
where
setmichosen x =
(input . mouseContext .~ OverInvDrag)
(input . mouseContext .~ OverInvDrag (Just b))
. (hud . hudElement . diSelectionExtra .~ x)
shiftInvItems ::