{-# LANGUAGE TupleSections #-}
module Dodge.Inventory
    ( checkInvSlotsYou
    , rmSelectedInvItem
    , invSelPos
    , invSelSize
    , selNumPos
    , selNumTextPos
    , selNumCol
    , selNumSlots
    , selNumMidHeight
    , augmentedInvSizes
    , rmInvItem
    , updateCloseObjects
    , updateRBList
    , updateTerminal
    , closeObjScrollDir
    , closeObjectCol
--    , swapInvDir
    , changeInvSel
    , changeSwapInvSel
    , changeAugInvSel
    , crNumFreeSlots
    , crInvSize
    , selectedCloseObject
    )
    where
import Dodge.Data
import Dodge.Inventory.CloseObject
import Dodge.Inventory.CheckSlots
import Dodge.Inventory.ItemSpace
import Dodge.Base
import Geometry
--import FoldableHelp
import Padding
import Color
import qualified IntMapHelp as IM
import ListHelp
import LensHelp

--import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
--import qualified Data.Set as S
import Data.Maybe
--import qualified Data.Text as T
--import SDL
--import Data.List
--import System.Random

-- | after this the item at the inventory position will no longer exist
rmInvItem :: Int      -- ^ Creature id
    -> Int      -- ^ Inventory position
    -> World 
    -> World
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
    Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
    _ -> w & creatures . ix cid . crInv %~ f
        & creatures . ix cid . crInvSel %~ g
        & creatures . ix cid . crLeftInvSel %~ g'
        & removeAnySlotEquipment
        & dounequipfunction
        & doanyitemeffect
        & creatures . ix cid . crInvEquipped %~ IM.delete invid
        & creatures . ix cid . crInvEquipped %~ IM.mapKeys g
                -- TODO check whether this can be mapKeysMonotonic
  where
    cr = _creatures w IM.! cid
    itm = _crInv cr IM.! invid
    dounequipfunction = fromMaybe id $ do
        rmf <- itm ^? itUse . eqEq . eqOnRemove
        return $ rmf itm cr
    doanyitemeffect = fromMaybe id $ do
        rmf <- itm ^? itEffect . ieDrop
        return $ rmf itm cr
    removeAnySlotEquipment = case w ^? creatures . ix cid . crInvEquipped . ix invid of
        Just epos   -> creatures . ix cid . crEquipment . at epos .~ Nothing
        Nothing     -> id
    maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
    f inv = let (xs,ys) = IM.split invid inv
        in xs `IM.union` IM.mapKeys (subtract 1) ys
    g x | x > invid || Just x == maxk = max 0 $ x - 1
        | otherwise = x
    g' Nothing = Nothing
    g' (Just x)
        | x == invid = Nothing
        | x > invid || Just x == maxk = Just $ max 0 $ x - 1
        | otherwise = Just x

rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w

augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize

bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
bimapAugmentInv f g w = IM.union
    (f <$> yourInv w)
    (IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)

invSelSize :: Int -> World -> Int
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i

closeObjectSize :: Either FloorItem Button -> Int
closeObjectSize e = case e of
    Left flit -> itSlotsTaken $ _flIt flit
    Right _  -> 1
closeObjectCol :: Either FloorItem Button -> Color
closeObjectCol e = case e of
    Left flit -> _itInvColor $ _flIt flit
    Right _  -> yellow

selNumSlots :: Int -> World -> Int
selNumSlots i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i

selNumPos :: Int -> World -> Int
selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w))
  where
    splitgap
        | i < length (yourInv w) = 0
        | otherwise = 1

selNumTextPos :: Configuration -> World -> Int -> Point2
selNumTextPos cfig w i = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 20))
  where
    hh = halfHeight cfig
    hw = halfWidth  cfig
    ipos = selNumPos i w

selNumMidHeight :: Configuration -> World -> Int -> Point2
selNumMidHeight cfig w i = V2 (150 - hw) ( hh + bump - (20 * fromIntegral ipos + 7.5))
  where
    hh = halfHeight cfig
    hw = halfWidth  cfig
    ipos = selNumPos i w
    bump = negate $ 10 * fromIntegral (selNumSlots i w)

selNumCol :: Int -> World -> Color
selNumCol i w = fromMaybe white $ bimapAugmentInv _itInvColor closeObjectCol w IM.!? i

invSelPos :: World -> Int
invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSizes w))
  where
    invsel = yourInvSel w
    splitgap
        | invsel < length (yourInv w) = 0
        | otherwise = 1

updateTerminal :: World -> World
updateTerminal = checkTermDist

checkTermDist :: World -> World
checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
    Just tmid -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) $ do
        btid    <- w ^? terminals . ix tmid . tmButtonID
        btpos   <- w ^? buttons . ix btid . btPos 
        if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
    Nothing -> w

-- this looks ugly...
updateCloseObjects :: World -> World
updateCloseObjects w = w 
    & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
    & creatures . ix (_yourID w) . crInvSel %~ updateinvsel
  where
    updateinvsel curinvsel
        | length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
        | otherwise = curinvsel
    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 
        $ _buttons w
    currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons
    oldClose     = filt $ mapMaybe updatebyid $ _closeObjects w
    oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
    updatebyid (Left flid) = fmap Left $ w ^? floorItems . ix (_flItID flid)
    updatebyid (Right btid) = fmap Right $ w ^? buttons . ix (_btID btid)

updateRBList :: World -> World
updateRBList w 
    | w ^? rbOptions . opCurInvPos == Just curinvid 
        = w & setEquipAllocation & setEquipActivation
    | otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of
        Just esite -> w 
            & rbOptions .~ EquipOptions (equipSiteToPositions esite) 
                (chooseEquipmentPosition cr (equipSiteToPositions esite)) 
                curinvid 
                DoNotMoveEquipment 
                NoChangeActivateEquipment
            & setEquipAllocation & setEquipActivation
        Nothing -> w & rbOptions .~ NoRightButtonOptions
--    | otherwise = w & rbOptions .~ NoRightButtonOptions
  where
    curinvid = _crInvSel cr
    cr = you w

chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
    ep <- cr ^? crInvEquipped . ix (_crInvSel cr)
    elemIndex ep eps

chooseFreeSite :: Creature -> [EquipPosition] -> Int
chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
  where
    hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep

setEquipAllocation :: World -> World
setEquipAllocation w = case _rbOptions w of
    EquipOptions {_opEquip = es,_opSel=i} ->
        case you w ^? crInvEquipped . ix (_crInvSel (you w)) of
            Just epos | es !! i == epos
                    -> w & rbOptions . opAllocateEquipment .~ RemoveEquipment
                        {_allocOldPos = epos}
            Just epos | isJust (you w ^? crEquipment . ix (es !! i))
                    -> w & rbOptions . opAllocateEquipment .~ SwapEquipment
                        {_allocOldPos = epos
                        ,_allocNewPos = es !! i
                        ,_allocSwapID = _crEquipment (you w) M.! (es !! i)
                        }
            Just epos -> w & rbOptions . opAllocateEquipment .~ MoveEquipment
                        {_allocOldPos = epos
                        ,_allocNewPos = es !! i
                        }
            Nothing | isJust (you w ^? crEquipment . ix (es !! i))
                    -> w & rbOptions . opAllocateEquipment .~ ReplaceEquipment
                        {_allocNewPos = es !! i
                        ,_allocRemoveID = _crEquipment (you w) M.! (es !! i)
                        }
            Nothing -> w & rbOptions . opAllocateEquipment .~ PutOnEquipment
                        {_allocNewPos = es !! i}
    _ -> w
--  where
--    curpos = invSelPos w

setEquipActivation :: World -> World
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
    Just DoNotMoveEquipment -> w
    Just RemoveEquipment { }
        -> case _crLeftInvSel (you w) of
            Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment
                {_deactivateEquipment = i}
            _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
    Just rbos
        -> case _crLeftInvSel (you w) of
            Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
            Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
                {_activateEquipment = invsel,_deactivateEquipment = i}
            Just i | Just i == rbos ^? allocRemoveID
                   -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
            Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
            Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment
                {_activateEquipment = invsel}
            Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
    Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
  where
    invsel = _crInvSel (you w)
    invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse)

equipSiteToPositions :: EquipSite -> [EquipPosition]
equipSiteToPositions es = case es of
    GoesOnHead    -> [OnHead]
    GoesOnChest   -> [OnChest]
    GoesOnBack    -> [OnBack]
    GoesOnWrist   -> [OnLeftWrist,OnRightWrist]
    GoesOnLegs    -> [OnLegs]
    GoesOnSpecial -> [OnSpecial]


closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x 
    | x > 0 = over closeObjects rotU
    | x < 0 = over closeObjects rotD
    | otherwise = id

changeInvSel :: Int -> World -> World
changeInvSel i w 
    | n == 0    = w
    | yourInvSel w < n    =  w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
    | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (i+n))
    -- arguably this should jump the invpos into the inventory proper
  where 
    n = length $ _crInv $ _creatures w IM.! _yourID w
    numCO = length $ _closeObjects w

changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w 
    | n == 0    = w
    | yourInvSel w < n    =  w 
        & creatures . ix (_yourID w) %~ updatecreature
    | otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
        & closeObjects %~ swapIndices (i - n) (ico' - n)
  where 
    updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi )
        . (crLeftInvSel . _Just %~ updateLeftInvSel)
        . (crInvSel %~ (`mod` n) . subtract k)
        . (crInvEquipped %~ IM.safeSwapKeys i swapi)
        . swapSite i swapi
        . swapSite swapi i
    swapSite a b = case cr ^? crInvEquipped . ix a of
        Just epos -> crEquipment . ix epos .~ b
        Nothing -> id
    cr = you w
    swapi = (i - k) `mod` n
    updateLeftInvSel li | i == li = swapi
        | swapi == li = i
        | otherwise = li
    i = _crInvSel cr
    ico' = ( (i - (k+n)) `mod` numCO ) + n
    n = length $ _crInv cr
    numCO = length $ _closeObjects w

changeAugInvSel :: Int -> World -> World
changeAugInvSel i w 
    | n == 0    = w
    | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
  where 
    n = length (yourInv w) + length (_closeObjects w)

bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ _closeObjects w
  where
    f (Right _) = True
    f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
    ycr = you w

selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
selectedCloseObject w
    | invsel >= length inv = selectNthCloseObject w (invsel - length inv)
    | otherwise = selectNthCloseObject w =<< bestCloseObjectIndex w
  where
    invsel = _crInvSel cr
    cr = you w
    inv = _crInv cr

selectNthCloseObject :: World -> Int -> Maybe (Int,Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects w !? n)