module Dodge.KeyEvents where
-- imports {{{
import Dodge.Data
import Dodge.Base
import Dodge.CreatureActions
import Dodge.SoundLogic

import Geometry

import Control.Lens

import Data.Maybe
import Data.Char
import Data.List
import Data.Function

import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM

import SDL

--import Graphics.Gloss
--import Graphics.Gloss.Interface.IO.Game

-- }}}

pauseGame :: World -> World
pauseGame w = w {_menuState = PauseMenu}

handleEvent :: World -> Event -> Maybe World
handleEvent w e = case eventPayload e of
    KeyboardEvent kev -> handleKeyEvent w kev
    MouseMotionEvent mmev -> handleMouseMotionEvent w mmev
    MouseButtonEvent mbev -> handleMouseButtonEvent w mbev
    MouseWheelEvent mwev -> handleMouseWheelEvent w mwev
    WindowSizeChangedEvent sev -> handleResizeEvent w sev
    _ -> Just w

handleKeyEvent :: World -> KeyboardEventData -> Maybe World
handleKeyEvent w kev = case keyboardEventKeyMotion kev of
    Released -> Just $ over keys (S.delete $ getKeycode kev) w
    _  -> handlePressedKeyEvent (addKey (getKeycode kev) w) (keyboardEventRepeat kev) (getKeycode kev)
    where getKeycode :: KeyboardEventData -> Keycode
          getKeycode = keysymKeycode . keyboardEventKeysym

addKey :: Keycode -> World -> World
addKey k = over keys $ S.insert k

handlePressedKeyEvent :: World -> Bool -> Keycode -> Maybe World
handlePressedKeyEvent w True _ = Just w
handlePressedKeyEvent w _    keycode
    = case keycode of
        KeycodeEscape -> Nothing
--        KeycodeEscape -> Just $ pauseGame $ escapeMap w
        KeycodeC      -> Just $ pauseGame $ escapeMap w
        KeycodeF      -> Just $ dropItem w
        KeycodeM      -> Just $ toggleMap w
        KeycodeP      -> Just $ pauseGame $ escapeMap w
        KeycodeR      -> Just $ fromMaybe w $ reloadWeapon (_yourID w) w
        KeycodeT      -> Just $ testEvent w
        KeycodeSpace  -> Just $ spaceAction w
        KeycodeQ      -> Just $ w {_cameraRot = _cameraRot w + 0.01}
        KeycodeE      -> Just $ w {_cameraRot = _cameraRot w - 0.01}
        _ -> Just w

handleMouseMotionEvent :: World -> MouseMotionEventData -> Maybe World
handleMouseMotionEvent w mmev 
    = Just $ set mousePos (fromIntegral x - 0.5*_windowX w
                          ,0.5*_windowY w - fromIntegral y
                          ) w
    where P (V2 x y) = mouseMotionEventPos mmev

handleMouseButtonEvent :: World -> MouseButtonEventData -> Maybe World
handleMouseButtonEvent w mbev = case mouseButtonEventMotion mbev of
    Released -> Just $ over mouseButtons (S.delete but) w
    Pressed  -> handlePressedMouseButton but $ over mouseButtons (S.insert but) w
    where but = mouseButtonEventButton mbev

handlePressedMouseButton :: MouseButton -> World -> Maybe World
handlePressedMouseButton ButtonMiddle w = Just $ set lbClickMousePos (_mousePos w) w
handlePressedMouseButton _ w = Just w

handleMouseWheelEvent :: World -> MouseWheelEventData -> Maybe World
handleMouseWheelEvent w mwev = 
    case mouseWheelEventPos mwev of
        V2 x y | y > 0 -> Just $ wheelUpEvent w
               | y < 0 -> Just $ wheelDownEvent w
               | otherwise -> Just $ w
--        case mouseWheelEventDirection mwev of
--    ScrollNormal  -> Just $ wheelUpEvent w
--    ScrollFlipped -> Just $ wheelDownEvent w


handleResizeEvent :: World -> WindowSizeChangedEventData -> Maybe World
handleResizeEvent w sev = Just $ set windowX (fromIntegral x)
                               $ set windowY (fromIntegral y) w
    where V2 x y = windowSizeChangedEventSize sev

toggleMap w = w & mapDisplay . _1 %~ not
escapeMap w = w & mapDisplay . _1 .~ False

wheelUpEvent :: World -> World
wheelUpEvent w 
    = case _mapDisplay w of
        (True,z) -> w & mapDisplay . _2 .~ min 0.3 (z+(0.1*z))
        _ | rbPressed -> fromMaybe w $ (yourItem w ^? itScrollUp) <*> pure (_crInvSel (you w))
                                                                  <*> pure w
          | lbPressed -> w {_cameraZoom = _cameraZoom w + 0.1}
          | otherwise -> upInvPos w
    where lbPressed = ButtonLeft `S.member` mbs
          rbPressed = ButtonRight `S.member` mbs
          mbs = _mouseButtons w
wheelDownEvent :: World -> World
wheelDownEvent w 
    = case _mapDisplay w of
        (True,z) -> w & mapDisplay . _2 .~ max 0.05 (z-(0.1*z))
        _ | rbPressed ->  fromMaybe w $ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w))
                                                                     <*> pure w
          | lbPressed -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
          | otherwise -> downInvPos w
    where lbPressed = ButtonLeft `S.member` mbs
          rbPressed = ButtonRight `S.member` mbs
          mbs = _mouseButtons w

upInvPos :: World -> World
--upInvPos w = soundOnce 3 $ stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
    where is = IM.keys $ _crInv $ _creatures w IM.! _yourID w
          isis = is ++ is
          x = before (_crInvSel (you w)) isis
downInvPos :: World -> World
--downInvPos w = playSoundFromFor InventorySound 3 2 $ stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
downInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
    where is = IM.keys $ _crInv $ _creatures w IM.! _yourID w
          isis = is ++ is
          x = after (_crInvSel (you w)) isis


-- these are incomplete: should put in error case here!
before y (x:z:ys) | y == z    = x
                  | otherwise = before y (z:ys)
after y (x:z:ys)  | y == x    = z
                  | otherwise = after y (z:ys)

mouseActionsCr :: S.Set MouseButton -> Creature -> Creature
mouseActionsCr keys cr 
    | rbPressed 
        = set ( crState . stance . posture) Aiming cr
    | otherwise
        = set ( crState . stance . posture) AtEase cr
    where lbPressed = ButtonLeft `S.member` keys
          rbPressed = ButtonRight `S.member` keys
--          wUp       = MouseButton WheelUp `S.member` keys
--         -- wUp       = Char 'q' `S.member` keys
--          wDown     = MouseButton WheelDown `S.member` keys

mouseActionsWorld :: S.Set MouseButton -> World -> World
mouseActionsWorld keys w 
    | lbPressed && rbPressed 
        = useItemContinuous (_yourID w) w
    | mbPressed 
        = set lbClickMousePos (_mousePos w) $ over cameraRot (\r-> r - rotation) w
    | otherwise
        = w
    where lbPressed = ButtonLeft `S.member` keys
          rbPressed = ButtonRight `S.member` keys
          mbPressed = ButtonMiddle `S.member` keys
          ---wUp       = MouseButton WheelUp `S.member` keys
          ---wDown     = MouseButton WheelDown `S.member` keys
          ---theItem   = _crInv (you w) IM.! _crInvSel (you w)
          rotation  = angleBetween (_mousePos w) (_lbClickMousePos w)

-- for now, left are floor items, right are buttons
closestActiveObject :: World -> Maybe (Either FloorItem Button)
closestActiveObject w = listToMaybe $ sortBy (compare `on` dist ypos . pos) $ actObjs
    where ypos = _crPos $ you w
          actObjs = filter (\obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w) 
                        $ map Left (IM.elems $ _floorItems w) ++ map Right (IM.elems $ _buttons w)
          pos (Right x) = _btPos x
          pos (Left x)  = _flItPos x

spaceAction :: World -> World
spaceAction w = case closestActiveObject w of
    Just (Left flit) -> pickUpItem' flit w
    Just (Right but) -> _btEvent but but w
    Nothing -> w

testEvent :: World -> World
testEvent w = w