{-# LANGUAGE LambdaCase #-}

module Dodge.Update.Input.InGame (
    updateUseInputInGame,
    updateMouseInGame,
) where

import Control.Applicative
import Control.Monad
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.List (sort)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Dodge.Camera
import Dodge.Creature.Action
import Dodge.Data.Combine
import Dodge.Data.Universe
import Dodge.DisplayInventory
import Dodge.Event.Test
import Dodge.Inventory
import Dodge.Inventory.Add
import Dodge.Item.Display
import Dodge.Item.InvSize
import Dodge.ListDisplayParams
import Dodge.Menu
import Dodge.Save
import Dodge.SelectedClose
import Dodge.SelectionSections
import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.Update.Input.DebugTest
import Dodge.Update.Input.Text
--import Dodge.WorldPos
--import Geometry
import LensHelp
import NewInt
import SDL

updateUseInputInGame :: Universe -> Universe
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of
    DisplayInventory{_subInventory = si, _diSelection = disel} -> case si of
        DisplayTerminal tmid -> updateKeysInTerminal tmid u
        CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} ->
            u
                & uvWorld . hud . hudElement . subInventory
                    %~ docombineregexinput sss msel
                & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
        _
            | disel ^? _Just . _1 == Just (-1) ->
                u
                    & uvWorld . hud . hudElement
                        %~ dodisplayregexinput diInvFilter diInvFilter (-1)
                    & uvWorld . worldEventFlags . at InventoryChange ?~ ()
                    & uvWorld %~ setInvPosFromSS
        _
            | disel ^? _Just . _1 == Just 2 ->
                u
                    & uvWorld . hud . hudElement
                        %~ dodisplayregexinput diCloseFilter diCloseFilter 2
                    & uvWorld . worldEventFlags . at InventoryChange ?~ ()
                    & uvWorld %~ setInvPosFromSS
        _ -> M.foldlWithKey' updateKeyInGame u pkeys
  where
    pkeys = u ^. uvWorld . input . pressedKeys
    dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
        sss <- di ^? diSections
        msel <- di ^? diSelection
        filts <- di ^? filterprism
        let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
        return $
            di & diSections .~ sss'
                & diSelection .~ msel'
                & filterlens .~ filts'
    docombineregexinput sss msel ci = fromMaybe ci $ do
        filts <- ci ^? ciFilter
        let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
        return $
            ci & ciSections .~ sss'
                & ciSelection .~ msel'
                & ciFilter .~ filts'

updateMouseInGame :: Configuration -> World -> World
updateMouseInGame cfig w
    | Just 0 <- lbpress = updateMouseClickInGame cfig w
    | Just _ <- lbpress = updateMouseHeldInGame cfig w
    | Just 0 <- lbrelease = updateMouseReleaseInGame w
    | otherwise = w
  where
    lbpress = w ^? input . mouseButtons . ix ButtonLeft
    lbrelease = w ^? input . mouseButtonsReleased . ix ButtonLeft

updateMouseHeldInGame :: Configuration -> World -> World
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
    OverInvDragSelect sstart _ -> fromMaybe w $ do
        sss <- w ^? hud . hudElement . diSections
        let msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos)
        guard $ Just (fst sstart) == fmap fst msel || isNothing msel
        return $ w & input . mouseContext . mcoSelEnd .~ fmap snd msel
    OverInvDrag k mmouseover ab bn -> doDrag 30 k mmouseover ab bn w
    _ -> w

doDrag ::
    Int ->
    Int ->
    Maybe (Int, Int) ->
    Maybe (Int, Int) ->
    Maybe (Int, Int) ->
    World ->
    World
doDrag 0 _ _ _ _ w = w
doDrag n k mmouseover ab bn w = fromMaybe w $ do
    ss <- w ^? hud . hudElement . diSections . ix k . ssItems
    x <- mmouseover
    is <- w ^? hud . hudElement . diSelection . _Just . _3
    return $
        if concurrentIS is
            then shiftInvItems n k x ab bn is ss w
            else collectInvItems k is w

tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
tryDropSelected mpos w = do
    guard $ maybe True (\(i, _) -> i == 3) mpos
    cr <- w ^? cWorld . lWorld . creatures . ix 0
    (0, _, xs) <- w ^? hud . hudElement . diSelection . _Just
    return . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs

tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
tryPickupSelected k mpos w = do
    guard $ k == 3
    guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
    cr <- w ^? cWorld . lWorld . creatures . ix 0
    let nfreeslots = crNumFreeSlots cr
    xs <- w ^? hud . hudElement . diSelection . _Just . _3
    let itmstopickup = mapMaybe g $ IS.toList xs
    let slotsneeded = alaf Sum foldMap (itInvHeight . _flIt) itmstopickup
    guard $ nfreeslots >= slotsneeded
    return $ case mpos of
        Just (0, j) ->
            foldr (pickUpItemAt j 0) w itmstopickup
                & hud . hudElement . diSelection
                    ?~ ( 0
                       , j
                       , IS.fromDistinctAscList [j .. j + IS.size xs -1]
                       )
        _ ->
            foldl' (flip $ pickUpItem 0) w itmstopickup
                & hud . hudElement . diSelection . _Just . _3 %~ const mempty
  where
    g i = do
        NInt j <- w ^? hud . closeItems . ix i
        w ^? cWorld . lWorld . floorItems . unNIntMap . ix j

updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
    OverInvDrag k mpos _ _ ->
        input . mouseContext .~ MouseInGame $
            fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
    OverInvDragSelect ssel mesel
        | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
            w & input . mouseContext .~ MouseInGame
                & hud . hudElement . diSelection . _Just . _3
                    %~ getuniques
                        ( maybe
                            mempty
                            (h ssel)
                            ( guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1)
                                >> mesel ^? _Just
                            )
                        )
    OverInvDragSelect _ Nothing ->
        w & input . mouseContext .~ MouseInGame
            & hud . hudElement . diSelection . _Just . _3 %~ const mempty
    OverInvDragSelect ssel (Just esel) ->
        w & input . mouseContext .~ MouseInGame
            & invSetSelection (f (fst ssel, esel) (h ssel esel))
    _ -> w
  where
    getuniques x y = IS.union x y IS.\\ IS.intersection x y
    f (x, y) z = (x, y, z)
    h (k, i) j = fold $ do
        sss <- w ^? hud . hudElement . diSections . ix k . ssItems
        let (_, xss) = IM.split (min i j -1) sss
            (yss, _) = IM.split (max i j + 1) xss
        return . IM.keysSet $ yss

isGroupSelectableSection :: Int -> Bool
isGroupSelectableSection = \case
    0 -> True
    3 -> True
    _ -> False

updateMouseClickInGame :: Configuration -> World -> World
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
    MouseInGame -> fromMaybe w $ do
        sss <- w ^? hud . hudElement . diSections
        ysel <- inverseSelSecYint 
            (posSelSecYint cfig invDP (w ^. input . mousePos . _y)) sss
        guard (isGroupSelectableSection $ fst ysel)
        return $ w & input . mouseContext .~ OverInvDragSelect ysel Nothing
    OverInvSelect (-1, _)
        | selsec == Just (-1) ->
            w
                & hud . hudElement . diSelection %~ endRegex (-1) w
                & hud . hudElement . diInvFilter .~ Nothing
    OverInvSelect (2, _)
        | selsec == Just 2 ->
            w
                & hud . hudElement . diSelection %~ endRegex 2 w
                & hud . hudElement . diCloseFilter .~ Nothing
    OverInvSelect x
        | ScancodeLShift `M.member` (w ^. input . pressedKeys)
            && isGroupSelectableSection (fst x) ->
            w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
    OverInvSelect x -> startDrag x cfig w
    OverTerminalReturn tmid -> terminalReturnEffect tmid w
    OverTerminalEscape -> w & hud . hudElement . subInventory .~ NoSubInventory
    OverCombSelect x ->
        w & hud . hudElement . subInventory . ciSelection ?~ f x
            & worldEventFlags . at CombineInventoryChange ?~ ()
    OverCombFilter ->
        w & hud . hudElement . subInventory . ciFilter .~ Nothing
            & worldEventFlags . at CombineInventoryChange ?~ ()
            & hud . hudElement . subInventory . ciSelection %~ endCombineRegex w
    OverCombCombine x ->
        w
            & tryCombine x
            & worldEventFlags . at CombineInventoryChange ?~ ()
            & worldEventFlags . at InventoryChange ?~ ()
            & maybeExitCombine
    OverCombEscape ->
        w
            & worldEventFlags . at InventoryChange ?~ ()
            & hud . hudElement . subInventory .~ NoSubInventory
    OverCombFiltInv (0, j) -> fromMaybe w $ do
        str <-
            fmap (take 5) $
                w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j
                    >>= (listToMaybe . basicItemDisplay)
        return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
            case w ^? hud . hudElement . subInventory . ciFilter . _Just of
                Just ('#' : xs) | str == xs ->
                        w & hud . hudElement . subInventory . ciFilter .~ Nothing
                _ -> w & hud . hudElement . subInventory . ciFilter ?~ ("#" ++ str)
    _ -> w
  where
    f (x, y) = (x, y, mempty)
    selsec = w ^? hud . hudElement . diSelection . _Just . _1

endRegex ::
    Int ->
    World ->
    Maybe (Int, Int, IS.IntSet) ->
    Maybe (Int, Int, IS.IntSet)
endRegex i w = fromMaybe id $ do
    sss <- w ^? hud . hudElement . diSections
    let j = fromMaybe 0 $ do
            itms <- sss ^? ix i . ssItems
            (k, _) <- IM.lookupMin itms
            return k
    return $ ssSetCursor (ssLookupDown i j) sss

endCombineRegex ::
    World ->
    Maybe (Int, Int, IS.IntSet) ->
    Maybe (Int, Int, IS.IntSet)
endCombineRegex w = fromMaybe id $ do
    sss <- w ^? hud . hudElement . subInventory . ciSections
    let j = fromMaybe 0 $ do
            itms <- sss ^? ix 0 . ssItems
            (k, _) <- IM.lookupMin itms
            return (k -1)
    return $ ssSetCursor (ssLookupDown 0 j) sss

startDrag :: (Int, Int) -> Configuration -> World -> World
startDrag (a, b) cfig w = setcontext 
    $ case w ^? hud . hudElement . diSelection . _Just of
        Just (i,_,xs) | i == a && b `IS.member` xs -> w
        _ -> invSetSelection (a, b, IS.singleton b) w
  where
    setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath
    above = inverseSelSecYint (yint - 1) =<< w ^? hud . hudElement . diSections
    bneath = inverseSelSecYint (yint + 1) =<< w ^? hud . hudElement . diSections
    yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)

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
    (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'

shiftInvItems ::
    Int -> -- recurse limit
    Int -> -- section where drag started
    (Int, Int) -> -- selection item mouse is over
    Maybe (Int, Int) -> -- selection item "above" mouse position (can be same as over)
    Maybe (Int, Int) -> -- selection item "below" mouse position (can be same as over)
    IS.IntSet ->
    IM.IntMap (SelectionItem a) ->
    World ->
    World
shiftInvItems n k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do
    let xk = fst x
    guard $ xk == k || xk + 1 == k || xk -1 == k
    (maxi, _) <- IS.maxView xs
    (mini, _) <- IS.minView xs
    case True of
        _ | x < (k, mini) -> do
            guard $ not . null . fst $ IM.split mini ss
            guard $ Just (k, mini -1) /= ab
            return . doDrag (n -1) k (Just x) ab bn $ shiftInvItemsUp k xs w
        _ | x > (k, maxi) -> do
            guard $ not . null . snd $ IM.split maxi ss
            guard $ Just (k, maxi + 1) /= bn
            return . doDrag (n -1) k (Just x) ab bn $ shiftInvItemsDown k xs w
        _ -> Nothing

setSelWhileDragging :: World -> World
setSelWhileDragging w = fromMaybe w $ do
    (i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
    (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
    guard $ i == k && j `IS.member` xs
    return $ w & hud . hudElement . diSelection . _Just . _2 .~ j

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

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

updateFunctionKeys :: Universe -> Universe
updateFunctionKeys u =
    M.foldlWithKey'
        updateFunctionKey
        u
        (u ^. uvWorld . input . pressedKeys)

updateFunctionKey :: Universe -> Scancode -> PressType -> Universe
updateFunctionKey uv sc InitialPress = case sc of
    ScancodeF1 -> useNormalCamera uv
    ScancodeF2 -> pauseAndFloatCam uv
    ScancodeF5 -> doQuicksave uv
    ScancodeF9 -> doQuickload uv
    ScancodeF6 -> doDebugTestF6 uv
    ScancodeF7 -> doDebugTestF7 uv
    ScancodeF8 -> doDebugTestF8 uv
    ScancodeF10 -> doDebugTestF10 uv
    ScancodeF11 -> doDebugTestF11 uv
    ScancodeF12 -> doDebugTestF12 uv
    ScancodeEscape -> pauseGame uv
    _ -> uv
updateFunctionKey uv ScancodeF3 _ = doDebugTest uv
updateFunctionKey uv ScancodeF4 _ = doDebugTest2 uv
updateFunctionKey uv _ _ = uv

updateKeysInTerminal :: Int -> Universe -> Universe
updateKeysInTerminal tmid u =
    u
        & doTextInputOverUniverse
            (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText)
        & checkEndStatus
  where
    checkEndStatus
        | u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just InitialPress =
            uvWorld %~ terminalReturnEffect tmid
        | otherwise = id

updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
updateKeyInGame uv sc pt = case pt of
    InitialPress -> updateInitialPressInGame uv sc
    LongPress -> updateLongPressInGame uv sc
    _ -> uv

updateInitialPressInGame :: Universe -> Scancode -> Universe
updateInitialPressInGame uv sc = case sc of
    ScancodeSpace -> over uvWorld spaceAction uv
    ScancodeP -> pauseGame uv
    ScancodeF -> over uvWorld youDropItem uv
    --    ScancodeM -> toggleMap uv
    ScancodeT -> over uvWorld testEvent uv
    ScancodeC -> toggleCombineInv uv
    -- the following should be put in a more sensible place
    ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
    ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
    _ -> uv

updateLongPressInGame :: Universe -> Scancode -> Universe
updateLongPressInGame uv sc = case sc of
    ScancodeF -> over uvWorld youDropItem uv
    ScancodeSpace -> over uvWorld spaceAction uv
    _ -> uv

doRegexInput ::
    Input ->
    Int ->
    IM.IntMap (SelectionSection a) ->
    Maybe (Int, Int, IS.IntSet) ->
    Maybe String ->
    (IM.IntMap (SelectionSection a), Maybe (Int, Int, IS.IntSet), Maybe String)
doRegexInput inp i sss msel filts
    | backspacetonothing || escapekey = endregex i 0
    | endkeys = endregex (i + 1) (j -1)
    | otherwise =
        ( sss
        , msel
        , filts & doTextInputOver inp _Just
        )
  where
    endregex a b =
        ( sss
        , msel & ssSetCursor (ssLookupDown a b) sss
        , Nothing
        )
    j = fromMaybe 0 $ do
        itms <- sss ^? ix (i + 1) . ssItems
        fst <$> IM.lookupMin itms
    escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
    endkeys =
        any
            ((== Just InitialPress) . (`M.lookup` pkeys))
            [ScancodeReturn, ScancodeSlash]
    backspacetonothing =
        filts == Just ""
            && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
    pkeys = inp ^. pressedKeys

updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of
    Just NoSubInventory{}
        | secfocus (-1) 0 ->
            w & hud . hudElement %~ trybackspace (-1) diInvFilter diInvFilter diSelection
                & worldEventFlags . at InventoryChange ?~ ()
    Just NoSubInventory{}
        | secfocus 2 3 ->
            w & hud . hudElement %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
                & worldEventFlags . at InventoryChange ?~ ()
    Just CombineInventory{} ->
        w & hud . hudElement . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
            & worldEventFlags . at InventoryChange ?~ ()
    _ -> w
  where
    secfocus a b = fromMaybe False $ do
        i <- di ^? diSelection . _Just . _1
        return $ i == a || i == b
    trybackspace x filtget filtset selset he = fromMaybe he $ do
        str <- he ^? filtget . _Just
        return $ case str of
            (_ : _) ->
                he & filtset . _Just %~ init
                    & selset ?~ (x, 0, mempty)
            [] -> he & filtset .~ Nothing
    di = w ^. hud . hudElement

updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
    Just NoSubInventory{}
        | secfocus [-1, 0, 1] ->
            w & hud . hudElement . diSelection ?~ (-1, 0, mempty)
                & hud . hudElement . diInvFilter %~ enterregex
    Just NoSubInventory{}
        | secfocus [2, 3] ->
            w & hud . hudElement . diSelection ?~ (2, 0, mempty)
                & hud . hudElement . diCloseFilter %~ enterregex
    Just CombineInventory{} ->
        w & hud . hudElement . subInventory . ciFilter %~ enterregex
            & hud . hudElement . subInventory . ciSelection ?~ (-1, 0, mempty)
    _ -> w
  where
    di = w ^. hud . hudElement
    secfocus xs = fromMaybe False $ do
        i <- di ^? diSelection . _Just . _1
        return $ i `elem` xs
    enterregex = (<|> Just "")

pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u]

spaceAction :: World -> World
spaceAction w = case w ^. hud . hudElement of
    DisplayInventory{_subInventory = NoSubInventory{}} ->
        maybe id interactWithCloseObj (getCloseObj w) w
    DisplayInventory{_subInventory = DisplayTerminal{}} ->
        w
            & hud . hudElement . subInventory .~ NoSubInventory
            & worldEventFlags . at InventoryChange ?~ ()
    _ -> w & hud . hudElement . subInventory .~ NoSubInventory

getCloseObj :: World -> Maybe (Either FloorItem Button)
getCloseObj w = getSelectedCloseObj w <|> firstcitem <|> firstcbut
  where
    firstcitem = do
        k' <- (w ^? hud . hudElement . diSections . ix 3 . ssItems) >>= (fmap fst . IM.lookupMin)
        NInt k <- w ^? hud . closeItems . ix k'
        fmap Left $ w ^? cWorld . lWorld . floorItems . unNIntMap . ix k
    firstcbut = do
        k <- w ^? hud . closeButtons . ix 0
        fmap Right $ w ^? cWorld . lWorld . buttons . ix k

tryCombine :: (Int, Int) -> World -> World
tryCombine (i, j) w = fromMaybe w $ do
    sss <- w ^? hud . hudElement . subInventory . ciSections
    CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload
    p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
    return $
        snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
            & soundStart InventorySound p wrench1S Nothing
            & hud . hudElement . diSelection . _Just . _3 .~ mempty

maybeExitCombine :: World -> World
maybeExitCombine w
    | ButtonRight `M.member` (w ^. input . mouseButtons) = w
    | otherwise =
        w & hud . hudElement . subInventory .~ NoSubInventory