ef8d8000a59c7d60b96681c040d0c202b2bf84c1
[fp1415-soccerfun.git] / src / Game / Footballer.icl
1 implementation module Footballer
2
3 import StdEnvExt
4 import Football, FootballerFunctions, Geometry
5
6 instance == Edge where == North North = True
7 == South South = True
8 == _ _ = False
9 instance == FootballerID where == i1 i2 = i1.clubName == i2.clubName && i1.playerNr == i2.playerNr
10 instance == Half where == FirstHalf FirstHalf = True
11 == SecondHalf SecondHalf = True
12 == _ _ = False
13 instance == Reprimand where == Warning Warning = True
14 == YellowCard YellowCard = True
15 == RedCard RedCard = True
16 == _ _ = False
17 instance == Skill where == s1 s2 = toString s1 == toString s2
18 instance == Success where == Success Success = True
19 == Fail Fail = True
20 == _ _ = False
21 instance == Footballer where == fb1 fb2 = fb1.playerID == fb2.playerID
22 instance == Home where == West West = True
23 == East East = True
24 == _ _ = False
25 instance == FeintDirection where == FeintLeft FeintLeft = True
26 == FeintRight FeintRight = True
27 == _ _ = False
28 instance == FootballerAction where == (Move speed1 angle1) (Move speed2 angle2) = speed1 == speed2 && angle1 == angle2
29 == GainBall GainBall = True
30 == (KickBall speed3D1) (KickBall speed3D2) = speed3D1 == speed3D2
31 == (HeadBall speed3D1) (HeadBall speed3D2) = speed3D1 == speed3D2
32 == (Feint fd1) (Feint fd2) = fd1 == fd2
33 == (Tackle tf1 v1) (Tackle tf2 v2) = tf1 == tf2 && v1 == v2
34 == CatchBall CatchBall = True
35 == _ _ = False
36 instance other Edge where other North = South
37 other South = North
38 instance other Half where other FirstHalf = SecondHalf
39 other SecondHalf = FirstHalf
40 instance other Home where other West = East
41 other East = West
42 instance toString Edge where toString North = "North"
43 toString South = "South"
44 instance toString FootballerID where toString i = "{clubName=" <+++ i.clubName +++ ",playerNr=" <+++ i.playerNr +++ "}"
45 instance toString Half where toString FirstHalf = "FirstHalf"
46 toString SecondHalf = "SecondHalf"
47 instance toString Reprimand where toString Warning = "Warning"
48 toString YellowCard = "YellowCard"
49 toString RedCard = "RedCard"
50 instance toString Skill where toString Running = "Running"
51 toString Dribbling = "Dribbling"
52 toString Rotating = "Rotating"
53 toString Gaining = "Gaining"
54 toString Kicking = "Kicking"
55 toString Heading = "Heading"
56 toString Feinting = "Feinting"
57 toString Jumping = "Jumping"
58 toString Catching = "Catching"
59 toString Tackling = "Tackling"
60 instance toString Success where toString Success = "Success"
61 toString Fail = "Fail"
62 instance toString Home where toString West = "West"
63 toString East = "East"
64 instance toString FeintDirection where toString FeintLeft = "FeintLeft"
65 toString FeintRight = "FeintRight"
66 instance toString FootballerAction where toString (Move speed angle) = "(Move " <+++ speed <+++ " " <+++ angle <+++ ")"
67 toString GainBall = "GainBall"
68 toString (KickBall speed) = "(KickBall " <+++ speed <+++ ")"
69 toString (HeadBall speed) = "(HeadBall " <+++ speed <+++ ")"
70 toString (Feint fd) = "(Feint " <+++ fd <+++ ")"
71 toString (Tackle fbID v) = "(Tackle " <+++ fbID.playerNr <+++ " " <+++ v <+++ ")"
72 toString CatchBall = "CatchBall"
73
74 :: Minutes = Minutes !Real
75
76 instance zero Minutes where zero = Minutes zero
77 instance < Minutes where < (Minutes m1) (Minutes m2) = m1 < m2
78 instance == Minutes where == (Minutes m1) (Minutes m2) = m1 == m2
79 instance + Minutes where + (Minutes m1) (Minutes m2) = Minutes (m1+m2)
80 instance - Minutes where - (Minutes m1) (Minutes m2) = Minutes (m1-m2)
81 instance scale Minutes where scale k (Minutes m) = Minutes (k * m)
82 instance toString Minutes where toString (Minutes m) = toString (s/60) <+++ ":" <+++ if (s mod 60 < 10) "0" "" <+++ (s mod 60) <+++" min"
83 where s = toInt (((toReal (toInt (m * 100.0)))/100.0) * 60.0)
84 instance toReal Minutes where toReal (Minutes m) = m
85 instance minutes Real where minutes m = Minutes m
86
87 instance toPosition Footballer where toPosition fb = fb.pos
88 instance toPosition3D Footballer where toPosition3D fb = toPosition3D fb.pos
89 instance nameOf Footballer where nameOf {name,nose} = name
90 instance nameOf FootballerID where nameOf {clubName} = clubName
91 instance sameClub FootballerID where sameClub id1 id2 = nameOf id1 == nameOf id2
92 instance sameClub Footballer where sameClub fb1 fb2 = sameClub fb1.playerID fb2.playerID
93
94 defaultFootballer :: !FootballerID -> Footballer
95 defaultFootballer playerID = { playerID = playerID
96 , name = "default"
97 , length = m 1.6
98 , pos = zero
99 , speed = zero
100 , nose = zero
101 , skills = (Running, Kicking, Dribbling)
102 , effect = Nothing
103 , stamina = max_stamina
104 , health = max_health
105 , brain = {memory=Void, ai=returnAI (Move zero zero)}
106 }
107
108 inRadiusOfFootballer :: !Position !Footballer -> Bool
109 inRadiusOfFootballer pos player = isbetween pos.px (player.pos.px - xWidthFootballer) (player.pos.px + xWidthFootballer) &&
110 isbetween pos.py (player.pos.py - yWidthFootballer) (player.pos.py + yWidthFootballer)
111
112 skillsAsList :: !Footballer -> [Skill]
113 skillsAsList fb = (\(a,b,c)->[a,b,c]) fb.skills
114
115 identify_player :: !FootballerID !Footballer -> Bool
116 identify_player id fb = id == fb.playerID
117
118 player_identity :: !Footballer -> FootballerID
119 player_identity fb = fb.playerID
120
121 getClubName :: !Footballer -> ClubName
122 getClubName fb = nameOf fb.playerID
123
124 isKeeper :: !Footballer -> Bool
125 isKeeper fb = fb.playerID.playerNr == 1
126
127 isFielder :: !Footballer -> Bool
128 isFielder fb = not (isKeeper fb)
129
130 /** Footballer attribute dependent abilities:
131 */
132 maxGainReach :: !Footballer -> Metre
133 maxGainReach fb = scale (if (isMember Gaining (skillsAsList fb)) 0.5 0.3) fb.length
134
135 maxJumpReach :: !Footballer -> Metre
136 maxJumpReach fb = scale (if (isMember Jumping (skillsAsList fb)) 0.6 0.4) fb.length
137
138 maxGainVelocityDifference :: !Footballer !Metre -> Velocity
139 maxGainVelocityDifference fb d_player_ball = ms (if (isMember Gaining (skillsAsList fb)) 15.0 10.0 - distanceDifficulty)
140 where
141 length = toReal fb.length
142 distanceDifficulty = max zero ((0.8 * length)^4.0 * ((toReal d_player_ball)/length))
143
144 maxCatchVelocityDifference :: !Footballer !Metre -> Velocity
145 maxCatchVelocityDifference fb d_player_ball = ms (if (isMember Gaining (skillsAsList fb)) 20.0 17.0 - distanceDifficulty)
146 where
147 length = toReal fb.length
148 distanceDifficulty = max zero ((0.8 * length)^4.0 * ((toReal d_player_ball)/length))
149
150 maxKickReach :: !Footballer -> Metre
151 maxKickReach fb = scale (if (isMember Kicking (skillsAsList fb)) 0.6 0.4) fb.length
152
153 maxHeadReach :: !Footballer -> Metre
154 maxHeadReach fb = scale (if (isMember Heading (skillsAsList fb)) 0.4 0.2) fb.length
155
156 maxCatchReach :: !Footballer -> Metre // includes horizontal jumping
157 maxCatchReach fb = scale (if (isMember Catching (skillsAsList fb)) 1.8 1.5) fb.length
158
159 maxTackleReach :: !Footballer -> Metre
160 maxTackleReach fb = scale (if (isMember Tackling (skillsAsList fb)) 0.33 0.25) fb.length
161
162 maxVelocityBallKick :: !Footballer -> Velocity
163 maxVelocityBallKick fb = ms ((if (isMember Kicking (skillsAsList fb)) 27.0 25.0 + (toReal fb.length)/2.0) * (0.2*fatHealth+0.8))
164 where
165 fatHealth = getHealthStaminaFactor fb.health fb.stamina
166
167 maxVelocityBallHead :: !Footballer !Velocity -> Velocity
168 maxVelocityBallHead fb ballSpeed = scale 0.7 ballSpeed + scale (0.1*fatHealth+0.9) (ms (if (isMember Heading (skillsAsList fb)) 7.0 5.0))
169 where
170 fatHealth = getHealthStaminaFactor fb.health fb.stamina
171
172 maxKickingDeviation :: !Footballer -> Angle
173 maxKickingDeviation skills = rad (0.5*pi) //if (isMember Kicking skills) (pi/18.0) (pi/2.0)
174
175 maxHeadingDeviation :: !Footballer -> Angle
176 maxHeadingDeviation skills = rad (0.25*pi) //if (isMember Heading skills) (pi/16.0) (pi/5.0)
177
178 maxRotateAngle :: !Footballer -> Angle
179 maxRotateAngle fb=:{speed,length}
180 | velocity < 1.0 = rad pi
181 | otherwise = rad (pi/18.0*((5.0/velocity)*((toReal length)/2.0)))
182 where
183 velocity = abs (toReal speed.velocity)
184
185 maxFeintStep :: !Footballer -> Metre
186 maxFeintStep fb = m (if (isMember Feinting (skillsAsList fb)) 0.75 0.5)
187
188 :: HealthStaminaFactor :== Real // combination of stamina and health
189
190 getHealthStaminaFactor :: !Health !Stamina -> HealthStaminaFactor
191 getHealthStaminaFactor health stamina
192 | stamina <= health = stamina
193 | otherwise = avg [stamina,health]
194
195 isMove :: !FootballerAction -> Bool
196 isMove (Move _ _) = True
197 isMove _ = False
198
199 isGainBall :: !FootballerAction -> Bool
200 isGainBall GainBall = True
201 isGainBall _ = False
202
203 isKickBall :: !FootballerAction -> Bool
204 isKickBall (KickBall _) = True
205 isKickBall _ = False
206
207 isHeadBall :: !FootballerAction -> Bool
208 isHeadBall (HeadBall _) = True
209 isHeadBall _ = False
210
211 isFeint :: !FootballerAction -> Bool
212 isFeint (Feint _) = True
213 isFeint _ = False
214
215 isFootballerTackle :: !FootballerAction -> Bool
216 isFootballerTackle (Tackle _ _) = True
217 isFootballerTackle _ = False
218
219 isCatchBall :: !FootballerAction -> Bool
220 isCatchBall CatchBall = True
221 isCatchBall _ = False
222
223 isActionOnBall :: !FootballerAction -> Bool
224 isActionOnBall GainBall = True
225 isActionOnBall CatchBall = True
226 isActionOnBall (KickBall _) = True
227 isActionOnBall (HeadBall _) = True
228 isActionOnBall _ = False
229
230 getDefaultField :: FootballField
231 getDefaultField = { fwidth = m 75.0, flength = m 110.0 }
232
233 inPenaltyArea :: !FootballField !Home !Position -> Bool
234 inPenaltyArea field home pos = isbetween pos.py south_edge north_edge && if (home == West) (pos.px <= west_edge) (pos.px >= east_edge)
235 where
236 north_edge = northPole + radius_penalty_area
237 south_edge = southPole - radius_penalty_area
238 (northPole,southPole) = goal_poles field
239 half_length = scale 0.5 field.flength
240 west_edge = penalty_area_depth - half_length
241 east_edge = half_length - penalty_area_depth
242
243 goal_poles :: !FootballField -> (!Metre,!Metre)
244 goal_poles field = (half_goal_width,~half_goal_width)
245 where
246 half_goal_width = scale 0.5 goal_width
247
248 isMoved :: !FootballerEffect -> Bool
249 isMoved (Moved _ _) = True
250 isMoved _ = False
251
252 isGainedBall :: !FootballerEffect -> Bool
253 isGainedBall (GainedBall _) = True
254 isGainedBall _ = False
255
256 isKickedBall :: !FootballerEffect -> Bool
257 isKickedBall (KickedBall _) = True
258 isKickedBall _ = False
259
260 isHeadedBall :: !FootballerEffect -> Bool
261 isHeadedBall (HeadedBall _) = True
262 isHeadedBall _ = False
263
264 isFeinted :: !FootballerEffect -> Bool
265 isFeinted (Feinted _) = True
266 isFeinted _ = False
267
268 isTackled :: !FootballerEffect -> Bool
269 isTackled (Tackled _ _ _) = True
270 isTackled _ = False
271
272 isCaughtBall :: !FootballerEffect -> Bool
273 isCaughtBall (CaughtBall _) = True
274 isCaughtBall _ = False
275
276 isOnTheGround :: !FootballerEffect -> Bool
277 isOnTheGround (OnTheGround _) = True
278 isOnTheGround _ = False
279
280 failFootballerAction :: !FootballerAction -> FootballerEffect
281 failFootballerAction (Move s a) = Moved s a
282 failFootballerAction GainBall = GainedBall Fail
283 failFootballerAction CatchBall = CaughtBall Fail
284 failFootballerAction (KickBall v) = KickedBall Nothing
285 failFootballerAction (HeadBall v) = HeadedBall Nothing
286 failFootballerAction (Feint d) = Feinted d
287 failFootballerAction (Tackle p v) = Tackled p v Fail
288 failFootballerAction _ = abort "failFootballerAction: unknown action failed"
289
290 displacements :: !Team -> Displacements
291 displacements team = [(playerID,pos) \\ {playerID,pos} <- team]
292
293 showSuccintRefereeAction :: !RefereeAction -> String
294 showSuccintRefereeAction refAction
295 = case refAction of
296 (ReprimandPlayer id r) = player id <+++ " receives " <+++ r
297 (Hands id) = "Hands by " <+++ player id
298 (TackleDetected id) = "Tackle by " <+++ player id
299 (DangerousPlay id) = "Dangerous play by " <+++ player id
300 GameOver = "Game ended"
301 (GameCancelled mt) = "Game cancelled" <+++ if (isJust mt) (" winner is " <+++ fromJust mt) ""
302 PauseGame = "Game paused"
303 (AddTime t) = "Extra time added: " <+++ t
304 EndHalf = "First half ended"
305 (Goal t) = "Goal for " <+++ t
306 (Offside id) = "Offside by " <+++ player id
307 (DirectFreeKick t p) = "Direct free kick for " <+++ t
308 (GoalKick t) = "Goal kick for " <+++ t
309 (Corner t e) = "Corner for " <+++ t
310 (ThrowIn t p) = "Throw in for " <+++ t
311 (Penalty t) = "Penalty for " <+++ t
312 (CenterKick t) = "Center kick for " <+++ t
313 (Advantage t) = "Advantage for " <+++ t
314 (OwnBallIllegally id) = "Illegal ball possession by " <+++ player id
315 (DisplacePlayers _) = "Players displaced"
316 ContinueGame = "Game continued"
317 (TellMessage txt) = txt
318 where
319 player {clubName,playerNr} = clubName <+++"[" <+++ playerNr <+++ "]"
320
321 isReprimandPlayer :: !RefereeAction -> Bool
322 isReprimandPlayer (ReprimandPlayer _ _) = True
323 isReprimandPlayer _ = False
324
325 isHands :: !RefereeAction -> Bool
326 isHands (Hands _) = True
327 isHands _ = False
328
329 isTackleDetected :: !RefereeAction -> Bool
330 isTackleDetected (TackleDetected _) = True
331 isTackleDetected _ = False
332
333 isDangerousPlay :: !RefereeAction -> Bool
334 isDangerousPlay (DangerousPlay _) = True
335 isDangerousPlay _ = False
336
337 isGameOver :: !RefereeAction -> Bool
338 isGameOver GameOver = True
339 isGameOver _ = False
340
341 isGameCancelled :: !RefereeAction -> Bool
342 isGameCancelled (GameCancelled _) = True
343 isGameCancelled _ = False
344
345 isPauseGame :: !RefereeAction -> Bool
346 isPauseGame PauseGame = True
347 isPauseGame _ = False
348
349 isAddTime :: !RefereeAction -> Bool
350 isAddTime (AddTime _) = True
351 isAddTime _ = False
352
353 isEndHalf :: !RefereeAction -> Bool
354 isEndHalf EndHalf = True
355 isEndHalf _ = False
356
357 isGoal :: !RefereeAction -> Bool
358 isGoal (Goal _) = True
359 isGoal _ = False
360
361 isOffside :: !RefereeAction -> Bool
362 isOffside (Offside _) = True
363 isOffside _ = False
364
365 isDirectFreeKick :: !RefereeAction -> Bool
366 isDirectFreeKick (DirectFreeKick _ _ ) = True
367 isDirectFreeKick _ = False
368
369 isGoalKick :: !RefereeAction -> Bool
370 isGoalKick (GoalKick _) = True
371 isGoalKick _ = False
372
373 isCorner :: !RefereeAction -> Bool
374 isCorner (Corner _ _) = True
375 isCorner _ = False
376
377 isThrowIn :: !RefereeAction -> Bool
378 isThrowIn (ThrowIn _ _) = True
379 isThrowIn _ = False
380
381 isPenalty :: !RefereeAction -> Bool
382 isPenalty (Penalty _) = True
383 isPenalty _ = False
384
385 isCenterKick :: !RefereeAction -> Bool
386 isCenterKick (CenterKick _) = True
387 isCenterKick _ = False
388
389 isAdvantage :: !RefereeAction -> Bool
390 isAdvantage (Advantage _) = True
391 isAdvantage _ = False
392
393 isOwnBallIllegally :: !RefereeAction -> Bool
394 isOwnBallIllegally (OwnBallIllegally _) = True
395 isOwnBallIllegally _ = False
396
397 isDisplacePlayers :: !RefereeAction -> Bool
398 isDisplacePlayers (DisplacePlayers _) = True
399 isDisplacePlayers _ = False
400
401 isContinueGame :: !RefereeAction -> Bool
402 isContinueGame ContinueGame = True
403 isContinueGame _ = False
404
405 isTellMessage :: !RefereeAction -> Bool
406 isTellMessage (TellMessage _) = True
407 isTellMessage _ = False
408
409 getKickPos :: !FootballField !Half !RefereeAction -> Maybe Position
410 getKickPos field half (GoalKick home) = Just { zero & px = if (home == West) (penalty_area_depth - half_length) (half_length - penalty_area_depth) }
411 where
412 half_length = scale 0.5 field.flength
413 getKickPos field half (Corner home edge) = Just { px = if (home == West && half == SecondHalf || home == East && half == FirstHalf)
414 (half_radius_corner_kick_area - half_length)
415 (half_length - half_radius_corner_kick_area)
416 , py = if (edge == North)
417 (half_radius_corner_kick_area - half_width)
418 (half_width - half_radius_corner_kick_area)
419 }
420 where
421 half_width = scale 0.5 field.fwidth
422 half_length = scale 0.5 field.flength
423 half_radius_corner_kick_area = scale 0.5 radius_corner_kick_area
424 getKickPos field half (Penalty home) = Just { zero & px = if (home == West && half == SecondHalf || home == East && half == FirstHalf)
425 (penalty_spot_depth - half_length)
426 (half_length - penalty_spot_depth)
427 }
428 where
429 half_length = scale 0.5 field.flength
430 getKickPos field _ (CenterKick _) = Just zero
431 getKickPos _ _ (DirectFreeKick _ pos) = Just pos
432 getKickPos _ _ (ThrowIn _ pos) = Just pos
433 getKickPos _ _ _ = Nothing