loop/src/Dodge/Inventory.hs

--{-# LANGUAGE TupleSections #-}
module Dodge.Inventory (
    rmInvItem,
    destroyInvItem,
    updateCloseObjects,
    changeSwapSel,
    augInvDirectSelect,
    scrollAugInvSel,
    crNumFreeSlots,
    setInvPosFromSS,
    module Dodge.Inventory.RBList,
    swapInvItems,
    scrollAugNextInSection,
    swapItemWith,
) 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.Euse
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 ->
    -- | Inventory position
    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)

-- | 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
        & 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 = 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

-- this looks ugly...
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
    cbts = _btID <$> filter (isclose . _btPos) activeButtons
    citems =
        fmap _flItID
            . 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 ((/=) BtInactive . _btState)
            . IM.elems
            $ w ^. cWorld . lWorld . buttons

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) w = case j of
    0 -> w & swapInvItems f i
    3 -> w & changeSwapOther ispCloseItem 3 f i
    5 -> w & changeSwapOther ispCloseButton 5 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 & changeSwapOther ispCloseItem 3 f i
    Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
    _ -> w

augInvDirectSelect :: (Int, Int, IS.IntSet) -> World -> World
augInvDirectSelect sel w =
    w
        & hud . hudElement . diSelection ?~ sel
        & 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