Start refactor storing items in single intmap, done turrets

More checks required
This commit is contained in:
2025-08-24 11:53:21 +01:00
parent 7336177edf
commit c38d03165f
22 changed files with 642 additions and 269 deletions
+2 -2
View File
@@ -37,7 +37,7 @@ pointerYourRootItem f w = fromMaybe (pure w) $ do
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
OnTurret _ -> cWorld . lWorld . items . ix (x ^. itID . unNInt)
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
@@ -46,6 +46,6 @@ pointerToItemID itid f w = fromMaybe (pure w) $ do
itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
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
OnTurret _ -> cWorld . lWorld . items . ix (itid ^. unNInt)
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
+15 -15
View File
@@ -11,7 +11,7 @@ import Data.Traversable
initItemLocations :: LWorld -> LWorld
--initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
initItemLocations = initCrsItemLocations . initTusItemLocations
initItemLocations = initCrsItemLocations -- . initTusItemLocations
initCrsItemLocations :: LWorld -> LWorld
initCrsItemLocations w = w' & creatures .~ newcreatures
@@ -23,10 +23,10 @@ initCrsItemLocations w = w' & creatures .~ newcreatures
-- where
-- (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
initTusItemLocations :: LWorld -> LWorld
initTusItemLocations w = w' & machines .~ newmachines
where
(w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
--initTusItemLocations :: LWorld -> LWorld
--initTusItemLocations w = w' & machines .~ newmachines
-- where
-- (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
initSpecificCrItemLocations :: Int -> LWorld -> LWorld
initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
@@ -64,13 +64,13 @@ initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
-- locid = IM.newKey (w ^. itemLocations )
-- loc = OnFloor (_flItID flit)
initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
Nothing -> (w, mc)
Just _ ->
let locid = IM.newKey ( w ^. itemLocations)
loc = OnTurret (_mcID mc)
in ( w & itemLocations . at locid ?~ loc
, mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
& mcType . _McTurret . tuWeapon . itLocation .~ loc
)
--initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
--initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
-- Nothing -> (w, mc)
-- Just _ ->
-- let locid = IM.newKey ( w ^. itemLocations)
-- loc = OnTurret (_mcID mc)
-- in ( w & itemLocations . at locid ?~ loc
-- , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
-- & mcType . _McTurret . tuWeapon . itLocation .~ loc
-- )