--- /dev/null
+implementation module Footballer
+
+import StdEnvExt
+import Football, FootballerFunctions, Geometry
+
+instance == Edge where == North North = True
+ == South South = True
+ == _ _ = False
+instance == FootballerID where == i1 i2 = i1.clubName == i2.clubName && i1.playerNr == i2.playerNr
+instance == Half where == FirstHalf FirstHalf = True
+ == SecondHalf SecondHalf = True
+ == _ _ = False
+instance == Reprimand where == Warning Warning = True
+ == YellowCard YellowCard = True
+ == RedCard RedCard = True
+ == _ _ = False
+instance == Skill where == s1 s2 = toString s1 == toString s2
+instance == Success where == Success Success = True
+ == Fail Fail = True
+ == _ _ = False
+instance == Footballer where == fb1 fb2 = fb1.playerID == fb2.playerID
+instance == Home where == West West = True
+ == East East = True
+ == _ _ = False
+instance == FeintDirection where == FeintLeft FeintLeft = True
+ == FeintRight FeintRight = True
+ == _ _ = False
+instance == FootballerAction where == (Move speed1 angle1) (Move speed2 angle2) = speed1 == speed2 && angle1 == angle2
+ == GainBall GainBall = True
+ == (KickBall speed3D1) (KickBall speed3D2) = speed3D1 == speed3D2
+ == (HeadBall speed3D1) (HeadBall speed3D2) = speed3D1 == speed3D2
+ == (Feint fd1) (Feint fd2) = fd1 == fd2
+ == (Tackle tf1 v1) (Tackle tf2 v2) = tf1 == tf2 && v1 == v2
+ == CatchBall CatchBall = True
+ == _ _ = False
+instance other Edge where other North = South
+ other South = North
+instance other Half where other FirstHalf = SecondHalf
+ other SecondHalf = FirstHalf
+instance other Home where other West = East
+ other East = West
+instance toString Edge where toString North = "North"
+ toString South = "South"
+instance toString FootballerID where toString i = "{clubName=" <+++ i.clubName +++ ",playerNr=" <+++ i.playerNr +++ "}"
+instance toString Half where toString FirstHalf = "FirstHalf"
+ toString SecondHalf = "SecondHalf"
+instance toString Reprimand where toString Warning = "Warning"
+ toString YellowCard = "YellowCard"
+ toString RedCard = "RedCard"
+instance toString Skill where toString Running = "Running"
+ toString Dribbling = "Dribbling"
+ toString Rotating = "Rotating"
+ toString Gaining = "Gaining"
+ toString Kicking = "Kicking"
+ toString Heading = "Heading"
+ toString Feinting = "Feinting"
+ toString Jumping = "Jumping"
+ toString Catching = "Catching"
+ toString Tackling = "Tackling"
+instance toString Success where toString Success = "Success"
+ toString Fail = "Fail"
+instance toString Home where toString West = "West"
+ toString East = "East"
+instance toString FeintDirection where toString FeintLeft = "FeintLeft"
+ toString FeintRight = "FeintRight"
+instance toString FootballerAction where toString (Move speed angle) = "(Move " <+++ speed <+++ " " <+++ angle <+++ ")"
+ toString GainBall = "GainBall"
+ toString (KickBall speed) = "(KickBall " <+++ speed <+++ ")"
+ toString (HeadBall speed) = "(HeadBall " <+++ speed <+++ ")"
+ toString (Feint fd) = "(Feint " <+++ fd <+++ ")"
+ toString (Tackle fbID v) = "(Tackle " <+++ fbID.playerNr <+++ " " <+++ v <+++ ")"
+ toString CatchBall = "CatchBall"
+
+:: Minutes = Minutes !Real
+
+instance zero Minutes where zero = Minutes zero
+instance < Minutes where < (Minutes m1) (Minutes m2) = m1 < m2
+instance == Minutes where == (Minutes m1) (Minutes m2) = m1 == m2
+instance + Minutes where + (Minutes m1) (Minutes m2) = Minutes (m1+m2)
+instance - Minutes where - (Minutes m1) (Minutes m2) = Minutes (m1-m2)
+instance scale Minutes where scale k (Minutes m) = Minutes (k * m)
+instance toString Minutes where toString (Minutes m) = toString (s/60) <+++ ":" <+++ if (s mod 60 < 10) "0" "" <+++ (s mod 60) <+++" min"
+ where s = toInt (((toReal (toInt (m * 100.0)))/100.0) * 60.0)
+instance toReal Minutes where toReal (Minutes m) = m
+instance minutes Real where minutes m = Minutes m
+
+instance toPosition Footballer where toPosition fb = fb.pos
+instance toPosition3D Footballer where toPosition3D fb = toPosition3D fb.pos
+instance nameOf Footballer where nameOf {name,nose} = name
+instance nameOf FootballerID where nameOf {clubName} = clubName
+instance sameClub FootballerID where sameClub id1 id2 = nameOf id1 == nameOf id2
+instance sameClub Footballer where sameClub fb1 fb2 = sameClub fb1.playerID fb2.playerID
+
+defaultFootballer :: !FootballerID -> Footballer
+defaultFootballer playerID = { playerID = playerID
+ , name = "default"
+ , length = m 1.6
+ , pos = zero
+ , speed = zero
+ , nose = zero
+ , skills = (Running, Kicking, Dribbling)
+ , effect = Nothing
+ , stamina = max_stamina
+ , health = max_health
+ , brain = {memory=Void, ai=returnAI (Move zero zero)}
+ }
+
+inRadiusOfFootballer :: !Position !Footballer -> Bool
+inRadiusOfFootballer pos player = isbetween pos.px (player.pos.px - xWidthFootballer) (player.pos.px + xWidthFootballer) &&
+ isbetween pos.py (player.pos.py - yWidthFootballer) (player.pos.py + yWidthFootballer)
+
+skillsAsList :: !Footballer -> [Skill]
+skillsAsList fb = (\(a,b,c)->[a,b,c]) fb.skills
+
+identify_player :: !FootballerID !Footballer -> Bool
+identify_player id fb = id == fb.playerID
+
+player_identity :: !Footballer -> FootballerID
+player_identity fb = fb.playerID
+
+getClubName :: !Footballer -> ClubName
+getClubName fb = nameOf fb.playerID
+
+isKeeper :: !Footballer -> Bool
+isKeeper fb = fb.playerID.playerNr == 1
+
+isFielder :: !Footballer -> Bool
+isFielder fb = not (isKeeper fb)
+
+/** Footballer attribute dependent abilities:
+*/
+maxGainReach :: !Footballer -> Metre
+maxGainReach fb = scale (if (isMember Gaining (skillsAsList fb)) 0.5 0.3) fb.length
+
+maxJumpReach :: !Footballer -> Metre
+maxJumpReach fb = scale (if (isMember Jumping (skillsAsList fb)) 0.6 0.4) fb.length
+
+maxGainVelocityDifference :: !Footballer !Metre -> Velocity
+maxGainVelocityDifference fb d_player_ball = ms (if (isMember Gaining (skillsAsList fb)) 15.0 10.0 - distanceDifficulty)
+where
+ length = toReal fb.length
+ distanceDifficulty = max zero ((0.8 * length)^4.0 * ((toReal d_player_ball)/length))
+
+maxCatchVelocityDifference :: !Footballer !Metre -> Velocity
+maxCatchVelocityDifference fb d_player_ball = ms (if (isMember Gaining (skillsAsList fb)) 20.0 17.0 - distanceDifficulty)
+where
+ length = toReal fb.length
+ distanceDifficulty = max zero ((0.8 * length)^4.0 * ((toReal d_player_ball)/length))
+
+maxKickReach :: !Footballer -> Metre
+maxKickReach fb = scale (if (isMember Kicking (skillsAsList fb)) 0.6 0.4) fb.length
+
+maxHeadReach :: !Footballer -> Metre
+maxHeadReach fb = scale (if (isMember Heading (skillsAsList fb)) 0.4 0.2) fb.length
+
+maxCatchReach :: !Footballer -> Metre // includes horizontal jumping
+maxCatchReach fb = scale (if (isMember Catching (skillsAsList fb)) 1.8 1.5) fb.length
+
+maxTackleReach :: !Footballer -> Metre
+maxTackleReach fb = scale (if (isMember Tackling (skillsAsList fb)) 0.33 0.25) fb.length
+
+maxVelocityBallKick :: !Footballer -> Velocity
+maxVelocityBallKick fb = ms ((if (isMember Kicking (skillsAsList fb)) 27.0 25.0 + (toReal fb.length)/2.0) * (0.2*fatHealth+0.8))
+where
+ fatHealth = getHealthStaminaFactor fb.health fb.stamina
+
+maxVelocityBallHead :: !Footballer !Velocity -> Velocity
+maxVelocityBallHead fb ballSpeed = scale 0.7 ballSpeed + scale (0.1*fatHealth+0.9) (ms (if (isMember Heading (skillsAsList fb)) 7.0 5.0))
+where
+ fatHealth = getHealthStaminaFactor fb.health fb.stamina
+
+maxKickingDeviation :: !Footballer -> Angle
+maxKickingDeviation skills = rad (0.5*pi) //if (isMember Kicking skills) (pi/18.0) (pi/2.0)
+
+maxHeadingDeviation :: !Footballer -> Angle
+maxHeadingDeviation skills = rad (0.25*pi) //if (isMember Heading skills) (pi/16.0) (pi/5.0)
+
+maxRotateAngle :: !Footballer -> Angle
+maxRotateAngle fb=:{speed,length}
+| velocity < 1.0 = rad pi
+| otherwise = rad (pi/18.0*((5.0/velocity)*((toReal length)/2.0)))
+where
+ velocity = abs (toReal speed.velocity)
+
+maxFeintStep :: !Footballer -> Metre
+maxFeintStep fb = m (if (isMember Feinting (skillsAsList fb)) 0.75 0.5)
+
+:: HealthStaminaFactor :== Real // combination of stamina and health
+
+getHealthStaminaFactor :: !Health !Stamina -> HealthStaminaFactor
+getHealthStaminaFactor health stamina
+| stamina <= health = stamina
+| otherwise = avg [stamina,health]
+
+isMove :: !FootballerAction -> Bool
+isMove (Move _ _) = True
+isMove _ = False
+
+isGainBall :: !FootballerAction -> Bool
+isGainBall GainBall = True
+isGainBall _ = False
+
+isKickBall :: !FootballerAction -> Bool
+isKickBall (KickBall _) = True
+isKickBall _ = False
+
+isHeadBall :: !FootballerAction -> Bool
+isHeadBall (HeadBall _) = True
+isHeadBall _ = False
+
+isFeint :: !FootballerAction -> Bool
+isFeint (Feint _) = True
+isFeint _ = False
+
+isFootballerTackle :: !FootballerAction -> Bool
+isFootballerTackle (Tackle _ _) = True
+isFootballerTackle _ = False
+
+isCatchBall :: !FootballerAction -> Bool
+isCatchBall CatchBall = True
+isCatchBall _ = False
+
+isActionOnBall :: !FootballerAction -> Bool
+isActionOnBall GainBall = True
+isActionOnBall CatchBall = True
+isActionOnBall (KickBall _) = True
+isActionOnBall (HeadBall _) = True
+isActionOnBall _ = False
+
+getDefaultField :: FootballField
+getDefaultField = { fwidth = m 75.0, flength = m 110.0 }
+
+inPenaltyArea :: !FootballField !Home !Position -> Bool
+inPenaltyArea field home pos = isbetween pos.py south_edge north_edge && if (home == West) (pos.px <= west_edge) (pos.px >= east_edge)
+where
+ north_edge = northPole + radius_penalty_area
+ south_edge = southPole - radius_penalty_area
+ (northPole,southPole) = goal_poles field
+ half_length = scale 0.5 field.flength
+ west_edge = penalty_area_depth - half_length
+ east_edge = half_length - penalty_area_depth
+
+goal_poles :: !FootballField -> (!Metre,!Metre)
+goal_poles field = (half_goal_width,~half_goal_width)
+where
+ half_goal_width = scale 0.5 goal_width
+
+isMoved :: !FootballerEffect -> Bool
+isMoved (Moved _ _) = True
+isMoved _ = False
+
+isGainedBall :: !FootballerEffect -> Bool
+isGainedBall (GainedBall _) = True
+isGainedBall _ = False
+
+isKickedBall :: !FootballerEffect -> Bool
+isKickedBall (KickedBall _) = True
+isKickedBall _ = False
+
+isHeadedBall :: !FootballerEffect -> Bool
+isHeadedBall (HeadedBall _) = True
+isHeadedBall _ = False
+
+isFeinted :: !FootballerEffect -> Bool
+isFeinted (Feinted _) = True
+isFeinted _ = False
+
+isTackled :: !FootballerEffect -> Bool
+isTackled (Tackled _ _ _) = True
+isTackled _ = False
+
+isCaughtBall :: !FootballerEffect -> Bool
+isCaughtBall (CaughtBall _) = True
+isCaughtBall _ = False
+
+isOnTheGround :: !FootballerEffect -> Bool
+isOnTheGround (OnTheGround _) = True
+isOnTheGround _ = False
+
+failFootballerAction :: !FootballerAction -> FootballerEffect
+failFootballerAction (Move s a) = Moved s a
+failFootballerAction GainBall = GainedBall Fail
+failFootballerAction CatchBall = CaughtBall Fail
+failFootballerAction (KickBall v) = KickedBall Nothing
+failFootballerAction (HeadBall v) = HeadedBall Nothing
+failFootballerAction (Feint d) = Feinted d
+failFootballerAction (Tackle p v) = Tackled p v Fail
+failFootballerAction _ = abort "failFootballerAction: unknown action failed"
+
+displacements :: !Team -> Displacements
+displacements team = [(playerID,pos) \\ {playerID,pos} <- team]
+
+showSuccintRefereeAction :: !RefereeAction -> String
+showSuccintRefereeAction refAction
+ = case refAction of
+ (ReprimandPlayer id r) = player id <+++ " receives " <+++ r
+ (Hands id) = "Hands by " <+++ player id
+ (TackleDetected id) = "Tackle by " <+++ player id
+ (DangerousPlay id) = "Dangerous play by " <+++ player id
+ GameOver = "Game ended"
+ (GameCancelled mt) = "Game cancelled" <+++ if (isJust mt) (" winner is " <+++ fromJust mt) ""
+ PauseGame = "Game paused"
+ (AddTime t) = "Extra time added: " <+++ t
+ EndHalf = "First half ended"
+ (Goal t) = "Goal for " <+++ t
+ (Offside id) = "Offside by " <+++ player id
+ (DirectFreeKick t p) = "Direct free kick for " <+++ t
+ (GoalKick t) = "Goal kick for " <+++ t
+ (Corner t e) = "Corner for " <+++ t
+ (ThrowIn t p) = "Throw in for " <+++ t
+ (Penalty t) = "Penalty for " <+++ t
+ (CenterKick t) = "Center kick for " <+++ t
+ (Advantage t) = "Advantage for " <+++ t
+ (OwnBallIllegally id) = "Illegal ball possession by " <+++ player id
+ (DisplacePlayers _) = "Players displaced"
+ ContinueGame = "Game continued"
+ (TellMessage txt) = txt
+where
+ player {clubName,playerNr} = clubName <+++"[" <+++ playerNr <+++ "]"
+
+isReprimandPlayer :: !RefereeAction -> Bool
+isReprimandPlayer (ReprimandPlayer _ _) = True
+isReprimandPlayer _ = False
+
+isHands :: !RefereeAction -> Bool
+isHands (Hands _) = True
+isHands _ = False
+
+isTackleDetected :: !RefereeAction -> Bool
+isTackleDetected (TackleDetected _) = True
+isTackleDetected _ = False
+
+isDangerousPlay :: !RefereeAction -> Bool
+isDangerousPlay (DangerousPlay _) = True
+isDangerousPlay _ = False
+
+isGameOver :: !RefereeAction -> Bool
+isGameOver GameOver = True
+isGameOver _ = False
+
+isGameCancelled :: !RefereeAction -> Bool
+isGameCancelled (GameCancelled _) = True
+isGameCancelled _ = False
+
+isPauseGame :: !RefereeAction -> Bool
+isPauseGame PauseGame = True
+isPauseGame _ = False
+
+isAddTime :: !RefereeAction -> Bool
+isAddTime (AddTime _) = True
+isAddTime _ = False
+
+isEndHalf :: !RefereeAction -> Bool
+isEndHalf EndHalf = True
+isEndHalf _ = False
+
+isGoal :: !RefereeAction -> Bool
+isGoal (Goal _) = True
+isGoal _ = False
+
+isOffside :: !RefereeAction -> Bool
+isOffside (Offside _) = True
+isOffside _ = False
+
+isDirectFreeKick :: !RefereeAction -> Bool
+isDirectFreeKick (DirectFreeKick _ _ ) = True
+isDirectFreeKick _ = False
+
+isGoalKick :: !RefereeAction -> Bool
+isGoalKick (GoalKick _) = True
+isGoalKick _ = False
+
+isCorner :: !RefereeAction -> Bool
+isCorner (Corner _ _) = True
+isCorner _ = False
+
+isThrowIn :: !RefereeAction -> Bool
+isThrowIn (ThrowIn _ _) = True
+isThrowIn _ = False
+
+isPenalty :: !RefereeAction -> Bool
+isPenalty (Penalty _) = True
+isPenalty _ = False
+
+isCenterKick :: !RefereeAction -> Bool
+isCenterKick (CenterKick _) = True
+isCenterKick _ = False
+
+isAdvantage :: !RefereeAction -> Bool
+isAdvantage (Advantage _) = True
+isAdvantage _ = False
+
+isOwnBallIllegally :: !RefereeAction -> Bool
+isOwnBallIllegally (OwnBallIllegally _) = True
+isOwnBallIllegally _ = False
+
+isDisplacePlayers :: !RefereeAction -> Bool
+isDisplacePlayers (DisplacePlayers _) = True
+isDisplacePlayers _ = False
+
+isContinueGame :: !RefereeAction -> Bool
+isContinueGame ContinueGame = True
+isContinueGame _ = False
+
+isTellMessage :: !RefereeAction -> Bool
+isTellMessage (TellMessage _) = True
+isTellMessage _ = False
+
+getKickPos :: !FootballField !Half !RefereeAction -> Maybe Position
+getKickPos field half (GoalKick home) = Just { zero & px = if (home == West) (penalty_area_depth - half_length) (half_length - penalty_area_depth) }
+where
+ half_length = scale 0.5 field.flength
+getKickPos field half (Corner home edge) = Just { px = if (home == West && half == SecondHalf || home == East && half == FirstHalf)
+ (half_radius_corner_kick_area - half_length)
+ (half_length - half_radius_corner_kick_area)
+ , py = if (edge == North)
+ (half_radius_corner_kick_area - half_width)
+ (half_width - half_radius_corner_kick_area)
+ }
+where
+ half_width = scale 0.5 field.fwidth
+ half_length = scale 0.5 field.flength
+ half_radius_corner_kick_area = scale 0.5 radius_corner_kick_area
+getKickPos field half (Penalty home) = Just { zero & px = if (home == West && half == SecondHalf || home == East && half == FirstHalf)
+ (penalty_spot_depth - half_length)
+ (half_length - penalty_spot_depth)
+ }
+where
+ half_length = scale 0.5 field.flength
+getKickPos field _ (CenterKick _) = Just zero
+getKickPos _ _ (DirectFreeKick _ pos) = Just pos
+getKickPos _ _ (ThrowIn _ pos) = Just pos
+getKickPos _ _ _ = Nothing
repositories / fp1415-soccerfun.git / blobdiff