Correctly update root status of item in _ilIsRoot

ghcidOutput

@@ -1 +1 @@
-All good (594 modules, at 20:36:32)
+All good (594 modules, at 18:20:01)

src/Dodge/Base/You.hs

@@ -25,7 +25,7 @@ yourSelectedItem w = do
 
 yourRootItem :: World -> Maybe Item
 yourRootItem w = do
-    i <- you w ^? crManipulation . manObject . imRootItem
+    i <- you w ^? crManipulation . manObject . imRootSelectedItem
     _crInv (you w) IM.!? i
 
 --yourScrollAttachment :: World -> Maybe (Int,ScrollAttachParams)

src/Dodge/Creature/Impulse/UseItem.hs

@@ -25,7 +25,7 @@ import qualified IntMapHelp as IM
 useRootItem :: Int -> World -> World
 useRootItem crid w = fromMaybe w $ do
     cr <- w ^? cWorld . lWorld . creatures . ix crid
-    itRef <- cr ^? crManipulation . manObject . imRootItem
+    itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
     it <- invRootTrees (_crInv cr) ^? ix itRef
     return $
         itemUseEffect' cr it w

src/Dodge/Creature/State.hs

@@ -166,7 +166,7 @@ invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr
 
 updateHeldRootItem :: Creature -> World -> World
 updateHeldRootItem cr = fromMaybe id $ do
-    invid <- cr ^? crManipulation . manObject . imRootItem
+    invid <- cr ^? crManipulation . manObject . imRootSelectedItem
     itmtree <- invRootTrees (_crInv cr) ^? ix invid
     return $ updateAttachedItems itmtree cr
 

src/Dodge/Creature/Statistics.hs

@@ -38,6 +38,6 @@ strFromHeldItem :: Creature -> Int
 strFromHeldItem cr
 --x---    | _posture (_crStance cr) == Aiming || crIsReloading cr = negate $ fromMaybe 0 $ do
     | _posture (_crStance cr) == Aiming = negate $ fromMaybe 0 $ do
-        i <- cr ^? crManipulation . manObject . imRootItem
+        i <- cr ^? crManipulation . manObject . imRootSelectedItem
         cr ^? crInv . ix i . itUse . heldAim . aimWeight
     | otherwise = 0

src/Dodge/Creature/Test.hs

@@ -86,12 +86,10 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
 --crCanShoot cr = crIsAiming cr && crWeaponReady cr
 
 crInAimStance :: AimStance -> Creature -> Bool
-crInAimStance as cr =
+crInAimStance as cr = crIsAiming cr && mitstance == Just as
-    crIsAiming cr
-        && mitstance == Just as
   where
     mitstance = do
-        i <- cr ^? crManipulation . manObject . imRootItem
+        i <- cr ^? crManipulation . manObject . imRootSelectedItem
         cr ^? crInv . ix i . itUse . heldAim . aimStance
 
 oneH :: Creature -> Bool

src/Dodge/Creature/YourControl.hs

@@ -114,7 +114,7 @@ wasdAim inp cam cr
 wasdTwist :: Creature -> Creature
 wasdTwist cr
     | _posture (_crStance cr) == Aiming = fromMaybe cr $ do
-        itRef <- cr ^? crManipulation . manObject . imRootItem
+        itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
         astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
         case (astance, cr ^. crTwist) of
             (TwoHandUnder, 0) ->
@@ -144,7 +144,7 @@ aimTurn :: Float -> Creature -> Creature
 aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
   where
     x = fromMaybe 1 $ do
-        itRef <- cr ^? crManipulation . manObject . imRootItem
+        itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
         cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
 
 {- | Set posture according to mouse presses.

src/Dodge/Data/Item/Use/Consumption/LoadAction.hs

@@ -22,7 +22,7 @@ data ManipulatedObject
     = SortInventory
     | SelectedItem 
         { _imSelectedItem :: Int
-        , _imRootItem :: Int
+        , _imRootSelectedItem :: Int
         , _imAttachedItems :: IS.IntSet
         }    
     | SelNothing

src/Dodge/HeldUse.hs

@@ -477,7 +477,7 @@ shootTeslaArc itm cr mz w =
         & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
   where
     -- use items item location instead
-    itRef = cr ^?! crManipulation . manObject . imRootItem -- unsafe!! TODO change
+    itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change
     (w', ip) = makeTeslaArc (_itParams itm) pos dir w
     pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
     dir = _crDir cr + _mzRot mz

src/Dodge/Inventory.hs

@@ -17,6 +17,7 @@ module Dodge.Inventory (
     isFilteringInv,
 ) where
 
+import Dodge.SoundLogic
 import Control.Applicative
 import Data.Maybe
 import Dodge.Base
@@ -188,7 +189,8 @@ swapInvItems f i w = fromMaybe w $ do
             Just (0, j) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
             _ -> id
     return $
-        w & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
+        w & checkdisconnect k
+            & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
             & updateselection
             & worldEventFlags . at InventoryChange ?~ ()
             & cWorld . lWorld %~ crUpdateItemLocations 0
@@ -196,6 +198,13 @@ swapInvItems f i w = fromMaybe w $ do
             & cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
             -- a rethink is maybe in order
   where
+    cpos = fromMaybe 0 $ w ^? cWorld . lWorld . creatures . ix 0 . crPos
+    checkdisconnect k
+        | a || b = soundStart InventorySound cpos disconnectItemS Nothing
+        | otherwise = id
+      where
+        a = maybe False not $ w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix i . itLocation . ilIsRoot
+        b = maybe False not $ w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix k . itLocation . ilIsRoot
     updatecreature k =
         (crInv %~ IM.safeSwapKeys i k)
             . (crManipulation . manObject . imSelectedItem .~ k)

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

src/Dodge/Item/Draw.hs

@@ -17,6 +17,7 @@ import ShapePicture
 itemEquipPict :: Creature -> LabelDoubleTree ItemLink ComposedItem -> SPic
 itemEquipPict cr itmtree = case itm ^. itUse of
     UseHeld{} | itm ^? itLocation . ilIsRoot == Just True 
+            && itm ^? itLocation . ilIsSelected == Just True
         -> overPosSP (heldItemOffset itm cr) (itemTreeSPic itmtree)
     ituse -> fromMaybe mempty $ do
         attachpos <- ituse ^? uequipEffect . eeAttachPos

src/Dodge/Item/Grammar.hs

@@ -206,7 +206,7 @@ invTrees' = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (fmap (\(x,
         fromMaybe (error "in invTrees try to get non-inventory item tree") $
             i ^? itLocation . ilInvID
 
--- returns an intmap with trees for root items, indexed by inventory position
+-- returns an intmap with trees for (only!) root items, indexed by inventory position
 invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
 invRootTrees = IM.fromDistinctAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT
   where

src/Dodge/Item/Location.hs

@@ -41,7 +41,7 @@ pointerYourSelectedItem f w = fromMaybe (pure w) $ do
 
 pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
 pointerYourRootItem f w = fromMaybe (pure w) $ do
-    itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootItem
+    itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
     Just $ pointerToItemLocation (InInv 0 itinvid True True True) f w
 
 pointerToItem ::

src/Dodge/TestString.hs

@@ -21,12 +21,8 @@ import Dodge.Data.Universe
 import qualified IntMapHelp as IM
 
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ u ^? uvWorld . hud . hudElement . diSelection . _Just
+testStringInit u = fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . each . itLocation . ilIsRoot
-    , show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
-    , show $ u ^? uvWorld . hud . hudElement . diMouseOver . _Just
-    , show $ fmap fst $ IM.lookupMin =<< (u ^? uvWorld . hud . hudElement . diSections . ix 0 . ssItems) 
 --    , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
-        ]
 --    <> [[toEnum (i+j * 32) | i <- [0..31]] | j <- [0..7]]
 --    <> map show (IM.elems (L.postscan (L.premap _siHeight L.sum)
 --        $ fromMaybe mempty $ u ^? uvWorld . hud . hudElement . diSections . sssSections . ix 0 . ssItems)