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