124 lines
4.6 KiB
Haskell
124 lines
4.6 KiB
Haskell
module Dodge.Inventory.Location (
|
|
updateRootItemID,
|
|
crUpdateItemLocations,
|
|
setInvPosFromSS,
|
|
) where
|
|
|
|
import Dodge.Item.AimStance
|
|
import Control.Lens
|
|
import Data.Foldable
|
|
--import Data.IntMap.Merge.Strict
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Dodge.Base.You
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
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 ::
|
|
NewInt InvInt ->
|
|
NewIntMap InvInt Item ->
|
|
Maybe (Int, IS.IntSet)
|
|
tryGetRootAttachedFromInvID (NInt 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 . unNInt)) t)
|
|
|
|
-- this assumes the creature inventory is well formed, specifically the
|
|
-- location ids
|
|
-- note the item intmap is all items
|
|
getRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Int
|
|
getRootItemInvID m i cr = fromMaybe i $ do
|
|
let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
|
|
theroot <- adj ^? ix i
|
|
theroot ^? _1 . _Just . _1
|
|
|
|
updateRootItemID :: IM.IntMap Item -> Creature -> Creature
|
|
updateRootItemID m cr = fromMaybe cr $ do
|
|
i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
|
|
let j = getRootItemInvID m i cr
|
|
return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt 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
|
|
cinv <- lw ^? creatures . ix crid . crInv
|
|
let crinv = fmap (\k -> lw ^?! items . ix k) cinv
|
|
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv
|
|
|
|
crSetRoots :: Int -> LWorld -> LWorld
|
|
crSetRoots cid w = fromMaybe w $ do
|
|
inv <- w ^? creatures . ix cid . crInv
|
|
let cinv = invIMDT $ fmap (\i -> w ^?! items . ix i) inv
|
|
return $ foldl' f (foldl' g w inv) cinv
|
|
where
|
|
g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False
|
|
f :: LWorld -> DTree OItem -> LWorld
|
|
f w' x =
|
|
w' & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
|
|
|
|
crUpdateInvidLocations ::
|
|
ManipulatedObject ->
|
|
Int ->
|
|
LWorld ->
|
|
Int ->
|
|
Item ->
|
|
LWorld
|
|
crUpdateInvidLocations mo crid lw invid itm =
|
|
lw
|
|
& creatures . ix crid . crInv . ix (NInt invid) .~ itid
|
|
& items . ix itid .~ (itm & itLocation .~ newloc)
|
|
where
|
|
itid = itm ^. itID . unNInt
|
|
newloc =
|
|
InInv
|
|
{ _ilCrID = crid
|
|
, _ilInvID = NInt invid
|
|
, _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem
|
|
, _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem
|
|
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
|
|
, _ilEquipSite = lw ^? items . ix itid . 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
|
|
--Sel i j _ <- w ^? hud . diSelection . _Just
|
|
Sel i j <- w ^? hud . diSelection . _Just
|
|
case i of
|
|
(-1) -> Just SortInventory
|
|
0 -> do
|
|
(rootid, aset) <-
|
|
tryGetRootAttachedFromInvID
|
|
(NInt j)
|
|
( fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $
|
|
you w ^. crInv
|
|
)
|
|
dt <- invIMDT ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> you w ^. crInv) ^? ix rootid
|
|
-- there is redundancy above
|
|
return
|
|
SelectedItem
|
|
{ _imSelectedItem = NInt j
|
|
, _imRootSelectedItem = NInt rootid
|
|
, _imAimStance = itemAimStance ((\(x,y,_) -> (x,y)) <$> dt)
|
|
, _imAttachedItems = aset
|
|
}
|
|
1 -> Just SelNothing
|
|
2 -> Just SortCloseItem
|
|
3 -> Just $ SelCloseItem j
|
|
4 -> Just SortCloseButton
|
|
5 -> Just $ SelCloseButton j
|
|
_ -> error "selection out of bounds"
|