{-# LANGUAGE UnicodeSyntax, Rank2Types, ExistentialQuantification #-} -- | This module defines the part of the SoccerFun API that is concerned with the player data types. module SoccerFun.Player where --import Data.Maybe 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, -- ^ The identification of a player: this must be unique name ∷ String, -- ^ The name of a player: this need not be unique height ∷ Length, -- ^ The height of a player: should be in range [minHeight..maxHeight] pos ∷ Position, -- ^ The position of a player: should be on the ball field speed ∷ Speed, -- ^ The speed of a player: absolute direction and velocity with which player is moving nose ∷ Angle, -- ^ The bearing of a player: absolute direction in which player is looking skills ∷ MajorSkills, -- ^ The major skills of a player: these improve performance of affected actions effect ∷ Maybe PlayerEffect, -- ^ The effect(s) of the previous action stamina ∷ Stamina, -- ^ The current stamina of a player: 1.0 is optimal, 0.0 is worst health ∷ Health, -- ^ The current health of a player: 1.0 is optimal, 0.0 is worst brain ∷ Brain (PlayerAI m) m -- ^ The precious asset: use and update the memory and compute an action } type PlayerAI memory = BrainInput → State memory PlayerAction --type PlayerAI' = BrainInput → PlayerAction data BrainInput = BrainInput {referee ∷ [RefereeAction], -- ^ the referee actions ball:: BallState, -- ^ the state of the ball others :: [Player], -- ^ all other ball players me :: Player -- ^ the player himself } type PlayerWithAction = (PlayerAction, PlayerID) type PlayerWithEffect = (Maybe PlayerEffect, PlayerID) type MajorSkills = (Skill,Skill,Skill) data Skill = Running -- ^ Faster running without ball in possession | Dribbling -- ^ Faster running with ball in possession | Rotating -- ^ Wider range of rotation | Gaining -- ^ Better ball gaining ability | Kicking -- ^ More accurate and wider ball kicking | Heading -- ^ More accurate and wider ball heading | Feinting -- ^ Wider range of feint manouvre | Jumping -- ^ Further jumping | Catching -- ^ Better catching | Tackling -- ^ More effective tackling | Schwalbing -- ^ Better acting of tackles | PlayingTheater -- ^ Better acting of playing theater deriving (Eq,Show) data FeintDirection = FeintLeft | FeintRight deriving (Eq, Show) -- | actions a player can intend to perform data PlayerAction = Move Speed Angle -- ^ wish to rotate over given angle, and then move with given speed | Feint FeintDirection -- ^ wish to make feint manouvre | KickBall Speed3D -- ^ wish to kick ball with given speed | HeadBall Speed3D -- ^ wish to head ball with given speed | GainBall -- ^ wish to gain possession of the ball from other player | CatchBall -- ^ wish to catch the ball with his hands | Tackle PlayerID Velocity -- ^ wish to tackle identified player, higher velocity is higher chance of succes AND injury | Schwalbe -- ^ wish to fall as if he was tackled | PlayTheater -- ^ wish to act as if he was hurt deriving (Eq,Show) data PlayerEffect = Moved Speed Angle -- ^ player has rotated with given angle, and then ran with given speed | Feinted FeintDirection -- ^ player had feinted | KickedBall (Maybe Speed3D) -- ^ player kicked ball (Just v) with velocity, or didn't (Nothing) | HeadedBall (Maybe Speed3D) -- ^ player headed ball (Just v) with velocity, or didn't (Nothing) | GainedBall Success -- ^ player attempt to gain ball from other player | CaughtBall Success -- ^ player caught the ball with his hands | Tackled PlayerID Velocity Success -- ^ player attempt to tackle an opponent | Schwalbed -- ^ player had performed a schwalbe | PlayedTheater -- ^ player had started to act hurt | OnTheGround FramesToGo -- ^ tackled by someone else; FramesToGo is the amount of frames that you will be on the ground 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 returns the ball (containing its position and speed-information) that is either free or gained by a player. For this reason, the list of players must contain all players, otherwise this function may fail. -} 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 {-| Returns True if the ball is held by a Keeper in his own penaltyarea Returns False when the ball is held by a Keeper in open field Returns False when the ball is not held by a Keeper Keepers should be numbered with 1. -} 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 -- ^ belong to same club 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 -- ^ True iff position touches/hits player inRadiusOfPlayer p player = inRadiusOfPosition (zero {pxy=p}) xWidthPlayer yWidthPlayer (height player) (pos player) skillsAsList ∷ Player → [Skill] -- ^ Skills of the player as a list 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 -- | chest size of player xWidthPlayer = 0.7/2.0 -- | stomach size of player 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) -- | minimum length of a person. Advantages: better gainball; better stamina at sprinting; better dribbling; less health damage when fall, better rotating. minLength = 1.6 ∷ Float -- | maximum length of a person. Advantages: wider gainball; better stamina at running; higher headball; improved catching; harder kicking. maxLength = 2.1 ∷ Float -- | minimum height of a person. Advantages: better gainball; better stamina at sprinting; better dribbling; less health damage when fall, better rotating. minHeight = 1.6 ∷ Float -- | maximum height of a person. Advantages: wider gainball; better stamina at running; higher headball; improved catching; harder kicking. maxHeight = 2.1 ∷ Float maxStamina = 1.0 ∷ Float maxHealth = 1.0 ∷ Float {-| Player attribute dependent abilities: use these functions to make your player correctly dependent of abilities. -} maxGainReach ∷ Player → Metre maxGainReach fb = (if (elem Gaining (skillsAsList fb)) then 0.5 else 0.3) * (height fb) -- | vertical jumping 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) -- | includes horizontal jumping 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-- if (elem Kicking skills) (pi/18.0) (pi/2.0) maxHeadingDeviation ∷ Player → Angle maxHeadingDeviation skills = pi/4.0-- if (elem Heading skills) (pi/16.0) (pi/5.0) -- | maximum angle with which player can rotate maxRotateAngle ∷ Player → Angle maxRotateAngle fb = pi/18.0*((5.0/(velocity $ speed fb))*(height fb/2.0)) -- | maximum side step of player for feint manouvre maxFeintStep ∷ Player → Metre maxFeintStep fb = if (elem Feinting (skillsAsList fb)) then 0.75 else 0.5 -- | combination of stamina and health 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 --failPlayerAction _ = error "failPlayerAction: unknown action failed" 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) {- Player attribute dependent abilities: -} --instance Other Home where -- other West = East -- other East = West {-isReprimanded ∷ PlayerEffect → Bool isReprimanded (Reprimanded _) = True isReprimanded _ = False isScoredGoal ∷ PlayerEffect → Bool isScoredGoal (ScoredGoal _) = True isScoredGoal _ = False-}