MatchState.hs

{-# LANGUAGE TemplateHaskell #-}
module Match.State.MatchState
where

import Control.Monad.State as State
import qualified Data.IntMap as M
import System.Random

import Graphics.Rendering.OpenGL as OpenGL
import Graphics.UI.SDL as SDL
import Graphics.Rendering.FTGL as FTGL

import Drawing
import DeriveMod
import FVector
import Gen

import Match.Ball
import Match.Player

type Formation = M.IntMap Gen.Tactic

data Restart = ThrowIn FRange
             | GoalKick FRange
             | CornerKick FRange

getRestartPoint :: Restart -> FRange
getRestartPoint (ThrowIn r) = r
getRestartPoint (GoalKick r) = r
getRestartPoint (CornerKick r) = r

data BallPlay = BeforeKickoff 
              | WaitForKickoff Int 
              | DoKickoff 
              | InPlay
              | OutOfPlayWaiting Int Restart -- ai does nothing
              | OutOfPlay Int Restart        -- ai moves to positions
              | RestartPlay Restart          -- ai restarts play
              | Finished Int

data MatchEvent = BallKicked

type PlayerMap = M.IntMap Player

data Team = Team {
    players    :: PlayerMap
  , formation  :: Formation
  , goals      :: Int
  , teamname   :: String
  , teamowner  :: TeamOwner
}
$(deriveMods ''Team)

data MatchParams = MatchParams {
    matchtimedelta     :: Float -- time increase in seconds/frame
  , kickofftimer       :: Int -- time to spend in WaitForKickoff (ms)
  , kickoffballtimer   :: Int -- time after ball is centered in WaitForKickoff (ms)
  , oopthrowintimer    :: Int -- time to spend in OutOfPlayWaiting (throwin) (ms)
  , oopgoalkicktimer   :: Int -- time to spend in OutOfPlayWaiting (goal kick) (ms)
  , oopcornerkicktimer :: Int -- time to spend in OutOfPlayWaiting (corner kick) (ms)
  , ooptimer           :: Int -- time to spend in OutOfPlay (ms)
  , oopmoveballtimer   :: Int -- time after ball is moved in OutOfPlay (ms)
  , ballbounciness     :: Float -- 1: no bounce; 2: 100% elastic bounce
  , ballgravitypull    :: Float -- m/s^2 (approximate)
  , ballairviscosity   :: Float -- 0: none; 1/frametime(=50): complete
  , ballrollfriction   :: Float -- as in air viscosity
  , plcontrolmin       :: Float -- control coeff with control skill = 0
  , plcontrolmax       :: Float -- control coeff with control skill = 1
  , maxkickveclen      :: Float -- maximum length of kick vector
  , stillpassveclen    :: Float -- max. length of kick vector to still count as pass
  , stillpassvecheight :: Float -- max. height of kick vector to still count as pass
  , maxkickvar         :: Float -- percentage [0..1] of kick target variation in x, y
  , maxkickvarz        :: Float -- percentage [0..1] of kick target variation in z
  , setkicktimer       :: Int   -- kick timer in ms (max. time between kicks by a player)
  , aimaxlowpasslen    :: Float -- max. distance where to pass low
  , ailowpasspower     :: Float -- pass power coeff
  , aihighpasspower    :: Float -- pass power coeff
  , aihighpasszpower   :: Float -- pass power coeff (z)
  , plspeedcoeff       :: Float -- player speed coeff
  , plspeedmin         :: Float -- speed coeff with speed skill = 0
  , kickdistance       :: Float -- max kick distance
  , dribbledistance    :: Float -- max dribble distance
  , catchdistance      :: Float -- max catch distance
  , maxkickheight      :: Float -- max ball height for kick
  , maxdribbleheight   :: Float -- max ball height for dribble
  , maxcatchheight     :: Float -- max ball height for catch
  , maxballdspeed      :: Float -- max ball speed for dribbling
  , ctrlquitkey        :: SDLKey -- key to quit
  , ctrlshootkey       :: SDLKey -- key to shoot
  , ctrlleftkey        :: SDLKey
  , ctrlrightkey       :: SDLKey
  , ctrlupkey          :: SDLKey
  , ctrldownkey        :: SDLKey
  , ctrlpausekey       :: SDLKey
  }

defaultParams = MatchParams
  30 2000 1000 -- general
  1000 1000 1000 1000 1000  -- oop
  1.5 (-10) 0.5 1.2 -- ball
  0.6 0.8 -- control
  50 -- kick
  20 2 -- pass
  0.5 0.5 -- kick variation
  1000 -- kick timer
  30 4 1.5 0.5 -- ai pass
  20 0.7 -- speed
  1.2 0.6 2.0 -- max distances
  0.8 0.5 2.4 -- max heights
  40 -- max ball dribble speed
  SDLK_ESCAPE SDLK_RCTRL SDLK_LEFT SDLK_RIGHT SDLK_UP SDLK_DOWN SDLK_p

data MatchState = MatchState {
    pitchlist        :: DisplayList
  , matchgoal1       :: ImageInfo
  , matchgoal2       :: ImageInfo
  , matchgoal1shadow :: ImageInfo
  , matchgoal2shadow :: ImageInfo
  , currkeys         :: [SDLKey]
  , pitchsize        :: (Float, Float)
  , campos           :: (Float, Float)
  , hometeam         :: Team
  , awayteam         :: Team
  , controlledpl     :: Maybe PlayerID
  , ballplay         :: BallPlay
  , ball             :: Ball
  , pendingevents    :: [MatchEvent]
  , lasttouch        :: Maybe PlayerID
  , matchfont1       :: Font
  , matchfont2       :: Font
  , randomgen        :: StdGen
  , matchtime        :: (Bool, Float) -- half time?, seconds
  , paused           :: Bool
  , kickpower        :: Int
  , frametime        :: Float
  , homekickoff      :: Bool
  , homeattacksup    :: Bool
  , params           :: MatchParams
  }
$(deriveMods ''MatchState)

modHomeplayers :: (PlayerMap -> PlayerMap) -> MatchState -> MatchState
modHomeplayers f = modHometeam (modPlayers f)

modAwayplayers :: (PlayerMap -> PlayerMap) -> MatchState -> MatchState
modAwayplayers f = modAwayteam (modPlayers f)

sModHomegoals :: (Int -> Int) -> Match ()
sModHomegoals f = modify $ modHometeam (modGoals f)

sModAwaygoals :: (Int -> Int) -> Match ()
sModAwaygoals f = modify $ modAwayteam (modGoals f)

modPlayer :: PlayerID -> (Player -> Player) -> MatchState -> MatchState
modPlayer (pln, True)  f = modHomeplayers (M.adjust f pln)
modPlayer (pln, False) f = modAwayplayers (M.adjust f pln)

homeplayers :: MatchState -> PlayerMap
homeplayers = players . hometeam

awayplayers :: MatchState -> PlayerMap
awayplayers = players . awayteam

hometeamname :: MatchState -> String
hometeamname = teamname . hometeam

awayteamname :: MatchState -> String
awayteamname = teamname . awayteam

homegoals :: MatchState -> Int
homegoals = goals . hometeam

awaygoals :: MatchState -> Int
awaygoals = goals . awayteam

homeformation :: MatchState -> Formation
homeformation = formation . hometeam

awayformation :: MatchState -> Formation
awayformation = formation . awayteam

findPlayer :: PlayerID -> MatchState -> Maybe Player
findPlayer (pln, True)  m = M.lookup pln (homeplayers m)
findPlayer (pln, False) m = M.lookup pln (awayplayers m)

modAllPlayers :: (Player -> Player) -> MatchState -> MatchState
modAllPlayers f m = modHomeplayers (M.map f) (modAwayplayers (M.map f) m)

sModAllPlayers ::
     (Player -> Player) -> Match ()
sModAllPlayers f = modify $ modAllPlayers f

sModPlayer ::
     PlayerID -> (Player -> Player) -> Match ()
sModPlayer p f = modify $ modPlayer p f

type Match = StateT MatchState IO