diff --git a/SoccerFun.cabal b/SoccerFun.cabal --- a/SoccerFun.cabal +++ b/SoccerFun.cabal @@ -1,5 +1,5 @@ Name: SoccerFun -Version: 0.2.1 +Version: 0.3 Copyright: (c) 2010, Jan Rochel License: BSD3 License-File: LICENSE diff --git a/SoccerFun/Player.hs b/SoccerFun/Player.hs --- a/SoccerFun/Player.hs +++ b/SoccerFun/Player.hs @@ -9,103 +9,118 @@ import SoccerFun.Types import Control.Monad.State import SoccerFun.Field +import Data.List (find) -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 +data Player = ∀m. Player + {playerID ∷ PlayerID, -- ^ must be unique + name ∷ String, -- ^ need not be unique + height ∷ Length, -- ^ should be in range [minHeight..maxHeight] + pos ∷ Position, -- ^ should be on the ball field + speed ∷ Speed, -- ^ absolute direction and velocity with which player is moving + nose ∷ Angle, -- ^ absolute direction in which player is looking + skills ∷ MajorSkills, -- ^ 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 + stamina ∷ Stamina, -- ^ current stamina of a player: 1.0 is optimal, 0.0 is worst + health ∷ Health, -- ^ 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 make decisions } +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 ---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 + 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 +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) +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 + = 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 (and foul?) + | 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 + +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 + | 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 +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 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 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 +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 -{-| 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. --} +-- | 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 @@ -113,35 +128,15 @@ [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 +-- TODO: move this to SoccerFun.Geometry 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) @@ -151,6 +146,7 @@ isFirstHalf ∷ Half → Bool isFirstHalf FirstHalf = True isFirstHalf _ = False + isSecondHalf ∷ Half → Bool isSecondHalf SecondHalf = True isSecondHalf _ = False @@ -160,8 +156,6 @@ -- | 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 @@ -366,133 +360,6 @@ 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 @@ -502,11 +369,6 @@ {- Player attribute dependent abilities: -} - ---instance Other Home where --- other West = East --- other East = West - {-isReprimanded ∷ PlayerEffect → Bool isReprimanded (Reprimanded _) = True diff --git a/SoccerFun/Referee.hs b/SoccerFun/Referee.hs --- a/SoccerFun/Referee.hs +++ b/SoccerFun/Referee.hs @@ -3,10 +3,11 @@ -} module SoccerFun.Referee where -import SoccerFun.Player import SoccerFun.Team import SoccerFun.Types import SoccerFun.Ball +import SoccerFun.Field +import SoccerFun.Geometry import System.Random import Control.Monad.State import Control.Monad.Identity @@ -81,6 +82,131 @@ instance NameOf Referee where nameOf r = rname r + + +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 + +-- | Position of a referee-granted action like a throw-in, a corner kick, etc. +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 --defaultImage ∷ FileSystem env ⇒ Match RefereeAction env → (Bitmap,env) diff --git a/SoccerFun/Types.hs b/SoccerFun/Types.hs --- a/SoccerFun/Types.hs +++ b/SoccerFun/Types.hs @@ -4,6 +4,10 @@ import Control.Monad.State import SoccerFun.Geometry +class NameOf a where nameOf ∷ a → String + +data Brain ai memory = Brain {m ∷ memory, ai ∷ ai} + data Half = FirstHalf | SecondHalf deriving (Eq,Show) type PlayingTime = Minutes