module Menu.Connect where

import Affection as A

import qualified SDL hiding (V2)

import NanoVG hiding (V2)

import Linear hiding (rotate, translation)

import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Data.String

import Control.Concurrent.MVar

import Control.Monad

-- internal imports

import Types
import Util
import Menu.Adjust
import MainGame.WorldMap

loadMenu :: UserData -> Affection ()
loadMenu ud = do
  let (Subsystems _ m k j t) = subsystems ud
  uu1 <- partSubscribe j (joystickConnect ud)
  uu2 <- partSubscribe j (joystickDisconnect ud)
  uu3 <- partSubscribe j (emitJoyActionMessage ud)
  uu4 <- partSubscribe k (emitKbdActionMessage ud)
  uu5 <- partSubscribe t (handleActionMessages ud)
  uu6 <- partSubscribe m (handleClicks ud)
  -- uu6 <- partSubscribe k emitKbdActionMessage
  juuid <- liftIO $ readMVar (joyUUID ud)
  partUnSubscribe j juuid
  cache <- liftIO $ readMVar (joyCache ud)
  void $ liftIO $ swapMVar (uuid ud) [ uu1, uu2, uu3, uu4, uu5, uu6 ]
  void $ liftIO $ swapMVar (state ud) (Menu Connect)
  void $ liftIO $ swapMVar (stateData ud) (MenuData (V2 0 0) S 0 0)
  void $ liftIO $ swapMVar (joyCache ud) []
  mapM_ (partEmit j) cache

joystickConnect :: UserData -> JoystickMessage -> Affection ()
joystickConnect ud msg = do
  ctrls <- liftIO $ readMVar (controls ud)
  when (ctrls == NoController) $ do
    mjoy <- joystickAutoConnect msg
    maybe (return ()) (\joy -> do
      ident <- liftIO $ fromIntegral <$> SDL.getJoystickID joy
      liftIO $ logIO A.Debug $ "Joystick connected: " <> fromString (show (ident :: Int))
      void $ liftIO $ swapMVar (controls ud) (Joystick joy)
      void $ liftIO $ swapMVar (translation ud) (JoyTranslation defaultJoyTranslation)
      ) mjoy

joystickDisconnect :: UserData -> JoystickMessage -> Affection ()
joystickDisconnect ud msg = do
  ctrls <- liftIO $ readMVar (controls ud)
  case ctrls of
    Joystick joy -> do
      njoys <- joystickAutoDisconnect [joy] msg
      when (null njoys) $ do
        liftIO $ logIO A.Debug $ "Joystick disconnected"
        void $ liftIO $ swapMVar (controls ud) NoController
        void $ liftIO $ swapMVar (translation ud) NoTranslation
    _ -> return ()

handleActionMessages :: UserData -> ActionMessage -> Affection ()
handleActionMessages ud (ActionMessage ActActivate _) = do
  liftIO $ modifyMVar_ (stateData ud) (\dat -> return dat
    { activate = 0.5
    }
    )
handleActionMessages ud (ActionMessage ActSwitchMap _) = do
  liftIO $ modifyMVar_ (stateData ud) (\dat -> return dat
    { switchMap = 0.5
    }
    )
handleActionMessages ud (ActionMessage (ActUp f) _) = do
  liftIO $ modifyMVar_ (stateData ud) (\dat ->
    let V2 vx _ = velocity dat
    in return dat
      { velocity = (V2 vx (-f))
      }
    )
handleActionMessages ud (ActionMessage (ActDown f) _) = do
  liftIO $ modifyMVar_ (stateData ud) (\dat ->
    let V2 vx _ = velocity dat
    in return dat
      { velocity = (V2 vx f)
      }
    )
handleActionMessages ud (ActionMessage (ActLeft f) _) = do
  liftIO $ modifyMVar_ (stateData ud) (\dat ->
    let V2 _ vy = velocity dat
    in return dat
      { velocity = (V2 (-f) vy)
      }
    )
handleActionMessages ud (ActionMessage (ActRight f) _) = do
  liftIO $ modifyMVar_ (stateData ud) (\dat ->
    let V2 _ vy = velocity dat
    in return dat
      { velocity = (V2 f vy)
      }
    )

handleClicks :: UserData -> MouseMessage -> Affection ()
handleClicks ud (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft 1 cpos) = do
  rels <- liftIO $ fmap ((/ 2) . (+ 1)) <$> (relativizeMouseCoords cpos)
  ctrls <- liftIO $ readMVar (controls ud)
  case ctrls of
    Joystick _ -> do
      when (arrowUp rels) adjustKbdUp
      when (arrowDown rels) adjustKbdDown
      when (arrowLeft rels) adjustKbdLeft
      when (arrowRight rels) adjustKbdRight
      when (buttonActivate rels) adjustKbdActivate
      when (buttonSwitchMap rels) adjustKbdSwitchMap
      when (buttonPlay rels) enterGame
    NoController -> do
      when (kbdIcon rels) $ do
        void $ liftIO $ swapMVar (controls ud) Keyboard
        void $ liftIO $ swapMVar (translation ud) (KbdTranslation defaultKbdTranslation)
    Keyboard -> do
      when (kbdIcon rels) $ do
        void $ liftIO $ swapMVar (controls ud) NoController
        void $ liftIO $ swapMVar (translation ud) NoTranslation
      when (buttonPlay rels) enterGame
  where
    adjustKbdUp = do
        fullClean ud
        loadAdjust ud (ActUp 1) Keyboard (loadMenu ud)
    adjustKbdDown = do
        fullClean ud
        loadAdjust ud (ActDown 1) Keyboard (loadMenu ud)
    adjustKbdLeft = do
        fullClean ud
        loadAdjust ud (ActLeft 1) Keyboard (loadMenu ud)
    adjustKbdRight = do
        fullClean ud
        loadAdjust ud (ActRight 1) Keyboard (loadMenu ud)
    adjustKbdActivate = do
      fullClean ud
      loadAdjust ud ActActivate Keyboard (loadMenu ud)
    adjustKbdSwitchMap = do
      fullClean ud
      loadAdjust ud ActSwitchMap Keyboard (loadMenu ud)
    enterGame = do
      fullClean ud
      loadMap ud
    arrowUp (V2 rx ry) =
      rx > 310 / 1280 && rx < 410 / 1280 && ry > 190 / 720 && ry < 290 / 720
    arrowDown (V2 rx ry) =
      rx > 310 / 1280 && rx < 410 / 1280 && ry > 430 / 720 && ry < 530 / 720
    arrowLeft (V2 rx ry) =
      rx > 190 / 1280 && rx < 290 / 1280 && ry > 310 / 720 && ry < 410 / 720
    arrowRight (V2 rx ry) =
      rx > 430 / 1280 && rx < 530 / 1280 && ry > 310 / 720 && ry < 410 / 720
    buttonActivate (V2 rx ry) =
      rx > 650 / 1280 && rx < 800 / 1280 && ry > 160 / 720 && ry < 210 / 720
    buttonSwitchMap (V2 rx ry) =
      rx > 650 / 1280 && rx < 800 / 1280 && ry > 220 / 720 && ry < 270 / 720
    buttonPlay (V2 rx ry) =
      rx > 650 / 1280 && rx < 800 / 1280 && ry > 560 / 720 && ry < 610 / 720
    kbdIcon (V2 rx ry) =
      rx > 650 / 1280 && rx < 730 / 1280 && ry > 620 / 720 && ry < 700 / 720
handleClicks _ _ = return ()

updateMenu :: UserData -> Double -> Affection ()
updateMenu ud dt = do
  sData <- liftIO $ readMVar (stateData ud)
  case sData of
    MenuData _ _ _ _ ->
      void $ liftIO $ swapMVar (stateData ud) (
        MenuData
          (velocity sData)
          (rotation sData)
          (max 0 ((activate sData) - dt))
          (max 0 ((switchMap sData) - dt))
        )
    _ -> return ()

drawMenu :: UserData -> Affection ()
drawMenu ud = do
  sData <- liftIO $ readMVar (stateData ud)
  curState <- liftIO $ readMVar (state ud)
  aIcons <- liftIO $ readMVar (assetIcons ud)
  case sData of
    MenuData _ _ _ _ ->
      liftIO $ do
        let ctx = nano ud
        controller <- readMVar (controls ud)
        save ctx
        beginPath ctx
        cpaint <- imagePattern ctx 550 620 80 80 0 (aIcons M.!
          case controller of
          Joystick _ -> IconContrGreen
          _          -> IconContrBlue
          ) 1
        rect ctx 550 620 80 80
        fillPaint ctx cpaint
        closePath ctx
        fill ctx
        beginPath ctx
        cpaint2 <- imagePattern ctx 650 620 80 80 0 (aIcons M.!
          case controller of
          Keyboard -> IconKbdGreen
          _        -> IconKbdBlue
          ) 1
        rect ctx 650 620 80 80
        fillPaint ctx cpaint2
        closePath ctx
        fill ctx
        when (controller /= NoController) $ do
          let V2 vx vy = velocity sData
          beginPath ctx
          roundedRect ctx 140 110 1000 500 25
          strokeWidth ctx 5
          fillColor ctx (rgba 255 255 255 64)
          strokeColor ctx (rgb 255 255 255)
          stroke ctx
          fill ctx
          mapM_ (\deg -> do
            let V2 px py = fmap realToFrac $
                  V2 360 360 - V2 50 50 + fmap realToFrac rot
                rot = fmap (fromIntegral . floor) $
                  V2 0 120 `rotVec` deg :: V2 Int
            save ctx
            translate ctx (px + 50) (py + 50)
            rotate ctx (dtor deg)
            translate ctx (-50) (-50)
            case deg of
              0 -> do
                when (vy < 0) $ do
                  beginPath ctx
                  fillColor ctx (rgb 255 128 0)
                  roundedRect ctx 0 0 100 100 10
                  closePath ctx
                  fill ctx
                case curState of
                  Menu (Adjust (ActUp _) _) -> do
                    beginPath ctx
                    fillColor ctx (rgb 0 255 0)
                    roundedRect ctx 0 0 100 100 10
                    closePath ctx
                    fill ctx
                  Menu (Adjust (ActDown _) _) -> do
                    beginPath ctx
                    fillColor ctx (rgb 0 255 0)
                    roundedRect ctx 0 0 100 100 10
                    closePath ctx
                    fill ctx
                  _ ->
                    return ()
              90 -> do
                when (vx > 0) $ do
                  beginPath ctx
                  fillColor ctx (rgb 255 128 0)
                  roundedRect ctx 0 0 100 100 10
                  closePath ctx
                  fill ctx
                case curState of
                  Menu (Adjust (ActLeft _) _) -> do
                    beginPath ctx
                    fillColor ctx (rgb 0 255 0)
                    roundedRect ctx 0 0 100 100 10
                    closePath ctx
                    fill ctx
                  Menu (Adjust (ActRight _) _) -> do
                    beginPath ctx
                    fillColor ctx (rgb 0 255 0)
                    roundedRect ctx 0 0 100 100 10
                    closePath ctx
                    fill ctx
                  _ ->
                    return ()
              180 -> do
                when (vy > 0) $ do
                  beginPath ctx
                  fillColor ctx (rgb 255 128 0)
                  roundedRect ctx 0 0 100 100 10
                  closePath ctx
                  fill ctx
                case curState of
                  Menu (Adjust (ActUp _) _) -> do
                    beginPath ctx
                    fillColor ctx (rgb 0 255 0)
                    roundedRect ctx 0 0 100 100 10
                    closePath ctx
                    fill ctx
                  Menu (Adjust (ActDown _) _) -> do
                    beginPath ctx
                    fillColor ctx (rgb 0 255 0)
                    roundedRect ctx 0 0 100 100 10
                    closePath ctx
                    fill ctx
                  _ ->
                    return ()
              270 -> do
                when (vx < 0) $ do
                  beginPath ctx
                  fillColor ctx (rgb 255 128 0)
                  roundedRect ctx 0 0 100 100 10
                  closePath ctx
                  fill ctx
                case curState of
                  Menu (Adjust (ActLeft _) _) -> do
                    beginPath ctx
                    fillColor ctx (rgb 0 255 0)
                    roundedRect ctx 0 0 100 100 10
                    closePath ctx
                    fill ctx
                  Menu (Adjust (ActRight _) _) -> do
                    beginPath ctx
                    fillColor ctx (rgb 0 255 0)
                    roundedRect ctx 0 0 100 100 10
                    closePath ctx
                    fill ctx
                  _ ->
                    return ()
            beginPath ctx
            apaint <- imagePattern ctx 0 0 100 100 0 (aIcons M.! IconArrow) 1
            rect ctx 0 0 100 100
            fillPaint ctx apaint
            closePath ctx
            fill ctx
            restore ctx
            ) [0, 90, 180, 270]
          when (activate sData > 0) $ do
            beginPath ctx
            fillColor ctx (rgb 255 128 0)
            roundedRect ctx 650 160 150 50 10
            fill ctx
            closePath ctx
          case curState of
            Menu (Adjust ActActivate _) -> do
              beginPath ctx
              fillColor ctx (rgb 0 255 0)
              roundedRect ctx 650 160 150 50 10
              closePath ctx
              fill ctx
            _ ->
              return ()
          beginPath ctx
          roundedRect ctx 650 160 150 50 10
          strokeWidth ctx 2
          stroke ctx
          fontSize ctx 25
          fontFace ctx "bedstead"
          textAlign ctx (S.fromList [AlignCenter, AlignTop])
          fillColor ctx (rgb 255 255 255)
          textBox ctx 650 175 150 "Activate"
          closePath ctx
          when (switchMap sData > 0) $ do
            beginPath ctx
            fillColor ctx (rgb 255 128 0)
            roundedRect ctx 650 220 150 50 10
            fill ctx
            closePath ctx
          case curState of
            Menu (Adjust ActSwitchMap _) -> do
              beginPath ctx
              fillColor ctx (rgb 0 255 0)
              roundedRect ctx 650 220 150 50 10
              closePath ctx
              fill ctx
            _ ->
              return ()
          beginPath ctx
          roundedRect ctx 650 220 150 50 10
          strokeWidth ctx 2
          stroke ctx
          fontSize ctx 25
          fontFace ctx "bedstead"
          fillColor ctx (rgb 255 255 255)
          textAlign ctx (S.fromList [AlignCenter, AlignTop])
          textBox ctx 650 235 150 "Switch Map"
          closePath ctx
          beginPath ctx
          roundedRect ctx 650 560 150 50 10
          strokeWidth ctx 5
          stroke ctx
          closePath ctx
          fontSize ctx 25
          fontFace ctx "bedstead"
          textAlign ctx (S.fromList [AlignCenter, AlignTop])
          textBox ctx 650 575 150 "Play"
        restore ctx
    _ -> return ()
