105 lines
3.8 KiB
Haskell
105 lines
3.8 KiB
Haskell
module Dodge.Inventory.Location (
|
|
updateRootItemID,
|
|
crUpdateItemLocations,
|
|
setInvPosFromSS,
|
|
) where
|
|
|
|
import Control.Applicative
|
|
import Control.Lens
|
|
import Data.IntMap.Merge.Strict
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Dodge.Base.You
|
|
import Dodge.Data.Item.Use.Consumption.LoadAction
|
|
import Dodge.Data.World
|
|
import Dodge.Item.Grammar
|
|
import qualified IntMapHelp as IM
|
|
import NewInt
|
|
|
|
-- assumes all item locations inside the items are correct
|
|
tryGetRootAttachedFromInvID :: Int -> IM.IntMap Item -> Maybe (Int, IS.IntSet)
|
|
tryGetRootAttachedFromInvID invid im = do
|
|
let imroots = invRootMap im
|
|
theroot = fromMaybe invid $ imroots ^? ix invid . _1 . _Just
|
|
t <- imroots ^? ix theroot . _2
|
|
return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID)) t)
|
|
|
|
-- this assumes the creature inventory is well formed, specifically the
|
|
-- location ids
|
|
tryGetRootItemInvID :: Int -> Creature -> Maybe Int
|
|
tryGetRootItemInvID i cr = do
|
|
let adj = invAdj (_crInv cr)
|
|
theroot <- adj ^? ix i
|
|
theroot ^? _1 . _Just . _1 <|> Just i
|
|
|
|
updateRootItemID :: Creature -> Creature
|
|
updateRootItemID cr = fromMaybe cr $ do
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem
|
|
j <- tryGetRootItemInvID i cr
|
|
return $ cr & crManipulation . manObject . imRootSelectedItem .~ j
|
|
|
|
-- the following assumes that the crManipulation is correct
|
|
crUpdateItemLocations :: Int -> LWorld -> LWorld
|
|
crUpdateItemLocations crid lw = fromMaybe lw $ do
|
|
mo <- lw ^? creatures . ix crid . crManipulation . manObject
|
|
crinv <- lw ^? creatures . ix crid . crInv
|
|
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
|
|
|
|
crSetRoots :: Int -> LWorld -> LWorld
|
|
crSetRoots cid w = fromMaybe w $ do
|
|
inv <- w ^? creatures . ix cid . crInv
|
|
return $
|
|
w & creatures . ix cid . crInv
|
|
%~ merge
|
|
dropMissing
|
|
preserveMissing
|
|
(zipWithMatched f)
|
|
(invIMDT inv)
|
|
where
|
|
f _ _ = itLocation . ilIsRoot .~ True
|
|
|
|
crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
|
|
crUpdateInvidLocations mo crid lw invid itm =
|
|
lw
|
|
& creatures . ix crid . crInv . ix invid . itLocation .~ newloc
|
|
& itemLocations %~ IM.insert itid newloc
|
|
where
|
|
itid = itm ^. itID . unNInt
|
|
newloc =
|
|
InInv
|
|
{ _ilCrID = crid
|
|
, _ilInvID = invid
|
|
, _ilIsRoot = Just invid == mo ^? imRootSelectedItem
|
|
, _ilIsSelected = Just invid == mo ^? imSelectedItem
|
|
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
|
|
, _ilEquipSite = lw ^? creatures . ix crid . crInv . ix invid
|
|
. itLocation . ilEquipSite . _Just
|
|
}
|
|
|
|
-- this should be looked at, as it is sometimes used in functions that need not
|
|
-- concern the player creature
|
|
-- this might not work if the selpos is in the inventory but too large
|
|
setInvPosFromSS :: World -> World
|
|
setInvPosFromSS w =
|
|
w
|
|
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
|
|
where
|
|
thesel = fromMaybe SelNothing $ do
|
|
(i, j, _) <- w ^? hud . hudElement . diSelection . _Just
|
|
case i of
|
|
(-1) -> Just SortInventory
|
|
0 -> do
|
|
(rootid, aset) <- tryGetRootAttachedFromInvID j (you w ^. crInv)
|
|
return
|
|
SelectedItem
|
|
{ _imSelectedItem = j
|
|
, _imRootSelectedItem = rootid
|
|
, _imAttachedItems = aset
|
|
}
|
|
1 -> Just SelNothing
|
|
2 -> Just SortCloseItem
|
|
3 -> Just $ SelCloseItem j
|
|
4 -> Just SortCloseButton
|
|
5 -> Just $ SelCloseButton j
|
|
_ -> error "selection out of bounds"
|