module BallFSM (freeBallSF, controlledBallSF, outOfPlayBallSF)

where

import FRP.Yampa
import FRP.Yampa.Geometry

import Data.List
import Data.Maybe

import Data.FSM
import Message
import Physics
import Object
import States
import Helper
import BasicTypes
import Global

type BallPerception = (BallMsgParam, [VisibleState])

s1 :: State BallState BallTransition p [a]
s1 = addTransition BTCollisionB 3 $
     addTransition BTOutOfPlay 4 $
     state 1 BSFree (const []) (const []) (const [])
s2 :: Param -> State BallState BallTransition (BallMsgParam, (BallMsgParam, [VisibleState])) [Message]
s2 param = addTransition BTCollisionB 3 $
     addTransition BTOutOfPlay 4 $
     addTransition BTLost 1 $
     state 2 BSControlled (const []) (checkForOffsite param) (const [])
s3 :: Param -> State BallState BallTransition (BallStateParam, BallPerception) [Message]
s3 param = addTransition BTGained 2 $
     addTransition BTGainedOOP 5 $
     addTransition BTGainedGoalie 6 $
     addTransition BTLostOOP 4 $
     addTransition BTLost 1 $
     state 3 BSChallenged (const []) (takeMe param) (const [])
s4 :: State BallState BallTransition p [a]
s4 = addTransition BTCollisionB 3 $
     state 4 BSOutOfPlay (const []) (const []) (const [])
s5 :: State BallState BallTransition p [a]
s5 = addTransition BTLost 1 $
     state 5 BSControlledOOP (const []) (const []) (const [])
s6 :: Param -> State BallState BallTransition (BallMsgParam, (BallMsgParam, [VisibleState])) [Message]
s6 param = addTransition BTLost 1 $
     state 6 BSControlledGoalie (const []) (checkForOffsite param) (const [])
fsm :: Param -> Either [Problem BallTransition] (FSM BallState BallTransition (BallMsgParam, (BallMsgParam, [VisibleState])) [Message])
fsm param = fromList [s1, s2 param, s3 param, s4, s5, s6 param]

takeMe :: Param -> (BallStateParam, BallPerception) -> [Message]
takeMe _ (BPWho playerIdTouching t, (BPWho me _,vss)) =
 let (ballState, ballParam) = vsBallState . fetchBallVS $ vss
     gameVS = fetchGameVS vss
     game = vsObjId gameVS
     attacker = vsAttacker gameVS
     playerVS = fetchVS vss playerIdTouching
     teamTouching = vsTeam playerVS
 in
     if ballState == BSOutOfPlay then
         if teamTouching == attacker then
          -- if colliding player is on the right team, send him a kickoff/throw-in/kick-corner message,
          -- otherwise ignore him
             [(playerIdTouching, PlayerMessage (PhysicalPlayerMessage (PPTPrepareThrowIn, BSPWhoAndWhen me t)))]
         else
             [(me, BallMessage (BTLostOOP, ballParam))]
     else -- ball was in play
--            -- if goalie has the ball, then don't take it from him
        if ballState == BSControlledGoalie then
            [(me, BallMessage (BTLost, ballParam))]
        else
            [(playerIdTouching, PlayerMessage (PhysicalPlayerMessage (PPTTakeMe, BSPWhoAndWhen me t))),
             (game, GameMessage (GTTakePossession, GPTeamPosition teamTouching (-1) [] (Point2 0 0) (-1) False InPlay))] ++
             (map (\vs -> (vsObjId vs, PlayerMessage (PhysicalPlayerMessage (PPTLoseMe, BSPRelease 0 RTNothing)))) $ filter hasBall vss)

checkForOffsite :: Param -> (BallMsgParam, (BallMsgParam, [VisibleState])) -> [Message]
checkForOffsite param (BPWho playerIdTouching t, (BPWho _ _,vss)) =
 let gameVS = fetchGameVS vss
     playerVS = fetchVS vss playerIdTouching
     teamTouching = vsTeam playerVS
     posTouching = vsPos $ playerVS
 in snd $ checkOffsite' param t (fst (vsGameState gameVS))
                        playerIdTouching teamTouching posTouching
                        ((snd $ vsGameState gameVS), vss)

checkOffsite' :: Param -> Time -> GameState -> ObjId -> Team -> Position3 -> (GameStateParam, [VisibleState]) -> (Bool, [Message])
checkOffsite' param t gs playerIdTouching teamTouching _
             (GPTeamPosition teamPassing playerIdPassing oposs posPassing _ _ _, vss) =

  if gs /= GSOffsitePending then (False, [])
  else if teamTouching /= teamPassing then (False, noOffsiteMsg)
  else if playerIdTouching == playerIdPassing then (False, noOffsiteMsg)
  else if noOffsite teamTouching (point2Y posPassing) (posYTouchingT0 playerIdTouching) then (False, noOffsiteMsg)
  else (True, offsiteMsg)

   where
     me = vsObjId (fetchGameVS vss)
     noOffsite team posPassing' posTouchingT0 =
         False ||
         (team == Home && posTouchingT0 > halfLine) ||
         (team == Away && posTouchingT0 < halfLine) ||
         (team == Home && posTouchingT0 >= posPassing') ||
         (team == Away && posTouchingT0 <= posPassing') ||
         (twoBehind team posTouchingT0 oposs)

     noOffsiteMsg = [(me, GameMessage (GTNoOffsite,
                                       GPTeamPosition teamTouching (-1) [] (Point2 0 50) t False InPlay))]
     offsiteMsg = [(me, GameMessage (GTOffsite,
                                     GPTeamPosition (otherTeam teamTouching) (-1) [] (Point2 0 50) t False OOPOffsite))]
     halfLine = pPitchLength param / 2

     posYTouchingT0 oid = thrd3 $ fromJust $ find (\(_, oid', _) -> oid == oid') oposs

twoBehind :: Ord a => Team -> a -> [(Team, t, a)] -> Bool
twoBehind team p0 oposs =
    length (filter (\(t, _, p) ->
                        t == otherTeam team &&
                        if team == Home then p < p0 else p > p0) oposs) > 1

freeBallSF :: Param -> BallStateParam ->
          SF (BallPerception, Event [(BallTransition, BallStateParam)])
             ((State BallState BallTransition (BallStateParam, BallPerception) [Message], BallStateParam), [Message])
freeBallSF param me = reactMachineMult (fromRight $ fsm param) s1 me
controlledBallSF :: Param -> Bool -> BallMsgParam -> 
                      SF ((BallMsgParam, [VisibleState]), Event [(BallTransition, BallMsgParam)]) 
                           ((State BallState BallTransition (BallMsgParam, (BallMsgParam, [VisibleState])) [Message], BallMsgParam), [Message])
controlledBallSF param goalie me = reactMachineMult (fromRight $ fsm param) (if goalie then (s6 param) else s2 param) me
outOfPlayBallSF :: Param -> BallMsgParam -> SF ((BallMsgParam, [VisibleState]), Event [(BallTransition, BallMsgParam)]) ((State BallState BallTransition (BallMsgParam, (BallMsgParam, [VisibleState])) [Message], BallMsgParam), [Message])
outOfPlayBallSF param me = reactMachineMult (fromRight $ fsm param) s4 me