Fix bugs in item locations

src/Dodge/Inventory.hs

@@ -4,7 +4,6 @@ module Dodge.Inventory (
     rmSelectedInvItem,
     rmInvItem,
     updateCloseObjects,
-    --closeObjScrollDir,
     changeSwapSel,
     scrollAugInvSel,
     crNumFreeSlots,
@@ -14,7 +13,7 @@ module Dodge.Inventory (
     module Dodge.Inventory.RBList
 ) where
 
-import Dodge.Inventory.FindRoot
+import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
 import Control.Applicative
 import Data.Maybe
@@ -62,7 +61,7 @@ rmInvItem cid invid w = w
             & updateselection
             & pointcid %~ updateRootItemID
             & worldEventFlags . at InventoryChange ?~ ()
-            & updateCreatureItemLocations cid
+--            & updateCreatureItemLocations cid
   where
     pointcid = cWorld . lWorld . creatures . ix cid
 
@@ -95,14 +94,14 @@ rmInvItem cid invid w = w
         | x > invid || Just x == maxk = max 0 $ x - 1
         | otherwise = x
 
-updateCreatureItemLocations :: Int -> World -> World
-updateCreatureItemLocations crid w = fromMaybe w $ do
-    inv <- w ^? cWorld . lWorld . creatures . ix crid . crInv
-    return $ foldl' updateItemLocation w inv
-
-updateItemLocation :: World -> Item -> World
-updateItemLocation w itm = w
-    & cWorld . lWorld . itemLocations . ix (itm ^. itID) .~ itm ^. itLocation
+--updateCreatureItemLocations :: Int -> World -> World
+--updateCreatureItemLocations crid w = fromMaybe w $ do
+--    inv <- w ^? cWorld . lWorld . creatures . ix crid . crInv
+--    return $ foldl' updateItemLocation w inv
+--
+--updateItemLocation :: World -> Item -> World
+--updateItemLocation w itm = w
+--    & cWorld . lWorld . itemLocations . ix (itm ^. itID) .~ itm ^. itLocation
 
 ---- | after this the item at the inventory position will no longer exist
 --rmInvItem ::
@@ -202,18 +201,11 @@ updateCloseObjects w =
     updatebyid (Left flid) = fmap Left $ w ^? cWorld . lWorld . floorItems . ix (_flItID flid)
     updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
 
-
---closeObjScrollDir :: Float -> World -> World
---closeObjScrollDir x
---    | x > 0 = over (hud . closeObjects) rotU
---    | x < 0 = over (hud . closeObjects) rotD
---    | otherwise = id
-
 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w
     | yi == 0 = w
-    | yi > 0 = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
-    | otherwise = foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT)
+    | yi > 0 = (foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT))
+    | otherwise = (foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT))
   where
     f g i m = fst <$> g i m
 
@@ -243,17 +235,16 @@ changeSwapInv f i w = fromMaybe w $ do
     k <- f i ss
     return $
         w & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
-            & cWorld . lWorld . creatures . ix 0 %~ updateRootItemID
+--            & cWorld . lWorld . creatures . ix 0 %~ updateRootItemID
             & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
             & worldEventFlags . at InventoryChange ?~ ()
+        & cWorld . lWorld %~ crUpdateItemLocations 0
+             & setInvPosFromSS
+        & cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
+    -- a rethink is maybe in order
   where
---    updateLeftInvSel k li
---        | i == li = k
---        | k == li = i
---        | otherwise = li
     updatecreature k =
         (crInv %~ IM.safeSwapKeys i k)
---            . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
             . (crManipulation . manObject . inInventory . imSelectedItem .~ k)
             . (crInvEquipped %~ IM.safeSwapKeys i k)
             . swapSite i k
@@ -282,24 +273,7 @@ scrollAugInvSel yi w
         w & hud . hudElement . diSections %~ scrollSelectionSections yi
             & worldEventFlags . at InventoryChange ?~ ()
             & setInvPosFromSS
-
-setInvPosFromSS :: World -> World
-setInvPosFromSS w =
-    w
-        & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
-  where
-    thesel = fromMaybe SelNothing $ do
-        sss <- w ^? hud . hudElement . diSections
-        (i, j) <- sss ^? sssExtra . sssSelPos . _Just
-        case i of
-            (-1) -> Just $ InInventory SortInventory
-            --0 -> Just $ InInventory (SelItem j (getRootItemID i (you w)))
-            0 -> Just $ InInventory (SelectedItem j (getRootItemID j (you w)))
-            1 -> Just SelNothing
-            2 -> Just $ InNearby SortNearby
-            3 -> Just $ InNearby $ SelCloseObject j
-            _ -> error "selection out of bounds"
-
+            & cWorld . lWorld %~ crUpdateItemLocations 0
 
 
 selectedCloseObject :: World -> Maybe (Either FloorItem Button)