75 lines
2.5 KiB
Haskell
75 lines
2.5 KiB
Haskell
module Dodge.Item.Location.Initialize
|
|
( initSpecificCrItemLocations
|
|
, initItemLocations
|
|
)
|
|
where
|
|
import NewInt
|
|
import Dodge.Data.LWorld
|
|
import Control.Lens
|
|
import qualified IntMapHelp as IM
|
|
import Data.Traversable
|
|
|
|
initItemLocations :: LWorld -> LWorld
|
|
initItemLocations = initCrsItemLocations . initFlItemsLocations . 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)
|
|
|
|
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
|
|
where
|
|
(w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
|
|
|
|
initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
|
|
initCrItemLocations w cr = (w', cr & crInv .~ newinv)
|
|
where
|
|
(w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
|
|
|
|
-- does not worry about creature manipulation for now
|
|
initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
|
|
initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
|
|
,it & itID .~ NInt locid
|
|
& itLocation .~ loc)
|
|
where
|
|
locid = IM.newKey ( w ^. itemLocations)
|
|
loc = InInv
|
|
{ _ilCrID = _crID cr
|
|
, _ilInvID = invid
|
|
, _ilIsRoot = False
|
|
, _ilIsSelected = False
|
|
, _ilIsAttached = False
|
|
}
|
|
|
|
|
|
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
|
|
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
|
|
)
|