--- /dev/null
+implementation module matchControl\r
+\r
+import StdEnvExt\r
+import Gui2D // we choose the 2D GUI version of SoccerFun\r
+import Referee\r
+\r
+:: Seconds = Seconds !Real\r
+\r
+s :: !Real -> Seconds // (s x) represents x seconds of time\r
+s x = Seconds x\r
+\r
+instance zero Seconds where zero = Seconds zero\r
+instance == Seconds where == (Seconds s1) (Seconds s2)= s1 == s2\r
+instance < Seconds where < (Seconds s1) (Seconds s2)= s1 < s2\r
+instance + Seconds where + (Seconds s1) (Seconds s2)= Seconds (s1 + s2)\r
+instance - Seconds where - (Seconds s1) (Seconds s2)= Seconds (s1 - s2)\r
+instance minutes Seconds where minutes (Seconds s) = minutes (s/60.0)\r
+instance toReal Seconds where toReal (Seconds s) = s\r
+instance scale Seconds where scale k (Seconds s) = Seconds (k * s)\r
+instance toString Seconds where toString (Seconds s) = s +++> " sec."\r
+\r
+doSoccerFun :: !*World -> *World\r
+doSoccerFun world = SoccerFunGUI2D world\r
+\r
+setMatchStart :: !Team !Team !FootballField !Referee !PlayingTime !RandomSeed -> Match\r
+setMatchStart fstTeam sndTeam field referee time rs\r
+ = { team1 = validateTeam fstTeam\r
+ , team2 = validateTeam sndTeam\r
+ , theBall = Free zero\r
+ , theField = field\r
+ , theReferee = referee\r
+ , playingHalf = FirstHalf\r
+ , playingTime = time\r
+ , unittime = s 0.05\r
+ , score = (0,0)\r
+ , nextRandomP = nextRandomP\r
+ , seed = rs\r
+ , lastContact = Nothing\r
+ }\r
+\r
+stepMatch :: !Match -> (!(![RefereeAction],!AssocList FootballerID FootballerAction),!Match)\r
+stepMatch match\r
+# (refereeActions, match) = refereeTurn match\r
+# match = performRefereeActions refereeActions match\r
+# (intendedActions, match) = playersThink refereeActions match\r
+# (okActions, match) = successfulActions intendedActions match\r
+# match = doFootballerActions intendedActions okActions match\r
+# match = moveFootball match\r
+# match = advanceTime match\r
+= ((refereeActions,okActions),match)\r
+where\r
+/* refereeTurn match\r
+ determines whether the rules of soccer are adhered to and yields a list of referee actions.\r
+*/ refereeTurn :: !Match -> (![RefereeAction],!Match)\r
+ refereeTurn match=:{theReferee=referee=:{Referee | brain=brain=:{ai,memory}},theBall,playingHalf,team1,team2,playingTime,unittime,seed,lastContact}\r
+ = (refereeActions,{match & theReferee=new_referee,seed=new_seed})\r
+ where\r
+ (refereeActions,(memory`,new_seed)) = ai ({RefereeInput | playingTime = playingTime\r
+ , unittime = unittime\r
+ , theBall = theBall\r
+ , playingHalf = playingHalf\r
+ , team1 = team1\r
+ , team2 = team2\r
+ , lastContact = lastContact\r
+ }\r
+ ,(memory,seed)\r
+ )\r
+ new_referee = {Referee | referee & brain={Brain | brain & memory=memory`}}\r
+ \r
+/* performRefereeActions refereeActions match\r
+ performs for each football player in match his succeededAction, informs them about the referee actions, and moves the ball. \r
+*/ performRefereeActions :: ![RefereeAction] !Match -> Match\r
+ performRefereeActions refActions match = foldl doRefereeEvent match refActions\r
+ where\r
+ doRefereeEvent :: !Match !RefereeAction -> Match\r
+ doRefereeEvent theMatch=:{Match | playingHalf,theField,team1,team2} refereeAction\r
+ | isAlterMatchBallAndTeams = {Match | theMatch & theBall=Free (mkFootball pos zero),lastContact=Nothing}\r
+ | isProgressEvent = gameProgress theMatch\r
+ | isDisplaceTeamsEvent = {Match | theMatch & team1=map (displacePlayer ds) team1,team2=map (displacePlayer ds) team2}\r
+ | isReprimandEvent = let (team1`,team2`) = reprimandPlayer rep (team1,team2) in {Match | theMatch & team1=team1`,team2=team2`}\r
+ | otherwise = theMatch\r
+ where\r
+ (isAlterMatchBallAndTeams,pos) = case refereeAction of\r
+ DirectFreeKick _ pos = (True,pos)\r
+ ThrowIn _ pos = (True,pos)\r
+ Corner _ _ = (True,fromJust (getKickPos theField playingHalf refereeAction))\r
+ GoalKick _ = (True,fromJust (getKickPos theField playingHalf refereeAction))\r
+ Penalty _ = (True,fromJust (getKickPos theField playingHalf refereeAction))\r
+ CenterKick _ = (True,fromJust (getKickPos theField playingHalf refereeAction))\r
+ otherwise = (False,undef)\r
+ (isProgressEvent,gameProgress) = case refereeAction of\r
+ GameOver = (True,\m -> {Match | m & playingTime=zero})\r
+ GameCancelled mt = (True,\m -> {Match | m & playingTime=zero,score=case mt of\r
+ Nothing = (0,0)\r
+ Just West = if (playingHalf==FirstHalf) (1,0) (0,1)\r
+ just_east = if (playingHalf==FirstHalf) (0,1) (1,0)\r
+ })\r
+ AddTime t = (True,\m -> {Match | m & playingTime=m.Match.playingTime+t})\r
+ EndHalf = (True,\m -> {Match | m & playingHalf=SecondHalf})\r
+ Goal h = (True,\m=:{score=(w,e)} -> {Match | m & score=if (h==West && playingHalf==FirstHalf || h==East && playingHalf==SecondHalf) (w+1,e) (w,e+1)})\r
+ otherwise = (False,undef)\r
+ (isDisplaceTeamsEvent,ds) = case refereeAction of\r
+ DisplacePlayers ds = (True, ds)\r
+ otherwise = (False,undef)\r
+ (isReprimandEvent,rep) = case refereeAction of\r
+ ReprimandPlayer p r = (True, (p,r))\r
+ otherwise = (False,undef)\r
+ \r
+ displacePlayer :: !Displacements !Footballer -> Footballer\r
+ displacePlayer displacements fb = case lookup fb.playerID displacements of\r
+ Just pos = {fb & pos=pos}\r
+ nothing = fb\r
+ \r
+ reprimandPlayer :: !(!FootballerID,!Reprimand) !(![Footballer],![Footballer]) -> (![Footballer],![Footballer])\r
+ reprimandPlayer (playerID,RedCard) (team1,team2)\r
+ = splitAt (nr_players_1 - if (playerID.clubName == club1) 1 0) (uneq1++uneq2)\r
+ where\r
+ club1 = nameOf team1\r
+ (uneq1,_,uneq2) = break1 (identify_player playerID) (team1++team2)\r
+ nr_players_1 = length team1\r
+ reprimandPlayer _ teams = teams \r
+ \r
+/* playersThink match\r
+ lets every footballer player conjure an initiative.\r
+*/ playersThink :: ![RefereeAction] !Match -> (!AssocList FootballerID FootballerAction,!Match)\r
+ playersThink refereeActions match=:{Match | theBall,team1,team2}\r
+ = (intendedActions,new_match)\r
+ where\r
+ actionsOfTeam1 = map (think refereeActions theBall team2) (singleOutElems team1)\r
+ actionsOfTeam2 = map (think refereeActions theBall team1) (singleOutElems team2)\r
+ new_match = {Match | match & team1 = map snd actionsOfTeam1,team2 = map snd actionsOfTeam2}\r
+ intendedActions = [(playerID,action) \\ (action,{playerID}) <- actionsOfTeam1 ++ actionsOfTeam2]\r
+ \r
+ think :: ![RefereeAction] !FootballState ![Footballer] !(!Footballer,![Footballer]) -> (!FootballerAction,!Footballer)\r
+ think refereeActions ballstate opponents (me=:{Footballer | brain=brain=:{ai,memory}},ownTeam)\r
+ # (action,memory) = ai ({referee=refereeActions,football=ballstate,others=ownTeam ++ opponents,me=me},memory)\r
+ # me = {Footballer | me & brain = {Brain | brain & memory=memory}}\r
+ = (action,me)\r
+ \r
+/* successfulActions intendedActions match\r
+ removes all failing intended actions, and returns the list of remaining succeeding actions.\r
+ Players who are successfully tackled fail their action.\r
+ Players who are (still) lying on the ground fail their action.\r
+ At most one action of {GainBall, KickBall, HeadBall, CatchBall} succeeds.\r
+ If another player has successfully played the ball then his/her playerID is registered in Match.\r
+*/ successfulActions :: !(AssocList FootballerID FootballerAction) !Match -> (!AssocList FootballerID FootballerAction,!Match)\r
+ successfulActions intendedActions match=:{seed,lastContact,nextRandomP,team1,team2,theBall}\r
+ # otherActions = filter (\(playerID,_) -> not (isMember playerID groundVictims)) intendedActions\r
+ # (tackleActions,otherActions) = spanfilter (isFootballerTackle o snd) intendedActions\r
+ # (okTackleActions,seed) = selectTackleActions tackleActions seed\r
+ # tackleVictims = [victim \\ (_,Tackle victim _) <- okTackleActions]\r
+ # otherActions = filter (\(playerID,action) -> not (isMember playerID tackleVictims)) otherActions\r
+ # (ballActions,otherActions) = spanfilter (isActionOnBall o snd) otherActions\r
+ # (okBallAction,seed) = selectBallAction ballActions seed\r
+ # (okActions,newContact) = case okBallAction of\r
+ Just (player,action) = ([(player,action):okTackleActions ++ otherActions],Just player)\r
+ nope = ( okTackleActions ++ otherActions ,lastContact)\r
+ = (okActions,{match & seed=seed, lastContact=newContact})\r
+ where\r
+ all_players = team1 ++ team2\r
+ ball = getFootball theBall all_players\r
+ groundVictims = [playerID \\ {playerID,effect=Just (OnTheGround frames)} <- all_players | frames >= 0]\r
+ \r
+ /* selectBallAction picks at most one action of {GainBall, KickBall, HeadBall, CatchBall} intentions.\r
+ The association list is assumed to contain only these actions.\r
+ */ selectBallAction :: !(AssocList FootballerID FootballerAction) !RandomSeed -> (!Maybe (FootballerID,FootballerAction),!RandomSeed)\r
+ selectBallAction intendedActions seed\r
+ # (ps,seed) = iterateStn (length intendedActions) nextRandomP seed\r
+ = selectMostProbableAction [ (successOfAction action (if (p==one) p (makeRandomRealistic p)),action) \\ action <- intendedActions & p <- ps ] seed\r
+ where\r
+ successOfAction :: !(!FootballerID,!FootballerAction) !P -> P\r
+ successOfAction (who,action) p = me.stamina * me.health * p * success_of_action\r
+ where\r
+ success_of_action = if (isGainBall action && ballGainable && ballAtGainSpeed) success_gaining\r
+ (if (isCatchBall action && ballCatchable && ballAtCatchSpeed) success_catching\r
+ (if (isKickBall action && ballKickable) success_kicking\r
+ (if (isHeadBall action && ballHeadable) success_heading\r
+ zero\r
+ )))\r
+ me = find1 (identify_player who) all_players\r
+ mySkills = skillsAsList me\r
+ length = me.length\r
+ iGainWell = isMember Gaining mySkills\r
+ iKickWell = isMember Kicking mySkills\r
+ iHeadWell = isMember Heading mySkills\r
+ iCatchWell = isMember Catching mySkills\r
+ ballGainable = d_player_ball <= maxGainReach me && ball_height <= scale 0.8 length + scale (if iGainWell 0.2 0.0) length\r
+ ballKickable = d_player_ball <= maxKickReach me && ball_height <= scale 0.4 length + scale (if iKickWell 0.6 0.0) length\r
+ ballCatchable = d_player_ball <= maxCatchReach me && ball_height <= length + scale (if iCatchWell 1.0 0.5) length\r
+ ballHeadable = d_player_ball <= maxHeadReach me && ball_height <= length + scale (if iHeadWell 0.5 0.0) length && ball_height >= scale 0.8 length\r
+ ballAtGainSpeed = d_velocity <= maxGainVelocityDifference me d_player_ball\r
+ ballAtCatchSpeed = d_velocity <= maxCatchVelocityDifference me d_player_ball\r
+ d_speed = {zero & dxy = scale (toReal me.speed.velocity) (toRVector me.speed.direction)}\r
+ -\r
+ {dxy = scale (toReal ball.ballSpeed.vxy.velocity) (toRVector ball.ballSpeed.vxy.direction),dz = m (toReal ball.ballSpeed.vz)}\r
+ d_velocity = ms (toReal (size_vector3D d_speed))\r
+ ball_height = ball.ballPos.pz\r
+ d_player_ball = dist me ball\r
+ others_with_ball = case theBall of\r
+ GainedBy playerID = if (playerID <> who) (filter (identify_player playerID) all_players) []\r
+ free = []\r
+ other_has_ball = not (isEmpty others_with_ball)\r
+ otherDribblesWell = isMember Dribbling (skillsAsList (hd others_with_ball))\r
+ success_gaining = if (ballIsFree theBall) (if iGainWell 0.95 0.8)\r
+ (if other_has_ball (if iGainWell 0.75 0.3 * if otherDribblesWell 0.6 1.0)\r
+ 1.0)\r
+ success_kicking = if (ballIsFree theBall) (if iKickWell 0.95 0.85)\r
+ (if other_has_ball (if iKickWell 0.80 0.70 * if otherDribblesWell 0.7 1.0)\r
+ 1.0)\r
+ success_heading = if iHeadWell 0.95 0.90\r
+ success_catching = if iCatchWell 1.00 0.95\r
+ \r
+ /** selectTackleActions removes impossible tackle actions and, by chance, ignores some of the possible tackle actions.\r
+ */ selectTackleActions :: !(AssocList FootballerID FootballerAction) !RandomSeed -> (!AssocList FootballerID FootballerAction,!RandomSeed)\r
+ selectTackleActions performedActions seed\r
+ = filterSt isPossibleTackle [action \\ action <- performedActions | isFootballerTackle (snd action)] seed\r
+ where\r
+ isPossibleTackle :: !(!FootballerID,!FootballerAction) !RandomSeed -> (!Bool,!RandomSeed)\r
+ isPossibleTackle (playerID,Tackle victimID _) seed\r
+ | d_me_victim > maxTackleReach offender // victim is out of reach\r
+ = (False,seed)\r
+ # (p,seed) = nextRandomP seed\r
+ | otherwise = (avg [p,chanceOfSuccess] > 0.5,seed) // victim is within reach, but tackle may fail\r
+ where\r
+ offender = find1 (identify_player playerID) all_players\r
+ victim = find1 (identify_player victimID) all_players\r
+ d_me_victim = dist offender victim\r
+ chanceOfSuccess = avg [1.0 - toReal d_me_victim, if (isMember Tackling (skillsAsList offender)) 0.9 0.7]\r
+ \r
+/* doFootballerActions intendedActions okActions match\r
+ performs for each football player in match his succeededAction. \r
+*/ doFootballerActions :: !(AssocList FootballerID FootballerAction) !(AssocList FootballerID FootballerAction) !Match -> Match\r
+ doFootballerActions intendedActions okActions match=:{theField,theBall,team1,team2,seed,nextRandomP}\r
+ # (seed,ball,new_players1,new_players2) = foldl (flip doAction) (seed,theBall,team1,team2) intendedActions\r
+ = { match & team1 = new_players1, team2 = new_players2, theBall = ball, seed = seed }\r
+ where\r
+ dt = toReal match.Match.unittime // duration, in seconds, of one step\r
+ {fwidth,flength} = theField\r
+ \r
+ doAction :: !(!FootballerID,!FootballerAction) !(!RandomSeed,!FootballState,![Footballer],![Footballer]) \r
+ -> (!RandomSeed,!FootballState,![Footballer],![Footballer])\r
+ doAction intendedAction (seed,ball,allPlayers1,allPlayers2)\r
+ | isMember intendedAction okActions = act intendedAction (seed,ball,allPlayers1,allPlayers2)\r
+ | otherwise = (seed,ball,map (failThisPlayerAction intendedAction) allPlayers1,map (failThisPlayerAction intendedAction) allPlayers2) \r
+ where\r
+ failThisPlayerAction :: !(!FootballerID,!FootballerAction) !Footballer -> Footballer\r
+ failThisPlayerAction (id,idea) fb=:{playerID,effect}\r
+ | id <> playerID = fb\r
+ | otherwise = {fb & effect = new_effect}\r
+ where\r
+ new_effect = case effect of\r
+ Just (OnTheGround nr_of_frames) = if (nr_of_frames < 0) Nothing (Just (OnTheGround (nr_of_frames-1)))\r
+ _ = Just (failFootballerAction idea)\r
+ \r
+ act :: !(!FootballerID,!FootballerAction) !(!RandomSeed,!FootballState,![Footballer],![Footballer]) \r
+ -> (!RandomSeed,!FootballState,![Footballer],![Footballer])\r
+ \r
+ /** Rules for moving:\r
+ */ act (playerID,Move speed angle) (seed,ball,team1,team2)\r
+ # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))\r
+ = (seed,ball,team1,team2)\r
+ where\r
+ (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)\r
+ feasible_angle = scale (fromInt (sign angle)) (setbetween (abs angle) zero (maxRotateAngle fb))\r
+ new_nose = fb.nose + feasible_angle\r
+ angleDifficulty = angleHowFarFromPi (speed.direction-new_nose)\r
+ angleDifference = angleHowFarFromAngle speed.direction new_nose\r
+ new_stamina = alter_stamina ball fb angleDifficulty angleDifference\r
+ new_vel = scale (1.4 * fb.health * new_stamina) (setbetween speed.velocity zero (maxVelocity (skillsAsList fb) angleDifficulty angleDifference))\r
+ new_speed = {speed & velocity=new_vel}\r
+ new_position` = move_point (scale (dt * (toReal new_vel)) (toRVector new_speed.direction)) fb.pos\r
+ new_position = point_to_rectangle ({px=scale -0.5 flength, py=scale -0.5 fwidth},{px=scale 0.5 flength,py=scale 0.5 fwidth}) new_position` \r
+ new_fb = {fb & stamina = new_stamina\r
+ , speed = new_speed\r
+ , pos = new_position\r
+ , nose = new_nose\r
+ , effect = Just (Moved new_speed feasible_angle)\r
+ }\r
+ \r
+ /** Rules for gaining ball:\r
+ (1) ball obtains position and surface speed of obtaining player\r
+ */ act (playerID,GainBall) (seed,ball,team1,team2)\r
+ # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))\r
+ = (seed,GainedBy playerID,team1,team2)\r
+ where\r
+ (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)\r
+ new_fb = {fb & effect = Just (GainedBall Success)}\r
+ \r
+ /** Rules for kicking ball:\r
+ (1) kicking decreases stamina\r
+ (2) kicking is more effective towards your direction, and least effective in opposite direction\r
+ (3) being taller, you can kick harder\r
+ (4) a low stamina/health lower your max kickspeed\r
+ (5) todo: kicking a ball held/gained by a keeper, may damage the keeper\r
+ */ act (playerID,KickBall {vxy={velocity=v,direction=d},vz}) (seed,ball,team1,team2)\r
+ # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))\r
+ = (seed1,Free new_ball,team1,team2)\r
+ where\r
+ (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)\r
+ new_fb = {fb & stamina=new_stamina,effect=Just (KickedBall (Just new_speed))}\r
+ theBall = getFootball ball (team1 ++ team2)\r
+ skills = skillsAsList fb\r
+ max_v = maxVelocityBallKick fb\r
+ new_v = scale speed_factor (setbetween v zero max_v)\r
+ new_vz = scale speed_factor (setbetween vz zero max_v)\r
+ new_speed = {vxy={velocity=new_v,direction=new_d},vz=new_vz}\r
+ new_stamina = kickingPenalty fb new_v * fb.stamina\r
+ speed_factor = oppositeKickPenalty fb d\r
+ new_ball = {theBall & ballSpeed=new_speed}\r
+ (new_d,seed1) = new_ball_direction Kicking fb d seed\r
+ \r
+ /** Rules for heading ball:\r
+ (1) heading decreases stamina, but less than kicking\r
+ (2) kicking is more effective towards your direction, and least effective in opposite direction\r
+ (3) a low stamina/health lower your max headspeed, but less than kicking\r
+ (4) heading is less harder than kicking, but is not effected by your length\r
+ (5) todo: heading a ball held/gained by a keeper, may damage the keeper (less than with kicking)\r
+ */ act (playerID,HeadBall {vxy={velocity=v,direction=d},vz}) (seed,ballstate,team1,team2)\r
+ # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))\r
+ = (seed1,Free new_ball,team1,team2)\r
+ where\r
+ (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)\r
+ skills = skillsAsList fb\r
+ ball = getFootball ballstate (team1 ++ team2)\r
+ ball_speed = ball.ballSpeed.vxy.velocity\r
+ max_v = maxVelocityBallHead fb ball_speed\r
+ new_v = setbetween v zero max_v\r
+ new_vz = scale 0.25 (setbetween vz zero max_v)\r
+ new_speed = {vxy={velocity=new_v,direction=new_d},vz=new_vz}\r
+ new_stamina = headingPenalty fb new_v ball_speed * fb.stamina\r
+ new_fb = {fb & stamina=new_stamina,effect=Just (HeadedBall (Just new_speed))}\r
+ new_ball = {ball & ballSpeed=new_speed}\r
+ (new_d,seed1) = new_ball_direction Heading fb d seed\r
+ \r
+ /** Rules for feinting:\r
+ (1) you must have velocity in order to feint manouvre.\r
+ (2) a feint manouvre changes your position, and decreases your velocity (depends on Feinting skill)\r
+ */ act (playerID,Feint d) (seed,ball,team1,team2)\r
+ # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))\r
+ = (seed,ball,team1,team2)\r
+ where\r
+ (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)\r
+ new_stamina = (maxFatigueLossAtFeint fb) * fb.stamina\r
+ new_velocity = scale (fb.health * fb.stamina * (maxVelocityLossAtFeint fb)) fb.speed.velocity\r
+ new_speed = {fb.speed & velocity=new_velocity}\r
+ (leftv,rightv) = orthogonal fb.speed.direction\r
+ sidestep = case d of FeintLeft -> leftv; _ -> rightv\r
+ new_position` = move_point ((scale (toReal (maxFeintStep fb)) (toRVector sidestep))\r
+ + \r
+ (scale (dt * toReal new_velocity) (toRVector fb.speed.direction))\r
+ ) fb.pos\r
+ new_position = point_to_rectangle ({px=scale -0.5 flength,py=scale -0.5 fwidth},{px=scale 0.5 flength,py=scale 0.5 fwidth}) new_position`\r
+ new_fb = {fb & pos=new_position,speed=new_speed,stamina=new_stamina,effect=Just (Feinted d)}\r
+ \r
+ /** Rules for Tackling\r
+ (1) tackling may lower the health of the victim but increases his stamina (last is because he lies on the ground the next rounds)\r
+ (2) tackling costs stamina\r
+ */ act (playerID,Tackle victimID ve) (seed,ball,team1,team2)\r
+ = (seed1,new_ball,team1T,team2T)\r
+ where\r
+ nrPlayersTeam1 = length team1\r
+ (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)\r
+ (team1N,team2N) = splitAt nrPlayersTeam1 (unbreak1 (uneq1,new_fb,uneq2))\r
+ (uneq1T,fbT,uneq2T) = break1 (identify_player victimID) (team1N ++ team2N)\r
+ (team1T,team2T) = splitAt nrPlayersTeam1 (unbreak1 (uneq1T,new_target,uneq2T))\r
+ new_stamina_self = maxFatigueLossAtTackle fb * fb.stamina\r
+ new_fb = {fb & stamina = new_stamina_self, effect = Just (Tackled victimID ve Success)}\r
+ target_has_ball = ballIsGainedBy victimID ball\r
+ (p,seed1) = nextRandomP seed\r
+ new_v` = min max_tackle_velocity ve\r
+ max_tackle_velocity = ms 10.0\r
+ max_ground_time = s 30.0\r
+ ground_frames = toInt ((((toReal new_v`) / (toReal max_tackle_velocity)) * (toReal max_ground_time)) / dt)\r
+ new_v = scale 0.1 new_v`\r
+ healthDamageTarget = (toReal new_v) * fb.health * fb.stamina * (0.5*p + 0.1) + (toReal (fbT.length-min_length))/2.0\r
+ new_health_target = max zero (fbT.health - healthDamageTarget)\r
+ new_target = {fbT & health = new_health_target, effect = Just (OnTheGround ground_frames) }\r
+ new_ball = if target_has_ball (Free (mkFootball fbT.pos fbT.speed)) ball \r
+ \r
+ /** Rules for catching\r
+ (1) ball optains speed and distance of player\r
+ */ act (playerID,CatchBall) (seed,ball,team1,team2)\r
+ # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))\r
+ = (seed,GainedBy playerID,team1,team2)\r
+ where\r
+ (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)\r
+ new_fb = {fb & effect=Just (CaughtBall Success)}\r
+\r
+ new_ball_direction :: !Skill !Footballer !Angle !RandomSeed -> (!Angle,!RandomSeed)\r
+ new_ball_direction skill fb d seed\r
+ # (p1,seed) = nextRandomP seed\r
+ # (p2,seed) = nextRandomP seed\r
+ | p2 == one = (d,seed)\r
+ # failure = one - if (isMember skill (skillsAsList fb)) makeRandomRealisticSkilled makeRandomRealistic p2\r
+ # diff = scale failure (maxHeadingDeviation fb)\r
+ | p1 <= 0.5 = (d - diff, seed)\r
+ | otherwise = (d + diff, seed)\r
+\r
+/** moveFootball match\r
+ makes the free ball move (a gained ball moves along with its player).\r
+*/ moveFootball :: !Match -> Match\r
+ moveFootball match=:{Match | theBall=Free football=:{ballSpeed={vxy={velocity=v,direction=d},vz},ballPos},theField,team1,team2,seed,lastContact,unittime}\r
+ = { match & theBall = Free {football & ballSpeed=new_speed,ballPos=new_ballpos}, seed = seed1, lastContact = if (isJust hit_player) hit_player lastContact }\r
+ where\r
+ old_height = ballPos.pz\r
+ in_the_air = old_height > zero\r
+ resistance = if in_the_air air_resistance surface_resistance\r
+ dt = toReal unittime\r
+ surface_movement = scale (dt * (toReal v)) (toRVector d)\r
+ new_speed2D = let new_v = scale resistance v in {direction = d, velocity = if (new_v <= ms 0.05) zero new_v}\r
+ new_vz` = if in_the_air (vz - scale dt accelleration_sec) zero\r
+ new_height` = ballPos.pz + m (toReal vz)\r
+ (new_height,new_vz) = if (in_the_air && new_height` <= zero) // the ball bounces on the field\r
+ (scale 0.5 (abs new_height`),let new_vz`` = scale 0.33 (abs new_vz`) in if (new_vz`` <= ms 0.8) zero new_vz``)\r
+ (new_height`, new_vz`)\r
+ new_speed` = {vxy=new_speed2D, vz=new_vz}\r
+ new_ballpos = {pxy=move_point surface_movement ballPos.pxy,pz=new_height}\r
+ all_players = team1 ++ team2\r
+ (hit_player,new_speed,seed1) = ballBounces new_ballpos new_speed` seed\r
+ \r
+ // the direction of the ball changes after a bounce and its velocity may reduce in case of bouncing against a player\r
+ ballBounces :: !Position3D !Speed3D !RandomSeed -> (!Maybe FootballerID,!Speed3D,!RandomSeed)\r
+ ballBounces new_ballpos new_speed=:{vxy={velocity=v,direction=d},vz=s3d} seed\r
+ | hit_west_goal = (Nothing,{new_speed & vxy = {new_speed.vxy & direction = if (d <= rad pi) (d - rad (0.5*pi)) (d + rad (0.5*pi)), velocity = v}},seed)\r
+ | hit_east_goal = (Nothing,{new_speed & vxy = {new_speed.vxy & direction = if (d <= rad pi) (d + rad (0.5*pi)) (d - rad (0.5*pi)), velocity = v}},seed)\r
+ | isEmpty hit_players = (Nothing, new_speed, seed)\r
+ # (p1,seed) = nextRandomP seed\r
+ # (p2,seed) = nextRandomP seed\r
+ # (p3,seed) = nextRandomP seed\r
+ | otherwise = (Just (hd hit_players),{vxy = {direction = rad (p2*2.0*pi), velocity = scale p3 v}, vz=scale p1 s3d},seed)\r
+ where\r
+ half_length = scale 0.5 theField.flength\r
+ goal_pole_r = scale 0.5 goal_pole_width\r
+ (northPole,southPole) = goal_poles theField\r
+ hit_west_goal = againstGoalWestNorthPole || againstGoalWestSouthPole || againstGoalWestPoleUpper\r
+ hit_east_goal = againstGoalEastNorthPole || againstGoalEastSouthPole || againstGoalEastPoleUpper\r
+ hit_players = [playerID \\ fb=:{length,playerID} <- all_players | inRadiusOfFootballer new_ballpos.pxy fb && length >= new_ballpos.pz]\r
+ againstGoalWestNorthPole = inCircleRadiusOfPosition new_ballpos goal_pole_r goal_height {px = ~half_length, py = northPole + goal_pole_r}\r
+ againstGoalWestSouthPole = inCircleRadiusOfPosition new_ballpos goal_pole_r goal_height {px = ~half_length, py = southPole - goal_pole_r}\r
+ againstGoalEastNorthPole = inCircleRadiusOfPosition new_ballpos goal_pole_r goal_height {px = half_length, py = northPole + goal_pole_r}\r
+ againstGoalEastSouthPole = inCircleRadiusOfPosition new_ballpos goal_pole_r goal_height {px = half_length, py = southPole - goal_pole_r}\r
+ againstGoalWestPoleUpper = (isbetween new_ballpos.pxy.py (southPole - goal_pole_r) (northPole + goal_pole_r))\r
+ &&\r
+ (isbetween new_ballpos.pz goal_height (goal_height+goal_pole_width))\r
+ &&\r
+ (new_ballpos.pxy.px <= ~half_length)\r
+ againstGoalEastPoleUpper = (isbetween new_ballpos.pxy.py (southPole - goal_pole_r) (northPole + goal_pole_r))\r
+ &&\r
+ (isbetween new_ballpos.pz goal_height (goal_height+goal_pole_width))\r
+ &&\r
+ (new_ballpos.pxy.px >= half_length)\r
+ inCircleRadiusOfPosition {pxy,pz} r zr pos\r
+ = dist pxy pos <= r && pz <= zr\r
+\r
+ moveFootball match\r
+ = match\r
+ \r
+/** advanceTime match\r
+ decreases the time to play with unittime.\r
+*/ advanceTime :: !Match -> Match\r
+ advanceTime match=:{Match | playingTime, unittime}\r
+ = {Match | match & playingTime = max zero (playingTime - minutes unittime)}\r
+\r
+/* Attribute altering functions depending on angles:\r
+ params: \r
+ Angle :: between zero and pi, how much the player is running backwards (pi is backwards).\r
+ Angle :: between zero and pi, the difference between the desired angle and the angle the player previously ran to.\r
+*/\r
+alter_stamina :: !FootballState !Footballer !Angle !Angle -> Stamina\r
+alter_stamina ballState fb angleDifficulty angleDifference\r
+| velocity <= rfv // increase stamina\r
+ | stamina < MinimumFatigue = MinimumFatigue\r
+ | otherwise = stamina^0.8 \r
+| otherwise = fatigue * factor\r
+where\r
+ velocity = fb.speed.velocity\r
+ length = fb.length\r
+ stamina = fb.stamina\r
+ rfv = restore_stamina_velocity (ballIsGainedBy fb.playerID ballState) (skillsAsList fb) angleDifficulty angleDifference\r
+ diff = velocity - rfv\r
+ fv = if (diff >= ms 6.0) (stamina^(stamina^(1.6 + 0.02 * toReal length)))\r
+ (if (diff >= ms 4.0) (stamina^( 1.5 + 0.01 * toReal length))\r
+ (if (diff >= ms 2.0) (stamina^( 1.4 - 0.01 * toReal length))\r
+ (stamina^( 1.3 - 0.02 * toReal length))))\r
+ factor = one - (toReal angleDifficulty)/(4.0*pi)\r
+ fatigue = if (stamina > MaximumFatigue) MaximumFatigue fv\r
+\r
+restore_stamina_velocity :: !Bool ![Skill] !Angle !Angle -> Velocity\r
+restore_stamina_velocity gained_ball skills angleDifficulty angleDifference\r
+| gained_ball = scale ( one / if (isMember Running skills) 1.6 2.6) max_v\r
+| isMember Running skills = scale ((one / if (isMember Dribbling skills) 2.0 3.0) * 1.22) max_v\r
+| otherwise = scale ( one / if (isMember Dribbling skills) 2.0 3.0) max_v\r
+where\r
+ max_v = maxVelocity skills angleDifficulty angleDifference\r
+\r
+maxVelocity :: ![Skill] !Angle !Angle -> Velocity\r
+maxVelocity skills angleDifficulty angleDifference\r
+ = scale (dribblingPenalty * runningPenalty) base_velocity\r
+where\r
+ base_velocity = ms 10.0\r
+ dribblingPenalty = if (isMember Dribbling skills) 0.95 0.85\r
+ runningPenalty = if (isMember Running skills) 1.0 0.85\r
+\r
+MinimumFatigue :== 0.05\r
+MaximumFatigue :== 0.985\r
+\r
+\r
+/** The functions below defines the penalty factor: values between 0.0 and 1.0 that define the loss of an attribute of an action.\r
+*/\r
+:: PenaltyFactor :== Real // a value between 0.0 and 1.0\r
+\r
+kickingPenalty :: !Footballer !Velocity -> PenaltyFactor\r
+kickingPenalty fb new_v = 1.0 - (if (isMember Kicking (skillsAsList fb)) 0.3 0.6) * ((toReal new_v)/(toReal max_v))^2.0\r
+where\r
+ max_v = maxVelocityBallKick fb\r
+\r
+headingPenalty :: !Footballer !Velocity !Velocity -> PenaltyFactor\r
+headingPenalty fb new_v ball_v = 1.0 - (if (isMember Heading (skillsAsList fb)) 0.08 0.13) * ((toReal new_v)/(toReal max_v))^2.0\r
+where\r
+ max_v = maxVelocityBallHead fb ball_v\r
+\r
+maxFatigueLossAtTackle :: !Footballer -> PenaltyFactor\r
+maxFatigueLossAtTackle fb = if (isMember Tackling (skillsAsList fb)) 0.99 0.9\r
+\r
+maxFatigueLossAtFeint :: !Footballer -> PenaltyFactor\r
+maxFatigueLossAtFeint fb = if (isMember Feinting (skillsAsList fb)) 0.92 0.77\r
+\r
+maxVelocityLossAtFeint :: !Footballer -> PenaltyFactor\r
+maxVelocityLossAtFeint fb = if (isMember Feinting (skillsAsList fb)) 0.99 0.75\r
+\r
+oppositeKickPenalty :: !Footballer !Angle -> PenaltyFactor\r
+oppositeKickPenalty fb kick_to = 1.0 - toReal (scale (skillPenaltyFactor/pi) (angleHowFarFromPi angle))\r
+where\r
+ angle = abs (fb.nose - kick_to)\r
+ skills = skillsAsList fb\r
+ skillPenaltyFactor = if (isAllMember [Rotating,Kicking] skills) 0.3\r
+ (if (isAnyMember [Rotating,Kicking] skills) 0.5\r
+ 0.9)\r
+\r
+angleHowFarFromPi :: !Angle -> Angle\r
+angleHowFarFromPi a\r
+| a` > rad pi = rad (2.0*pi) - a`\r
+| otherwise = a`\r
+where\r
+ a` = abs a\r
+\r
+angleHowFarFromAngle :: !Angle !Angle -> Angle\r
+angleHowFarFromAngle a b\r
+| a` > b`\r
+ | a` - b` > rad pi = b` - a` + rad (2.0*pi)\r
+ | otherwise = a` - b`\r
+| otherwise\r
+ | b` - a` > rad pi = a` - b` + rad (2.0*pi)\r
+ | otherwise = b` - a`\r
+where\r
+ a` = abs a\r
+ b` = abs b\r
repositories / fp1415-soccerfun.git / blobdiff