91 lines
3.3 KiB
Haskell
91 lines
3.3 KiB
Haskell
module Dodge.Inventory.Location (
|
|
updateRootItemID,
|
|
crUpdateItemLocations,
|
|
setInvPosFromSS,
|
|
) where
|
|
|
|
import Control.Applicative
|
|
import Control.Lens
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Dodge.Base.You
|
|
import Dodge.Data.Item.Use.Consumption.LoadAction
|
|
import Dodge.Data.SelectionList
|
|
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 = case invAdj (_crInv cr) of
|
|
Left str -> error $ "tryToGetRootItemInvID: " ++ str
|
|
Right x -> x
|
|
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 . imRootItem .~ 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 $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
|
|
|
|
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 ^? imRootItem
|
|
, _ilIsSelected = Just invid == mo ^? imSelectedItem
|
|
, _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
|
|
}
|
|
|
|
-- 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
|
|
sss <- w ^? hud . hudElement . diSections
|
|
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
|
|
case i of
|
|
(-1) -> Just SortInventory
|
|
0 -> do
|
|
(rootid, aset) <- tryGetRootAttachedFromInvID j (you w ^. crInv)
|
|
return
|
|
SelectedItem
|
|
{ _imSelectedItem = j
|
|
, _imRootItem = rootid
|
|
, _imAttachedItems = aset
|
|
}
|
|
1 -> Just SelNothing
|
|
2 -> Just SortNearby
|
|
3 -> Just $ SelCloseObject j
|
|
_ -> error "selection out of bounds"
|