justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor initialising functions

Browse Source
This commit is contained in:
justin
2022-10-28 14:51:38 +01:00
parent 0150655c6d
commit 68c2a78f43
5 changed files with 223 additions and 202 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Location/Initialize.hs
+27 -24
View File
@@ -1,63 +1,66 @@
module Dodge.Item.Location.Initialize
( initSpecificCrItemLocations
, initItemLocations
)
where
import Dodge.Data.CWorld
import Dodge.Data.LWorld
import Control.Lens
import qualified IntMapHelp as IM
import Data.Traversable
initItemLocations :: CWorld -> CWorld
initItemLocations :: LWorld -> LWorld
initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
initCrsItemLocations :: CWorld -> CWorld
initCrsItemLocations w = w' & lWorld . creatures .~ newcreatures
initCrsItemLocations :: LWorld -> LWorld
initCrsItemLocations w = w' & creatures .~ newcreatures
where
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. lWorld . creatures)
(w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
initFlItemsLocations :: CWorld -> CWorld
initFlItemsLocations w = w' & lWorld . floorItems .~ newfloorItems
initFlItemsLocations :: LWorld -> LWorld
initFlItemsLocations w = w' & floorItems .~ newfloorItems
where
(w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. lWorld . floorItems)
(w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
initTusItemLocations :: CWorld -> CWorld
initTusItemLocations w = w' & lWorld . machines .~ newmachines
initTusItemLocations :: LWorld -> LWorld
initTusItemLocations w = w' & machines .~ newmachines
where
(w', newmachines) = mapAccumR initTuItemLocation w (w ^. lWorld . machines)
(w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
initSpecificCrItemLocations :: Int -> CWorld -> CWorld
initSpecificCrItemLocations crid w = w' & lWorld . creatures . ix crid .~ newcr
initSpecificCrItemLocations :: Int -> LWorld -> LWorld
initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
where
(w',newcr) = initCrItemLocations w (w ^?! lWorld . creatures . ix crid)
(w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
initCrItemLocations :: CWorld -> Creature -> (CWorld, Creature)
initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
initCrItemLocations w cr = (w', cr & crInv .~ newinv)
where
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
initCrItemLocation :: Creature -> Int -> CWorld -> Item -> (CWorld,Item)
initCrItemLocation cr invid w it = (w & lWorld . itemLocations . at locid ?~ loc
initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
,it & itID .~ locid
& itLocation .~ loc)
where
locid = IM.newKey ( w ^. lWorld . itemLocations)
locid = IM.newKey ( w ^. itemLocations)
loc = InInv (_crID cr) invid
initFlItemLocation :: CWorld -> FloorItem -> (CWorld, FloorItem)
initFlItemLocation w flit = (w & lWorld . itemLocations . at locid ?~ loc
initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
, flit & flIt . itID .~ locid
& flIt . itLocation .~ loc
)
where
locid = IM.newKey (w ^. lWorld . itemLocations )
locid = IM.newKey (w ^. itemLocations )
loc = OnFloor (_flItID flit)
initTuItemLocation :: CWorld -> Machine -> (CWorld, Machine)
initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
Nothing -> (w, mc)
Just _ ->
let locid = IM.newKey ( w ^. lWorld . itemLocations)
let locid = IM.newKey ( w ^. itemLocations)
loc = OnTurret (_mcID mc)
in ( w & lWorld . itemLocations . at locid ?~ loc
in ( w & itemLocations . at locid ?~ loc
, mc & mcType . _McTurret . tuWeapon . itID .~ locid
& mcType . _McTurret . tuWeapon . itLocation .~ loc
)