Rasenschach-0.1: BallFSM.hs

module BallFSM (freeBallSF, controlledBallSF, outOfPlayBallSF)


where

import Debug.Trace
import FRP.Yampa
import FRP.Yampa.Geometry

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

type BallPerception = (BallMsgParam, [VisibleState])

s1 = addTransition BTCollisionB 3 $
     addTransition BTOutOfPlay 4 $
     state 1 BSFree (const []) (const []) (const [])
s2 = addTransition BTCollisionB 3 $
     addTransition BTOutOfPlay 4 $
     addTransition BTLost 1 $
     state 2 BSControlled (const []) (const []) (const [])
s3 = addTransition BTGained 2 $
     addTransition BTGainedOOP 5 $
     addTransition BTGainedGoalie 6 $
     addTransition BTLostOOP 4 $
     addTransition BTLost 1 $
     state 3 BSChallenged (const []) takeMe (const [])
s4 = addTransition BTCollisionB 3 $
     state 4 BSOutOfPlay (const []) (const []) (const [])
s5 = addTransition BTLost 1 $
     state 5 BSControlledOOP (const []) (const []) (const [])
s6 = addTransition BTLost 1 $
     state 6 BSControlledGoalie (const []) (const []) (const [])
Right fsm = fromList [s1, s2, s3, s4, s5, s6]

takeMe :: (BallStateParam, BallPerception) -> [Message]
takeMe (BPWho player t, (BPWho me _,vss)) =
 let (ballState, ballParam) = vsBallState . fetchBallVS $ vss
     gameVS = fetchGameVS vss
     game = vsObjId gameVS
     attacker = vsAttacker gameVS
     teamTouching = vsTeam $ fetchVS vss player
 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
             [(player, 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
           [(player, PlayerMessage (PhysicalPlayerMessage (PPTTakeMe, BSPWhoAndWhen me t))),
            (game, GameMessage (GTTakePossession, GPTeamPosition teamTouching (Point2 0 0) (-1) False))] ++
            (map (\vs -> (vsObjId vs, PlayerMessage (PhysicalPlayerMessage (PPTLoseMe, BSPRelease 0 RTNothing)))) $ filter hasBall vss)


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