Commit before removing "above/below" checks on inventory dragging

I don't think these actually do anything
EDIT: they are actually necessary
This commit is contained in:
2025-08-26 11:27:04 +01:00
parent 5b95bcbf3b
commit 004c4d1950
5 changed files with 147 additions and 155 deletions
+16 -18
View File
@@ -111,19 +111,18 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
(posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss
guard (isGroupSelectableSection $ fst ysel)
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
OverInvDrag k mmouseover ab bn -> doDrag 30 k mmouseover ab bn w
OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w
_ -> w
doDrag :: Int -> Int -> Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int) -> World -> World
--doDrag 0 _ _ _ _ w = w
doDrag n k mmouseover ab bn w = fromMaybe w $ do
doDrag :: Configuration -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do
guard (n /= 0) -- > 0 ?
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3
return $
if concurrentIS is
then shiftInvItems n k x ab bn is ss w
then shiftInvItems cfig n k x is ss w
else collectInvItems k is w
tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
@@ -160,7 +159,7 @@ tryPickupSelected k mpos w = do
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDrag k mpos _ _ ->
OverInvDrag k mpos ->
input . mouseContext .~ MouseInGame $
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
OverInvDragSelect (Just ssel) mesel
@@ -222,7 +221,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
| ScancodeLShift `M.member` (w ^. input . pressedKeys)
&& isGroupSelectableSection (fst x) ->
w & input . mouseContext .~ OverInvDragSelect (Just x) (Just $ snd x)
OverInvSelect x -> startDrag x cfig w
OverInvSelect x -> startDrag x w
OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w
OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w
OutsideTerminal -> w & hud . hudElement . subInventory .~ NoSubInventory
@@ -277,16 +276,13 @@ endCombineRegex w = fromMaybe id $ do
return (k -1)
return $ ssSetCursor (ssLookupDown 0 j) sss
startDrag :: (Int, Int) -> Configuration -> World -> World
startDrag (a, b) cfig w = setcontext
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext
$ case w ^? hud . hudElement . diSelection . _Just of
Just (i,_,xs) | i == a && b `IS.member` xs -> w
_ -> invSetSelection (a, b, IS.singleton b) w
where
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath
above = inverseSelSecYint (yint - 1) =<< w ^? hud . hudElement . diSections
bneath = inverseSelSecYint (yint + 1) =<< w ^? hud . hudElement . diSections
yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
concurrentIS :: IS.IntSet -> Bool
concurrentIS = go . IS.minView
@@ -307,17 +303,19 @@ collectInvItems secid is w = fromMaybe w $ do
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
shiftInvItems ::
Configuration ->
Int -> -- recurse limit
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 n k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do
shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
let xk = fst x
let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
bn = inverseSelSecYint (yint + 1) =<< w ^? hud . hudElement . diSections
ab = inverseSelSecYint (yint - 1) =<< w ^? hud . hudElement . diSections
guard $ xk == k || xk + 1 == k || xk -1 == k
(maxi, _) <- IS.maxView xs
(mini, _) <- IS.minView xs
@@ -325,11 +323,11 @@ shiftInvItems n k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do
_ | x < (k, mini) -> do
guard $ not . null . fst $ IM.split mini ss
guard $ Just (k, mini -1) /= ab
return . doDrag (n -1) k (Just x) ab bn $ shiftInvItemsUp k xs w
return . doDrag cfig (n -1) k (Just x) $ shiftInvItemsUp k xs w
_ | x > (k, maxi) -> do
guard $ not . null . snd $ IM.split maxi ss
guard $ Just (k, maxi + 1) /= bn
return . doDrag (n -1) k (Just x) ab bn $ shiftInvItemsDown k xs w
return . doDrag cfig (n -1) k (Just x) $ shiftInvItemsDown k xs w
_ -> Nothing
setSelWhileDragging :: World -> World