loop/src/Dodge/Inventory.hs

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