--{-# LANGUAGE TupleSections #-} module Dodge.Inventory ( checkInvSlotsYou, rmInvItem, destroyInvItem, updateCloseObjects, changeSwapSel, augInvDirectSelect, scrollAugInvSel, crNumFreeSlots, crInvSize, selectedCloseObject, setInvPosFromSS, module Dodge.Inventory.RBList, swapInvItems, scrollAugNextInSection, isFilteringInv, ) where import Control.Monad import Dodge.Item.Grammar import Dodge.Data.DoubleTree import Sound.Data import Dodge.SoundLogic import Control.Applicative import Data.Maybe import Dodge.Base import Dodge.Data.SelectionList import Dodge.Data.World --import Dodge.DisplayInventory import Dodge.Euse import Dodge.Inventory.CheckSlots import Dodge.Inventory.CloseObject import Dodge.Inventory.Location import Dodge.Inventory.RBList import Dodge.ItEffect import Dodge.SelectionSections import Geometry import qualified IntMapHelp as IM import LensHelp import ListHelp import NewInt --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 .~ 0 | 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 . closeObjects .~ newcloseobjects & updatecursorposifnecessary where newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose 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 filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w ypos = _crPos $ you w activeButtons = map Right . filter ((/=) BtNoLabel . _btState) . IM.elems $ w ^. cWorld . lWorld . buttons currentClose = filt $ map Left (IM.elems $ w ^. cWorld . lWorld . floorItems . unNIntMap) ++ activeButtons oldClose = filt $ mapMaybe updatebyid $ w ^. hud . closeObjects oldCloseFiltered = intersectBy closeObjEq oldClose currentClose updatebyid (Left flid) = fmap Left $ w ^? cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt $ _flItID flid) updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid) 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 & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject .~ k & hud . closeObjects %~ 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 -- & checkconnect k InventorySound disconnectItemS & 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 -- & checkconnect k InventoryConnectSound connectItemS where -- 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 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 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 selectedCloseObject :: World -> Maybe (Either FloorItem Button) selectedCloseObject w = do i <- you w ^? crManipulation . manObject . ispCloseObject <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . ix 3 . ssItems) w ^? hud . closeObjects . ix i isFilteringInv :: IM.IntMap (SelectionSection a) -> Bool isFilteringInv = not . null . (^. ix (-1) . ssItems)