--- /dev/null
+implementation module Umpire\r
+\r
+import RefereeFunctions\r
+\r
+umpire :: !FootballField -> Referee\r
+umpire field = { name = "Umpire"\r
+ , brain = {memory = Nothing, ai = brain field}\r
+ , refActionPics = []\r
+ }\r
+\r
+:: Memory = { total_time :: !PlayingTime // the playing time\r
+ , current_half :: !Half // the current playing half (initially FirstHalf)\r
+ , placing1 :: !Displacements // the placing of team1 at the start of the match\r
+ , placing2 :: !Displacements // the placing of team2 at the start of the match\r
+ , forbidden :: !Maybe Home // players from (Just home) are not allowed to play the ball\r
+ , offside :: ![FootballerID] // players that are offside and thus should not play the ball\r
+ , reprimands :: !AssocList FootballerID [Reprimand] // the reprimands collected by each player\r
+ , situation :: !Maybe (Situation,Pending) // the situation of the game\r
+ }\r
+:: Situation = IsCenterKick | IsCornerKick | IsDirectFreeKick | IsGoalKick | IsPenaltyKick | IsThrowIn | IsKeeperBall !Home\r
+:: Pending = IsPending !Deadline | IsExecuted\r
+:: Deadline :== Seconds\r
+\r
+brain :: !FootballField !(!RefereeInput,!(!Maybe Memory,!RandomSeed)) -> (!RefereeOutput,!(!Maybe Memory,!RandomSeed))\r
+// Referee enters the game, so (s)he needs to be filled in on the game details:\r
+brain field (input=:{RefereeInput | team1,team2,playingTime},(Nothing,seed))\r
+| team1_ok && team2_ok = ([CenterKick West,DisplacePlayers ds], (Just memory,seed))\r
+| otherwise = ([TellMessage wrong_team,GameOver], (Nothing, seed))\r
+where\r
+ team1_ok = isValidTeam team1 && allPlayersAtHome field West team1\r
+ team2_ok = isValidTeam team2 && allPlayersAtHome field East team2\r
+ wrong_team = if (not team1_ok) (nameOf team1 +++ " is invalid. ") "" +++\r
+ if (not team2_ok) (nameOf team2 +++ " is invalid. ") ""\r
+ memory = { total_time = playingTime\r
+ , current_half = FirstHalf\r
+ , placing1 = displacements team1\r
+ , placing2 = displacements team2\r
+ , forbidden = Just East\r
+ , offside = []\r
+ , reprimands = []\r
+ , situation = Just (IsCenterKick,IsPending center_kick_deadline)\r
+ }\r
+ ds = center_kick_positions field West memory\r
+\r
+// Referee stops the game when a team has less than 7 players:\r
+brain field (input=:{RefereeInput | team1, team2},(Just memory,seed))\r
+| too_few_players = ([GameCancelled winner,TellMessage ("Game cancelled." <+++ msg)],(Just memory,seed))\r
+where\r
+ too_few_players = too_few_team1 || too_few_team2\r
+ too_few_team1 = length team1 < 7\r
+ too_few_team2 = length team2 < 7\r
+ (winner,msg) = if (too_few_team1 && too_few_team2) (Nothing, "Both teams have less than 7 players left.")\r
+ (if too_few_team1 (Just East, nameOf team1 +++> " has less than 7 players left.")\r
+ (Just West, nameOf team2 +++> " has less than 7 players left.")\r
+ )\r
+\r
+// Referee checks whether the game is at the first half, second half, or completely over:\r
+brain field (input=:{RefereeInput | playingTime},(Just memory=:{current_half,total_time},seed))\r
+| playingTime <= zero = ([GameOver], (Just memory_no_offside,seed))\r
+| current_half <> half = ([EndHalf,CenterKick West,DisplacePlayers ds], (Just memory_2nd_half, seed))\r
+where\r
+ half = half_of_game total_time input\r
+ memory_no_offside = { memory & situation = Nothing, offside = [] }\r
+ memory_2nd_half = { memory_no_offside & situation = Just (IsCenterKick,IsPending center_kick_deadline), current_half = half, forbidden = Just East }\r
+ ds = center_kick_positions field West memory_2nd_half\r
+\r
+// Referee checks whether a team has scored a goal:\r
+brain field (input,(Just memory=:{current_half},seed))\r
+| isJust in_goal = ([Goal scoring_team,CenterKick (other scoring_team),DisplacePlayers ds],(Just memory_goal,seed))\r
+where\r
+ in_goal = ball_in_goal field input\r
+ goal = fromJust in_goal\r
+ scoring_team = other goal\r
+ ds = center_kick_positions field goal memory\r
+ memory_goal = { memory & forbidden = Just scoring_team, offside = [], situation = Just (IsCenterKick,IsPending center_kick_deadline) }\r
+\r
+// Referee checks whether the keeper has caught the ball.\r
+// In that case the keeper is obliged to play the ball within 6 seconds.\r
+brain field (input=:{RefereeInput | team1, team2},(Just memory=:{situation},seed))\r
+| keeper_catches_ball = ([],(Just memory_keeper_ball,seed))\r
+where\r
+ keeper_catches_ball = not (isEmpty catchers) && catcher.playerNr == 1 && ball_was_uncaught\r
+ ball_was_uncaught = isNothing situation || isJust situation && fst (fromJust situation) <> IsKeeperBall team_of_catcher\r
+ catchers = [playerID \\ {playerID,effect=Just action} <- team1 ++ team2 | isCaughtBall action]\r
+ catcher = hd catchers\r
+ team_of_catcher = home_of_player catcher input\r
+ memory_keeper_ball = { memory & situation = Just (IsKeeperBall team_of_catcher,IsPending keeper_deadline)\r
+ , forbidden = Just (other team_of_catcher)\r
+ , offside = []\r
+ }\r
+\r
+// Referee checks whether the ball has exited the football field.\r
+// If the last player who played the ball is not known, then the ball is thrown in by the team playing on the half of the field where the ball left the field.\r
+brain field (input=:{RefereeInput | lastContact},(Just memory=:{current_half},seed))\r
+| isJust ball_exit = if is_throw_in ([ThrowIn (other team) exit_pos], (Just {memory_enter & situation = Just (IsThrowIn, IsPending restart_deadline)},seed))\r
+ (if is_corner ([Corner (other team) edge], (Just {memory_enter & situation = Just (IsCornerKick,IsPending restart_deadline)},seed))\r
+ ([GoalKick (other team)], (Just {memory_enter & situation = Just (IsGoalKick, IsPending keeper_deadline )},seed))\r
+ )\r
+where\r
+ ball_exit = ball_left_field_at field input\r
+ exit_pos = fromJust ball_exit\r
+ team = case lastContact of\r
+ Just fID = home_of_player fID input\r
+ unknown = if (home == West) (if (current_half == FirstHalf) West East) (if (current_half == FirstHalf) East West)\r
+ is_throw_in = abs exit_pos.py >= scale 0.5 field.fwidth\r
+ is_corner = exit_pos.px <= scale -0.5 field.flength && team == West || exit_pos.px >= scale 0.5 field.flength && team == East\r
+ home = if (exit_pos.px < zero) West East\r
+ edge = if (exit_pos.py > zero) North South\r
+ memory_enter = { memory & forbidden = Just team, offside = [] }\r
+\r
+// Referee checks whether the ball is not played correctly:\r
+brain field (input=:{RefereeInput | team1, team2, playingHalf},(Just memory=:{forbidden},seed))\r
+| improper_team = ([OwnBallIllegally ball_player,DirectFreeKick (other team) player_pos,DisplacePlayers ds:map (ReprimandPlayer ball_player) new_reprimands]\r
+ ,(Just memory_illegal,seed)\r
+ )\r
+where\r
+ improper_team = isJust forbidden && ball_is_played && team_of_ball_player == team\r
+ ball_players = [(playerID,pos) \\ {playerID,pos,effect=Just action} <- team1 ++ team2 | isBallAction action]\r
+ ball_is_played = not (isEmpty ball_players)\r
+ (ball_player,player_pos)= hd ball_players\r
+ team_of_ball_player = home_of_player ball_player input\r
+ team = fromJust forbidden\r
+ ds = direct_free_kick_positions team player_pos input\r
+ (new_reprimands,memory_reprimanded)\r
+ = reprimand_player ball_player Warning { memory & offside = [], situation = Just (IsDirectFreeKick,IsPending free_kick_deadline) }\r
+ expel = isMember RedCard new_reprimands\r
+ memory_illegal = if expel (expel_player ball_player team_of_ball_player playingHalf memory_reprimanded) memory_reprimanded\r
+\r
+// Referee checks whether the hands-rule has been offended:\r
+brain field (input=:{RefereeInput | team1, team2, playingHalf},(Just memory=:{current_half},seed))\r
+| hands_offense = ([Hands catcher,DirectFreeKick (other team) catcher_pos,DisplacePlayers ds:map (ReprimandPlayer catcher) new_reprimands]\r
+ ,(Just memory_hands,seed)\r
+ )\r
+where\r
+ hands_offense = ball_is_caught && (catcher.playerNr <> 1 || not (inPenaltyArea field team catcher_pos))\r
+ catchers = [(playerID,pos) \\ {playerID,pos,effect=Just action} <- team1 ++ team2 | isCaughtBall action]\r
+ (catcher,catcher_pos) = hd catchers\r
+ ball_is_caught = not (isEmpty catchers)\r
+ team = home_of_player catcher input\r
+ ds = direct_free_kick_positions team catcher_pos input\r
+ (new_reprimands,memory_reprimanded)\r
+ = reprimand_player catcher YellowCard { memory & forbidden = Just team, offside = [], situation = Just (IsDirectFreeKick,IsPending free_kick_deadline) }\r
+ expel = isMember RedCard new_reprimands\r
+ memory_hands = if expel (expel_player catcher team playingHalf memory_reprimanded) memory_reprimanded\r
+\r
+// Referee checks whether the offside-rule has been offended:\r
+brain field (input=:{RefereeInput | team1, team2},(Just memory=:{offside},seed))\r
+| offside_offense = ([Offside offender,DirectFreeKick (other team) player_pos,DisplacePlayers ds],(Just memory_offside_lifted,seed)) // this should really be an indirect free kick, but that is not implemented yet\r
+where\r
+ offside_offense = ball_is_played && isMember offender offside // offside is activated by a player in offside position playing the ball\r
+ ball_players = [(playerID,pos) \\ {playerID,pos,effect=Just action} <- team1 ++ team2 | isPlayBallAction action]\r
+ ball_is_played = not (isEmpty ball_players)\r
+ (offender,player_pos) = hd ball_players\r
+ team = home_of_player offender input\r
+ ds = direct_free_kick_positions team player_pos input\r
+ memory_offside_lifted = { memory & forbidden = Just team, offside = [], situation = Just (IsDirectFreeKick,IsPending free_kick_deadline) }\r
+\r
+// Referee checks whether a team is passive:\r
+brain field (input=:{RefereeInput | theBall, team1, team2, playingHalf},(Just memory=:{forbidden=Just team,situation=Just (state,IsPending dt)},seed))\r
+| passivity = ([TellMessage msg,DirectFreeKick team ball.ballPos.pxy,DisplacePlayers ds],(Just memory_passive,seed))\r
+where\r
+ passivity = dt < zero\r
+ memory_passive = { memory & forbidden = Just (other team), offside = [], situation = Just (IsDirectFreeKick,IsPending free_kick_deadline)}\r
+ ball = getFootball theBall (team1 ++ team2)\r
+ ds = direct_free_kick_positions (other team) ball.ballPos.pxy input\r
+ msg = "Passive play by " <+++ nameOf (if (team == West && playingHalf == FirstHalf || team == East && playingHalf == SecondHalf) team2 team1)\r
+\r
+// Referee checks the status of the rules and remains silent to let the game continue:\r
+brain field (input=:{RefereeInput | theBall, team1, team2},(Just memory=:{situation,forbidden},seed))\r
+# memory = decrease_pending_time input memory\r
+# memory = if ball_is_played { memory & situation = new_situation } memory\r
+# memory = if (ball_is_played && not no_offside_situation) { memory & offside = at_offside } memory\r
+# memory = if (ball_is_played && lift_forbidden_rule) { memory & forbidden = Nothing } memory\r
+= ([],(Just memory,seed))\r
+where\r
+ new_situation = if (isJust situation) (case pending of\r
+ IsPending _ = Just (state,IsExecuted)\r
+ _ = Nothing\r
+ ) Nothing\r
+ no_offside_situation = isJust situation && isMember state [IsCornerKick,IsGoalKick,IsThrowIn]\r
+ lift_forbidden_rule = isJust forbidden && team_of_ball_player == other forbidden_team\r
+ (state,pending) = fromJust situation\r
+ forbidden_team = fromJust forbidden\r
+ ball_players = [playerID \\ {playerID,effect=Just action} <- team1 ++ team2 | isBallAction action]\r
+ ball_is_played = not (isEmpty ball_players)\r
+ ball_player = hd ball_players\r
+ team_of_ball_player = home_of_player ball_player input\r
+ at_offside = [playerID \\ (playerID,_) <- players_in_offside_position field team_of_ball_player input | playerID <> ball_player]\r
+\r
+decrease_pending_time :: !RefereeInput !Memory -> Memory\r
+decrease_pending_time input=:{RefereeInput | unittime} memory=:{situation = Just (state,IsPending dt)}\r
+ = { memory & situation = Just (state,IsPending (dt - unittime)) }\r
+decrease_pending_time _ memory\r
+ = memory\r
+\r
+expel_player :: !FootballerID !Home !Half !Memory -> Memory\r
+expel_player player team half memory=:{placing1,placing2}\r
+| team == West && half == FirstHalf || team == East && half == SecondHalf\r
+ = { memory & placing1 = deletekeyvalue player placing1 }\r
+| otherwise = { memory & placing2 = deletekeyvalue player placing2 }\r
+\r
+reprimand_player :: !FootballerID !Reprimand !Memory -> (![Reprimand],!Memory)\r
+reprimand_player player reprimand memory=:{reprimands}\r
+# new_reprimands = [reprimand]\r
+# new_reprimands = if (length (filter ((==) Warning) (new_reprimands ++ player_reprimands)) >= 3) (new_reprimands ++ [YellowCard]) new_reprimands\r
+# new_reprimands = if (length (filter ((==) YellowCard) (new_reprimands ++ player_reprimands)) >= 2) (new_reprimands ++ [RedCard]) new_reprimands\r
+= (new_reprimands, {memory & reprimands = addkeyvalue (player,player_reprimands ++ new_reprimands) reprimands})\r
+where\r
+ player_reprimands = lookupd [] player reprimands\r
+\r
+home_of_player :: !FootballerID !RefereeInput -> Home\r
+home_of_player player {RefereeInput | playingHalf,team1}\r
+| sameClub player (hd team1).playerID\r
+ = if (playingHalf == FirstHalf) West East\r
+| otherwise = if (playingHalf == FirstHalf) East West\r
+\r
+isPlayBallAction :: !FootballerEffect -> Bool\r
+isPlayBallAction action = isKickedBall action || isHeadedBall action\r
+\r
+isBallAction :: !FootballerEffect -> Bool\r
+isBallAction action = isKickedBall action || isHeadedBall action || isGainedBall action || isCaughtBall action\r
+\r
+center_kick_positions :: !FootballField !Home !Memory -> Displacements\r
+center_kick_positions field home_kicking_off {placing1,placing2,current_half}\r
+| home_kicking_off == West = kick_off positions1 ++ map repell_from_center positions2\r
+| otherwise = map repell_from_center positions1 ++ kick_off positions2\r
+where\r
+ (positions1,positions2) = if (current_half == FirstHalf) (placing1,placing2)\r
+ ([(playerID,mirror field pos) \\ (playerID,pos) <- placing2]\r
+ ,[(playerID,mirror field pos) \\ (playerID,pos) <- placing1]\r
+ )\r
+ center = zero\r
+ repell_from_center = \(player,pos) -> (player,repell radius_centre_circle center pos)\r
+ attract_to_center = \(player,pos) -> (player,attract (m 0.5) center pos)\r
+ kick_off placement = map attract_to_center closest ++ map repell_from_center others\r
+ where\r
+ sorted = sortBy (\(_,pos1) (_,pos2) -> dist pos1 center < dist pos2 center) placement\r
+ (closest,others) = splitAt 2 sorted\r
+\r
+/** direct_free_kick_positions home pos input:\r
+ move players of @home away from @pos, and attract the closest fielder of (other @home) to @pos.\r
+*/\r
+direct_free_kick_positions :: !Home !Position !RefereeInput -> Displacements\r
+direct_free_kick_positions team free_kick_pos input=:{RefereeInput | team1, team2, playingHalf}\r
+ = [attract_kicker : push_away_offenders]\r
+where\r
+ (offenders,free_kickers)= if (team == West && playingHalf == FirstHalf || team == East && playingHalf == SecondHalf) (team1,team2) (team2,team1)\r
+ push_away_offenders = map (\{playerID,pos} -> (playerID,repell repell_distance free_kick_pos pos)) offenders\r
+ closest_player = snd (hd (sortBy (\(d1,_) (d2,_) -> d1 < d2) [(dist free_kick_pos player,player) \\ player <- free_kickers | isFielder player]))\r
+ attract_kicker = (closest_player.playerID,attract (m 1.0) free_kick_pos closest_player.pos)\r
+\r
+keeper_deadline :== s 6.0\r
+center_kick_deadline :== s 1.0\r
+free_kick_deadline :== s 1.0\r
+restart_deadline :== s 20.0\r
+\r
+instance == Situation where == IsCenterKick IsCenterKick = True\r
+ == IsCornerKick IsCornerKick = True\r
+ == IsDirectFreeKick IsDirectFreeKick = True\r
+ == IsGoalKick IsGoalKick = True\r
+ == IsPenaltyKick IsPenaltyKick = True\r
+ == IsThrowIn IsThrowIn = True\r
+ == (IsKeeperBall t1) (IsKeeperBall t2) = t1 == t2\r
+ == _ _ = False\r
+instance == Pending where == (IsPending t1) (IsPending t2) = t1 == t2\r
+ == IsExecuted IsExecuted = True\r
+ == _ _ = False\r
+instance toString Situation where toString IsCenterKick = "IsCenterKick"\r
+ toString IsCornerKick = "IsCornerKick"\r
+ toString IsDirectFreeKick = "IsDirectFreeKick"\r
+ toString IsGoalKick = "IsGoalKick"\r
+ toString IsPenaltyKick = "IsPenaltyKick"\r
+ toString IsThrowIn = "IsThrowIn"\r
+ toString (IsKeeperBall h) = "(IsKeeperBall " <+++ h <+++ ")"\r
+instance toString Pending where toString (IsPending t) = "(IsPending " <+++ t <+++ ")"\r
+ toString IsExecuted = "IsExecuted"\r
repositories / fp1415-soccerfun.git / blobdiff