repositories / fp1415-soccerfun.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
initial framework added
[fp1415-soccerfun.git] / src / Game / matchControl.icl
1 implementation module matchControl
2
3 import StdEnvExt
4 import Gui2D // we choose the 2D GUI version of SoccerFun
5 import Referee
6
7 :: Seconds = Seconds !Real
8
9 s :: !Real -> Seconds // (s x) represents x seconds of time
10 s x = Seconds x
11
12 instance zero Seconds where zero = Seconds zero
13 instance == Seconds where == (Seconds s1) (Seconds s2)= s1 == s2
14 instance < Seconds where < (Seconds s1) (Seconds s2)= s1 < s2
15 instance + Seconds where + (Seconds s1) (Seconds s2)= Seconds (s1 + s2)
16 instance - Seconds where - (Seconds s1) (Seconds s2)= Seconds (s1 - s2)
17 instance minutes Seconds where minutes (Seconds s) = minutes (s/60.0)
18 instance toReal Seconds where toReal (Seconds s) = s
19 instance scale Seconds where scale k (Seconds s) = Seconds (k * s)
20 instance toString Seconds where toString (Seconds s) = s +++> " sec."
21
22 doSoccerFun :: !*World -> *World
23 doSoccerFun world = SoccerFunGUI2D world
24
25 setMatchStart :: !Team !Team !FootballField !Referee !PlayingTime !RandomSeed -> Match
26 setMatchStart fstTeam sndTeam field referee time rs
27 = { team1 = validateTeam fstTeam
28 , team2 = validateTeam sndTeam
29 , theBall = Free zero
30 , theField = field
31 , theReferee = referee
32 , playingHalf = FirstHalf
33 , playingTime = time
34 , unittime = s 0.05
35 , score = (0,0)
36 , nextRandomP = nextRandomP
37 , seed = rs
38 , lastContact = Nothing
39 }
40
41 stepMatch :: !Match -> (!(![RefereeAction],!AssocList FootballerID FootballerAction),!Match)
42 stepMatch match
43 # (refereeActions, match) = refereeTurn match
44 # match = performRefereeActions refereeActions match
45 # (intendedActions, match) = playersThink refereeActions match
46 # (okActions, match) = successfulActions intendedActions match
47 # match = doFootballerActions intendedActions okActions match
48 # match = moveFootball match
49 # match = advanceTime match
50 = ((refereeActions,okActions),match)
51 where
52 /* refereeTurn match
53 determines whether the rules of soccer are adhered to and yields a list of referee actions.
54 */ refereeTurn :: !Match -> (![RefereeAction],!Match)
55 refereeTurn match=:{theReferee=referee=:{Referee | brain=brain=:{ai,memory}},theBall,playingHalf,team1,team2,playingTime,unittime,seed,lastContact}
56 = (refereeActions,{match & theReferee=new_referee,seed=new_seed})
57 where
58 (refereeActions,(memory`,new_seed)) = ai ({RefereeInput | playingTime = playingTime
59 , unittime = unittime
60 , theBall = theBall
61 , playingHalf = playingHalf
62 , team1 = team1
63 , team2 = team2
64 , lastContact = lastContact
65 }
66 ,(memory,seed)
67 )
68 new_referee = {Referee | referee & brain={Brain | brain & memory=memory`}}
69
70 /* performRefereeActions refereeActions match
71 performs for each football player in match his succeededAction, informs them about the referee actions, and moves the ball.
72 */ performRefereeActions :: ![RefereeAction] !Match -> Match
73 performRefereeActions refActions match = foldl doRefereeEvent match refActions
74 where
75 doRefereeEvent :: !Match !RefereeAction -> Match
76 doRefereeEvent theMatch=:{Match | playingHalf,theField,team1,team2} refereeAction
77 | isAlterMatchBallAndTeams = {Match | theMatch & theBall=Free (mkFootball pos zero),lastContact=Nothing}
78 | isProgressEvent = gameProgress theMatch
79 | isDisplaceTeamsEvent = {Match | theMatch & team1=map (displacePlayer ds) team1,team2=map (displacePlayer ds) team2}
80 | isReprimandEvent = let (team1`,team2`) = reprimandPlayer rep (team1,team2) in {Match | theMatch & team1=team1`,team2=team2`}
81 | otherwise = theMatch
82 where
83 (isAlterMatchBallAndTeams,pos) = case refereeAction of
84 DirectFreeKick _ pos = (True,pos)
85 ThrowIn _ pos = (True,pos)
86 Corner _ _ = (True,fromJust (getKickPos theField playingHalf refereeAction))
87 GoalKick _ = (True,fromJust (getKickPos theField playingHalf refereeAction))
88 Penalty _ = (True,fromJust (getKickPos theField playingHalf refereeAction))
89 CenterKick _ = (True,fromJust (getKickPos theField playingHalf refereeAction))
90 otherwise = (False,undef)
91 (isProgressEvent,gameProgress) = case refereeAction of
92 GameOver = (True,\m -> {Match | m & playingTime=zero})
93 GameCancelled mt = (True,\m -> {Match | m & playingTime=zero,score=case mt of
94 Nothing = (0,0)
95 Just West = if (playingHalf==FirstHalf) (1,0) (0,1)
96 just_east = if (playingHalf==FirstHalf) (0,1) (1,0)
97 })
98 AddTime t = (True,\m -> {Match | m & playingTime=m.Match.playingTime+t})
99 EndHalf = (True,\m -> {Match | m & playingHalf=SecondHalf})
100 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)})
101 otherwise = (False,undef)
102 (isDisplaceTeamsEvent,ds) = case refereeAction of
103 DisplacePlayers ds = (True, ds)
104 otherwise = (False,undef)
105 (isReprimandEvent,rep) = case refereeAction of
106 ReprimandPlayer p r = (True, (p,r))
107 otherwise = (False,undef)
108
109 displacePlayer :: !Displacements !Footballer -> Footballer
110 displacePlayer displacements fb = case lookup fb.playerID displacements of
111 Just pos = {fb & pos=pos}
112 nothing = fb
113
114 reprimandPlayer :: !(!FootballerID,!Reprimand) !(![Footballer],![Footballer]) -> (![Footballer],![Footballer])
115 reprimandPlayer (playerID,RedCard) (team1,team2)
116 = splitAt (nr_players_1 - if (playerID.clubName == club1) 1 0) (uneq1++uneq2)
117 where
118 club1 = nameOf team1
119 (uneq1,_,uneq2) = break1 (identify_player playerID) (team1++team2)
120 nr_players_1 = length team1
121 reprimandPlayer _ teams = teams
122
123 /* playersThink match
124 lets every footballer player conjure an initiative.
125 */ playersThink :: ![RefereeAction] !Match -> (!AssocList FootballerID FootballerAction,!Match)
126 playersThink refereeActions match=:{Match | theBall,team1,team2}
127 = (intendedActions,new_match)
128 where
129 actionsOfTeam1 = map (think refereeActions theBall team2) (singleOutElems team1)
130 actionsOfTeam2 = map (think refereeActions theBall team1) (singleOutElems team2)
131 new_match = {Match | match & team1 = map snd actionsOfTeam1,team2 = map snd actionsOfTeam2}
132 intendedActions = [(playerID,action) \\ (action,{playerID}) <- actionsOfTeam1 ++ actionsOfTeam2]
133
134 think :: ![RefereeAction] !FootballState ![Footballer] !(!Footballer,![Footballer]) -> (!FootballerAction,!Footballer)
135 think refereeActions ballstate opponents (me=:{Footballer | brain=brain=:{ai,memory}},ownTeam)
136 # (action,memory) = ai ({referee=refereeActions,football=ballstate,others=ownTeam ++ opponents,me=me},memory)
137 # me = {Footballer | me & brain = {Brain | brain & memory=memory}}
138 = (action,me)
139
140 /* successfulActions intendedActions match
141 removes all failing intended actions, and returns the list of remaining succeeding actions.
142 Players who are successfully tackled fail their action.
143 Players who are (still) lying on the ground fail their action.
144 At most one action of {GainBall, KickBall, HeadBall, CatchBall} succeeds.
145 If another player has successfully played the ball then his/her playerID is registered in Match.
146 */ successfulActions :: !(AssocList FootballerID FootballerAction) !Match -> (!AssocList FootballerID FootballerAction,!Match)
147 successfulActions intendedActions match=:{seed,lastContact,nextRandomP,team1,team2,theBall}
148 # otherActions = filter (\(playerID,_) -> not (isMember playerID groundVictims)) intendedActions
149 # (tackleActions,otherActions) = spanfilter (isFootballerTackle o snd) intendedActions
150 # (okTackleActions,seed) = selectTackleActions tackleActions seed
151 # tackleVictims = [victim \\ (_,Tackle victim _) <- okTackleActions]
152 # otherActions = filter (\(playerID,action) -> not (isMember playerID tackleVictims)) otherActions
153 # (ballActions,otherActions) = spanfilter (isActionOnBall o snd) otherActions
154 # (okBallAction,seed) = selectBallAction ballActions seed
155 # (okActions,newContact) = case okBallAction of
156 Just (player,action) = ([(player,action):okTackleActions ++ otherActions],Just player)
157 nope = ( okTackleActions ++ otherActions ,lastContact)
158 = (okActions,{match & seed=seed, lastContact=newContact})
159 where
160 all_players = team1 ++ team2
161 ball = getFootball theBall all_players
162 groundVictims = [playerID \\ {playerID,effect=Just (OnTheGround frames)} <- all_players | frames >= 0]
163
164 /* selectBallAction picks at most one action of {GainBall, KickBall, HeadBall, CatchBall} intentions.
165 The association list is assumed to contain only these actions.
166 */ selectBallAction :: !(AssocList FootballerID FootballerAction) !RandomSeed -> (!Maybe (FootballerID,FootballerAction),!RandomSeed)
167 selectBallAction intendedActions seed
168 # (ps,seed) = iterateStn (length intendedActions) nextRandomP seed
169 = selectMostProbableAction [ (successOfAction action (if (p==one) p (makeRandomRealistic p)),action) \\ action <- intendedActions & p <- ps ] seed
170 where
171 successOfAction :: !(!FootballerID,!FootballerAction) !P -> P
172 successOfAction (who,action) p = me.stamina * me.health * p * success_of_action
173 where
174 success_of_action = if (isGainBall action && ballGainable && ballAtGainSpeed) success_gaining
175 (if (isCatchBall action && ballCatchable && ballAtCatchSpeed) success_catching
176 (if (isKickBall action && ballKickable) success_kicking
177 (if (isHeadBall action && ballHeadable) success_heading
178 zero
179 )))
180 me = find1 (identify_player who) all_players
181 mySkills = skillsAsList me
182 length = me.length
183 iGainWell = isMember Gaining mySkills
184 iKickWell = isMember Kicking mySkills
185 iHeadWell = isMember Heading mySkills
186 iCatchWell = isMember Catching mySkills
187 ballGainable = d_player_ball <= maxGainReach me && ball_height <= scale 0.8 length + scale (if iGainWell 0.2 0.0) length
188 ballKickable = d_player_ball <= maxKickReach me && ball_height <= scale 0.4 length + scale (if iKickWell 0.6 0.0) length
189 ballCatchable = d_player_ball <= maxCatchReach me && ball_height <= length + scale (if iCatchWell 1.0 0.5) length
190 ballHeadable = d_player_ball <= maxHeadReach me && ball_height <= length + scale (if iHeadWell 0.5 0.0) length && ball_height >= scale 0.8 length
191 ballAtGainSpeed = d_velocity <= maxGainVelocityDifference me d_player_ball
192 ballAtCatchSpeed = d_velocity <= maxCatchVelocityDifference me d_player_ball
193 d_speed = {zero & dxy = scale (toReal me.speed.velocity) (toRVector me.speed.direction)}
194 -
195 {dxy = scale (toReal ball.ballSpeed.vxy.velocity) (toRVector ball.ballSpeed.vxy.direction),dz = m (toReal ball.ballSpeed.vz)}
196 d_velocity = ms (toReal (size_vector3D d_speed))
197 ball_height = ball.ballPos.pz
198 d_player_ball = dist me ball
199 others_with_ball = case theBall of
200 GainedBy playerID = if (playerID <> who) (filter (identify_player playerID) all_players) []
201 free = []
202 other_has_ball = not (isEmpty others_with_ball)
203 otherDribblesWell = isMember Dribbling (skillsAsList (hd others_with_ball))
204 success_gaining = if (ballIsFree theBall) (if iGainWell 0.95 0.8)
205 (if other_has_ball (if iGainWell 0.75 0.3 * if otherDribblesWell 0.6 1.0)
206 1.0)
207 success_kicking = if (ballIsFree theBall) (if iKickWell 0.95 0.85)
208 (if other_has_ball (if iKickWell 0.80 0.70 * if otherDribblesWell 0.7 1.0)
209 1.0)
210 success_heading = if iHeadWell 0.95 0.90
211 success_catching = if iCatchWell 1.00 0.95
212
213 /** selectTackleActions removes impossible tackle actions and, by chance, ignores some of the possible tackle actions.
214 */ selectTackleActions :: !(AssocList FootballerID FootballerAction) !RandomSeed -> (!AssocList FootballerID FootballerAction,!RandomSeed)
215 selectTackleActions performedActions seed
216 = filterSt isPossibleTackle [action \\ action <- performedActions | isFootballerTackle (snd action)] seed
217 where
218 isPossibleTackle :: !(!FootballerID,!FootballerAction) !RandomSeed -> (!Bool,!RandomSeed)
219 isPossibleTackle (playerID,Tackle victimID _) seed
220 | d_me_victim > maxTackleReach offender // victim is out of reach
221 = (False,seed)
222 # (p,seed) = nextRandomP seed
223 | otherwise = (avg [p,chanceOfSuccess] > 0.5,seed) // victim is within reach, but tackle may fail
224 where
225 offender = find1 (identify_player playerID) all_players
226 victim = find1 (identify_player victimID) all_players
227 d_me_victim = dist offender victim
228 chanceOfSuccess = avg [1.0 - toReal d_me_victim, if (isMember Tackling (skillsAsList offender)) 0.9 0.7]
229
230 /* doFootballerActions intendedActions okActions match
231 performs for each football player in match his succeededAction.
232 */ doFootballerActions :: !(AssocList FootballerID FootballerAction) !(AssocList FootballerID FootballerAction) !Match -> Match
233 doFootballerActions intendedActions okActions match=:{theField,theBall,team1,team2,seed,nextRandomP}
234 # (seed,ball,new_players1,new_players2) = foldl (flip doAction) (seed,theBall,team1,team2) intendedActions
235 = { match & team1 = new_players1, team2 = new_players2, theBall = ball, seed = seed }
236 where
237 dt = toReal match.Match.unittime // duration, in seconds, of one step
238 {fwidth,flength} = theField
239
240 doAction :: !(!FootballerID,!FootballerAction) !(!RandomSeed,!FootballState,![Footballer],![Footballer])
241 -> (!RandomSeed,!FootballState,![Footballer],![Footballer])
242 doAction intendedAction (seed,ball,allPlayers1,allPlayers2)
243 | isMember intendedAction okActions = act intendedAction (seed,ball,allPlayers1,allPlayers2)
244 | otherwise = (seed,ball,map (failThisPlayerAction intendedAction) allPlayers1,map (failThisPlayerAction intendedAction) allPlayers2)
245 where
246 failThisPlayerAction :: !(!FootballerID,!FootballerAction) !Footballer -> Footballer
247 failThisPlayerAction (id,idea) fb=:{playerID,effect}
248 | id <> playerID = fb
249 | otherwise = {fb & effect = new_effect}
250 where
251 new_effect = case effect of
252 Just (OnTheGround nr_of_frames) = if (nr_of_frames < 0) Nothing (Just (OnTheGround (nr_of_frames-1)))
253 _ = Just (failFootballerAction idea)
254
255 act :: !(!FootballerID,!FootballerAction) !(!RandomSeed,!FootballState,![Footballer],![Footballer])
256 -> (!RandomSeed,!FootballState,![Footballer],![Footballer])
257
258 /** Rules for moving:
259 */ act (playerID,Move speed angle) (seed,ball,team1,team2)
260 # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))
261 = (seed,ball,team1,team2)
262 where
263 (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)
264 feasible_angle = scale (fromInt (sign angle)) (setbetween (abs angle) zero (maxRotateAngle fb))
265 new_nose = fb.nose + feasible_angle
266 angleDifficulty = angleHowFarFromPi (speed.direction-new_nose)
267 angleDifference = angleHowFarFromAngle speed.direction new_nose
268 new_stamina = alter_stamina ball fb angleDifficulty angleDifference
269 new_vel = scale (1.4 * fb.health * new_stamina) (setbetween speed.velocity zero (maxVelocity (skillsAsList fb) angleDifficulty angleDifference))
270 new_speed = {speed & velocity=new_vel}
271 new_position` = move_point (scale (dt * (toReal new_vel)) (toRVector new_speed.direction)) fb.pos
272 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`
273 new_fb = {fb & stamina = new_stamina
274 , speed = new_speed
275 , pos = new_position
276 , nose = new_nose
277 , effect = Just (Moved new_speed feasible_angle)
278 }
279
280 /** Rules for gaining ball:
281 (1) ball obtains position and surface speed of obtaining player
282 */ act (playerID,GainBall) (seed,ball,team1,team2)
283 # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))
284 = (seed,GainedBy playerID,team1,team2)
285 where
286 (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)
287 new_fb = {fb & effect = Just (GainedBall Success)}
288
289 /** Rules for kicking ball:
290 (1) kicking decreases stamina
291 (2) kicking is more effective towards your direction, and least effective in opposite direction
292 (3) being taller, you can kick harder
293 (4) a low stamina/health lower your max kickspeed
294 (5) todo: kicking a ball held/gained by a keeper, may damage the keeper
295 */ act (playerID,KickBall {vxy={velocity=v,direction=d},vz}) (seed,ball,team1,team2)
296 # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))
297 = (seed1,Free new_ball,team1,team2)
298 where
299 (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)
300 new_fb = {fb & stamina=new_stamina,effect=Just (KickedBall (Just new_speed))}
301 theBall = getFootball ball (team1 ++ team2)
302 skills = skillsAsList fb
303 max_v = maxVelocityBallKick fb
304 new_v = scale speed_factor (setbetween v zero max_v)
305 new_vz = scale speed_factor (setbetween vz zero max_v)
306 new_speed = {vxy={velocity=new_v,direction=new_d},vz=new_vz}
307 new_stamina = kickingPenalty fb new_v * fb.stamina
308 speed_factor = oppositeKickPenalty fb d
309 new_ball = {theBall & ballSpeed=new_speed}
310 (new_d,seed1) = new_ball_direction Kicking fb d seed
311
312 /** Rules for heading ball:
313 (1) heading decreases stamina, but less than kicking
314 (2) kicking is more effective towards your direction, and least effective in opposite direction
315 (3) a low stamina/health lower your max headspeed, but less than kicking
316 (4) heading is less harder than kicking, but is not effected by your length
317 (5) todo: heading a ball held/gained by a keeper, may damage the keeper (less than with kicking)
318 */ act (playerID,HeadBall {vxy={velocity=v,direction=d},vz}) (seed,ballstate,team1,team2)
319 # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))
320 = (seed1,Free new_ball,team1,team2)
321 where
322 (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)
323 skills = skillsAsList fb
324 ball = getFootball ballstate (team1 ++ team2)
325 ball_speed = ball.ballSpeed.vxy.velocity
326 max_v = maxVelocityBallHead fb ball_speed
327 new_v = setbetween v zero max_v
328 new_vz = scale 0.25 (setbetween vz zero max_v)
329 new_speed = {vxy={velocity=new_v,direction=new_d},vz=new_vz}
330 new_stamina = headingPenalty fb new_v ball_speed * fb.stamina
331 new_fb = {fb & stamina=new_stamina,effect=Just (HeadedBall (Just new_speed))}
332 new_ball = {ball & ballSpeed=new_speed}
333 (new_d,seed1) = new_ball_direction Heading fb d seed
334
335 /** Rules for feinting:
336 (1) you must have velocity in order to feint manouvre.
337 (2) a feint manouvre changes your position, and decreases your velocity (depends on Feinting skill)
338 */ act (playerID,Feint d) (seed,ball,team1,team2)
339 # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))
340 = (seed,ball,team1,team2)
341 where
342 (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)
343 new_stamina = (maxFatigueLossAtFeint fb) * fb.stamina
344 new_velocity = scale (fb.health * fb.stamina * (maxVelocityLossAtFeint fb)) fb.speed.velocity
345 new_speed = {fb.speed & velocity=new_velocity}
346 (leftv,rightv) = orthogonal fb.speed.direction
347 sidestep = case d of FeintLeft -> leftv; _ -> rightv
348 new_position` = move_point ((scale (toReal (maxFeintStep fb)) (toRVector sidestep))
349 +
350 (scale (dt * toReal new_velocity) (toRVector fb.speed.direction))
351 ) fb.pos
352 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`
353 new_fb = {fb & pos=new_position,speed=new_speed,stamina=new_stamina,effect=Just (Feinted d)}
354
355 /** Rules for Tackling
356 (1) tackling may lower the health of the victim but increases his stamina (last is because he lies on the ground the next rounds)
357 (2) tackling costs stamina
358 */ act (playerID,Tackle victimID ve) (seed,ball,team1,team2)
359 = (seed1,new_ball,team1T,team2T)
360 where
361 nrPlayersTeam1 = length team1
362 (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)
363 (team1N,team2N) = splitAt nrPlayersTeam1 (unbreak1 (uneq1,new_fb,uneq2))
364 (uneq1T,fbT,uneq2T) = break1 (identify_player victimID) (team1N ++ team2N)
365 (team1T,team2T) = splitAt nrPlayersTeam1 (unbreak1 (uneq1T,new_target,uneq2T))
366 new_stamina_self = maxFatigueLossAtTackle fb * fb.stamina
367 new_fb = {fb & stamina = new_stamina_self, effect = Just (Tackled victimID ve Success)}
368 target_has_ball = ballIsGainedBy victimID ball
369 (p,seed1) = nextRandomP seed
370 new_v` = min max_tackle_velocity ve
371 max_tackle_velocity = ms 10.0
372 max_ground_time = s 30.0
373 ground_frames = toInt ((((toReal new_v`) / (toReal max_tackle_velocity)) * (toReal max_ground_time)) / dt)
374 new_v = scale 0.1 new_v`
375 healthDamageTarget = (toReal new_v) * fb.health * fb.stamina * (0.5*p + 0.1) + (toReal (fbT.length-min_length))/2.0
376 new_health_target = max zero (fbT.health - healthDamageTarget)
377 new_target = {fbT & health = new_health_target, effect = Just (OnTheGround ground_frames) }
378 new_ball = if target_has_ball (Free (mkFootball fbT.pos fbT.speed)) ball
379
380 /** Rules for catching
381 (1) ball optains speed and distance of player
382 */ act (playerID,CatchBall) (seed,ball,team1,team2)
383 # (team1,team2) = splitAt (length team1) (unbreak1 (uneq1,new_fb,uneq2))
384 = (seed,GainedBy playerID,team1,team2)
385 where
386 (uneq1,fb,uneq2) = break1 (identify_player playerID) (team1 ++ team2)
387 new_fb = {fb & effect=Just (CaughtBall Success)}
388
389 new_ball_direction :: !Skill !Footballer !Angle !RandomSeed -> (!Angle,!RandomSeed)
390 new_ball_direction skill fb d seed
391 # (p1,seed) = nextRandomP seed
392 # (p2,seed) = nextRandomP seed
393 | p2 == one = (d,seed)
394 # failure = one - if (isMember skill (skillsAsList fb)) makeRandomRealisticSkilled makeRandomRealistic p2
395 # diff = scale failure (maxHeadingDeviation fb)
396 | p1 <= 0.5 = (d - diff, seed)
397 | otherwise = (d + diff, seed)
398
399 /** moveFootball match
400 makes the free ball move (a gained ball moves along with its player).
401 */ moveFootball :: !Match -> Match
402 moveFootball match=:{Match | theBall=Free football=:{ballSpeed={vxy={velocity=v,direction=d},vz},ballPos},theField,team1,team2,seed,lastContact,unittime}
403 = { match & theBall = Free {football & ballSpeed=new_speed,ballPos=new_ballpos}, seed = seed1, lastContact = if (isJust hit_player) hit_player lastContact }
404 where
405 old_height = ballPos.pz
406 in_the_air = old_height > zero
407 resistance = if in_the_air air_resistance surface_resistance
408 dt = toReal unittime
409 surface_movement = scale (dt * (toReal v)) (toRVector d)
410 new_speed2D = let new_v = scale resistance v in {direction = d, velocity = if (new_v <= ms 0.05) zero new_v}
411 new_vz` = if in_the_air (vz - scale dt accelleration_sec) zero
412 new_height` = ballPos.pz + m (toReal vz)
413 (new_height,new_vz) = if (in_the_air && new_height` <= zero) // the ball bounces on the field
414 (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``)
415 (new_height`, new_vz`)
416 new_speed` = {vxy=new_speed2D, vz=new_vz}
417 new_ballpos = {pxy=move_point surface_movement ballPos.pxy,pz=new_height}
418 all_players = team1 ++ team2
419 (hit_player,new_speed,seed1) = ballBounces new_ballpos new_speed` seed
420
421 // the direction of the ball changes after a bounce and its velocity may reduce in case of bouncing against a player
422 ballBounces :: !Position3D !Speed3D !RandomSeed -> (!Maybe FootballerID,!Speed3D,!RandomSeed)
423 ballBounces new_ballpos new_speed=:{vxy={velocity=v,direction=d},vz=s3d} seed
424 | 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)
425 | 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)
426 | isEmpty hit_players = (Nothing, new_speed, seed)
427 # (p1,seed) = nextRandomP seed
428 # (p2,seed) = nextRandomP seed
429 # (p3,seed) = nextRandomP seed
430 | otherwise = (Just (hd hit_players),{vxy = {direction = rad (p2*2.0*pi), velocity = scale p3 v}, vz=scale p1 s3d},seed)
431 where
432 half_length = scale 0.5 theField.flength
433 goal_pole_r = scale 0.5 goal_pole_width
434 (northPole,southPole) = goal_poles theField
435 hit_west_goal = againstGoalWestNorthPole || againstGoalWestSouthPole || againstGoalWestPoleUpper
436 hit_east_goal = againstGoalEastNorthPole || againstGoalEastSouthPole || againstGoalEastPoleUpper
437 hit_players = [playerID \\ fb=:{length,playerID} <- all_players | inRadiusOfFootballer new_ballpos.pxy fb && length >= new_ballpos.pz]
438 againstGoalWestNorthPole = inCircleRadiusOfPosition new_ballpos goal_pole_r goal_height {px = ~half_length, py = northPole + goal_pole_r}
439 againstGoalWestSouthPole = inCircleRadiusOfPosition new_ballpos goal_pole_r goal_height {px = ~half_length, py = southPole - goal_pole_r}
440 againstGoalEastNorthPole = inCircleRadiusOfPosition new_ballpos goal_pole_r goal_height {px = half_length, py = northPole + goal_pole_r}
441 againstGoalEastSouthPole = inCircleRadiusOfPosition new_ballpos goal_pole_r goal_height {px = half_length, py = southPole - goal_pole_r}
442 againstGoalWestPoleUpper = (isbetween new_ballpos.pxy.py (southPole - goal_pole_r) (northPole + goal_pole_r))
443 &&
444 (isbetween new_ballpos.pz goal_height (goal_height+goal_pole_width))
445 &&
446 (new_ballpos.pxy.px <= ~half_length)
447 againstGoalEastPoleUpper = (isbetween new_ballpos.pxy.py (southPole - goal_pole_r) (northPole + goal_pole_r))
448 &&
449 (isbetween new_ballpos.pz goal_height (goal_height+goal_pole_width))
450 &&
451 (new_ballpos.pxy.px >= half_length)
452 inCircleRadiusOfPosition {pxy,pz} r zr pos
453 = dist pxy pos <= r && pz <= zr
454
455 moveFootball match
456 = match
457
458 /** advanceTime match
459 decreases the time to play with unittime.
460 */ advanceTime :: !Match -> Match
461 advanceTime match=:{Match | playingTime, unittime}
462 = {Match | match & playingTime = max zero (playingTime - minutes unittime)}
463
464 /* Attribute altering functions depending on angles:
465 params:
466 Angle :: between zero and pi, how much the player is running backwards (pi is backwards).
467 Angle :: between zero and pi, the difference between the desired angle and the angle the player previously ran to.
468 */
469 alter_stamina :: !FootballState !Footballer !Angle !Angle -> Stamina
470 alter_stamina ballState fb angleDifficulty angleDifference
471 | velocity <= rfv // increase stamina
472 | stamina < MinimumFatigue = MinimumFatigue
473 | otherwise = stamina^0.8
474 | otherwise = fatigue * factor
475 where
476 velocity = fb.speed.velocity
477 length = fb.length
478 stamina = fb.stamina
479 rfv = restore_stamina_velocity (ballIsGainedBy fb.playerID ballState) (skillsAsList fb) angleDifficulty angleDifference
480 diff = velocity - rfv
481 fv = if (diff >= ms 6.0) (stamina^(stamina^(1.6 + 0.02 * toReal length)))
482 (if (diff >= ms 4.0) (stamina^( 1.5 + 0.01 * toReal length))
483 (if (diff >= ms 2.0) (stamina^( 1.4 - 0.01 * toReal length))
484 (stamina^( 1.3 - 0.02 * toReal length))))
485 factor = one - (toReal angleDifficulty)/(4.0*pi)
486 fatigue = if (stamina > MaximumFatigue) MaximumFatigue fv
487
488 restore_stamina_velocity :: !Bool ![Skill] !Angle !Angle -> Velocity
489 restore_stamina_velocity gained_ball skills angleDifficulty angleDifference
490 | gained_ball = scale ( one / if (isMember Running skills) 1.6 2.6) max_v
491 | isMember Running skills = scale ((one / if (isMember Dribbling skills) 2.0 3.0) * 1.22) max_v
492 | otherwise = scale ( one / if (isMember Dribbling skills) 2.0 3.0) max_v
493 where
494 max_v = maxVelocity skills angleDifficulty angleDifference
495
496 maxVelocity :: ![Skill] !Angle !Angle -> Velocity
497 maxVelocity skills angleDifficulty angleDifference
498 = scale (dribblingPenalty * runningPenalty) base_velocity
499 where
500 base_velocity = ms 10.0
501 dribblingPenalty = if (isMember Dribbling skills) 0.95 0.85
502 runningPenalty = if (isMember Running skills) 1.0 0.85
503
504 MinimumFatigue :== 0.05
505 MaximumFatigue :== 0.985
506
507
508 /** The functions below defines the penalty factor: values between 0.0 and 1.0 that define the loss of an attribute of an action.
509 */
510 :: PenaltyFactor :== Real // a value between 0.0 and 1.0
511
512 kickingPenalty :: !Footballer !Velocity -> PenaltyFactor
513 kickingPenalty fb new_v = 1.0 - (if (isMember Kicking (skillsAsList fb)) 0.3 0.6) * ((toReal new_v)/(toReal max_v))^2.0
514 where
515 max_v = maxVelocityBallKick fb
516
517 headingPenalty :: !Footballer !Velocity !Velocity -> PenaltyFactor
518 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
519 where
520 max_v = maxVelocityBallHead fb ball_v
521
522 maxFatigueLossAtTackle :: !Footballer -> PenaltyFactor
523 maxFatigueLossAtTackle fb = if (isMember Tackling (skillsAsList fb)) 0.99 0.9
524
525 maxFatigueLossAtFeint :: !Footballer -> PenaltyFactor
526 maxFatigueLossAtFeint fb = if (isMember Feinting (skillsAsList fb)) 0.92 0.77
527
528 maxVelocityLossAtFeint :: !Footballer -> PenaltyFactor
529 maxVelocityLossAtFeint fb = if (isMember Feinting (skillsAsList fb)) 0.99 0.75
530
531 oppositeKickPenalty :: !Footballer !Angle -> PenaltyFactor
532 oppositeKickPenalty fb kick_to = 1.0 - toReal (scale (skillPenaltyFactor/pi) (angleHowFarFromPi angle))
533 where
534 angle = abs (fb.nose - kick_to)
535 skills = skillsAsList fb
536 skillPenaltyFactor = if (isAllMember [Rotating,Kicking] skills) 0.3
537 (if (isAnyMember [Rotating,Kicking] skills) 0.5
538 0.9)
539
540 angleHowFarFromPi :: !Angle -> Angle
541 angleHowFarFromPi a
542 | a` > rad pi = rad (2.0*pi) - a`
543 | otherwise = a`
544 where
545 a` = abs a
546
547 angleHowFarFromAngle :: !Angle !Angle -> Angle
548 angleHowFarFromAngle a b
549 | a` > b`
550 | a` - b` > rad pi = b` - a` + rad (2.0*pi)
551 | otherwise = a` - b`
552 | otherwise
553 | b` - a` > rad pi = a` - b` + rad (2.0*pi)
554 | otherwise = b` - a`
555 where
556 a` = abs a
557 b` = abs b
1415-Q4 NWI-IBC030: Functioneel Programmeren 2