loop/src/Dodge/Update/Input/InGame.hs

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

import NewInt
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 Dodge.Base.You
import Dodge.Button.Event
import Dodge.Camera
import Dodge.Creature.Action
import Dodge.Data.Combine
import Dodge.Data.Universe
import Dodge.DisplayInventory
import Dodge.Event.Test
import Dodge.InputFocus
import Dodge.Inventory
import Dodge.Inventory.Add
import Dodge.ListDisplayParams
import Dodge.Menu
import Dodge.Save
import Dodge.SelectionSections
import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.Update.Input.Text
import Dodge.WorldPos
import Geometry
import LensHelp
import SDL

updateUseInputInGame :: Universe -> Universe
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of
    DisplayCarte -> over uvWorld updatePressedButtonsCarte u
    DisplayInventory{_subInventory = si} -> case si of
        DisplayTerminal tmid -> updateKeysInTerminal tmid u
        CombineInventory{_ciSections = sss, _ciSelection = msel}
            | inSubInvRegex (u ^. uvWorld) ->
                u
                    & uvWorld . hud . hudElement . subInventory
                        %~ docombineregexinput sss msel
                    & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
        _
            | inInvRegex (u ^. uvWorld) ->
                u & uvWorld . hud . hudElement 
                        %~ dodisplayregexinput diInvFilter diInvFilter (-1)
                    & uvWorld . worldEventFlags . at InventoryChange ?~ ()
                    & uvWorld %~ setInvPosFromSS
        _
            | inCloseRegex (u ^. uvWorld) ->
                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 = case w ^? input . mouseButtons . ix ButtonLeft of
    Just 0 -> updateMouseClickInGame cfig w
    Just _ -> updateMouseHeldInGame cfig w
    Nothing -> case w ^? input . mouseButtonsReleased . ix ButtonLeft of
        Just 0 -> updateMouseReleaseInGame w
        _ -> w

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 ldp sss (w ^. input . mousePos)
        guard $ Just (fst sstart) == fmap fst msel || isNothing msel
        return $ w & input . mouseContext . mcoSelEnd .~ msel
    OverInvDrag k mmouseover ab bn -> fromMaybe w $ do
        ss <- w ^? hud . hudElement . diSections . ix k . ssItems
        x <- mmouseover
        is <- w ^? hud . hudElement . diSelectionExtra
        return $ if concurrentIS is
            then shiftInvItems k x ab bn is ss w
            else collectInvItems is w
--        let mpos = w ^. input . mousePos
--        return $ w & dragInvItems k xs cfig mpos ldp sss
    _ -> w
  where
    ldp = invDisplayParams 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, _) <- w ^? hud . hudElement . diSelection . _Just
    xs <- w ^? hud . hudElement . diSelectionExtra
    return $ IS.foldr (dropItem cr) w xs

tryPickupSelected :: Maybe (Int,Int) -> World -> Maybe World
tryPickupSelected mpos w = do
    guard $ maybe True (\(i,_) -> i == 0) mpos
--    cr <- w ^? cWorld . lWorld . creatures . ix 0
--    let nfreeslots = crNumFreeSlots cr
    (3, _) <- w ^? hud . hudElement . diSelection . _Just
--    xs <- w ^? hud . hudElement . diSelectionExtra
--    OverInvDrag 3 x <- w ^? input . mouseContext
    return w
--    return $ IS.foldr (dropItem cr) w xs

updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
    OverInvDrag _ mpos _ _ -> 
        input . mouseContext .~ MouseInGame $
        fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected mpos w
--    OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
--        j <- mpos
--        guard $ fst j == i
--        return $ w & input . mouseContext .~ OverInvSelect j
    OverInvDragSelect _ Nothing ->
        w & input . mouseContext .~ MouseInGame
            & hud . hudElement . diSelectionExtra .~ mempty
    OverInvDragSelect ssel (Just esel) ->
        w & input . mouseContext .~ MouseInGame
            & hud . hudElement . diSelectionExtra
                .~ h ssel (snd esel) -- IM.keysSet  [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
            & augInvDirectSelect (min ssel esel)
    _ -> w
  where
    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

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 ldp (mpos ^. _y)) sss
        return $
            w & input . mouseContext
                .~ OverInvDragSelect ysel Nothing
    OverInvSelect x -> startDrag x cfig w
    OverTerminalReturn tmid -> terminalReturnEffect tmid w
    OverTerminalEscape ->
        w
            & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
    OverCombSelect x ->
        w & hud . hudElement . subInventory . ciSelection ?~ x
            & worldEventFlags . at CombineInventoryChange ?~ ()
    OverCombFilter ->
        w & hud . hudElement . subInventory . ciFilter .~ Nothing
            & worldEventFlags . at CombineInventoryChange ?~ ()
    OverCombCombine x ->
        w
            & tryCombine x
            & worldEventFlags . at CombineInventoryChange ?~ ()
            & worldEventFlags . at InventoryChange ?~ ()
            & maybeExitCombine
    OverCombEscape ->
        w
            & worldEventFlags . at InventoryChange ?~ ()
            & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
    OverInvFilt (i, j) -> fromMaybe w $ do
        guard $ i == 0
        str <-
            fmap (take 5) $
                w
                    ^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0
        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
    ldp = invDisplayParams w
    mpos = w ^. input . mousePos

startDrag :: (Int, Int) -> Configuration -> World -> World
startDrag (a, b) cfig w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
    (i, _) <- w ^? hud . hudElement . diSelection . _Just
    xs <- w ^? hud . hudElement . diSelectionExtra
    guard $ i == a && b `IS.member` xs
    return $ setmichosen xs w
  where
    setmichosen :: IS.IntSet -> World -> World
    setmichosen x =
        (input . mouseContext .~ OverInvDrag a (Just (a, b)) above bneath)
            . (hud . hudElement . diSelectionExtra .~ x)
    above :: Maybe (Int,Int)
    above = do
        sss <- w ^? hud . hudElement . diSections
        inverseSelSecYint (yint - 1) sss
    bneath :: Maybe (Int,Int)
    bneath = do
        sss <- w ^? hud . hudElement . diSections
        inverseSelSecYint (yint + 1) sss
    yint = posSelSecYint cfig (invDisplayParams w) (w ^. input . mousePos . _y)

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

collectInvItems :: IS.IntSet -> World -> World
collectInvItems is w = fromMaybe w $ do
    (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 -> -- 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 k x ab bn xs ss w = fromMaybe w $ do
    (maxi,_) <- IS.maxView xs
    (mini,_) <- IS.minView xs
    if x < (k,mini)
        then do
            above <- ss ^? ix (mini - 1)
            guard $ Just (k,mini-1) /= ab
--            minss <- IM.lookupMin ss
--            guard (mini > fst minss)
            return $ shiftInvItemsUp k xs w
        else do
            guard $ x > (k,maxi)
            maxss <- IM.lookupMax ss
            guard (maxi < fst maxss)
            return $ shiftInvItemsDown k xs w

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
    ScancodeEscape -> pauseGame uv
    _ -> uv
updateFunctionKey uv _ _ = uv

updatePressedButtonsCarte :: World -> World
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w

updatePressedButtonsCarte' :: M.Map MouseButton Int -> World -> World
updatePressedButtonsCarte' pkeys w
    | isDown ButtonRight =
        w & hud . carteCenter %~ (-.- trans)
    | isDown ButtonLeft =
        w
            & hud . carteRot -~ rot
            & hud . carteZoom *~ czoom
    | otherwise = w
  where
    isDown but = but `M.member` pkeys
    mbutpos but = theinput ^. heldPos . at but
    rot = maybe 0 (angleBetween (_mousePos (_input w))) $ mbutpos SDL.ButtonLeft
    czoom = fromMaybe 1 $ do
        p <- mbutpos SDL.ButtonLeft
        return $ magV (_mousePos theinput) / magV p
    theinput = w ^. input
    trans = fromMaybe 0 $ do
        p <- mbutpos SDL.ButtonRight
        return . rotateV (w ^. hud . carteRot) $
            1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- p)

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
    --    ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crReloadToggle uv
    ScancodeT -> over uvWorld testEvent uv
    ScancodeX -> uv & uvWorld %~ toggleTweakInv
    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) ->
    Maybe String ->
    (IM.IntMap (SelectionSection a), Maybe (Int, Int), 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 & ix i . ssItems .~ mempty
        , 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)
                & worldEventFlags . at InventoryChange ?~ ()
    Just NoSubInventory{}
        | secfocus 2 3 ->
            w & hud . hudElement %~ trybackspace'' 2
                & worldEventFlags . at InventoryChange ?~ ()
    Just CombineInventory{} ->
        w & hud . hudElement . subInventory %~ trybackspace' (-1)
            & worldEventFlags . at InventoryChange ?~ ()
    _ -> w
  where
    secfocus a b = fromMaybe False $ do
        i <- di ^? diSelection . _Just . _1
        return $ i == a || i == b
    trybackspace x he = fromMaybe he $ do
        str <- he ^? diInvFilter . _Just
        return $ case str of
            (_ : _) ->
                he & diInvFilter . _Just %~ init
                    & diSelection ?~ (x, 0)
            [] -> he & diInvFilter .~ Nothing
    trybackspace'' x he = fromMaybe he $ do
        str <- he ^? diCloseFilter . _Just
        return $ case str of
            (_ : _) ->
                he & diCloseFilter . _Just %~ init
                    & diSelection ?~ (x, 0)
            [] -> he & diCloseFilter .~ Nothing
    trybackspace' x ci = fromMaybe ci $ do
        str <- ci ^? ciFilter . _Just
        return $ case str of
            (_ : _) ->
                ci & ciFilter . _Just %~ init
                    & ciSelection ?~ (x, 0)
            [] -> ci & ciFilter .~ Nothing
    di = w ^. hud . hudElement

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

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

spaceAction :: World -> World
spaceAction w = case w ^. hud . hudElement of
    DisplayCarte -> w & hud . carteCenter .~ theLoc
    DisplayInventory{_subInventory = NoSubInventory{}} -> fromMaybe w $ do
        cobj <- selCloseObj w
        return $ case cobj of -- case Left <$> selectedCloseItem w of
            (Left flit) -> pickUpItem 0 flit w 
                & worldEventFlags . at InventoryChange ?~ ()
            (Right but) -> doButtonEvent (_btEvent but) but w
                & worldEventFlags . at InventoryChange ?~ ()
    DisplayInventory{_subInventory = DisplayTerminal{}} -> w 
            & hud . hudElement . subInventory .~ NoSubInventory
            & worldEventFlags . at InventoryChange ?~ ()
    _ -> w & hud . hudElement . subInventory .~ NoSubInventory
  where
    theLoc =
        doWorldPos
            (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1)
            w

selCloseObj :: World -> Maybe (Either FloorItem Button)
selCloseObj w = selobj <|> firstcitem <|> firstcbut
  where
    selobj = do
        (i,j) <- w ^? hud . hudElement . diSelection . _Just
        case i of
            3 -> do
                NInt k <- w ^? hud . closeItems . ix j
                fmap Left $ w ^? cWorld . lWorld . floorItems . unNIntMap . ix k
            5 -> do
                k <- w ^? hud . closeButtons . ix j
                fmap Right $ w ^? cWorld . lWorld . buttons . ix k
            _ -> Nothing
    firstcitem = do
        NInt k <- w ^? hud . closeItems . ix 0
        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

toggleMap :: Universe -> Universe
toggleMap u = case u ^. uvWorld . hud . hudElement of
    DisplayCarte ->
        u & uvWorld . hud . hudElement
            .~ DisplayInventory
                { _subInventory = NoSubInventory
                , _diSections = mempty
                , _diSelection = Nothing
                , _diSelectionExtra = mempty
                , _diInvFilter = mempty
                , _diCloseFilter = mempty
                }
    _ -> u & uvWorld . hud . hudElement .~ DisplayCarte

toggleTweakInv :: World -> World
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
    Just ExamineInventory{} ->
        w
            & thepointer .~ NoSubInventory --MouseInvNothing
    _ -> w & thepointer .~ ExamineInventory -- mi
  where
    thepointer = hud . hudElement . subInventory

tryCombine ::
    --    IM.IntMap (SelectionSection CombinableItem) ->
    (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)))
            & cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
            & soundStart InventorySound p wrench1S Nothing

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