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