module SoccerFun.Player where
import SoccerFun.RefereeAction
import SoccerFun.Prelude
import SoccerFun.Ball
import SoccerFun.Geometry
import SoccerFun.Types
import Control.Monad.State
import SoccerFun.Field
import Data.List (find)
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
}
instance Eq Player where f1 == f2 = playerID f1 == playerID f2
instance Show Player where show (Player {playerID = pid}) = show pid
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
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
{m = error "You need to provide defaultPlayer with a new brain.",
ai = const $ return $ Move zero zero}}
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 find (identifyPlayer playerID) allPlayers of
Nothing → error "getBall: no player found with requested identifier."
Just (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."
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)
class SameClub a where sameClub ∷ a → a → Bool
class GetPosition a where getPosition ∷ a → Position
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
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
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)