{-# LANGUAGE TemplateHaskell #-}
module Match.Match(playMatch, TeamOwner(..),
  MatchTextureSet(..), PlayerTextureSet(..)
  )
where

import Control.Monad
import Control.Monad.State as State
import Data.List
import Data.Maybe
import qualified Data.IntMap as M
import System.CPUTime
import Data.Function
import Text.Printf
import System.Random
import Control.Applicative

import Graphics.Rendering.OpenGL as OpenGL
import Graphics.UI.SDL as SDL hiding (flip)
import Graphics.Rendering.FTGL as FTGL

import SDLUtils
import Drawing
import FVector
import Utils
import Gen

import Match.DrawPitch
import Match.Ball
import Match.Player

import Match.State.MatchState
import Match.State.MatchBase
import Match.State.AI
import Match.State.Actions
import Match.State.Formation
import Match.State.Controls

data MatchTextureSet = MatchTextureSet {
    pitchtexture      :: TextureObject
  , hometextureset    :: PlayerTextureSet
  , awaytextureset    :: PlayerTextureSet
  , playershadowinfo  :: ImageInfo
  , ballimginfo       :: ImageInfo
  , ballshadowinfo    :: ImageInfo
  , humandrawsize     :: FRange
  , goal1             :: ImageInfo
  , goal2             :: ImageInfo
  , goal1shadow       :: ImageInfo
  , goal2shadow       :: ImageInfo
  }

playMatch :: Either Int StdGen
          -> MatchTextureSet 
          -> Font 
          -> Font
          -> (GenTeam, GenFormation, TeamOwner) 
          -> (GenTeam, GenFormation, TeamOwner) 
          -> IO ()
playMatch gen texs f f2 ht at = do
  let psize = (68, 105)
      contr = Nothing
  plist <- liftIO $ defineNewList Compile (drawPitch (pitchtexture texs) (16, 16) psize)
  evalStateT runMatch (initMatchState gen plist psize (20, 40) texs ht at contr f f2)
  (w, h) <- liftIO $ getWindowSize
  setCamera ((0, 0), (w, h))

initMatchState :: Either Int StdGen
               -> DisplayList 
               -> FRange -> FRange 
               -> MatchTextureSet 
               -> (GenTeam, GenFormation, TeamOwner)
               -> (GenTeam, GenFormation, TeamOwner)
               -> Maybe PlayerID 
               -> Font -> Font
               -> MatchState
initMatchState gen plist psize cpos pltexs (ht, htac, ho) (at, atac, ao) c f1 f2 = 
  MatchState plist (goal1 pltexs) (goal2 pltexs) (goal1shadow pltexs) (goal2shadow pltexs)
             [] psize cpos 
             (Team hps (genFormationToFormation hps htac) 0 (genteamname ht) ho) 
             (Team aps (genFormationToFormation aps atac) 0 (genteamname at) ao) 
             c BeforeKickoff 
             (initialBall onPitchZ psize (ballimginfo pltexs) (ballshadowinfo pltexs))
             [] Nothing f1 f2 (getgen gen) (False, 0) False 0 0.020 False True
             defaultParams
  where hps = createPlayers True pltexs psize ht
        aps = createPlayers False pltexs psize at
        getgen (Left n)  = mkStdGen n
        getgen (Right g) = g

onPitchZ :: Float
onPitchZ = 1

genTeamToTeam :: MatchTextureSet -> FRange -> Bool -> Formation -> TeamOwner -> GenTeam -> Team
genTeamToTeam pltexs psize home frm town g = Team pls frm 0 tnam town
  where tnam = genteamname g
        pls  = createPlayers home pltexs psize g

createPlayers :: Bool -> MatchTextureSet -> FRange -> GenTeam -> PlayerMap
createPlayers home texs psize t =
  let (d, m, f) = teamtactics t
      g  = take 1 $ filter (\p -> isGoalkeeper p) (teamplayers t)
      ds = take d $ filter (\p -> isDefender p) (teamplayers t)
      ms = take m $ filter (\p -> isMidfielder p) (teamplayers t)
      fs = take f $ filter (\p -> isAttacker p) (teamplayers t)
      pllist = g ++ ds ++ ms ++ fs
      plnums = map plnumber pllist
  in M.fromList 
       (zip plnums 
            (map (genPlayerToPlayer onPitchZ home
                                     (if home then hometextureset texs else awaytextureset texs)
                                     (playershadowinfo texs)
                                     (humandrawsize texs) 
                                     psize) 
                 pllist))

camZoomLevel :: (Num a) => a
camZoomLevel = 20

cameraCenter w h s =
   let (bx, by) =
         case ballplay s of
           OutOfPlayWaiting _ r -> getRestartPoint r
           OutOfPlay _ r        -> getRestartPoint r
           RestartPlay r        -> getRestartPoint r
           _                    -> to2D (ballposition $ ball s)
       (px, py) = pitchsize s
       nx = clamp 0 px bx
       ny = clamp 0 py by
   in (nx - (w / (2 * camZoomLevel)), ny - (h / (2 * camZoomLevel)))

drawMatch :: Match ()
drawMatch = do
  s <- State.get
  (w, h) <- liftIO $ getWindowSize
  let text = printf "%16s %d - %d %-16s" (hometeamname s) (homegoals s) (awaygoals s) (awayteamname s)
      coords = (fromIntegral w / 2, 50)
  liftIO $ do
    clear [ColorBuffer, DepthBuffer]
    let cpos = cameraCenter (fromIntegral w) (fromIntegral h) s
        (px, py) = pitchsize s
    setCamera' (cpos, (fromIntegral (w `div` camZoomLevel), fromIntegral (h `div` camZoomLevel)))
    callList (pitchlist s)
    drawSprite' (imgtexture $ matchgoal1shadow s) ((px / 2 - 3.66 - 0.4, py - 1.0), imgsize $ matchgoal1shadow s) (-1)
    drawSprite' (imgtexture $ matchgoal2shadow s) ((px / 2 - 3.66 - 0.4, -2.44 - 1.0), imgsize $ matchgoal2shadow s) (-1)
    drawSprite' (imgtexture $ matchgoal1 s) ((px / 2 - 3.66, py), imgsize $ matchgoal1 s) (-1)
    drawBallShadow $ ball s
    mapM_ drawPlayerShadow (allPlayers s)
    mapM_ drawSprite $ sortBy (compare `on` getDepth) (SB (ball s) : map SB (allPlayers s))
    drawSprite' (imgtexture $ matchgoal2 s) ((px / 2 - 3.66, -2.44), imgsize $ matchgoal2 s) (-1)
    case controlledpl s of
      Nothing            -> return ()
      Just i@(pid, _) -> case findPlayer i s of
                              Nothing -> return ()
                              Just pl -> do
                                let (plx, ply) = plposition pl
                                writeOnPitch (matchfont2 s) (show pid) (plx, ply + 2)
    -- writeTexts come in last, as they reset the camera.
    when (pausedBallplay s) $ writeText True w h (matchfont1 s) text coords
    when (inPlay (ballplay s)) $ writeText False w h 
                                     (matchfont2 s) 
                                     (fromMaybe "" 
                                         (liftM (\p -> show (playerNumber p) ++ " " ++ Match.Player.plname p)
                                                (lasttouch s >>= flip findPlayer s))) 
                                     (10, fromIntegral h - 20)
    writeText False w h (matchfont2 s) (printf "%d min" (floor (snd (matchtime s)) `div` (60 :: Int))) (10, fromIntegral h - 50)
    glSwapBuffers

uniformScale :: GLfloat -> IO ()
uniformScale n = scale n n n

writeOnPitch :: Font -> String -> FRange -> IO ()
writeOnPitch f str (x, y) = do
  loadIdentity
  color $ Color3 1 1 (1 :: GLfloat)
  translate $ Vector3 (realToFrac x) (realToFrac y) (2 :: GLfloat)
  uniformScale (1 / camZoomLevel)
  textlen <- getFontAdvance f str
  translate $ Vector3 (-(realToFrac textlen / 2)) 0 (0 :: GLfloat)
  renderFont f str FTGL.Front

writeText :: Bool -> Int -> Int -> Font -> String -> FRange -> IO ()
writeText centered w h f str (x, y) = do
  loadIdentity
  setCamera ((0, 0), (w, h))
  color $ Color3 1 1 (1 :: GLfloat)
  translate $ Vector3 (realToFrac x) (realToFrac y) (2 :: GLfloat)
  when centered $ do
    textlen <- getFontAdvance f str
    translate $ Vector3 (-(realToFrac textlen / 2)) 0 (0 :: GLfloat)
  renderFont f str FTGL.Front

playerOnHisSide :: MatchState -> Player -> Bool
playerOnHisSide m p =
  let (_, y) = absToRel m (plposition p)
      lower  = playerHome p == homeattacksup m
  in if lower then y <= 0.5 else y >= 0.5

updateBallPlay :: Match ()
updateBallPlay = do
  s <- State.get
  let (px, py) = pitchsize s
      frameTime = floor $ 1000 * frametime s
  case ballplay s of
    BeforeKickoff -> do
      when (all (playerOnHisSide s) (allPlayers s)) $
        sModBallplay (const $ WaitForKickoff (kickofftimer (params s)))
    WaitForKickoff timer -> do
      when (timer < (kickoffballtimer (params s))) $ sModBall $ modBallposition $ const $ to3D (px / 2, py / 2) 0
      sModBall $ modBallvelocity $ const nullFVector3
      if timer < 0
        then sModBallplay (const DoKickoff)
        else sModBallplay (const $ WaitForKickoff (timer - frameTime))
    DoKickoff -> do
      return () -- updated by handleMatchEvent BallKicked
    InPlay -> do
      let (bx, by, bz) = ballposition $ ball s
      when (bx < 0) $ do -- throwin from the left
        let restartpos = (0, by)
        sModBallplay $ const $ OutOfPlayWaiting (oopthrowintimer (params s)) (ThrowIn restartpos)
      when (bx > px) $ do -- throwin from the right
        let restartpos = (px, by)
        sModBallplay $ const $ OutOfPlayWaiting (oopthrowintimer (params s)) (ThrowIn restartpos)
      when (by < 0) $ do  -- corner kick or goal kick on bottom half
        if bx > px / 2 - 3.66 && bx < px / 2 + 3.66 && bz < 2.44 -- goal
          then do
            let restartpos = (px / 2, py / 2)
            if homeattacksup s
              then do
                sModAwaygoals succ
                sModHomekickoff $ const True
              else do
                sModHomegoals succ
                sModHomekickoff $ const False
            sModBallplay $ const BeforeKickoff
          else
            if homeattacksup s == not (homeRestarts s) -- corner kick
              then do
                let restartpos =
                      if bx < px / 2
                        then (0, 0)
                        else (px, 0)
                sModBallplay $ const $ OutOfPlayWaiting (oopcornerkicktimer (params s)) (CornerKick restartpos)
              else do -- goal kick
                let restartpos =
                      if bx < px / 2
                        then (px / 2 - 9.15, 5.5) -- TODO: clean up pitch constants
                        else (px / 2 + 9.15, 5.5)
                sModBallplay $ const $ OutOfPlayWaiting (oopgoalkicktimer (params s)) (GoalKick restartpos)
      when (by > py) $ do  -- corner kick of goal kick on upper half
        if bx > px / 2 - 3.66 && bx < px / 2 + 3.66 && bz < 2.44 -- goal
          then do
            let restartpos = (px / 2, py / 2)
            if homeattacksup s
              then do
                sModHomegoals succ
                sModHomekickoff $ const False
              else do
                sModAwaygoals succ
                sModHomekickoff $ const True
            sModBallplay $ const BeforeKickoff
          else
            if homeattacksup s == not (homeRestarts s) -- goal kick
              then do
                let restartpos =
                      if bx < px / 2
                        then (px / 2 - 9.15, py - 5.5)
                        else (px / 2 + 9.15, py - 5.5)
                sModBallplay $ const $ OutOfPlayWaiting (oopgoalkicktimer (params s)) (GoalKick restartpos)
              else do -- corner kick
                let restartpos =
                      if bx < px / 2
                        then (0, py)
                        else (px, py)
                sModBallplay $ const $ OutOfPlayWaiting (oopcornerkicktimer (params s)) (CornerKick restartpos)
    OutOfPlayWaiting timer restart -> 
      if timer > 0
        then sModBallplay $ const $ OutOfPlayWaiting (timer - frameTime) restart
        else sModBallplay $ const $ OutOfPlay (ooptimer (params s)) restart
    OutOfPlay timer restart ->
      if timer > 0
        then do
          when (timer < (oopmoveballtimer (params s))) $ sModBall $ modBallposition $ const $ to3D (getRestartPoint restart) 0
          sModBall $ modBallvelocity $ const nullFVector3
          sModBallplay $ const $ OutOfPlay (timer - frameTime) restart
        else sModBallplay $ const $ RestartPlay restart
    RestartPlay _ -> do
      when ((to2D $ ballposition (ball s)) `inside2s` ((0, 0), (pitchsize s))) $
        sModBallplay $ const InPlay
      -- in case the ball is kicked further away from pitch
      when (not $ (to2D $ ballposition (ball s)) `inside2s` ((-0.2, -0.2), (px + 0.2, py + 0.2))) $
        sModBallplay $ const InPlay
    Finished t ->
      sModBallplay $ const $ Finished $ (t + frameTime)

handleMatchEvent :: MatchEvent -> Match ()
handleMatchEvent BallKicked = do
  s <- State.get
  case ballplay s of
    DoKickoff -> do
      sModBallplay $ const InPlay
    _ -> return ()

handleMatchEvents :: Match ()
handleMatchEvents = do
  s <- State.get
  mapM_ handleMatchEvent (pendingevents s)
  sModPendingevents $ const []

updateBallPosition :: Match ()
updateBallPosition = do
  s <- State.get
  let dt = frametime s
      (px, py) = pitchsize s
      postradius = 0.25
      postdiameter = 2 * postradius
      postheight = 2.44
      goaldepth = 2.44
      post1 = CylinderZ (px / 2 - 3.66, 0, -1) postdiameter postheight
      post2 = CylinderZ (px / 2 + 3.66, 0, -1) postdiameter postheight
      post3 = CylinderZ (px / 2 - 3.66, py, -1) postdiameter postheight
      post4 = CylinderZ (px / 2 + 3.66, py, -1) postdiameter postheight
      bar1 = CylinderX (px / 2 - 3.66, 0, postheight) postdiameter 7.32
      bar2 = CylinderX (px / 2 - 3.66, py, postheight) postdiameter 7.32
      wall1 = (((px / 2 - 3.66 - postradius, -goaldepth - postdiameter,     -1 - postradius), 
                (0 + postdiameter,            goaldepth + postradius,       postheight + 1 + postdiameter)), 
                (-0.1, 1, 1))
      wall2 = (((px / 2 - 3.66 - postradius, -goaldepth - postdiameter,     -1 - postradius), 
                (7.32 + postdiameter,         0 + postradius,               postheight + 1 + postdiameter)), 
                (1, -0.1, 1))
      wall3 = (((px / 2 + 3.66 - postradius, -goaldepth - postdiameter,     -1 - postradius), 
                (0 + postdiameter,           goaldepth + postradius,        postheight + 1 + postdiameter)), 
                (-0.1, 1, 1))
      wall4 = (((px / 2 - 3.66 - postradius, -goaldepth - postdiameter,     postheight - postradius), 
                (7.32 + postdiameter,        goaldepth + postradius,        0 + postdiameter)), 
                (1, 1, -0.5))
      wall5 = (((px / 2 - 3.66 - postradius, py + postdiameter,             -1 - postradius), 
                (0 + postdiameter,           goaldepth + postradius,        postheight + 1 + postdiameter)), 
                (-0.1, 1, 1))
      wall6 = (((px / 2 - 3.66 - postradius, py + goaldepth + postdiameter, -1 - postradius), 
                (7.32 + postdiameter,        0 + postradius,                postheight + 1 + postdiameter)), 
                (1, -0.1, 1))
      wall7 = (((px / 2 + 3.66 - postradius, py + postdiameter,             -1 - postradius), 
                (0 + postdiameter,           goaldepth + postradius,        postheight + 1 + postdiameter)), 
                (-0.1, 1, 1))
      wall8 = (((px / 2 - 3.66 - postradius, py + postdiameter,             postheight - postradius), 
                (7.32  + postdiameter,       goaldepth + postradius,        0 + postdiameter)), 
                (1, 1, -0.5))
  sModBall $ modBallposition (*+* ((ballvelocity (ball s)) *** dt))
  sModBall $ collCheckGroundBall (ballbounciness (params s))
  sModBall $ collCheckPostsBall dt [post1, post2, post3, post4, bar1, bar2]
  sModBall $ collCheckNetBall dt [wall1, wall2, wall3, wall4, wall5, wall6, wall7, wall8]
  sModBall $ gravitateBall (ballgravitypull (params s)) dt
  sModBall $ slowDownBall (ballairviscosity (params s)) (ballrollfriction (params s)) dt

execAI :: Match ()
execAI = do
  s <- State.get
  let plactions = doAI s
  mapM_ plact plactions

modFst :: (a -> a) -> (a, b) -> (a, b)
modFst f (a, b) = (f a, b)

modSnd :: (b -> b) -> (a, b) -> (a, b)
modSnd f (a, b) = (a, f b)

updateTimers :: Match ()
updateTimers = do
  s <- State.get
  let dt = frametime s
  sModAllPlayers (modKicktimer (\t -> max 0 (t - floor (dt * 1000))))
  when (inPlay (ballplay s)) $ do
    sModMatchtime $ modSnd $ (+ (dt * matchtimedelta (params s)))
    case fst (matchtime s) of
      False -> do
        when (snd (matchtime s) > 45 * 60) $ do
          sModMatchtime $ const (True, 45 * 60)
          sModBallplay $ const BeforeKickoff
          sModHomeattacksup $ not
          sModHomekickoff $ const True
      True  -> do
        when (snd (matchtime s) > 90 * 60) $ do
          sModBallplay $ const $ Finished 0
          let (px, py) = pitchsize s
          sModBall $ modBallposition $ const $ to3D (px / 2, py / 2) 0
          sModBall $ modBallvelocity $ const nullFVector3

controllable :: BallPlay -> Bool
controllable InPlay                     = True
controllable DoKickoff                  = False
controllable (RestartPlay (GoalKick _)) = False
controllable (RestartPlay _)            = False
controllable _                          = False

setControl :: Bool -> Match ()
setControl h = do
  s <- State.get
  let p = if h
            then nearestToBallHwoGK s
            else nearestToBallAwoGK s
  sModControlledpl $ const $ Just $ playerid p

setControlledPlayer :: Match ()
setControlledPlayer = do
  s <- State.get
  if (controllable (ballplay s))
    then
      if teamowner (hometeam s) == HumanOwner
        then setControl True
        else if teamowner (awayteam s) == HumanOwner
               then setControl False
               else sModControlledpl $ const Nothing
     else sModControlledpl $ const Nothing

runMatch :: Match ()
runMatch = do
  t1 <- liftIO $ getCPUTime
  dt <- frametime <$> State.get
  quitting <- handleInput (floor (1000 * dt) :: Int)
  if quitting
    then return ()
    else do
      drawMatch
      setControlledPlayer
      pause <- paused <$> State.get
      if (not pause)
        then do
          execAI
          handleMatchEvents
          updateBallPosition
          updateBallPlay
          updateTimers
          t2 <- liftIO $ getCPUTime
          let tdiff = fromIntegral (t2 - t1) * (1e-12 :: Float)
          sModFrametime $ const ((dt * 3 + tdiff) / 4)
        else liftIO $ SDL.delay 20
      runMatch