--{-# LANGUAGE TupleSections #-} module Dodge.Inventory ( checkInvSlotsYou, rmInvItem, destroyInvItem, updateCloseObjects, changeSwapSel, augInvDirectSelect, scrollAugInvSel, crNumFreeSlots, crInvSize, selectedCloseItem, setInvPosFromSS, module Dodge.Inventory.RBList, swapInvItems, scrollAugNextInSection, -- isFilteringInv, swapItemWith, ) where import Control.Applicative import Control.Monad import Data.Function import qualified Data.IntSet as IS import Data.Maybe import Dodge.Base import Dodge.Data.DoubleTree import Dodge.Data.SelectionList import Dodge.Data.World import Dodge.Euse import Dodge.Inventory.CheckSlots import Dodge.Inventory.Location import Dodge.Inventory.RBList import Dodge.ItEffect import Dodge.Item.Grammar import Dodge.SelectionSections import Dodge.SoundLogic import Geometry import qualified IntMapHelp as IM import LensHelp import ListHelp import NewInt import Sound.Data --import Padding -- 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 -> -- | Inventory position Int -> World -> World destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc where removeitloc = fromMaybe id $ do itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt return $ cWorld . lWorld . itemLocations . at itid .~ Nothing -- | after this the item at the inventory position will no longer exist rmInvItem :: -- | Creature id Int -> -- | Inventory position Int -> World -> World rmInvItem cid invid w = w & doanyitemeffect & dounequipfunction --the ordering of these is & pointcid . crInv %~ f -- important & removeAnySlotEquipment & pointcid . crEquipment . each %~ g & pointcid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.mapKeys g & removeanyactivation & pointcid . crHotkeys . each %~ g & pointcid . crInvHotkeys %~ IM.delete invid & pointcid . crInvHotkeys %~ IM.mapKeys g & updateselection & updateselectionextra & pointcid %~ updateRootItemID & worldEventFlags . at InventoryChange ?~ () where -- & updateCreatureItemLocations cid pointcid = cWorld . lWorld . creatures . ix cid updateselectionextra | cid == 0 = hud . hudElement . diSelectionExtra .~ mempty | otherwise = id updateselection | cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid = scrollAugInvSel (-1) . scrollAugInvSel 1 -- . updateInventorySectionItems -- id -- . updateInventorySectionItems | otherwise = pointcid . crManipulation . manObject . imSelectedItem %~ g cr = w ^?! cWorld . lWorld . creatures . ix cid itm = _crInv cr IM.! invid dounequipfunction = fromMaybe id $ do rmf <- itm ^? itUse . uequipEffect . eeOnRemove return $ useE rmf itm cr doanyitemeffect = fromMaybe id $ do rmf <- itm ^? itEffect . ieOnDrop return $ doInvEffect rmf itm cr removeAnySlotEquipment = fromMaybe id $ do epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid return $ pointcid . crEquipment . at epos .~ Nothing removeanyactivation = fromMaybe id $ do epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvHotkeys . ix invid return $ pointcid . crHotkeys . 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 -- this looks ugly... updateCloseObjects :: World -> World updateCloseObjects w = w & hud . closeItems %~ f & hud . closeInterfaces %~ g where -- the following should update any changed properties of flits/bts g oldbts = intersectBy bteq cbts oldbts `btunion` cbts f olditems = intersectBy feq citems olditems `itunion` citems itunion = unionBy feq btunion = unionBy bteq feq = (==) `on` _flItID bteq = (==) `on` _btID cbts = filter (isclose . _btPos) activeButtons citems = filter (isclose . _flItPos) . IM.elems $ w ^. cWorld . lWorld . floorItems . unNIntMap isclose pos = dist ypos pos < 40 && hasButtonLOS ypos pos w ypos = _crPos $ you w activeButtons = filter ((/=) BtNoLabel . _btState) . IM.elems $ w ^. cWorld . lWorld . buttons -- updatecursorposifnecessary = -- case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject of -- Just i -- | i >= length newcloseobjects -> scrollAugInvSel 1 -- | isNothing (w ^? hud . hudElement . diSections . ix 3 . ssItems . ix i) -> -- scrollAugInvSel (-1) -- _ -> id changeSwapSel :: Int -> World -> World changeSwapSel yi w | yi == 0 = 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 changeSwapClose :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> Int -> World -> World changeSwapClose f i w = fromMaybe w $ do ss <- w ^? hud . hudElement . diSections . ix 3 . ssItems k <- f i ss return $ w & swapAnyExtraSelection i k & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject .~ k & hud . closeItems %~ swapIndices i k & hud . hudElement . diSelection . _Just . _2 .~ k & worldEventFlags . at InventoryChange ?~ () -- can be specialised for when we know that item i is selected swapInvItems :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> Int -> World -> World swapInvItems f i w = fromMaybe w $ do ss <- w ^? hud . hudElement . diSections . ix 0 . ssItems k <- f i ss let updateselection = case w ^? hud . hudElement . diSelection . _Just of Just (0, j) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i Just (0, j) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k _ -> id return $ w & swapAnyExtraSelection i k & checkConnection InventorySound disconnectItemS i k & cWorld . lWorld . creatures . ix 0 %~ updatecreature k & updateselection & worldEventFlags . at InventoryChange ?~ () & cWorld . lWorld %~ crUpdateItemLocations 0 & setInvPosFromSS & cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes -- a rethink is maybe in order & checkConnection InventoryConnectSound connectItemS i k where -- & checkconnect k InventoryConnectSound connectItemS -- cpos = fromMaybe 0 $ w ^? cWorld . lWorld . creatures . ix 0 . crPos -- checkconnect k stype s w' -- | p (i+1) || p (i-1) -- || p (k+1) || p (k-1) = soundStart stype cpos s Nothing w' -- | otherwise = w' -- where -- p j = maybe False not $ w' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j . itLocation . ilIsRoot updatecreature k = (crInv %~ IM.safeSwapKeys i k) . (crManipulation . manObject . imSelectedItem .~ k) . (crInvEquipped %~ IM.safeSwapKeys i k) . swapSite i k . swapSite k i . (crInvHotkeys %~ IM.safeSwapKeys i k) . swapSite' i k . swapSite' k i cr = you w swapSite a b = case cr ^? crInvEquipped . ix a of Just epos -> crEquipment . ix epos .~ b Nothing -> id swapSite' a b = case cr ^? crInvHotkeys . ix a of Just epos -> crHotkeys . ix epos .~ b Nothing -> id swapAnyExtraSelection :: Int -> Int -> World -> World swapAnyExtraSelection i k w = fromMaybe w $ do is <- w ^? hud . hudElement . diSelectionExtra let f = if i `IS.member` is then IS.insert k else id g = if k `IS.member` is then IS.insert i else id return $ w & hud . hudElement . diSelectionExtra %~ (f . g . IS.delete i . IS.delete k) checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World checkConnection so s i j w = fromMaybe w $ do inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos let locs = allInvLocs inv iit <- locs ^? ix i . _2 jit <- locs ^? ix j . _2 guard $ isConnected iit || isConnected jit return $ soundStart so cpos s Nothing w isConnected :: LocationLDT b a -> Bool isConnected x = case x ^. locLdtContext of TopLDT -> not (null $ x ^. locLDT . ldtRight) || not (null $ x ^. locLDT . ldtLeft) _ -> True swapItemWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> (Int, Int) -> World -> World swapItemWith f (j, i) w = case j of 0 -> w & swapInvItems f i 3 -> w & changeSwapClose f i _ -> 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 & changeSwapClose f i _ -> w augInvDirectSelect :: (Int, Int) -> World -> World augInvDirectSelect (i, j) w = w & hud . hudElement . diSelection ?~ (i, j) & worldEventFlags . at InventoryChange ?~ () & setInvPosFromSS & cWorld . lWorld %~ crUpdateItemLocations 0 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 selectedCloseItem :: World -> Maybe FloorItem selectedCloseItem w = do i <- you w ^? crManipulation . manObject . ispCloseObject <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . ix 3 . ssItems) w ^? hud . closeItems . ix i