Refactor floor items, removing ids (not fully checked)

src/Dodge/Item/Location.hs

@@ -1,6 +1,6 @@
 module Dodge.Item.Location (
     pointerToItemID,
-    pointerToItemLocation,
+    --pointerToItemLocation,
     pointerToItem,
     pointerYourSelectedItem,
     pointerYourRootItem,
@@ -11,42 +11,41 @@ import Control.Lens
 import Data.Maybe
 import Dodge.Data.World
 
-pointerToItemLocation ::
-    Applicative f =>
-    ItemLocation ->
-    (Item -> f Item) ->
-    World ->
-    f World
-pointerToItemLocation InInv {_ilCrID = cid, _ilInvID = invid} 
-        = cWorld . lWorld . creatures . ix cid . crInv . ix invid
-pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flid) . flIt
-pointerToItemLocation _ = const pure
+--pointerToItemLocation ::
+--    Applicative f =>
+--    ItemLocation ->
+--    (Item -> f Item) ->
+--    World ->
+--    f World
+--pointerToItemLocation InInv {_ilCrID = cid, _ilInvID = invid} 
+--        = cWorld . lWorld . creatures . ix cid . crInv . ix invid
+--pointerToItemLocation (OnFloor) = \f w -> 
+----    cWorld . lWorld . floorItems . ix (_unNInt flid) . flIt
+--pointerToItemLocation _ = const pure
 
 pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
 pointerYourSelectedItem f w = fromMaybe (pure w) $ do
     itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
-    Just $ pointerToItemLocation (InInv 0 itinvid True True True Nothing) f w
+    Just $ (cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid) f w
     -- note the ilIsRoot/Selected/Attached booleans are irrelevant
 
 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 . imRootSelectedItem
-    Just $ pointerToItemLocation (InInv 0 itinvid True True True Nothing) f w
+    Just $ (cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid) f w
 
-pointerToItem ::
-    Applicative f =>
-    Item ->
-    (Item -> f Item) ->
-    World ->
-    f World
-pointerToItem = pointerToItemLocation . _itLocation
+pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
+pointerToItem x = case x ^. itLocation of
+    OnFloor -> cWorld . lWorld . floorItems . ix (x ^. itID . unNInt) . flIt
+    OnTurret tid -> cWorld . lWorld . machines . ix tid . mcType . mctTurret . tuWeapon
+    InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
+    InVoid -> const pure
 
-pointerToItemID :: 
-    Applicative f =>
-    NewInt ItmInt ->
-    (Item -> f Item) ->
-    World ->
-    f World
+pointerToItemID :: Applicative f => NewInt ItmInt -> (Item -> f Item) -> World -> f World
 pointerToItemID itid f w = fromMaybe (pure w) $ do
     itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
-    return $ pointerToItemLocation itloc f w
+    return $ (\x -> x f w) $ case itloc of
+        OnFloor -> cWorld . lWorld . floorItems . ix (_unNInt itid) . flIt
+        OnTurret tid -> cWorld . lWorld . machines . ix tid . mcType . mctTurret . tuWeapon
+        InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
+        InVoid -> const pure

src/Dodge/Item/Location/Initialize.hs

@@ -10,17 +10,18 @@ import qualified IntMapHelp as IM
 import Data.Traversable
 
 initItemLocations :: LWorld -> LWorld
-initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
+--initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
+initItemLocations = initCrsItemLocations . initTusItemLocations
 
 initCrsItemLocations :: LWorld -> LWorld
 initCrsItemLocations w = w' & creatures .~ newcreatures
   where
     (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
 
-initFlItemsLocations :: LWorld -> LWorld
-initFlItemsLocations w = w' & floorItems .~ NIntMap newfloorItems
-  where
-    (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems . unNIntMap)
+--initFlItemsLocations :: LWorld -> LWorld
+--initFlItemsLocations w = w' & floorItems .~ newfloorItems
+--  where
+--    (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
 
 initTusItemLocations :: LWorld -> LWorld
 initTusItemLocations w = w' & machines .~ newmachines
@@ -54,14 +55,14 @@ initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
             }
 
 
-initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
-initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
-    , flit & flIt . itID .~ NInt locid
-        & flIt . itLocation .~ loc
-    )
-  where
-    locid = IM.newKey (w ^. itemLocations )
-    loc = OnFloor (_flItID flit)
+--initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
+--initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
+--    , flit & flIt . itID .~ NInt locid
+--        & flIt . itLocation .~ loc
+--    )
+--  where
+--    locid = IM.newKey (w ^. itemLocations )
+--    loc = OnFloor (_flItID flit)
 
 initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
 initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of