loop/src/Dodge/Inventory.hs

--{-# 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