{- |
Module      : Dodge.Event
Description : Direct event handling

Deals with direct events.
This could include individual key or mouse presses.
However, we cannot handle multiple keys held down at once here,
(eg left mouse button + right mouse button)
because these are separate events.
Nor could we handle continuous mouse button input.
Instead we store button presses (in a Map) and deal with the combinations in
the simulation step; in particular see 'updatePressedButtons'.
-}
module Dodge.Event
    ( handleEvent
    ) where
import Dodge.Terminal
import Dodge.Tweak
import Dodge.HeldScroll
import Dodge.InputFocus
import Dodge.Combine
import Dodge.Event.Keyboard
import Dodge.Base
import Dodge.Data
import Dodge.PreloadData
import Dodge.Inventory
import Dodge.SoundLogic
import qualified IntMapHelp           as IM

import Control.Lens
import Data.Maybe
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import SDL

handleEvent :: Event -> Universe -> IO (Maybe Universe)
handleEvent e = case eventPayload e of
    TextInputEvent tev         -> return . Just . handleTextInput (textInputEventText tev)
    KeyboardEvent kev          -> handleKeyboardEvent kev
    MouseMotionEvent mmev      -> return . handleMouseMotionEvent mmev
    MouseButtonEvent mbev      -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
    MouseWheelEvent mwev       -> return . handleMouseWheelEvent mwev
    WindowSizeChangedEvent sev -> handleResizeEvent sev
    WindowMovedEvent mev       -> return . handleWindowMoveEvent mev
    _                          -> return . Just

handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
    (fromIntegral x - 0.5*_windowX cfig)
    (0.5*_windowY cfig - fromIntegral y)
  where
    cfig = _uvConfig u
    P (V2 x y) = mouseMotionEventPos mmev

handleMouseButtonEvent :: MouseButtonEventData -> World -> World
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
    Released -> mouseButtons . at thebutton .~ Nothing
    Pressed  -> mouseButtons . at thebutton ?~ False
  where
    thebutton = mouseButtonEventButton mbev

{- | Sets window position in config. -}
handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
handleWindowMoveEvent mev = Just
    . (uvConfig . windowPosX .~ fromIntegral x)
    . (uvConfig . windowPosY .~ fromIntegral y)
  where
    P (V2 x y) = windowMovedEventPosition mev

{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -}
-- using a sideeffect here for the io change seems to work better, more testing
-- later may be a good idea
handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe)
handleResizeEvent sev u = return . Just $ u
    & uvConfig . windowX .~ fromIntegral x
    & uvConfig . windowY .~ fromIntegral y
    & uvIOEffects %~ sideEffectUpdatePreload divRes x y
  where
    x = fromIntegral x'
    y = fromIntegral y'
    V2 x' y' = windowSizeChangedEventSize sev
    divRes = resFactorNum $ u ^. uvConfig . graphics_resolution_factor

handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe
handleMouseWheelEvent mwev w = case _menuLayers w of
    [] -> case mouseWheelEventPos mwev of
        V2 _ y -> Just $ w & uvWorld %~ wheelEvent (fromIntegral y)
    _ -> Just w

wheelEvent :: Float -> World -> World
wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
    DisplayCarte
        | rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
        | otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi)
    DisplayInventory NoSubInventory
            -- functions that modify the inventory should be centralised so that
            -- this lock can be sensibly applied, perhaps
        | _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w
        | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of
            (_,EquipOptions{}) -> scrollRBOption y w
            (Nothing,_) -> closeObjScrollDir y w
            (Just f,_)  -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
        | lbDown -> w & cWorld . cameraZoom +~ y
        | invKeyDown -> changeSwapInvSel yi w
        | otherwise  -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
    DisplayInventory TweakInventory
        | invKeyDown && rbDown -> w & moveTweakSel yi
        | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
        | rbDown ->     w & changeTweakParam yi
        | otherwise ->  w & moveTweakSel yi
    DisplayInventory (CombineInventory _) -> w
        & cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
    DisplayInventory (DisplayTerminal tmid)
        | rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w
            & cWorld . terminals . ix tmid %~ updatetermsubsel
        | inTermFocus w -> w
            & cWorld . terminals . ix tmid %~ updatetermsel
    _ -> w
  where
    updatetermsel tm = case tm ^? tmInput . tiSel of
        Nothing -> tm & tmInput . tiSel .~ (0,0)
        Just (i,_) -> let newi = (i - yi) `mod` length (scrollCommands tm)
            in tm & setInput newi 0 w
    updatetermsubsel tm = case tm ^? tmInput . tiSel of
        Nothing -> tm & tmInput . tiSel .~ (0,0)
        Just (i,j) -> let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
            in tm & setInput i newj w
    setInput i j w' tm = tm
        & tmInput . tiSel .~ (i,j)
        & tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
      where
        tc = scrollCommands tm !! i
        arg = getArguments' tc tm w' !! j
    numcombs = length $ combineItemListYou w
    yi = round $ signum y
    numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1
    rbDown = ButtonRight `M.member` _mouseButtons w
    lbDown = ButtonLeft `M.member` _mouseButtons w
    invKeyDown = ScancodeCapsLock `S.member` _keys w

getArguments' :: TerminalCommand -> Terminal -> World -> [String]
getArguments' tc tm = ("" :) . getArguments tc tm

getArguments :: TerminalCommand -> Terminal -> World -> [String]
getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
    NoArguments {} -> []
    OneArgument _ m -> M.keys m

scrollCommands :: Terminal -> [TerminalCommand]
scrollCommands = (nullCommand :) . _tmScrollCommands
nullCommand :: TerminalCommand
nullCommand = TerminalCommand
    { _tcString = ""
    , _tcAlias  = []
    , _tcHelp   = ""
    , _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
    }

scrollRBOption :: Float -> World -> World
scrollRBOption y w
    | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))
    | y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
    | otherwise = w

moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
    Just l -> w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
                    . itTweaks . tweakSel %~ (`mod` length l) . subtract i
    _ -> w
changeTweakParam :: Int -> World -> World
changeTweakParam i w = w
    & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) %~
        ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
        . doTweak (_tweakType params) x)
  where
    tweaks = _itTweaks . fromJust $ yourItem w
    params = _tweakParams tweaks IM.! paramid
    x = (_tweakVal params + i) `mod` _tweakMax params
    paramid = _tweakSel tweaks