234 lines
8.2 KiB
Haskell
234 lines
8.2 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Inventory (
|
|
rmInvItem,
|
|
destroyInvItem,
|
|
updateCloseObjects,
|
|
changeSwapSel,
|
|
invSetSelection,
|
|
invSetSelectionPos,
|
|
scrollAugInvSel,
|
|
crNumFreeSlots,
|
|
setInvPosFromSS,
|
|
module Dodge.Inventory.RBList,
|
|
swapInvItems,
|
|
scrollAugNextInSection,
|
|
swapItemWith,
|
|
destroyItem,
|
|
destroyAllInvItems,
|
|
) where
|
|
|
|
import Data.Function
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.World
|
|
import Dodge.Equipment
|
|
import Dodge.Inventory.CheckSlots
|
|
import Dodge.Inventory.Location
|
|
import Dodge.Inventory.RBList
|
|
import Dodge.Inventory.Swap
|
|
import Dodge.SelectionSections
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import ListHelp
|
|
import NewInt
|
|
|
|
-- TODO check what happens to selection index when dropping non-selected items
|
|
|
|
-- should consider never fully destroying items, but assigning a flag saying how
|
|
-- they were moved from play
|
|
destroyInvItem :: Int -> Int -> World -> World
|
|
destroyInvItem cid invid w =
|
|
rmInvItem cid invid w & removeitloc
|
|
& removeithotkey
|
|
where
|
|
removeitloc = fromMaybe id $ do
|
|
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
|
|
return $ cWorld . lWorld . itemLocations . at itid .~ Nothing
|
|
removeithotkey = fromMaybe id $ do
|
|
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
|
|
hk <- w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid
|
|
return $
|
|
(cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
|
|
. (cWorld . lWorld . hotkeys . at hk .~ Nothing)
|
|
|
|
destroyAllInvItems :: Creature -> World -> World
|
|
destroyAllInvItems cr w =
|
|
foldl' (flip $ destroyInvItem (cr ^. crID)) w
|
|
. reverse
|
|
. IM.keys
|
|
$ cr ^. crInv
|
|
|
|
destroyItem :: Int -> World -> World
|
|
destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
|
|
Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
|
|
Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
|
|
Just OnTurret{} -> error "need to write code for destroying items on turrets"
|
|
Just (OnFloor (NInt i)) ->
|
|
w & cWorld . lWorld . itemLocations . at itid .~ Nothing
|
|
& cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
|
|
Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
|
|
|
|
-- note rmInvItem does not fully destroy the item, other updates to the item
|
|
-- location are required
|
|
rmInvItem :: Int -> Int -> World -> World
|
|
rmInvItem cid invid w =
|
|
w
|
|
& dounequipfunction --the ordering of these is
|
|
& pointcid . crInv %~ f -- important
|
|
& removeAnySlotEquipment
|
|
& pointcid . crEquipment . each %~ g
|
|
& updateselection
|
|
& updateselectionextra
|
|
& pointcid %~ updateRootItemID
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
where
|
|
pointcid = cWorld . lWorld . creatures . ix cid
|
|
updateselectionextra
|
|
| cid == 0 = hud . hudElement . diSelection . _Just . _3 %~ const mempty
|
|
| otherwise = id
|
|
updateselection
|
|
| cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
|
|
scrollAugInvSel (-1) . scrollAugInvSel 1
|
|
| otherwise =
|
|
pointcid . crManipulation . manObject . imSelectedItem %~ g
|
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
|
itm = _crInv cr IM.! invid
|
|
dounequipfunction = effectOnRemove itm cr
|
|
-- fromMaybe id $ do
|
|
-- rmf <- itm ^? itUse . uequipEffect . eeOnRemove
|
|
-- return $ doItmCrWdWd rmf itm cr
|
|
removeAnySlotEquipment = fromMaybe id $ do
|
|
epos <-
|
|
w
|
|
^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
|
|
. itLocation
|
|
. ilEquipSite
|
|
. _Just
|
|
return $ pointcid . crEquipment . at epos .~ Nothing
|
|
maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
|
|
f inv =
|
|
let (xs, ys) = IM.split invid inv
|
|
in xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
|
|
-- the following might not work if a non-player creature drops their last item
|
|
g x
|
|
| x > invid || Just x == maxk = max 0 $ x - 1
|
|
| otherwise = x
|
|
|
|
updateCloseObjects :: World -> World
|
|
updateCloseObjects w =
|
|
w & hud . closeItems %~ f
|
|
& hud . closeButtons %~ g
|
|
where
|
|
g oldbts = intersect oldbts cbts `union` cbts
|
|
f olditems = intersect olditems citems `union` citems
|
|
lw = w ^. cWorld . lWorld
|
|
citems = lw^..floorItems . unNIntMap . each . filtered (isclose . _flItPos) . to _flItID
|
|
isclose x = dist y x < 40 && hasButtonLOS y x w
|
|
y = _crPos $ you w
|
|
cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
|
|
canpress bt = case bt ^. btEvent of
|
|
ButtonPress{_btOn = t} -> not t
|
|
ButtonAccessTerminal tid -> fromMaybe False $ do
|
|
x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
|
|
return (x /= TerminalDeactivated)
|
|
_ -> True
|
|
|
|
changeSwapSel :: Int -> World -> World
|
|
changeSwapSel yi w
|
|
| yi >= 0 = foldl' (&) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
|
|
| otherwise = foldl' (&) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT)
|
|
where
|
|
f g i m = fst <$> g i m
|
|
|
|
changeSwapOther ::
|
|
((Int -> Identity Int) -> ManipulatedObject -> Identity ManipulatedObject) ->
|
|
Int ->
|
|
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
|
|
Int ->
|
|
World ->
|
|
World
|
|
changeSwapOther manlens n f i w = fromMaybe w $ do
|
|
ss <- w ^? hud . hudElement . diSections . ix n . ssItems
|
|
k <- f i ss
|
|
let doswap j
|
|
| j == i = k
|
|
| j == k = i
|
|
| otherwise = j
|
|
return $
|
|
w
|
|
& swapAnyExtraSelection i k
|
|
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens
|
|
%~ doswap
|
|
& hud . closeItems %~ swapIndices i k
|
|
& hud . hudElement . diSelection . _Just . _2 %~ doswap
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
|
|
swapItemWith ::
|
|
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
|
|
(Int, Int) ->
|
|
World ->
|
|
World
|
|
swapItemWith f (j, i) = case j of
|
|
0 -> swapInvItems f i
|
|
3 -> changeSwapOther ispCloseItem 3 f i
|
|
5 -> changeSwapOther ispCloseButton 5 f i
|
|
_ -> id
|
|
|
|
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
|
|
changeSwapWith f w
|
|
| Just (j,i,_) <- w ^. hud . hudElement . diSelection = swapItemWith f (j,i) w
|
|
| otherwise = w
|
|
|
|
--changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
|
|
--changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
|
|
-- Just (0, i, _) -> w & swapInvItems f i
|
|
-- Just (3, i, _) -> w & changeSwapOther ispCloseItem 3 f i
|
|
-- Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
|
|
-- _ -> w
|
|
|
|
invSetSelection :: (Int, Int, IS.IntSet) -> World -> World
|
|
invSetSelection sel w =
|
|
w
|
|
& hud . hudElement . diSelection ?~ sel
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& setInvPosFromSS
|
|
& cWorld . lWorld %~ crUpdateItemLocations 0
|
|
|
|
invSetSelectionPos :: Int -> Int -> World -> World
|
|
invSetSelectionPos i j w =
|
|
w
|
|
& hud . hudElement . diSelection %~ f
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& setInvPosFromSS
|
|
& cWorld . lWorld %~ crUpdateItemLocations 0
|
|
where
|
|
f Nothing = Just (i, j, mempty)
|
|
f (Just (_, _, s)) = Just (i, j, s)
|
|
|
|
scrollAugInvSel :: Int -> World -> World
|
|
scrollAugInvSel yi w
|
|
| yi == 0 = w
|
|
| otherwise =
|
|
w & hud . hudElement %~ doscroll
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& setInvPosFromSS
|
|
& cWorld . lWorld %~ crUpdateItemLocations 0
|
|
where
|
|
doscroll he = fromMaybe he $ do
|
|
sss <- he ^? diSections
|
|
return $ he & diSelection %~ scrollSelectionSections yi sss
|
|
|
|
scrollAugNextInSection :: World -> World
|
|
scrollAugNextInSection w =
|
|
w & hud . hudElement %~ doscroll
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& setInvPosFromSS
|
|
& cWorld . lWorld %~ crUpdateItemLocations 0
|
|
where
|
|
doscroll he = fromMaybe he $ do
|
|
sss <- he ^? diSections
|
|
return $ he & diSelection %~ nextInSectionSS sss
|