Make inventory cursor change when dropping items sensible

src/Dodge/DisplayInventory.hs

@@ -5,6 +5,7 @@ module Dodge.DisplayInventory (
     updateCombinePositioning,
 ) where
 
+import Dodge.Inventory
 import Control.Lens
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
@@ -79,8 +80,13 @@ updateInventoryPositioning u =
         %~ updateDisplaySections (_uvWorld u) (_uvConfig u)
         & checkInventorySelectionExists
 
+-- this is possibly not completely correct
 checkInventorySelectionExists :: Universe -> Universe
-checkInventorySelectionExists u = u
+checkInventorySelectionExists u = fromMaybe u $ do
+    (i,j) <- u ^? uvWorld . hud . hudElement . diSelection . _Just
+    Just $ case u ^? uvWorld . hud . hudElement . diSections . ix i . ssItems . ix j of
+        Nothing -> u & uvWorld %~ scrollAugNextInSection
+        _ -> u
 
 updateDisplaySections ::
     World ->

src/Dodge/Inventory.hs

@@ -13,6 +13,7 @@ module Dodge.Inventory (
     setInvPosFromSS,
     module Dodge.Inventory.RBList,
     swapInvItems,
+    scrollAugNextInSection,
 ) where
 
 import Control.Applicative
@@ -236,6 +237,17 @@ scrollAugInvSel yi w
         sss <- he ^? diSections
         return $ he & diSelection %~ scrollSelectionSections yi sss
 
+scrollAugNextInSection :: World -> World
+scrollAugNextInSection w =
+        w & hud . hudElement %~ doscroll
+            & worldEventFlags . at InventoryChange ?~ ()
+            & setInvPosFromSS
+            & cWorld . lWorld %~ crUpdateItemLocations 0
+  where
+    doscroll he = fromMaybe he $ do
+        sss <- he ^? diSections
+        return $ he & diSelection %~ nextInSectionSS sss
+
 selectedCloseObject :: World -> Maybe (Either FloorItem Button)
 selectedCloseObject w = do
     i <-

src/Dodge/SelectionSections.hs

@@ -1,5 +1,6 @@
 module Dodge.SelectionSections (
     scrollSelectionSections,
+    nextInSectionSS,
     ssLookupDown,
     ssLookupGT,
     ssSetCursor,
@@ -35,6 +36,12 @@ scrollSelectionSections yi sss msel
     | yi > 0 = foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
     | otherwise = foldl' (&) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss)
 
+nextInSectionSS :: 
+    IM.IntMap (SelectionSection a) ->
+    Maybe (Int, Int) ->
+    Maybe (Int, Int)
+nextInSectionSS sss = ssScrollUsing ssLookupNextMax sss
+
 --setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
 --setFirstPosSelectionSections sss = fromMaybe sss $ do
 --    (i, j, _) <- ssLookupMin sss
@@ -93,6 +100,22 @@ ssLookupDown i j sss = case ssLookupGT i j sss of
     Nothing -> ssLookupMin sss
     x -> x
 
+ssLookupNextMax ::
+    Int ->
+    Int ->
+    IM.IntMap (SelectionSection a) ->
+    Maybe (Int, Int, SelectionItem a)
+ssLookupNextMax i j sss = case ssLookupGT i j sss of
+    Just x@(i',j',_) | i' == i && j' > j -> Just x
+    _ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss
+
+ssLookupMaxInSection :: Int -> IM.IntMap (SelectionSection a) ->
+    Maybe (Int, Int, SelectionItem a)
+ssLookupMaxInSection i sss = do
+    ss <- sss ^? ix i . ssItems
+    (j,s) <- IM.lookupMax ss
+    return (i,j,s)
+
 ssLookupLT ::
     Int ->
     Int ->