-- {-# LANGUAGE TupleSections #-}
module Dodge.Inventory (
    rmInvItem,
    destroyInvItem,
    updateCloseObjects,
    changeSwapSel,
    invSetSelection,
    invSetSelectionPos,
    scrollAugInvSel,
    setInvPosFromSS,
    module Dodge.Inventory.RBList,
    swapInvItems,
    scrollAugNextInSection,
    swapItemWith,
    destroyAllInvItems,
    multiSelScroll,
    changeSwapSelSet,
    concurrentIS,
    collectInvItems,
    shiftInvItemsUp,
    shiftInvItemsDown,
    closeItemDist,
) where

import Control.Monad
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.Location
import Dodge.Inventory.RBList
import Dodge.Inventory.Swap
import Dodge.SelectionSections
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Linear
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 -> NewInt InvInt -> 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
        return $ cWorld . lWorld . items . at itid .~ Nothing
    removeithotkey = fromMaybe id $ do
        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
        hk <- w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid
        return $
            (cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
                . (cWorld . lWorld . hotkeys . at hk .~ Nothing)

destroyAllInvItems :: Creature -> World -> World
destroyAllInvItems cr w =
    foldl' (flip $ destroyInvItem (cr ^. crID)) w
        . reverse
        . fmap NInt
        . IM.keys
        . _unNIntMap
        $ cr ^. crInv

-- note rmInvItem does not fully destroy the item, other updates to the item
-- location are required
-- note if this gets called ssInvPosFromSS might be necessary elsewhere
rmInvItem :: Int -> NewInt InvInt -> World -> World
rmInvItem cid invid w =
    w
        & dounequipfunction -- the ordering of these is
        & pointcid . crInv %~ f -- important
        & removeAnySlotEquipment
        & cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
        & updateselection
        & worldEventFlags . at InventoryChange ?~ ()
  where
    pointcid = cWorld . lWorld . creatures . ix cid
    updateselection
        | cid == 0 && (w ^? hud .diSelection._Just) == Just (Sel 0 (invid^.unNInt)) =
            scrollAugInvSel (-1) . scrollAugInvSel 1
        | otherwise = id
    cr = w ^?! cWorld . lWorld . creatures . ix cid
    itid = cr ^?! crInv . ix invid
    itm = w ^?! cWorld . lWorld . items . ix itid
    dounequipfunction = effectOnRemove itm cr
    removeAnySlotEquipment = fromMaybe id $ do
        epos <- itm ^? itLocation . ilEquipSite . _Just
        return $ pointcid . crEquipment . at epos .~ Nothing
    f inv =
        let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
         in NIntMap $ xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys

updateCloseObjects :: World -> World
updateCloseObjects w =
    w
        & hud . closeItems %~ h citems
        & hud . closeButtons %~ h cbts
  where
    h a b = intersect b a `union` a
    lw = w ^. cWorld . lWorld
    citems =
        map NInt $
            IM.keys $
                IM.intersection (lw ^. items) $
                    IM.filter (isclose . _flItPos) (lw ^. floorItems)
    cbts = lw ^.. buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
    canpress bt = case bt ^. btEvent of
        ButtonPress{_btOn = t} -> not t
        ButtonAccessTerminal tid -> fromMaybe False $ do
            x <- lw ^? terminals . ix tid . tmStatus
            return (x /= TerminalDeactivated)
        _ -> True
    isclose x = dist y x < closeItemDist && hasButtonLOS y x w
    y = you w ^. crPos . _xy

closeItemDist :: Float
closeItemDist = 30

changeSwapSelSet :: Int -> World -> World
changeSwapSelSet yi w
    | yi >= 0 = foldl' (&) w $ replicate yi (swapSelSet shiftSetUp)
    | otherwise = foldl' (&) w $ replicate (negate yi) (swapSelSet shiftSetDown)

swapSelSet :: (Int -> IS.IntSet -> World -> World) -> World -> World
swapSelSet f w = fromMaybe w $ do
    Sel j i <- w ^. hud . diSelection
    is' <- w ^? hud . diSections . ix j . ssSet
    let is = if IS.null is' 
        then IS.singleton i
        else is'
    return $
        if concurrentIS is
            then f j is w
            else collectInvItems j is w

shiftSetUp :: Int -> IS.IntSet -> World -> World
shiftSetUp j is w = fromMaybe w $ do
    (mini, _) <- IS.minView is
    guard (mini > 0)
    return $ shiftInvItemsUp j is w

shiftSetDown :: Int -> IS.IntSet -> World -> World
shiftSetDown j is w = fromMaybe w $ do
    (maxi, _) <- IS.maxView is
    (maxinv, _) <- IM.lookupMax =<< (w ^? hud . diSections . ix j . ssItems)
    guard (maxi < maxinv)
    return $ shiftInvItemsDown j is w

shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
shiftInvItemsDown j is w = fromMaybe w $ do
    let i = IS.findMax is
    guard . isJust $ w ^? hud . diSections . ix j . ssItems . ix i
    return $ IS.foldr f w is
  where
    f i' = swapItemWith g (j, i')
    g i' m = fst <$> IM.lookupGT i' m


shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
shiftInvItemsUp j is w = IS.foldl' f w is
  where
    f w' i' = swapItemWith g (j, i') w'
    g i' m = fst <$> IM.lookupLT i' m

concurrentIS :: IS.IntSet -> Bool
concurrentIS = go . IS.minView
  where
    go x = fromMaybe True $ do
        (i, is) <- x
        (j, js) <- IS.minView is
        return $ i + 1 == j && go (Just (j, js))

collectInvItems :: Int -> IS.IntSet -> World -> World
collectInvItems secid is w = fromMaybe w $ do
    guard $ secid == 0 || secid == 3
    (j, js) <- IS.minView is
    return $ h j js w
  where
    h j js w' = fromMaybe w' $ do
        (k, ks) <- IS.minView js
--        return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
        return . h (j + 1) ks $ swapItemWith (\_ _ -> Just (j + 1)) (secid,k) w'

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

multiSelScroll :: Int -> World -> World
multiSelScroll yi w
    | yi >= 0 = foldl' (&) w $ replicate yi (multiSelScroll' $ f IM.lookupLT)
    | otherwise = foldl' (&) w $ replicate (negate yi) (multiSelScroll' $ f IM.lookupGT)
  where
    f g i m = fst <$> g i m

multiSelScroll' :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
multiSelScroll' f w = fromMaybe w $ do
    --Sel j i is <- w ^. hud . diSelection
    Sel j i <- w ^. hud . diSelection
    is <- w ^? hud . diSections . ix j . ssSet
    ss <- w ^? hud . diSections . ix j . ssItems
    k <- f i ss
    let insertordelete 
            | not (i `IS.member` is) && k `IS.member` is = IS.delete k
            | k `IS.member` is = IS.delete i 
            | otherwise = IS.insert i . IS.insert k
    return $
        w
--            & hud . diSelection . _Just . slSet %~ insertordelete
            & hud . diSections . ix j . ssSet %~ insertordelete
            & hud . diSelection . _Just . slInt .~ k

changeSwapOther ::
    Int ->
    (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
    Int ->
    World ->
    World
changeSwapOther n f i w = fromMaybe w $ do
    ss <- w ^? hud . diSections . ix n . ssItems
    k <- f i ss
    let doswap j
            | j == i = k
            | j == k = i
            | otherwise = j
    return $
        w
            & hud . diSections . ix 3 . ssSet %~ swapInIntSet i k
            & hud . closeItems %~ swapIndices i k
            & hud . diSelection . _Just . slInt %~ doswap
            & worldEventFlags . at InventoryChange ?~ ()

swapItemWith ::
    (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
    (Int, Int) ->
    World ->
    World
swapItemWith f (j, i) = case j of
    0 -> swapInvItems f i
    3 -> changeSwapOther 3 f i
    5 -> changeSwapOther 5 f i
    _ -> id

changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w
    | Just (Sel j i) <- w ^. hud . diSelection = swapItemWith f (j, i) w
    | otherwise = w

invSetSelection :: Selection -> World -> World
invSetSelection sel w =
    w
        & hud . diSelection ?~ sel
        & worldEventFlags . at InventoryChange ?~ ()
--        & crUpdateItemLocations
        & setInvPosFromSS -- is this necessary here?
        & crUpdateItemLocations

invSetSelectionPos :: Int -> Int -> World -> World
invSetSelectionPos i j = invSetSelection (Sel i j)

scrollAugInvSel :: Int -> World -> World
scrollAugInvSel yi w
    | yi == 0 = w
    | otherwise =
        w
            & hud %~ doscroll
            & worldEventFlags . at InventoryChange ?~ ()
            & crUpdateItemLocations
            & setInvPosFromSS
            & crUpdateItemLocations
  where
    doscroll he = fromMaybe he $ do
        sss <- he ^? diSections
        return $ he & diSelection %~ scrollSelectionSections yi sss

scrollAugNextInSection :: World -> World
scrollAugNextInSection w =
    w
        & hud %~ doscroll
        & worldEventFlags . at InventoryChange ?~ ()
        & crUpdateItemLocations
        & setInvPosFromSS
        & crUpdateItemLocations
  where
    doscroll he = fromMaybe he $ do
        sss <- he ^? diSections
        return $ he & diSelection %~ nextInSectionSS sss