1 implementation module Footballer
4 import Football, FootballerFunctions, Geometry
6 instance == Edge where == North North = True
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
13 instance == Reprimand where == Warning Warning = True
14 == YellowCard YellowCard = True
15 == RedCard RedCard = True
17 instance == Skill where == s1 s2 = toString s1 == toString s2
18 instance == Success where == Success Success = True
21 instance == Footballer where == fb1 fb2 = fb1.playerID == fb2.playerID
22 instance == Home where == West West = True
25 instance == FeintDirection where == FeintLeft FeintLeft = True
26 == FeintRight FeintRight = True
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
36 instance other Edge where other North = South
38 instance other Half where other FirstHalf = SecondHalf
39 other SecondHalf = FirstHalf
40 instance other Home where other West = East
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"
74 :: Minutes = Minutes !Real
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
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
94 defaultFootballer :: !FootballerID -> Footballer
95 defaultFootballer playerID = { playerID = playerID
101 , skills = (Running, Kicking, Dribbling)
103 , stamina = max_stamina
104 , health = max_health
105 , brain = {memory=Void, ai=returnAI (Move zero zero)}
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)
112 skillsAsList :: !Footballer -> [Skill]
113 skillsAsList fb = (\(a,b,c)->[a,b,c]) fb.skills
115 identify_player :: !FootballerID !Footballer -> Bool
116 identify_player id fb = id == fb.playerID
118 player_identity :: !Footballer -> FootballerID
119 player_identity fb = fb.playerID
121 getClubName :: !Footballer -> ClubName
122 getClubName fb = nameOf fb.playerID
124 isKeeper :: !Footballer -> Bool
125 isKeeper fb = fb.playerID.playerNr == 1
127 isFielder :: !Footballer -> Bool
128 isFielder fb = not (isKeeper fb)
130 /** Footballer attribute dependent abilities:
132 maxGainReach :: !Footballer -> Metre
133 maxGainReach fb = scale (if (isMember Gaining (skillsAsList fb)) 0.5 0.3) fb.length
135 maxJumpReach :: !Footballer -> Metre
136 maxJumpReach fb = scale (if (isMember Jumping (skillsAsList fb)) 0.6 0.4) fb.length
138 maxGainVelocityDifference :: !Footballer !Metre -> Velocity
139 maxGainVelocityDifference fb d_player_ball = ms (if (isMember Gaining (skillsAsList fb)) 15.0 10.0 - distanceDifficulty)
141 length = toReal fb.length
142 distanceDifficulty = max zero ((0.8 * length)^4.0 * ((toReal d_player_ball)/length))
144 maxCatchVelocityDifference :: !Footballer !Metre -> Velocity
145 maxCatchVelocityDifference fb d_player_ball = ms (if (isMember Gaining (skillsAsList fb)) 20.0 17.0 - distanceDifficulty)
147 length = toReal fb.length
148 distanceDifficulty = max zero ((0.8 * length)^4.0 * ((toReal d_player_ball)/length))
150 maxKickReach :: !Footballer -> Metre
151 maxKickReach fb = scale (if (isMember Kicking (skillsAsList fb)) 0.6 0.4) fb.length
153 maxHeadReach :: !Footballer -> Metre
154 maxHeadReach fb = scale (if (isMember Heading (skillsAsList fb)) 0.4 0.2) fb.length
156 maxCatchReach :: !Footballer -> Metre // includes horizontal jumping
157 maxCatchReach fb = scale (if (isMember Catching (skillsAsList fb)) 1.8 1.5) fb.length
159 maxTackleReach :: !Footballer -> Metre
160 maxTackleReach fb = scale (if (isMember Tackling (skillsAsList fb)) 0.33 0.25) fb.length
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))
165 fatHealth = getHealthStaminaFactor fb.health fb.stamina
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))
170 fatHealth = getHealthStaminaFactor fb.health fb.stamina
172 maxKickingDeviation :: !Footballer -> Angle
173 maxKickingDeviation skills = rad (0.5*pi) //if (isMember Kicking skills) (pi/18.0) (pi/2.0)
175 maxHeadingDeviation :: !Footballer -> Angle
176 maxHeadingDeviation skills = rad (0.25*pi) //if (isMember Heading skills) (pi/16.0) (pi/5.0)
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)))
183 velocity = abs (toReal speed.velocity)
185 maxFeintStep :: !Footballer -> Metre
186 maxFeintStep fb = m (if (isMember Feinting (skillsAsList fb)) 0.75 0.5)
188 :: HealthStaminaFactor :== Real // combination of stamina and health
190 getHealthStaminaFactor :: !Health !Stamina -> HealthStaminaFactor
191 getHealthStaminaFactor health stamina
192 | stamina <= health = stamina
193 | otherwise = avg [stamina,health]
195 isMove :: !FootballerAction -> Bool
196 isMove (Move _ _) = True
199 isGainBall :: !FootballerAction -> Bool
200 isGainBall GainBall = True
203 isKickBall :: !FootballerAction -> Bool
204 isKickBall (KickBall _) = True
207 isHeadBall :: !FootballerAction -> Bool
208 isHeadBall (HeadBall _) = True
211 isFeint :: !FootballerAction -> Bool
212 isFeint (Feint _) = True
215 isFootballerTackle :: !FootballerAction -> Bool
216 isFootballerTackle (Tackle _ _) = True
217 isFootballerTackle _ = False
219 isCatchBall :: !FootballerAction -> Bool
220 isCatchBall CatchBall = True
221 isCatchBall _ = False
223 isActionOnBall :: !FootballerAction -> Bool
224 isActionOnBall GainBall = True
225 isActionOnBall CatchBall = True
226 isActionOnBall (KickBall _) = True
227 isActionOnBall (HeadBall _) = True
228 isActionOnBall _ = False
230 getDefaultField :: FootballField
231 getDefaultField = { fwidth = m 75.0, flength = m 110.0 }
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)
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
243 goal_poles :: !FootballField -> (!Metre,!Metre)
244 goal_poles field = (half_goal_width,~half_goal_width)
246 half_goal_width = scale 0.5 goal_width
248 isMoved :: !FootballerEffect -> Bool
249 isMoved (Moved _ _) = True
252 isGainedBall :: !FootballerEffect -> Bool
253 isGainedBall (GainedBall _) = True
254 isGainedBall _ = False
256 isKickedBall :: !FootballerEffect -> Bool
257 isKickedBall (KickedBall _) = True
258 isKickedBall _ = False
260 isHeadedBall :: !FootballerEffect -> Bool
261 isHeadedBall (HeadedBall _) = True
262 isHeadedBall _ = False
264 isFeinted :: !FootballerEffect -> Bool
265 isFeinted (Feinted _) = True
268 isTackled :: !FootballerEffect -> Bool
269 isTackled (Tackled _ _ _) = True
272 isCaughtBall :: !FootballerEffect -> Bool
273 isCaughtBall (CaughtBall _) = True
274 isCaughtBall _ = False
276 isOnTheGround :: !FootballerEffect -> Bool
277 isOnTheGround (OnTheGround _) = True
278 isOnTheGround _ = False
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"
290 displacements :: !Team -> Displacements
291 displacements team = [(playerID,pos) \\ {playerID,pos} <- team]
293 showSuccintRefereeAction :: !RefereeAction -> String
294 showSuccintRefereeAction refAction
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
319 player {clubName,playerNr} = clubName <+++"[" <+++ playerNr <+++ "]"
321 isReprimandPlayer :: !RefereeAction -> Bool
322 isReprimandPlayer (ReprimandPlayer _ _) = True
323 isReprimandPlayer _ = False
325 isHands :: !RefereeAction -> Bool
326 isHands (Hands _) = True
329 isTackleDetected :: !RefereeAction -> Bool
330 isTackleDetected (TackleDetected _) = True
331 isTackleDetected _ = False
333 isDangerousPlay :: !RefereeAction -> Bool
334 isDangerousPlay (DangerousPlay _) = True
335 isDangerousPlay _ = False
337 isGameOver :: !RefereeAction -> Bool
338 isGameOver GameOver = True
341 isGameCancelled :: !RefereeAction -> Bool
342 isGameCancelled (GameCancelled _) = True
343 isGameCancelled _ = False
345 isPauseGame :: !RefereeAction -> Bool
346 isPauseGame PauseGame = True
347 isPauseGame _ = False
349 isAddTime :: !RefereeAction -> Bool
350 isAddTime (AddTime _) = True
353 isEndHalf :: !RefereeAction -> Bool
354 isEndHalf EndHalf = True
357 isGoal :: !RefereeAction -> Bool
358 isGoal (Goal _) = True
361 isOffside :: !RefereeAction -> Bool
362 isOffside (Offside _) = True
365 isDirectFreeKick :: !RefereeAction -> Bool
366 isDirectFreeKick (DirectFreeKick _ _ ) = True
367 isDirectFreeKick _ = False
369 isGoalKick :: !RefereeAction -> Bool
370 isGoalKick (GoalKick _) = True
373 isCorner :: !RefereeAction -> Bool
374 isCorner (Corner _ _) = True
377 isThrowIn :: !RefereeAction -> Bool
378 isThrowIn (ThrowIn _ _) = True
381 isPenalty :: !RefereeAction -> Bool
382 isPenalty (Penalty _) = True
385 isCenterKick :: !RefereeAction -> Bool
386 isCenterKick (CenterKick _) = True
387 isCenterKick _ = False
389 isAdvantage :: !RefereeAction -> Bool
390 isAdvantage (Advantage _) = True
391 isAdvantage _ = False
393 isOwnBallIllegally :: !RefereeAction -> Bool
394 isOwnBallIllegally (OwnBallIllegally _) = True
395 isOwnBallIllegally _ = False
397 isDisplacePlayers :: !RefereeAction -> Bool
398 isDisplacePlayers (DisplacePlayers _) = True
399 isDisplacePlayers _ = False
401 isContinueGame :: !RefereeAction -> Bool
402 isContinueGame ContinueGame = True
403 isContinueGame _ = False
405 isTellMessage :: !RefereeAction -> Bool
406 isTellMessage (TellMessage _) = True
407 isTellMessage _ = False
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) }
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)
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)
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