Allow dragging of selected items in inventory

src/Dodge/Inventory.hs

@@ -10,7 +10,8 @@ module Dodge.Inventory (
     crInvSize,
     selectedCloseObject,
     setInvPosFromSS,
-    module Dodge.Inventory.RBList
+    module Dodge.Inventory.RBList,
+    swapInvItems,
 ) where
 
 import NewInt
@@ -162,18 +163,22 @@ changeSwapClose f i w = fromMaybe w $ do
             & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
             & worldEventFlags . at InventoryChange ?~ ()
 
-changeSwapInv ::
+-- can be specialised for when we know that item i is selected
+swapInvItems ::
     (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
     Int ->
     World ->
     World
-changeSwapInv f i w = fromMaybe w $ do
+swapInvItems f i w = fromMaybe w $ do
     ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
     k <- f i ss
+    let updateselection = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of
+            Just (0,j) | j == k -> hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ i
+            Just (0,j) | j == i -> hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
+            _ -> id
     return $
         w & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
---            & cWorld . lWorld . creatures . ix 0 %~ updateRootItemID
-            & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
+            & updateselection
             & worldEventFlags . at InventoryChange ?~ ()
         & cWorld . lWorld %~ crUpdateItemLocations 0
              & setInvPosFromSS
@@ -199,7 +204,7 @@ changeSwapInv f i w = fromMaybe w $ do
 
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of
-    Just (0, i) -> w & changeSwapInv f i
+    Just (0, i) -> w & swapInvItems f i
     Just (3, i) -> w & changeSwapClose f i
     _ -> w