Work on selections when picking up/droping items

src/Dodge/Creature/Action.hs

@@ -10,6 +10,9 @@ module Dodge.Creature.Action (
     youDropItem,
 ) where
 
+import qualified IntSetHelp as IS
+import Dodge.DisplayInventory
+import Dodge.Data.SelectionList
 import RandomHelp
 import Dodge.WorldEvent.ThingsHit
 import Control.Applicative
@@ -174,22 +177,32 @@ performTurnToA cr p
 
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
-dropItem cr invid w' =
-    doanyitemdropeffect
+dropItem cr invid w =
+    itEffectOnDrop itm cr
+        . maybesetdropped
+        . (hud . diSections . ix 3 . ssSet %~ IS.map (+ 1))
+        . (hud . diSections . ix 0 . ssSet %~ IS.deleteShift invid)
         . maybeshiftseldown
         . copyItemToFloor (cr ^. crPos . _xy) itm -- . mayberemoveequip
         . rmInvItem (_crID cr) (NInt invid) -- it is important
         -- to do this before copying the item to the floor!
         . soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) whiteNoiseFadeOutS Nothing
-        $ w'
+        $ w
   where
-    doanyitemdropeffect = itEffectOnDrop itm cr
     itm = fromMaybe (error "dropItem cannot find item") $ do
         itid <- cr ^? crInv . ix (NInt invid)
-        w' ^? cWorld . lWorld . items . ix itid
-    maybeshiftseldown w = fromMaybe w $ do
+        w ^? cWorld . lWorld . items . ix itid
+    t = fromMaybe True $ do
+        s <- w ^? hud . diCloseFilter . _Just
+        si <- w ^? hud . diSections . ix 0 . ssItems . ix invid
+        return $ plainRegex s si
+    maybesetdropped = fromMaybe id $ do
+        guard $ t && (invid `IS.member` (w ^?! hud . diSections . ix 0 . ssSet))
+        return $ hud . diSections . ix 3 . ssSet %~ IS.insert 0
+    maybeshiftseldown = fromMaybe id $ do
+        guard t
         3 <- w ^? hud . diSelection . _Just . slSec
-        return $ w & hud . diSelection . _Just . slInt +~ 1
+        return $ hud . diSelection . _Just . slInt +~ 1
 
 -- | Get your creature to drop the item under the cursor.
 youDropItem :: World -> World