SoccerFun 0.2.1 → 0.3

raw patch · 4 files changed

+213/−221 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• SoccerFun.cabal +1/−1
• SoccerFun/Player.hs +81/−219
• SoccerFun/Referee.hs +127/−1
• SoccerFun/Types.hs +4/−0

@@ -1,5 +1,5 @@ Name:           SoccerFun-Version:        0.2.1+Version:        0.3 Copyright:      (c) 2010, Jan Rochel License:        BSD3 License-File:   LICENSE

@@ -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

@@ -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)

@@ -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