Fix bug in manObject update when dropping items

src/Dodge/Creature/Action.hs

@@ -215,7 +215,7 @@ youDropItem w = fromMaybe w $ do
     guard $ not $ w ^. cWorld . lWorld . lInvLock
     return $ case cr ^. crStance . posture of
         Aiming{} -> throwItem w
-        AtEase -> dropItem cr curpos w
+        AtEase -> setInvPosFromSS $ dropItem cr curpos w
   where
     cr = you w
     mi = do

src/Dodge/Creature/State.hs

@@ -235,7 +235,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
     magitid <- mag ^? dtValue . _1 . itID . unNInt
     return $
         w
-            & worldEventFlags . at InventoryChange ?~ ()
+            & worldEventFlags . at InventoryChange ?~ () -- why?
             & cWorld . lWorld . items
                 . ix magitid
                 . itConsumables

src/Dodge/Inventory.hs

@@ -89,19 +89,12 @@ rmInvItem cid invid w =
         & removeAnySlotEquipment
         & cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
         & updateselection
-        & updateselectionextra
-        & uprootitem
+--        & uprootitem
 --revise1        & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
         & worldEventFlags . at InventoryChange ?~ ()
   where
-    uprootitem w' = updateRootItemID (w ^. cWorld . lWorld . items) (w'^?!cWorld.lWorld.creatures.ix 0) w'
+--    uprootitem w' = updateRootItemID (w ^. cWorld . lWorld . items) (w'^?!cWorld.lWorld.creatures.ix 0) w'
     pointcid = cWorld . lWorld . creatures . ix cid
-    updateselectionextra
---        | cid == 0 = hud . diSelection . _Just . slSet %~ IS.foldl' h mempty
-        | otherwise = id
---    h x i | i > _unNInt invid = IS.insert (i-1) x
---        | i < _unNInt invid = IS.insert i x
---        | otherwise = x
     updateselection
         | cid == 0 && (w ^? hud .diSelection._Just) == Just (Sel 0 (invid^.unNInt)) =
 --revise2        | cid == 0 && w ^? hud . manObject . imSelectedItem == Just invid =
@@ -113,21 +106,11 @@ rmInvItem cid invid w =
     itm = w ^?! cWorld . lWorld . items . ix itid
     dounequipfunction = effectOnRemove itm cr
     removeAnySlotEquipment = fromMaybe id $ do
-        epos <-
-            itm
-                ^? itLocation
-                . ilEquipSite
-                . _Just
+        epos <- itm ^? itLocation . ilEquipSite . _Just
         return $ pointcid . crEquipment . at epos .~ Nothing
-    --        return $ pointcid . crEquipment .~ mempty
-    maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
     f inv =
         let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
          in NIntMap $ xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
-    -- the following might not work if a non-player creature drops their last item
-    g x
-        | x > invid || Just x == fmap NInt maxk = max 0 $ x - 1
-        | otherwise = x
 
 updateCloseObjects :: World -> World
 updateCloseObjects w =
@@ -298,7 +281,7 @@ invSetSelection sel w =
     w
         & hud . diSelection ?~ sel
         & worldEventFlags . at InventoryChange ?~ ()
-        & setInvPosFromSS
+        & setInvPosFromSS -- is this necessary here?
         & crUpdateItemLocations 0
 --revise1        & cWorld . lWorld %~ crUpdateItemLocations 0
 

src/Dodge/Inventory/Location.hs

@@ -1,5 +1,5 @@
 module Dodge.Inventory.Location (
-    updateRootItemID,
+--    updateRootItemID,
     crUpdateItemLocations,
     setInvPosFromSS,
 ) where
@@ -7,7 +7,6 @@ module Dodge.Inventory.Location (
 import Dodge.Item.AimStance
 import Control.Lens
 import Data.Foldable
---import Data.IntMap.Merge.Strict
 import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base.You
@@ -30,21 +29,21 @@ tryGetRootAttachedFromInvID (NInt invid) im = do
     t <- imroots ^? ix theroot . _2
     return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID . unNInt)) t)
 
--- this assumes the creature inventory is well formed, specifically the
--- location ids
--- note the item intmap is all items
-getRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Int
-getRootItemInvID m i cr = fromMaybe i $ do
-    let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
-    theroot <- adj ^? ix i
-    theroot ^? _1 . _Just . _1
+---- this assumes the creature inventory is well formed, specifically the
+---- location ids
+---- note the item intmap is all items
+--getRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Int
+--getRootItemInvID m i cr = fromMaybe i $ do
+--    let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
+--    theroot <- adj ^? ix i
+--    theroot ^? _1 . _Just . _1
 
-updateRootItemID :: IM.IntMap Item -> Creature -> World -> World
-updateRootItemID m cr w = fromMaybe w $ do
-    Sel 0 i <- w^?hud.diSelection._Just
---revise2    i <- w^?hud . manObject . imSelectedItem . unNInt
-    let j = getRootItemInvID m i cr
-    return $ w & hud . manObject . hiRootSelectedItem .~ NInt j
+--updateRootItemID :: IM.IntMap Item -> Creature -> World -> World
+--updateRootItemID m cr w = fromMaybe w $ do
+--    Sel 0 i <- w^?hud.diSelection._Just
+----revise2    i <- w^?hud . manObject . imSelectedItem . unNInt
+--    let j = getRootItemInvID m i cr
+--    return $ w & hud . manObject . hiRootSelectedItem .~ NInt j
 
 -- the following assumes that the crManipulation is correct
 crUpdateItemLocations :: Int -> World -> World

src/Dodge/TestString.hs

@@ -58,7 +58,10 @@ crs :: Universe -> [Creature]
 crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
 
 testStringInit :: Universe -> [String]
-testStringInit u = u ^.. uvWorld . hud . diSections . each . ssSet . to show
+testStringInit u = 
+    u ^. uvWorld . hud . manObject . to prettyShort
+    <>
+    u ^.. uvWorld . hud . diSections . each . ssSet . to show
 --testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort
     --[show . getSum $ foldMap (Sum . crslime) (crs u)]
 --     u ^.. tocrs . each . crType . slimeSplitTimer . to show

src/Dodge/Update.hs

@@ -129,6 +129,7 @@ updateWorldEventFlags u =
 updateWorldEventFlag :: WorldEventFlag -> Universe -> Universe
 updateWorldEventFlag wef = case wef of
     InventoryChange -> id -- updateInventoryPositioning
+        -- setInvPosFromSS ?
     -- for now update inventory positioning every tick
     CombineInventoryChange -> updateCombinePositioning
 

src/Dodge/Update/Input/InGame.hs

@@ -60,7 +60,7 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . subInven
     f x y i = u
         & uvWorld . hud %~ dodisplayregexinput x y i
         & uvWorld . worldEventFlags . at InventoryChange ?~ ()
-        & uvWorld %~ setInvPosFromSS
+        & uvWorld %~ setInvPosFromSS -- not sure if this is necessary
     dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
         sss <- di ^? diSections
         msel <- di ^? diSelection
@@ -153,6 +153,7 @@ tryDropSelected mpos w = do
     xs <- selectionSet w
     let xmin = IS.findMin xs
     return
+        . setInvPosFromSS
         . (hud . diSelection ?~ Sel 3 (j - xmin))
         . foldl' (flip $ dropItem cr) w
         . IS.toDescList
@@ -491,27 +492,17 @@ updateBackspaceRegex w = case di ^? subInventory of
     Just NoSubInventory{}
         | secfocus (-1) 0 ->
             w
-                & hud
-                %~ trybackspace (-1) diInvFilter diInvFilter diSelection
-                & worldEventFlags
-                . at InventoryChange
-                ?~ ()
+                & hud %~ trybackspace (-1) diInvFilter diInvFilter diSelection
+                & worldEventFlags . at InventoryChange ?~ ()
     Just NoSubInventory{}
         | secfocus 2 3 ->
             w
-                & hud
-                %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
-                & worldEventFlags
-                . at InventoryChange
-                ?~ ()
+                & hud %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
+                & worldEventFlags . at InventoryChange ?~ ()
     Just CombineInventory{} ->
         w
-            & hud
-            . subInventory
-            %~ trybackspace (-1) ciFilter ciFilter ciSelection
-            & worldEventFlags
-            . at InventoryChange
-            ?~ ()
+            & hud . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
+            & worldEventFlags . at InventoryChange ?~ ()
     _ -> w
   where
     secfocus a b = fromMaybe False $ do