packages feed

freekick2-0.1.0: src/Match/State/Actions.hs

module Match.State.Actions(Action(..),
  PlAction,
  act,
  actP,
  plact)
where

import Control.Monad.State as State
import System.Random

import Utils
import FVector
import qualified Gen

import Match.Ball
import Match.Player

import Match.State.MatchState
import Match.State.MatchBase

data Action = Goto FRange | Kick FVector3 | HoldBall | Idle

type PlAction = (Player, Action)

plact :: PlAction -> Match ()
plact = uncurry act

act :: Player -> Action -> Match ()
act p (Goto t)    = goto t p
act p (Kick t)    = kick t p
act p (HoldBall)  = hold p
act p Idle        = idle p

actP :: PlayerID -> Action -> Match ()
actP p a = do
  s <- State.get
  case findPlayer p s of
    Nothing -> return ()
    Just pl  -> act pl a

playerControlCoeff :: Float -> Float -> Player -> Float
playerControlCoeff mn mx pl =
  mn + (mx - mn) * (Gen.controlskill $ plskills pl)

goto :: FRange -> Player -> Match ()
goto (x, y) pl = do
  s <- State.get
  let dt = frametime s
  let (curx,  cury)  = plposition pl
      (diffx, diffy) = (curx - x, cury - y)
      c              = playerid pl
      spd            = plspeed (plspeedcoeff (params s)) (plspeedmin (params s)) dt pl
      atpos          = abs diffx < spd && abs diffy < spd
      addvec = if atpos
                 then (-diffx, -diffy)
                 else
                   let ang = atan2 diffy diffx
                       xvel = cos ang * spd
                       yvel = sin ang * spd
                   in (-xvel, -yvel)
      dribbling = canDribble s pl && len2 addvec > 0.0000001
      (px, py) = pitchsize s
      runvec = if dribbling 
                 then addvec `mul2` playerControlCoeff (plcontrolmin (params s)) (plcontrolmax (params s)) pl 
                 else addvec
  when dribbling $ do
    sModBall $ modBallposition $ const $ to3D (plposition pl `add2` (addvec `mul2` 2)) 0
    sModBall $ modBallvelocity (const nullFVector3)
    sModPendingevents $ (BallKicked:)
    sModLasttouch $ const $ Just $ playerid pl
  doRot (Just (x, y)) pl
  let npos = clamp2 (-4, -0.2) (px + 4, py + 0.2) (plposition pl `add2` runvec)
  modify $ modPlayer c $ modPlposition $ const npos

getRandomR :: (Random a) => (a, a) -> State StdGen a
getRandomR v = State $ \s -> randomR v s

getKickVec :: FVector3 -> Player -> Match FVector3
getKickVec v p = do
  s <- State.get
  let (x, y, z) = capLen3 (maxkickveclen (params s)) v
      relskill = if len2 (x, y) < (stillpassveclen (params s)) && z < (stillpassvecheight (params s))
                   then Gen.passingskill $ plskills p
                   else Gen.shootingskill $ plskills p
      vlen = len3 (x, y, z)
  let xvarmax = vlen * ((maxkickvar (params s)) * (1 - relskill))
  let yvarmax = vlen * ((maxkickvar (params s)) * (1 - relskill))
  let zvarmax = abs z * ((maxkickvarz (params s)) * (1 - relskill))
  let (vc, g') = flip runState (randomgen s) $ do
                  x' <- getRandomR (-xvarmax, xvarmax)
                  y' <- getRandomR (-yvarmax, yvarmax)
                  z' <- getRandomR (0, zvarmax)
                  return (x + x', y + y', z + z')
  sModRandomgen $ const g'
  -- liftIO $ putStrLn $ "Orig: " ++ (show $ capLen3 40 v)
  -- liftIO $ putStrLn $ "New:  " ++ (show $ capLen3 40 vc)
  return $ capLen3 (maxkickveclen (params s)) vc

kick :: FVector3 -> Player -> Match ()
kick vec p = do
  s <- State.get
  if not (inKickDistance s p) || (kicktimer p > 0)
    then return ()
    else do
      kvec <- getKickVec vec p
      sModBall $ modBallvelocity $ const kvec
      sModPendingevents $ (BallKicked:)
      sModLasttouch $ const $ Just $ playerid p
      sModPlayer (playerid p) $ modKicktimer $ const (setkicktimer (params s))

hold :: Player -> Match ()
hold pl = do
  s <- State.get
  when (inCatchDistance s pl) $ do
    sModBall $ modBallvelocity $ const $ nullFVector3
    sModBall $ modBallposition $ const $ to3D (plposition pl) 0
    sModLasttouch $ const $ Just $ playerid pl

doRot :: Maybe FRange -> Player -> Match ()
doRot mtgt pl = do
  s <- State.get
  let (curx, cury)   = plposition pl
      bpos@(bx, by)  = to2D $ ballposition $ ball s
      gpos           = oppositeGoalAbs s pl
      atball         = abs (curx - bx) < 0.5 && abs (cury - by) < 0.5
      maintgtsimple  = if atball then gpos else bpos
      (ttx, tty)     = case mtgt of
        Nothing       -> maintgtsimple
        Just (tx, ty) -> let attgt = abs (curx - tx) < 0.5 && abs (cury - ty) < 0.5
                         in if attgt
                              then maintgtsimple
                              else (tx, ty)
  -- yup, this is correct (0 degrees = north)
  sModPlayer (playerid pl) $ modPlrotation $ const $ wrap 0 360 $ radToDeg $ atan2 (ttx - curx) (tty - cury)

idle :: Player -> Match ()
idle pl = doRot Nothing pl