module SoccerFun.Player where
import SoccerFun.Prelude
import SoccerFun.Ball
import SoccerFun.Geometry
import SoccerFun.Types
import Control.Monad.State
import SoccerFun.Field
data Player = ∀ m. Player
{playerID ∷ PlayerID,
name ∷ String,
height ∷ Length,
pos ∷ Position,
speed ∷ Speed,
nose ∷ Angle,
skills ∷ MajorSkills,
effect ∷ Maybe PlayerEffect,
stamina ∷ Stamina,
health ∷ Health,
brain ∷ Brain (PlayerAI m) m
}
type PlayerAI memory = BrainInput → State memory PlayerAction
data BrainInput = BrainInput
{referee ∷ [RefereeAction],
ball:: BallState,
others :: [Player],
me :: Player
}
type PlayerWithAction = (PlayerAction, PlayerID)
type PlayerWithEffect = (Maybe PlayerEffect, PlayerID)
type MajorSkills = (Skill,Skill,Skill)
data Skill = Running
| Dribbling
| Rotating
| Gaining
| Kicking
| Heading
| Feinting
| Jumping
| Catching
| Tackling
| Schwalbing
| PlayingTheater
deriving (Eq,Show)
data FeintDirection = FeintLeft | FeintRight
deriving (Eq, Show)
data PlayerAction
= Move Speed Angle
| Feint FeintDirection
| KickBall Speed3D
| HeadBall Speed3D
| GainBall
| CatchBall
| Tackle PlayerID Velocity
| Schwalbe
| PlayTheater
deriving (Eq,Show)
data PlayerEffect = Moved Speed Angle
| Feinted FeintDirection
| KickedBall (Maybe Speed3D)
| HeadedBall (Maybe Speed3D)
| GainedBall Success
| CaughtBall Success
| Tackled PlayerID Velocity Success
| Schwalbed
| PlayedTheater
| OnTheGround FramesToGo
type Stamina = Float
type Health = Float
instance Eq Player where
f1 == f2 = playerID f1 == playerID f2
identifyPlayer ∷ PlayerID → Player → Bool
identifyPlayer id fb = id == (playerID fb)
playerIdentity ∷ Player → PlayerID
playerIdentity fb = (playerID fb)
getBall ∷ BallState → [Player] → Ball
getBall (Free ball) _ = ball
getBall (GainedBy playerID) allPlayers
= case filter (identifyPlayer playerID) allPlayers of
[] → error "getBall: no player found with requested identifier."
(Player {pos=pos,speed=speed}:_) → mkBall pos speed
ballGainedByKeeper ∷ BallState → [Player] → ClubName → Home → Field → Bool
ballGainedByKeeper (Free _) _ _ _ _ = False
ballGainedByKeeper (GainedBy playerID) allPlayers club home field
= case filter (identifyPlayer playerID) allPlayers of
[keeper] → playerNo playerID == 1 && inPenaltyArea field (if (clubName playerID==club) then home else (other home)) (pos keeper)
wrongNumber → error "ballGainedByKeeper: wrong number of keepers found."
instance Show Player where
show (Player {playerID = pid}) = show pid
clonePlayer ∷ Brain (PlayerAI m) m → Player → Player
clonePlayer brain (Player playerID name height pos speed nose skills effect stamina health _)
= (Player playerID name height pos speed nose skills effect stamina health brain)
data Brain ai memory = Brain {m ∷ memory, ai ∷ ai}
class SameClub a where sameClub ∷ a → a → Bool
class GetPosition a where getPosition ∷ a → Position
defaultPlayer ∷ PlayerID → Player
defaultPlayer playerID
= Player { playerID = playerID
, name = "default"
, height = 1.6
, pos = zero
, speed = zero
, nose = zero
, skills = (Running, Kicking, Dribbling)
, effect = Nothing
, stamina = maxStamina
, health = maxHealth
, brain = Brain undefined (const $ return $ Move zero zero)}
inRadiusOfPlayer ∷ Position → Player → Bool
inRadiusOfPlayer p player = inRadiusOfPosition (zero {pxy=p}) xWidthPlayer yWidthPlayer (height player) (pos player)
skillsAsList ∷ Player → [Skill]
skillsAsList fb = (\(a,b,c)→[a,b,c]) (skills fb)
isFirstHalf ∷ Half → Bool
isFirstHalf FirstHalf = True
isFirstHalf _ = False
isSecondHalf ∷ Half → Bool
isSecondHalf SecondHalf = True
isSecondHalf _ = False
xWidthPlayer = 0.7/2.0
yWidthPlayer = 0.4/2.0
class NameOf a where nameOf ∷ a → String
getClubName ∷ Player → ClubName
getClubName fb = nameOf (playerID fb)
isKeeper ∷ Player → Bool
isKeeper fb = playerNo (playerID fb) == 1
isFielder ∷ Player → Bool
isFielder fb = not (isKeeper fb)
minLength = 1.6 ∷ Float
maxLength = 2.1 ∷ Float
minHeight = 1.6 ∷ Float
maxHeight = 2.1 ∷ Float
maxStamina = 1.0 ∷ Float
maxHealth = 1.0 ∷ Float
maxGainReach ∷ Player → Metre
maxGainReach fb = (if (elem Gaining (skillsAsList fb)) then 0.5 else 0.3) * (height fb)
maxJumpReach ∷ Player → Metre
maxJumpReach fb = (if (elem Jumping (skillsAsList fb)) then 0.6 else 0.4) * (height fb)
maxGainVelocityDifference ∷ Player → Metre → Velocity
maxGainVelocityDifference fb dPlayerBall = (if (elem Gaining (skillsAsList fb)) then 15.0 else 10.0) distanceDifficulty where
distanceDifficulty = max zero (((0.8*(height fb))**4.0)*(dPlayerBall/(height fb)))
maxCatchVelocityDifference ∷ Player → Metre → Velocity
maxCatchVelocityDifference fb dPlayerBall = (if (elem Gaining (skillsAsList fb)) then 20.0 else 17.0) distanceDifficulty where
distanceDifficulty = max zero (((0.8*(height fb))**4.0) * (dPlayerBall/(height fb)))
maxKickReach ∷ Player → Metre
maxKickReach fb = (if (elem Kicking (skillsAsList fb)) then 0.6 else 0.4) * (height fb)
maxHeadReach ∷ Player → Metre
maxHeadReach fb = (if (elem Heading (skillsAsList fb)) then 0.4 else 0.2) * (height fb)
maxCatchReach ∷ Player → Metre
maxCatchReach fb = (if (elem Catching (skillsAsList fb)) then 1.8 else 1.5) * (height fb)
maxTackleReach ∷ Player → Metre
maxTackleReach fb = (if (elem Tackling (skillsAsList fb)) then 0.33 else 0.25) * (height fb)
maxVelocityBallKick ∷ Player → Velocity
maxVelocityBallKick fb = (if (elem Kicking (skillsAsList fb)) then 27.0 else 25.0 + (height fb)/2.0) * (0.2*fatHealth+0.8) where
fatHealth = getHealthStaminaFactor (health fb) (stamina fb)
maxVelocityBallHead ∷ Player → Velocity → Velocity
maxVelocityBallHead fb ballSpeed = 0.7*ballSpeed + (if (elem Heading (skillsAsList fb)) then 7.0 else 5.0)*(0.1*fatHealth+0.9) where
fatHealth = getHealthStaminaFactor (health fb) (stamina fb)
maxKickingDeviation ∷ Player → Angle
maxKickingDeviation skills = pi/2.0
maxHeadingDeviation ∷ Player → Angle
maxHeadingDeviation skills = pi/4.0
maxRotateAngle ∷ Player → Angle
maxRotateAngle fb = pi/18.0*((5.0/(velocity $ speed fb))*(height fb/2.0))
maxFeintStep ∷ Player → Metre
maxFeintStep fb = if (elem Feinting (skillsAsList fb)) then 0.75 else 0.5
type HealthStaminaFactor = Float
getHealthStaminaFactor ∷ Health → Stamina → HealthStaminaFactor
getHealthStaminaFactor health stamina
| stamina <= health = stamina
| otherwise = (stamina + health) / 2
teamHome ∷ ATeam → Half → Home
teamHome team half
| team == Team1 && half == FirstHalf || team == Team2 && half == SecondHalf
= West
| otherwise = East
opponentHome ∷ ATeam → Half → Home
opponentHome team half
| team == Team2 && half == FirstHalf || team == Team1 && half == SecondHalf
= West
| otherwise = East
isMove ∷ PlayerAction → Bool
isMove (Move _ _) = True
isMove _ = False
isGainBall ∷ PlayerAction → Bool
isGainBall GainBall = True
isGainBall _ = False
isCatchBall ∷ PlayerAction → Bool
isCatchBall CatchBall = True
isCatchBall _ = False
isKickBall ∷ PlayerAction → Bool
isKickBall (KickBall _) = True
isKickBall _ = False
isHeadBall ∷ PlayerAction → Bool
isHeadBall (HeadBall _) = True
isHeadBall _ = False
isFeint ∷ PlayerAction → Bool
isFeint (Feint _) = True
isFeint _ = False
isPlayerTackle ∷ PlayerAction → Bool
isPlayerTackle (Tackle _ _) = True
isPlayerTackle _ = False
isSchwalbe ∷ PlayerAction → Bool
isSchwalbe Schwalbe = True
isSchwalbe _ = False
isPlayTheater ∷ PlayerAction → Bool
isPlayTheater PlayTheater = True
isPlayTheater _ = False
isSkillOfAction ∷ Skill → PlayerAction → Bool
isSkillOfAction Running (Move _ _) = True
isSkillOfAction Rotating (Move _ _) = True
isSkillOfAction Gaining GainBall = True
isSkillOfAction Kicking (KickBall _) = True
isSkillOfAction Heading (HeadBall _) = True
isSkillOfAction Feinting (Feint _) = True
isSkillOfAction Tackling (Tackle _ _) = True
isSkillOfAction Schwalbing Schwalbe = True
isSkillOfAction Catching CatchBall = True
isSkillOfAction PlayingTheater PlayTheater = True
isSkillOfAction _ _ = False
isActionOnBall ∷ PlayerAction → Bool
isActionOnBall GainBall = True
isActionOnBall CatchBall = True
isActionOnBall (KickBall _) = True
isActionOnBall (HeadBall _) = True
isActionOnBall _ = False
isMoved ∷ PlayerEffect → Bool
isMoved (Moved _ _) = True
isMoved _ = False
isGainedBall ∷ PlayerEffect → Bool
isGainedBall (GainedBall _) = True
isGainedBall _ = False
isKickedBall ∷ PlayerEffect → Bool
isKickedBall (KickedBall _) = True
isKickedBall _ = False
isHeadedBall ∷ PlayerEffect → Bool
isHeadedBall (HeadedBall _) = True
isHeadedBall _ = False
isFeinted ∷ PlayerEffect → Bool
isFeinted (Feinted _) = True
isFeinted _ = False
isTackled ∷ PlayerEffect → Bool
isTackled (Tackled _ _ _) = True
isTackled _ = False
isSchwalbed ∷ PlayerEffect → Bool
isSchwalbed Schwalbed = True
isSchwalbed _ = False
isCaughtBall ∷ PlayerEffect → Bool
isCaughtBall (CaughtBall _) = True
isCaughtBall _ = False
isPlayedTheater ∷ PlayerEffect → Bool
isPlayedTheater PlayedTheater = True
isPlayedTheater _ = False
isOnTheGround ∷ PlayerEffect → Bool
isOnTheGround (OnTheGround _) = True
isOnTheGround _ = False
failPlayerAction ∷ PlayerAction → PlayerEffect
failPlayerAction (Move s a) = Moved s a
failPlayerAction GainBall = GainedBall Fail
failPlayerAction CatchBall = CaughtBall Fail
failPlayerAction (KickBall v) = KickedBall Nothing
failPlayerAction (HeadBall v) = HeadedBall Nothing
failPlayerAction (Feint d) = Feinted d
failPlayerAction (Tackle p v) = Tackled p v Fail
failPlayerAction Schwalbe = Schwalbed
failPlayerAction PlayTheater = PlayedTheater
isReprimandPlayer ∷ RefereeAction → Bool
isReprimandPlayer (ReprimandPlayer _ _) = True
isReprimandPlayer _ = False
isHands ∷ RefereeAction → Bool
isHands (Hands _) = True
isHands _ = False
isTackleDetected ∷ RefereeAction → Bool
isTackleDetected (TackleDetected _) = True
isTackleDetected _ = False
isSchwalbeDetected ∷ RefereeAction → Bool
isSchwalbeDetected (SchwalbeDetected _) = True
isSchwalbeDetected _ = False
isTheaterDetected ∷ RefereeAction → Bool
isTheaterDetected (TheaterDetected _) = True
isTheaterDetected _ = False
isDangerousPlay ∷ RefereeAction → Bool
isDangerousPlay (DangerousPlay _) = True
isDangerousPlay _ = False
isGameOver ∷ RefereeAction → Bool
isGameOver GameOver = True
isGameOver _ = 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
isGoal4ATeam ∷ ATeam → RefereeAction → Bool
isGoal4ATeam t (Goal t') = t == t'
isGoal4ATeam _ _ = False
getKickPos ∷ Field → Half → RefereeAction → Maybe Position
getKickPos field half (GoalKick team) = Just $ Position { py = (fwidth field)/2.0
, px = if (team == Team1 && half == FirstHalf || team == Team2 && half == SecondHalf)
then penaltyAreaDepth
else (flength field) penaltyAreaDepth }
getKickPos field half (Corner team edge) = Just $ Position { px = if (team == Team1 && half == SecondHalf || team == Team2 && half == FirstHalf)
then halfRadiusCornerKickArea
else ((flength field) halfRadiusCornerKickArea)
, py = if (edge == North)
then halfRadiusCornerKickArea
else ((fwidth field) halfRadiusCornerKickArea)
}
where
halfRadiusCornerKickArea = radiusCornerKickArea / 2.0
getKickPos field half (Penalty team) = Just $ Position { py = (fwidth field)/2.0
, px = if (team == Team1 && half == SecondHalf || team == Team2 && half == FirstHalf)
then penaltySpotDepth
else ((flength field) penaltySpotDepth)
}
getKickPos field _ (CenterKick _) = Just $ Position { px = (flength field)/2.0
, py = (fwidth field) /2.0
}
getKickPos _ _ (DirectFreeKick _ pos) = Just pos
getKickPos _ _ (ThrowIn _ pos) = Just pos
getKickPos _ _ _ = Nothing
instance GetPosition Player where getPosition fb = (pos fb)
instance NameOf Player where nameOf fb = name fb
instance NameOf PlayerID where nameOf f = clubName f
instance SameClub PlayerID where sameClub id1 id2 = nameOf id1 == nameOf id2
instance SameClub Player where sameClub fb1 fb2 = sameClub (playerID fb1) (playerID fb2)