64 lines
2.2 KiB
Haskell
64 lines
2.2 KiB
Haskell
module Dodge.Item.Location.Initialize
|
|
where
|
|
import Dodge.Data.CWorld
|
|
import Control.Lens
|
|
import qualified IntMapHelp as IM
|
|
import Data.Traversable
|
|
|
|
initItemLocations :: CWorld -> CWorld
|
|
initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
|
|
|
|
initCrsItemLocations :: CWorld -> CWorld
|
|
initCrsItemLocations w = w' & creatures .~ newcreatures
|
|
where
|
|
(w', newcreatures) = mapAccumR initCrItemLocations w (_creatures w)
|
|
|
|
initFlItemsLocations :: CWorld -> CWorld
|
|
initFlItemsLocations w = w' & floorItems .~ newfloorItems
|
|
where
|
|
(w', newfloorItems) = mapAccumR initFlItemLocation w (_floorItems w)
|
|
|
|
initTusItemLocations :: CWorld -> CWorld
|
|
initTusItemLocations w = w' & machines .~ newmachines
|
|
where
|
|
(w', newmachines) = mapAccumR initTuItemLocation w (_machines w)
|
|
|
|
initSpecificCrItemLocations :: Int -> CWorld -> CWorld
|
|
initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
|
|
where
|
|
(w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
|
|
|
|
initCrItemLocations :: CWorld -> Creature -> (CWorld, 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 & itemLocations . at locid ?~ loc
|
|
,it & itID .~ locid
|
|
& itLocation .~ loc)
|
|
where
|
|
locid = IM.newKey (_itemLocations w)
|
|
loc = InInv (_crID cr) invid
|
|
|
|
|
|
initFlItemLocation :: CWorld -> FloorItem -> (CWorld, FloorItem)
|
|
initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
|
|
, flit & flIt . itID .~ locid
|
|
& flIt . itLocation .~ loc
|
|
)
|
|
where
|
|
locid = IM.newKey (_itemLocations w)
|
|
loc = OnFloor (_flItID flit)
|
|
|
|
initTuItemLocation :: CWorld -> Machine -> (CWorld, Machine)
|
|
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
|
|
Nothing -> (w, mc)
|
|
Just _ ->
|
|
let locid = IM.newKey (_itemLocations w)
|
|
loc = OnTurret (_mcID mc)
|
|
in ( w & itemLocations . at locid ?~ loc
|
|
, mc & mcType . _McTurret . tuWeapon . itID .~ locid
|
|
& mcType . _McTurret . tuWeapon . itLocation .~ loc
|
|
)
|