120 lines
4.9 KiB
Haskell
120 lines
4.9 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 -> World -> World
|
|
updateRootItemID m cr w = fromMaybe w $ do
|
|
Sel 0 i <- w^?hud.diSelection._Just
|
|
--revise2 i <- w^?hud . manObject . imSelectedItem . unNInt
|
|
let j = getRootItemInvID m i cr
|
|
return $ w & hud . manObject . imRootSelectedItem .~ NInt j
|
|
|
|
-- the following assumes that the crManipulation is correct
|
|
crUpdateItemLocations :: Int -> World -> World
|
|
crUpdateItemLocations crid lw = fromMaybe lw $ do
|
|
mo <- lw ^? hud . manObject
|
|
cinv <- lw ^? cWorld.lWorld.creatures . ix crid . crInv
|
|
let crinv = fmap (\k -> lw ^?! cWorld.lWorld.items . ix k) cinv
|
|
return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv
|
|
|
|
crSetRoots :: Int -> World -> World
|
|
crSetRoots cid w = fromMaybe w $ do
|
|
inv <- w ^? cWorld .lWorld. creatures . ix cid . crInv
|
|
let cinv = invIMDT $ fmap (\i -> w ^?! cWorld.lWorld.items . ix i) inv
|
|
return $ foldl' f (foldl' g w inv) cinv
|
|
where
|
|
g w' i = w' &cWorld.lWorld.items . ix i . itLocation . ilIsRoot .~ False
|
|
f :: World -> DTree OItem -> World
|
|
f w' x =
|
|
w' &cWorld.lWorld.items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
|
|
|
|
crUpdateInvidLocations :: ManipulatedObject -> Int -> World -> Int -> Item -> World
|
|
crUpdateInvidLocations mo crid lw invid itm =
|
|
lw
|
|
&cWorld.lWorld.creatures . ix crid . crInv . ix (NInt invid) .~ itid
|
|
&cWorld.lWorld.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) == lw ^? hud.diSelection._Just.slInt.to NInt -- this may match with the wrong sections, not sure if this is possible
|
|
--revise1 , _ilIsSelected = Just (NInt i2vid) == mo ^? imSelectedItem
|
|
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
|
|
, _ilEquipSite = lw ^? cWorld .lWorld. items . ix itid . itLocation . ilEquipSite . _Just
|
|
--revise1 , _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 &hud . manObject .~ thesel
|
|
--revise1 & 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
|
|
{ _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"
|