Correctly update root status of item in _ilIsRoot

src/Dodge/Inventory/Location.hs

@@ -13,6 +13,7 @@ import Dodge.Data.Item.Use.Consumption.LoadAction
 import Dodge.Data.World
 import Dodge.Item.Grammar
 import qualified IntMapHelp as IM
+import Data.IntMap.Merge.Strict
 import NewInt
 
 -- assumes all item locations inside the items are correct
@@ -35,14 +36,24 @@ updateRootItemID :: Creature -> Creature
 updateRootItemID cr = fromMaybe cr $ do
     i <- cr ^? crManipulation . manObject . imSelectedItem
     j <- tryGetRootItemInvID i cr
-    return $ cr & crManipulation . manObject . imRootItem .~ j
+    return $ cr & crManipulation . manObject . imRootSelectedItem .~ j
 
 -- the following assumes that the crManipulation is correct
 crUpdateItemLocations :: Int -> LWorld -> LWorld
 crUpdateItemLocations crid lw = fromMaybe lw $ do
     mo <- lw ^? creatures . ix crid . crManipulation . manObject
     crinv <- lw ^? creatures . ix crid . crInv
-    return $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
+    return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
+
+crSetRoots :: Int -> LWorld -> LWorld
+crSetRoots cid w = fromMaybe w $ do
+    inv <- w ^? creatures . ix cid . crInv
+--    invRootTrees inv
+    return $ w & creatures . ix cid . crInv %~ merge dropMissing preserveMissing 
+        (zipWithMatched f)
+        (invRootTrees inv)
+  where
+    f _ _ = itLocation . ilIsRoot .~ True
 
 crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
 crUpdateInvidLocations mo crid lw invid itm =
@@ -55,7 +66,7 @@ crUpdateInvidLocations mo crid lw invid itm =
         InInv
             { _ilCrID = crid
             , _ilInvID = invid
-            , _ilIsRoot = Just invid == mo ^? imRootItem
+            , _ilIsRoot = Just invid == mo ^? imRootSelectedItem
             , _ilIsSelected = Just invid == mo ^? imSelectedItem
             , _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
             }
@@ -77,7 +88,7 @@ setInvPosFromSS w =
                 return
                     SelectedItem
                         { _imSelectedItem = j
-                        , _imRootItem = rootid
+                        , _imRootSelectedItem = rootid
                         , _imAttachedItems = aset
                         }
             1 -> Just SelNothing