SoccerFun (empty) → 0.1

raw patch · 20 files changed

+3723/−0 lines, 20 filesdep +GLUTdep +OpenGLdep +basesetup-changed

Dependencies added: GLUT, OpenGL, base, base-unicode-symbols, mtl, random

Files

• LICENSE +10/−0
• Setup.hs +2/−0
• SoccerFun.cabal +39/−0
• SoccerFun/Ball.hs +50/−0
• SoccerFun/Field.hs +60/−0
• SoccerFun/Geometry.hs +292/−0
• SoccerFun/MatchControl.hs +742/−0
• SoccerFun/MatchGame.hs +350/−0
• SoccerFun/Player.hs +517/−0
• SoccerFun/Prelude.hs +124/−0
• SoccerFun/Random.hs +8/−0
• SoccerFun/Referee.hs +130/−0
• SoccerFun/Referee/Ivanov.hs +945/−0
• SoccerFun/Team.hs +74/−0
• SoccerFun/Types.hs +73/−0
• SoccerFun/UI/GL.hs +178/−0
• template/Child.hs +80/−0
• template/Children.hs +31/−0
• template/Main.hs +8/−0
• template/Makefile +10/−0

@@ -0,0 +1,10 @@+Copyright (c) 2010, Jan Rochel+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+* Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+* Neither the name of the University of Utrecht nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,39 @@+Name:           SoccerFun+Version:        0.1+Copyright:      (c) 2010, Jan Rochel+License:        BSD3+License-File:   LICENSE+Author:         Jan Rochel+Maintainer:     jan@rochel.info+Stability:      experimental+Build-Type:     Simple+Synopsis:       Haskell port of a football simulation framework for teaching functional programming+Homepage:       http://www.cs.ru.nl/~peter88/SoccerFun/SoccerFun.html+Description:+	From the website: Soccer-Fun is an educational project to stimulate functional programming by thinking about, designing, implementing, running, and competing with the brains of football players! It is open for participation by everybody who likes to contribute. It is not restricted to a particular functional programming language.+Category:       Game, Education, AI+Cabal-Version:  >= 1.6+Extensions:     UnicodeSyntax, NamedFieldPuns, Rank2Types, ExistentialQuantification+Data-Files:	template/Makefile template/*.hs+Build-Depends:+	base >= 4 && < 4.3,+	base-unicode-symbols >= 0.2 && < 0.3,+	GLUT >= 2.2 && < 2.3,+	OpenGL >= 2.4 && < 2.5,+	random >= 1.0 && < 1.1,+	mtl >= 1.1 && < 1.2+Exposed-Modules:+	SoccerFun.UI.GL+	SoccerFun.Prelude+	SoccerFun.Ball+	SoccerFun.Types+	SoccerFun.Team+	SoccerFun.Random+	SoccerFun.Geometry+	SoccerFun.Field+	SoccerFun.Player+Other-Modules:+	SoccerFun.MatchGame+	SoccerFun.MatchControl+	SoccerFun.Referee+	SoccerFun.Referee.Ivanov

@@ -0,0 +1,50 @@+{-# LANGUAGE UnicodeSyntax #-}+module SoccerFun.Ball where++import SoccerFun.Prelude+import System.Random+import SoccerFun.Types+import SoccerFun.Geometry+import SoccerFun.Field++data BallState = Free Ball | GainedBy PlayerID deriving Show++data Ball = Ball {ballPos ∷ Position3D, ballSpeed ∷ Speed3D} deriving Show++{-| mkBall returns a ball with 3D dimensions. -}+mkBall ∷ Position → Speed → Ball+mkBall pos2D speed2D = Ball {ballPos = toPosition3D pos2D, ballSpeed = toSpeed3D speed2D}++{-| ballIsFree yields True iff argument is (Free ...). -}+ballIsFree ∷ BallState → Bool+ballIsFree (Free _) = True+ballIsFree _ = False++{-| ballAtCenter returns a non-moving ball at the center of the ball field. -}+ballAtCenter ∷ Field → Ball+ballAtCenter field = Ball {ballPos=zero {pxy=Position{px=flength field /2.0,py=fwidth field /2.0}}, ballSpeed = zero}++{-| ballIsGainedBy yields True iff the ball is in possession by the given player. -}+ballIsGainedBy ∷ PlayerID → BallState → Bool+ballIsGainedBy id (GainedBy id') = id == id'+ballIsGainedBy _ _ = False++data BounceDirection = Down | Up | Forward | Back++{-| Function used for giving a new random direction towards the given BounceDirection (#param1) -}+bounceBall ∷ BounceDirection → (Speed3D,StdGen) → (Speed3D,StdGen)+bounceBall Up (speed,seed) = let (p,seed1) = random seed in (speed {vz = (10.0-vz speed ) * p}, seed1)+bounceBall Down (speed,seed) = let (p,seed1) = random seed in (speed {vz = vz speed  * p}, seed1)+bounceBall Forward (speed@Speed3D{vxy=sp2d@Speed{direction=d}},seed) = let (p,seed1) = random seed in (speed {vxy = sp2d {direction=d + p*pi/2.0 }},seed1)+bounceBall Back (speed@Speed3D{vxy=sp2d@Speed{direction=d}},seed) = let (p,seed1) = random seed in (speed {vxy = sp2d {direction=d - p*pi/2.0 }},seed1)++------------------------------------------------------------------------------++radiusBall		∷ Float -- officially it should be 0.113m, but that turns out to be too small for rendering+radiusBall		= 0.3+surfaceResistance	∷ Float -- ^ maximum speed of ball when moving over surface+surfaceResistance	= 0.85+airResistance		∷ Float -- ^ maximum speed of ball when moving through air (should depend on velocity)+airResistance		= 0.95+accellerationSec	∷ Float -- ^ acceleration difference per square second+accellerationSec	= 9.81

@@ -0,0 +1,60 @@+{-# LANGUAGE UnicodeSyntax #-}+module SoccerFun.Field where++import SoccerFun.Geometry+import SoccerFun.Types (Other (other))++defaultField ∷ Field+defaultField = Field { fwidth = 75.0, flength = 110.0 }++data Field = Field+	{fwidth ∷ FieldWidth, -- ^ width of ball field (64m <=width <=75m)+	 flength ∷ FieldLength -- ^ height of ball field (100m<=height<=110m)+	} deriving Show++type FieldWidth = Metre+type FieldLength = Metre++inPenaltyArea ∷ Field → Home → Position → Bool+inPenaltyArea field home pos = northEdge <= py pos && py pos <= southEdge && if home == West then px pos <= westEdge else px pos >= eastEdge where+	northEdge = (fwidth field) / 2.0 - radiusPenaltyArea+	southEdge = (fwidth field) / 2.0 + radiusPenaltyArea+	westEdge = penaltyAreaDepth+	eastEdge = (flength field) - penaltyAreaDepth++radiusPenaltySpot = 0.3 ∷ Metre+radiusPenaltyArea = 9.15 ∷ Metre+penaltyAreaDepth = 16.50 ∷ Metre+penaltySpotDepth = 11.00 ∷ Metre++data Home = West | East deriving (Eq,Show)++instance Other Home where+	other West = East+	other East = West++isWest ∷ Home → Bool+isWest West = True+isWest _ = False++isEast ∷ Home → Bool+isEast East = True+isEast _ = False++{-| goalPoles yields the py coordinates of the north pole and south pole of the goal (note that north < south). -}+goalPoles ∷ Field → (Metre,Metre)+goalPoles field = (northPole,southPole) where+	northPole = ((fwidth field)-goalWidth)/2.0+	southPole = northPole + goalWidth++{-| Official metrics of a ball field: -}+radiusCentreCircle = 9.15 ∷ Float+-- | not official, taken for rendering+radiusCentreSpot = 0.3 :: Float+goalWidth = 7.32 :: Float+goalHeight = 2.44 :: Float+goalAreaDepth = 5.50 :: Float+radiusCornerKickArea = 0.90 :: Float+-- | not official+goalPoleWidth = 0.3 :: Float+

@@ -0,0 +1,292 @@+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses #-}+module SoccerFun.Geometry where++import Prelude.Unicode+import SoccerFun.Prelude+import Data.List (sort)++type Metre = Float+type Length = Metre+type XPos = Metre+type YPos = Metre+type ZPos = Metre++data Position = Position+	{px ∷ XPos, -- ^ x-coordinate in plane (0.0<=px)+	 py ∷ YPos  -- ^ y-coordinate in plane (0.0<=py)+	} deriving (Show,Eq)++data Position3D = Position3D {pxy ∷ Position, pz ∷ ZPos} deriving (Show,Eq)++coordinates ∷ Position3D → (Metre,Metre,Metre)+coordinates pos = (px $ pxy pos, py $ pxy pos, pz pos)++-- position3D is within the cube around #param5 with measures of #param2t/m4+inRadiusOfPosition ∷ Position3D → XRadius → YRadius → ZRadius → Position → Bool+inRadiusOfPosition pos1 xr yr zr pos2 = let+		(x1,y1,z1) = coordinates pos1+		Position x2 y2 = pos2+	in x2+xr >= x1 && x1 >= x2-xr && y2+yr >= y1 && y1 >= y2-yr && z1 <= zr++type XRadius = Metre+type YRadius = Metre+type ZRadius = Metre++type Angle = Radian -- ^ angle in radians, clockwise+type Radian = Float++angleHowFarFromPi ∷ Angle → Angle+angleHowFarFromPi a = toRadian (if (a' > 180) then (360 - a') else a')+	where+	a' = fromRadian (abs a)++angleHowFarFromAngle ∷ Angle → Angle → Angle+angleHowFarFromAngle a b+	| a' > b' = if a' - b' > 180 then toRadian (b' - a' + 360) else toRadian (a' - b')+	| otherwise =  if b' - a' > 180 then toRadian (a' - b' + 360) else toRadian (b' - a')+	where+	a' = fromRadian (abs a)+	b' = fromRadian (abs b)++-- | @movePoint v p@ moves point p over vector v.+movePoint ∷ RVector → Position → Position+movePoint (RVector dx dy) (Position px py) = Position (px+dx) (py+dy)++movePoint3D ∷ RVector3D → Position3D → Position3D+movePoint3D (RVector3D dxy dz) (Position3D pxy pz) = Position3D (movePoint dxy pxy) (pz+dz)++-- | @pointToRectangle (a,b) c@ returns c if (pointInRectangle (a,b) c) and the+-- | projected point c' of c that is exactly on the closest edge of rectangle+-- | (a,b).+pointToRectangle ∷ (Position,Position) → Position → Position+pointToRectangle (a,b) c+	| pointInRectangle (a,b) c = c+	| otherwise = let (x,y) = c' in Position x y+	where+	(minX,maxX) = minmax ((px a),(px b))+	(minY,maxY) = minmax ((py a),(py b))+	left = (px c) <= minX+	right = (px c) >= maxX+	above = (py c) <= minY+	below = (py c) >= maxY++	c' | left && above = (minX,minY)+	   | right && above = (maxX,minY)+	   | left && below = (minX,maxY)+	   | right && below = (maxX,maxY)+	   | above = ((px c), minY)+	   | below = ((px c), maxY)+	   | left = (minX,(py c) )+	   | right = (maxX,(py c) )+	   | otherwise = error ("unsuspected error; please rotate with angles between pi and -pi\n")++-- | @pointInRectangle (a,b) c@+-- | returns True iff point c is inside the rectangle determined by+-- | the diagonal corner points a and b.+pointInRectangle ∷ (Position,Position) → Position → Bool+pointInRectangle (a,b) c = minX ≤ px c ∧ px c ≤ maxX ∧ minY ≤ py c ∧ py c ≤ maxY where+	(minX,maxX) = minmax ((px a),(px b))+	(minY,maxY) = minmax ((py a),(py b))++inCircleRadiusOfPosition ∷ Position3D → XRadius → ZRadius → Position → Bool+inCircleRadiusOfPosition (Position3D pxy pz) r zr pos+	= dist pxy pos <= r && pz <= zr++data RVector = RVector+	{dx ∷ Metre, -- ^difference in x-coordinate (|dx| <= 1.0)+	 dy ∷ Metre -- ^difference in y-coordinate (|dy| <= 1.0)+	} deriving (Show,Eq)++data RVector3D = RVector3D {dxy ∷ RVector, dz ∷ Metre} deriving (Show,Eq)++-- | speed of an object+data Speed = Speed+	{direction ∷ Angle, -- ^ direction of object+	 velocity ∷ Velocity -- ^ velocity of object+	} deriving (Show,Eq)+-- | speed of an object in space+data Speed3D = Speed3D+	{vxy ∷ Speed, -- ^ surface speed of object+	 vz ∷ Velocity -- ^ velocity in z-axis (positive: goes up; negative: goes down; zero: horizontally)+	} deriving (Show,Eq)++type Velocity = Float -- ^ velocity in metre/second++class ToSpeed a where toSpeed ∷ a → Speed+class FromSpeed a where fromSpeed ∷ Speed → a+class ToSpeed3D a where toSpeed3D ∷ a → Speed3D+class FromSpeed3D a where fromSpeed3D ∷ Speed3D → a++instance ToSpeed3D Speed where toSpeed3D s = Speed3D {vxy = s, vz = zero}++instance Num RVector3D where+	p1 + p2 = RVector3D {dxy = dxy p1 + dxy p2, dz = dz p1 + dz p2}+	p1 * p2 = RVector3D {dxy = dxy p1 * dxy p2, dz = dz p1 * dz p2}+	p1 - p2 = RVector3D {dxy = dxy p1 - dxy p2, dz = dz p1 - dz p2}+	abs p = RVector3D {dxy = abs $ dxy p, dz = abs $ dz p}+	signum p = RVector3D {dxy = signum $ dxy p, dz = signum $ dz p}+	fromInteger i = RVector3D {dxy = fromInteger i, dz = zero}++instance Num Speed3D where+	p1 + p2 = Speed3D {vxy = vxy p1 + vxy p2, vz = vz p1 + vz p2}+	p1 * p2 = Speed3D {vxy = vxy p1 * vxy p2, vz = vz p1 * vz p2}+	p1 - p2 = Speed3D {vxy = vxy p1 - vxy p2, vz = vz p1 - vz p2}+	abs p = Speed3D {vxy = abs $ vxy p, vz = abs $ vz p}+	signum p = Speed3D {vxy = signum $ vxy p, vz = signum $ vz p}+	fromInteger i = Speed3D {vxy = fromInteger i, vz = zero}++instance Num Position3D where+	p1 + p2 = Position3D {pxy = pxy p1 + pxy p2, pz = pz p1 + pz p2}+	p1 * p2 = Position3D {pxy = pxy p1 * pxy p2, pz = pz p1 * pz p2}+	p1 - p2 = Position3D {pxy = pxy p1 - pxy p2, pz = pz p1 - pz p2}+	abs p = Position3D {pxy = abs $ pxy p, pz = abs $ pz p}+	signum p = Position3D {pxy = signum $ pxy p, pz = signum $ pz p}+	fromInteger i = Position3D {pxy = fromInteger i, pz = zero}++instance Num RVector where+	p1 + p2 = RVector {dx = dx p1 + dx p2, dy = dy p1 + dy p2}+	p1 * p2 = RVector {dx = dx p1 * dx p2, dy = dy p1 * dy p2}+	p1 - p2 = RVector {dx = dx p1 - dx p2, dy = dy p1 - dy p2}+	abs p = RVector {dx = abs $ dx p, dy = abs $ dy p}+	signum p = RVector {dx = signum $ dx p, dy = signum $ dy p}+	fromInteger i = RVector {dx = fromInteger i, dy = zero}++instance Num Position where+	p1 + p2 = Position {px = px p1 + px p2, py = py p1 + py p2}+	p1 * p2 = Position {px = px p1 * px p2, py = py p1 * py p2}+	p1 - p2 = Position {px = px p1 - px p2, py = py p1 - py p2}+	abs p = Position {px = abs $ px p, py = abs $ py p}+	signum p = Position {px = signum $ px p, py = signum $ py p}+	fromInteger i = Position {px = fromInteger i, py = zero}++instance Num Speed where+	p1 + p2 = Speed {direction = direction p1 + direction p2, velocity = velocity p1 + velocity p2}+	p1 * p2 = Speed {direction = direction p1 * direction p2, velocity = velocity p1 * velocity p2}+	p1 - p2 = Speed {direction = direction p1 - direction p2, velocity = velocity p1 - velocity p2}+	abs p = Speed {direction = abs $ direction p, velocity = abs $ velocity p}+	signum p = Speed {direction = signum $ direction p, velocity = signum $ velocity p}+	fromInteger i = Speed {direction = fromInteger i, velocity = zero}++class ToRVector a where toRVector ∷ a → RVector++class ToPosition a where toPosition ∷ a → Position+class FromPosition a where fromPosition ∷ Position → a+class ToPosition3D a where toPosition3D ∷ a → Position3D+class FromPosition3D a where fromPosition3D ∷ Position3D → a+++{-| Conversion of radians to degrees and vice versa:+-}+type Degrees = Int -- 0 <= degree < 360 (clockwise)++-- | @scaleVector k {dx,dy}@ returns {k*dx,k*dy}+-- | @scaleVector3D k {dxy,dz}@ returns @{scaleVector k dxy,k*dz}@+scaleVector ∷ Float → RVector → RVector+scaleVector k (RVector dx dy) = RVector (k*dx) (k*dy)++scaleVector3D ∷ Float → RVector3D → RVector3D+scaleVector3D k (RVector3D dxy dz) = RVector3D (scaleVector k dxy) (k*dz)++fromRadian ∷ Radian → Degrees+fromRadian a = (round (a * (360.0 / (2.0*pi)))) `mod` 360++toRadian ∷ Degrees → Radian+toRadian a = (fromIntegral a) * pi / 180.0++-- | @betweenPoints (a,b) c@ returns True iff c is on the line between a and b.+betweenPoints ∷ (Position,Position) → Position → Bool+betweenPoints (a,b) c+	= pointInRectangle (a,b) c && dcx / dcy == dx / dy+	where+	(minX:maxX:_) = sort [(px a),(px b)]+	(minY:maxY:_) = sort [(py a),(py b)]+	(dx, dy) = ((px a) - (px b), (py a) - (py b))+	(dcx,dcy) = ((px a) - (px c), (py a) - (py c))++-- | interpret Float as angle in radians+instance ToRVector Float where toRVector angle = RVector {dx=cos angle,dy=sin angle}++instance ToRVector Position where toRVector p = RVector {dx=(px p),dy=(py p)}++-- | @sizeVector {dx,dy} = sqrt (dx**2 + dy**2)@+-- | @sizeVector3D {dxy,dz} = sqrt ((dx dxy)**2 + (dy dxy)**2 + dz**2)@+sizeVector ∷ RVector → Float+sizeVector (RVector dx dy) = sqrt (dx*82.0 + dy**2.0)++sizeVector3D ∷ RVector3D → Float+sizeVector3D (RVector3D dxy dz) = sqrt ((dx dxy)**2.0 + (dy dxy)**2.0 + dz**2.0)++class Dist a b where dist ∷ a → b → Float+instance Dist Float Float where+	dist a b = abs (a-b)+instance Dist Position Position where+	dist a b = sqrt ((abs ((px a)-(px b)))**2.0 + (abs ((py a)-(py b)))**2.0)+instance Dist Position3D Position3D where+	dist a b = sqrt ((abs (px (pxy a)-px(pxy b)))**2.0 + (abs (py (pxy a)-py (pxy b)))**2.0 + (abs ((pz a)-(pz b)))**2.0)+instance Dist Position Position3D where+	dist a b = dist (Position3D a zero) b+instance Dist Position3D Position where+	dist a b = dist a (Position3D b zero)+++{-| @orthogonal a@ returns the left- and right- orthogonal angles to a -}+orthogonal ∷ Angle → (Angle,Angle)+orthogonal a = (a+pi/4.0, a-pi/4.0)++--instance toPosition (Float,Float) where toPosition (x,y) = {px=x,py=y}+--instance toPosition Position3D where toPosition p3D = p3D.pxy+--instance fromPosition (Float,Float) where fromPosition p2D = (p2D.px,p2D.py)+--instance fromPosition Position3D where fromPosition p2D = zero {pxy=p2D}+--instance toPosition3D (Float,Float,Float) where toPosition3D (x,y,z) = {pxy=toPosition (x,y),pz=z}+instance ToPosition3D Position where toPosition3D p2D = zero {pxy=p2D}+--instance fromPosition3D (Float,Float,Float) where fromPosition3D p3D = (p3D.(px pxy),p3D.(py pxy),p3D.pz)+--instance fromPosition3D Position where fromPosition3D p3D = p3D.pxy++--instance show Speed where show {direction,velocity}= "{direction=" +++ show direction +++ ",velocity=" +++ show velocity +++ "}"+--instance show Speed3D where show {vxy,vz} = "{vxy=" +++ show vxy +++ ",vz=" +++ show vz +++ "}"+--instance show Position where show {px, py} = "{px=" +++ show px +++ ",py=" +++ show py +++ "}"+--instance show Position3D where show {pxy,pz} = "{pxy=" +++ show pxy +++ ",pz=" +++ show pz +++ "}"+--++--instance toSpeed Speed3D where toSpeed s = (vxy s)+--instance fromSpeed Speed3D where fromSpeed s = zero {vxy=s}+--instance toSpeed3D Speed where toSpeed3D s = zero {vxy=s}+--instance fromSpeed3D Speed where fromSpeed3D s = (vxy s)++--zero ∷ Num a ⇒ a+--zero = fromIntegral 0++oppositeAngle ∷ Angle → Angle+oppositeAngle a+	| newAngle < (-pi) = newAngle + 2.0*pi+	| otherwise = newAngle+	where+	newAngle = a - pi++angleWithObject ∷ Position → Position → Angle+angleWithObject base target+	| a >= (0.5*pi) && b >= zero = ((-pi)+a) -- linksvoor, naar boven, negatieve hoek, -0.5*pi < hoek < zero+	| a <= (0.5*pi) && b >= zero = (-pi)+b -- linksachter, naar beneden, negatieve hoek, -0.5*pi < hoek < -pi+	| a <= (0.5*pi) && b <= zero = pi+b -- rechtsachter, naar beneden, positieve hoek, 0.5*pi < hoek < pi+	| a >= (0.5*pi) && b <= zero = (-b) -- rechtsvoor, naar boven, positieve hoek, 0 < hoek < 0.5*pi+	where+	v = RVector (px base-px target) (py base-py target)+	d = dist base target+	a = acos (max1 ((dx v) / d))+	b = asin (max1 ((dy v) / d))++	max1 ∷ Float → Float+	max1 r+		| r < -1.0 = -1.0+		| r > 1.0 = 1.0+		| otherwise = r++-- | gets the angle between two objects+-- | positive angle is CW, negative is CCW+angleWithObjectForRun ∷ (Position,Angle) → Position → Angle+angleWithObjectForRun (base,angle) target+	| newAngle > pi = newAngle - 2.0*pi+	| newAngle < (-pi) = newAngle + 2.0*pi+	| otherwise = newAngle+	where+	newAngle = angleWithObject base target - angle

@@ -0,0 +1,742 @@+{-# LANGUAGE UnicodeSyntax #-}+module SoccerFun.MatchControl where++import Prelude.Unicode+import SoccerFun.Prelude+import SoccerFun.Referee+import SoccerFun.Geometry+import System.Random+import SoccerFun.Types+import SoccerFun.Referee+import SoccerFun.Random+import SoccerFun.Team+import SoccerFun.Ball+import SoccerFun.Player+import Control.Monad.Identity+import Control.Monad.State+import Data.Maybe+import Data.List+import SoccerFun.Field++data Match = Match	{ team1		∷ Team			-- ^ team1+					  , team2		∷ Team			-- ^ team2+					  , theBall		∷ BallState	-- ^ the whereabouts of the ball+					  , theField	∷ Field	-- ^ the ball field+					  , theReferee	∷ Referee			-- ^ the referee+					  , playingHalf	∷ Half			-- ^ first half or second half team1 plays West at first half and East at second half+					  , playingTime	∷ PlayingTime		-- ^ todo: add a boolean gameOver, playingtime will not walk back to (zero) and its up to the referee at which time he is to end the game+					  , score		∷ Score			-- ^ the score+					  , seed		∷ StdGen		-- ^ random seed for generating pseudo random values+					  , unittime	∷ TimeUnit		-- ^ the time unit of a single simulation step+					  }+	deriving Show+type Score			= (NrOfGoals,NrOfGoals)			-- ^ (goals by Team1, goals by Team2)+type NrOfGoals		= Int								-- ^ (zero) <= nr of goals+++setMatchStart ∷ Team → Team → Field → Referee → PlayingTime → StdGen → Match+setMatchStart fstTeam sndTeam field referee time rs+	= Match { team1						= validateTeam fstTeam+	  , team2						= validateTeam sndTeam+	  , theBall						= Free (ballAtCenter field)+	  , theField					= field+	  , theReferee					= referee+	  , playingHalf					= FirstHalf+	  , playingTime					= time+	  , unittime					= 0.1+	  , score						= (0,0)+	  , seed						= rs+	  }++stepMatch ∷ Match → (([RefereeAction],[PlayerWithAction]),Match)+stepMatch match = runIdentity $ do+	(refereeActions,  match)		← return $ refereeTurn match+	match							← return $ performRefereeActions refereeActions match+	(intendedActions, match)		← return $ playersTurn   refereeActions  match+	(succeededActions,match)		← return $ selectActions intendedActions match+	match							← return $ performPlayerActions intendedActions succeededActions match+	match							← return $ advanceTime match+	return $ ((refereeActions,succeededActions),match)+	where+{-	playersTurn match+		lets every player player conjure an initiative+-}+	playersTurn ∷ [RefereeAction] → Match → ([PlayerWithAction],Match)+	playersTurn refereeActions match= (intendedActions,newMatch)+		where+		actionsOfTeam1				= map (think refereeActions (theBall match) (team2 match)) (singleOutElems (team1 match))+		actionsOfTeam2				= map (think refereeActions (theBall match) (team1 match)) (singleOutElems (team2 match))+		newMatch					= match { team1 = map snd actionsOfTeam1,team2 = map snd actionsOfTeam2}+		intendedActions				= [(action,playerID) | (action,Player{playerID=playerID}) <- actionsOfTeam1 ++ actionsOfTeam2]++		think ∷ [RefereeAction] → BallState → [Player] → (Player,[Player]) → (PlayerAction,Player)+		think refereeActions ballstate opponents (me@Player{  effect=effect,brain=brain@Brain{ai=ai,m=m}},ownTeam)+			| isNothing effect		= (action,newMe)+			| otherwise				= checkIfNotOnGround (fromJust effect) action newMe+			where+			(action,newM)			= runState (ai $ BrainInput{referee=refereeActions,ball=ballstate,others=ownTeam ++ opponents,me=me}) m+			newMe = clonePlayer (brain{ai=ai,m=newM}) me {  effect=effect}++			checkIfNotOnGround ∷ PlayerEffect → PlayerAction → Player → (PlayerAction,Player)+			checkIfNotOnGround (OnTheGround i) action fb+				| i <= 0			= (action,              fb { effect = Nothing})+				| otherwise			= (allowOnlyPlayTheater,fb { effect = Just (OnTheGround (i-1))+									                            , stamina= alterStamina ballstate fb (zero) (zero)})+				where+				allowOnlyPlayTheater= case action of+										PlayTheater	→ action+										_			→ Move (zero) { direction = (direction (speed fb))} (zero) -- Run (zero) { direction = (direction (speed fb))}+			checkIfNotOnGround _ action fb+									= (action,fb)++{-	selectActions actions match+		removes all failing actions, and returns the list of remaining succeeding actions.+		It updates the random stream in match, and neutralizes actions of tackled players.+-}	selectActions ∷ [PlayerWithAction] → Match → ([PlayerWithAction],Match)+	selectActions actions match@Match{seed=seed} = runIdentity $ do+		(seed,succeededActions)				← return $ validActions match seed actions+		((successTackles,failedTackles),seed)	← return $ analyseTackleActions match succeededActions seed+		succeededActions						← return $ filter (isNoTackleVictim successTackles) (removeMembers succeededActions failedTackles)+		return $ (succeededActions,match { seed=seed})+		where+	{-	actions that are always valid: {Move, Run, Rotate, Feint, Schwalbe, PlayTheater}+		actions that may have success: {Tackle} (looked at later at performactions)+		actions where at most (fromIntegral 1) can succeed: {GainBall, KickBall, HeadBall, Catch}+	-}	validActions ∷ Match → StdGen → [PlayerWithAction] → (StdGen,[PlayerWithAction])+		validActions match seed []			= (seed,[])+		validActions match seed actions+			| isJust ballAction			= (seed1,(fromJust ballAction:otherActions))+			| otherwise						= (seed1,otherActions)+			where+			allPlayers					= (team1 match) ++ (team2 match)+			(ballActions,otherActions)	= spanfilter (isActionOnBall ∘ fst) actions+			(seed1,ballAction)				= selectBallAction (theBall match) allPlayers seed ballActions++			selectBallAction ∷ BallState → [Player] → StdGen → [PlayerWithAction] → (StdGen,Maybe PlayerWithAction)+			selectBallAction ballstate allPlayers seed desiredActions = runIdentity $ do+				(ps,seed)					← return $ iterateStn (length desiredActions) random seed+				odds						← return $ [ (successOfAction ballstate allPlayers action (if (p==fromIntegral 1) then p else (makeRandomRealistic p)),action)+											  | (action,p) <- zip desiredActions ps+											  ]+				okOdds					← return $ filter (\(p,a) → p > (zero)) odds+				if null okOdds			then return $ (seed,Nothing) else do+					maxOddProb				← return $ maximum (map fst okOdds)+					bestActions				← return $ [a | (p,a) <- okOdds, p >= maxOddProb]+					(p,seed)					← return $ random seed+					if p==fromIntegral 1					then return $ (seed,Just (head bestActions)) else do+						let l = fromIntegral $ length bestActions ∷ Float+						let m = p * l+						let idx = floor m+						return (seed,Just (bestActions !! idx))+				where+				successOfAction ∷ BallState → [Player] → PlayerWithAction → Float → Float+				successOfAction ballstate allPlayers (action,who) p+											= myFatigue * myHealth * p * successOfAction+					where+					successOfAction		= if (isGainBall  action && ballGainable  && ballAtGainSpeed) then  successGaining else+											 (if (isCatchBall action && ballCatchable && ballAtCatchSpeed) then successCatching else+											 (if (isKickBall  action && ballKickable) then                      successKicking else+											 (if (isHeadBall  action && ballHeadable) then                      successHeading else+											 	                                                           (zero)+											 )))+					Just me						= find (identifyPlayer who) allPlayers+					myFatigue 				= (stamina me)+					myHealth				= (health me)+					mySkills 				= skillsAsList me+					myLength 				= (height me)+					iGainWell				= elem Gaining  mySkills+					iKickWell				= elem Kicking  mySkills+					iHeadWell				= elem Heading  mySkills+					iCatchWell				= elem Catching mySkills++					ballGainable			= dPlayerBall <= maxGainReach  me+					ballKickable			= dPlayerBall <= maxKickReach  me+					ballHeadable			= dPlayerBall <= maxHeadReach  me+					ballCatchable			= dPlayerBall <= maxCatchReach me+					ballAtGainSpeed			= dVelocity    <= maxGainVelocityDifference  me dPlayerBall+					ballAtCatchSpeed		= dVelocity    <= maxCatchVelocityDifference me dPlayerBall+					dSpeed 				= (zero) { dxy = scaleVector (velocity (speed me)) (toRVector (direction (speed me)))}+												-+											  RVector3D {       dxy = scaleVector (velocity (vxy (ballSpeed theBall))) (toRVector (direction (vxy (ballSpeed theBall))))+											  ,       dz  = (vz (ballSpeed theBall))+											  }+					dVelocity 				= sizeVector3D dSpeed++					theBall 				= getBall ballstate allPlayers+					dPlayerBall 			= dist (toPosition3D (pos me)) (ballPos theBall)++					othersWithBall		= [fb | fb <- allPlayers, ballIsGainedBy (playerID fb) ballstate && not (identifyPlayer who fb)]+					otherHasBall			= not (null othersWithBall)+					otherDribblesWell		= elem Dribbling (skillsAsList (head othersWithBall))++					successGaining			= if (ballIsFree ballstate) then (lengthPenalty * if iGainWell then 0.95 else 0.8) else+											 (if  otherHasBall        then (lengthPenalty * if iGainWell then 0.75 else 0.3 * if otherDribblesWell then 0.6 else 1.0)+												                        else 1.0)+					successKicking			= if (ballIsFree ballstate) then (lengthBonus * if iKickWell then 0.95 else 0.85) else+											 (if  otherHasBall        then (lengthBonus * if iKickWell then 0.80 else 0.70 * if otherDribblesWell then 0.7 else 1.0)+												                        else 1.0)+					successHeading			= if iHeadWell then  0.95 else 0.9+					successCatching		= if iCatchWell then 1.0 else  0.95+					lengthBonus				= (myLength-1.2) ** 0.15+					lengthPenalty			= (2.6-myLength) ** 0.1++		analyseTackleActions ∷ Match → [PlayerWithAction] → StdGen → (([PlayerWithAction],[PlayerWithAction]),StdGen)+		analyseTackleActions match performedActions seed+			= spanfilterSt (isPossibleTackle match) [action | action <- performedActions, isPlayerTackle (fst action)] seed+			where+			isPossibleTackle ∷ Match → PlayerWithAction → StdGen → (Bool,StdGen)+			isPossibleTackle match@Match{team1=team1,team2=team2} (Tackle victimID _,playerID) seed+				| dMeVictim > maxTackleReach offender								--  victim is out of reach+								= (False,seed)+				| otherwise		= (((p + chanceOfSuccess) / 2) > 0.5,seed')				-- victim is within reach, but tackle may fail+				where+				(p,seed')		= random seed+				allPlayers		= team1 ++ team2+				Just offender		= find (identifyPlayer playerID) allPlayers+				Just victim			= find (identifyPlayer victimID) allPlayers+				dMeVictim		= dist (pos offender) (pos victim)+				chanceOfSuccess	= (1.0 - dMeVictim + if (elem Tackling (skillsAsList offender)) then 0.9 else 0.7) /2++		isNoTackleVictim ∷ [PlayerWithAction] → PlayerWithAction → Bool+		isNoTackleVictim tackles (action,playerID)+								= isSchwalbe    action+									||+								  isPlayTheater action+								  	||+								  null [victim | (Tackle victim _,_) <- tackles, victim==playerID]++{-	refereeTurn match+		determines whether the rules of soccer are adhered to and yields a list of referee actions.+-}	refereeTurn ∷ Match → ([RefereeAction],Match)+	refereeTurn match@Match{theReferee=referee@Referee{  rbrain=brain@Brain{ai=ai,m=m}},theBall=theBall,playingHalf=playingHalf,team1=team1,team2=team2,playingTime=playingTime,unittime=unittime,seed=seed}+											= (refereeActions,match { theReferee=newReferee,seed=newSeed})+		where+		(refereeActions,(newM,newSeed))	= ai playingTime unittime theBall playingHalf team1 team2 (m,seed)+		newReferee							= cloneReferee (Brain{ai=ai,m=newM}) referee++{-	performRefereeActions refereeActions match+		performs for each ball player in match his succeededAction, informs them about the referee actions, and moves the ball.+-}	performRefereeActions ∷ [RefereeAction] → Match → Match+	performRefereeActions refActions match	= foldl doRefereeEvent match refActions+		where+		doRefereeEvent ∷ Match → RefereeAction → Match+		doRefereeEvent theMatch@Match{playingHalf=playingHalf,theField=theField,team1=team1,team2=team2} refereeAction+			| isAlterMatchBallAndTeams		= theMatch { theBall=Free (mkBall pos (zero))}+			| isGameProgressEvent			= gameProgress theMatch+			| isDisplaceTeamsEvent			= theMatch { team1=map (displacePlayer ds) team1,team2=map (displacePlayer ds) team2}+			| isReprimandEvent				= let (team1',team2')		= reprimandPlayer (nameOf team1) tef repr (team1,team2) in theMatch { team1=team1',team2=team2'}+			| otherwise						= theMatch+			where+			(isAlterMatchBallAndTeams,pos)	= case refereeAction of+												DirectFreeKick _ pos	→ (True,pos)+												ThrowIn        _ pos	→ (True,pos)+												Corner         _ _		→ (True,fromJust (getKickPos theField playingHalf refereeAction))+												GoalKick       _		→ (True,fromJust (getKickPos theField playingHalf refereeAction))+												Penalty        _		→ (True,fromJust (getKickPos theField playingHalf refereeAction))+												CenterKick     _		→ (True,fromJust (getKickPos theField playingHalf refereeAction))+												otherwise				→ (False,error "UNDEF pos")+			(isGameProgressEvent,gameProgress)+											= case refereeAction of+												GameOver				→ (True,\m                → m { playingTime=(zero)})+												AddTime t				→ (True,\m                → m { playingTime=(playingTime m+)t})+												EndHalf					→ (True,\m                →         m { playingHalf=SecondHalf})+												Goal    t				→ (True,\m@Match{score=(w,e)} →         m { score=if (t==Team1) then (w+1,e) else (w,e+1)})+												otherwise				→ (False,error "UNDEF gameProgress")+			(isDisplaceTeamsEvent,ds)		= case refereeAction of+												DisplacePlayers ds		→ (True, ds)+												otherwise				→ (False,error "UNDEF ds")+			(isReprimandEvent,(tef,repr))	= case refereeAction of+												ReprimandPlayer p r		→ (True, (p,r))+												otherwise				→ (False,(error "UNDEF tef", error "UNDEF repr"))++			displacePlayer ∷ Displacements → Player → Player+			displacePlayer displacements fb+				= case lookup (playerID fb) displacements of+					Just pos				→ fb { pos=pos}+					nothing					→ fb++			reprimandPlayer ∷ ClubName → PlayerID → Reprimand → ([Player],[Player]) → ([Player],[Player])+			reprimandPlayer club1 playerID RedCard (team1,team2)+				= splitAt (nrPlayers1 - if ((clubName playerID) == club1) then 1 else 0) (uneq1++uneq2)+				where+				(uneq1,_,uneq2)				= break1 (identifyPlayer playerID) (team1++team2)+				nrPlayers1				= length team1+			reprimandPlayer _ _ _ teams		= teams++{-	performPlayerActions actions succeededActions match+		performs for each ball player in match his succeededAction and moves the ball.+-}	performPlayerActions ∷ [PlayerWithAction] → [PlayerWithAction] → Match → Match+	performPlayerActions actions succeededActions match@Match{theField=theField,theBall=theBall,team1=team1,team2=team2,seed=seed,unittime=unittime} = runIdentity $ do+		(seed,ball,newPlayers1,newPlayers2)+						← return $ foldl (flip (performAction succeededActions)) (seed,theBall,team1,team2) actions+		(ball,seed)	← return $ moveBall theField (newPlayers1++newPlayers2) (ball,seed)+		match			←  return $ match { team1=newPlayers1, team2=newPlayers2, theBall=ball, seed=seed }+		return $ match+		where+		performAction ∷ [PlayerWithAction] → PlayerWithAction → (StdGen,BallState,[Player],[Player])+		                                                             → (StdGen,BallState,[Player],[Player])+		performAction succeededActions initiative (seed,ball,allPlayers1,allPlayers2)+			| elem initiative succeededActions				-- plan has succeeded+				= performAction' initiative (seed,ball,allPlayers1,allPlayers2)+			| otherwise											-- plan has failed+				= (seed,ball,map (failThisPlayerAction initiative) allPlayers1,map (failThisPlayerAction initiative) allPlayers2)+			where+			failThisPlayerAction ∷ PlayerWithAction → Player → Player+			failThisPlayerAction (idea,playerID) fb+				| identifyPlayer playerID fb+									= fb { effect=Just (failPlayerAction idea)}+				| otherwise			= fb++			performAction' ∷ PlayerWithAction → (StdGen,BallState,[Player],[Player])+							                      → (StdGen,BallState,[Player],[Player])++			performAction' (Move sp angle,playerID) (seed,ball,team1,team2) = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return (seed1,ball,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				curNose			= (nose fb)+				curSpeed			= (speed fb)+				skills				= skillsAsList fb+				playerHasBall		= ballIsGainedBy playerID ball+				(p,seed1)			= random seed+				feasibleAngle		= ((signum angle)) * (abs angle `boundedBy` (0, maxRotateAngle fb))+				newNose			= curNose + feasibleAngle+				angleDifficulty 	= angleHowFarFromPi ((direction sp)-newNose)+				angleDifference		= angleHowFarFromAngle (direction sp) newNose+				newStamina			= alterStamina ball fb   angleDifficulty angleDifference+				newHealth			= alterHealth  ball fb p angleDifficulty angleDifference+				healthFat			= getHealthStaminaFactor newHealth newStamina+				newVel				= healthFat * (velocity sp `boundedBy` (0, maxVelocity fb angleDifficulty angleDifference))+				newSpeed			= sp { velocity=newVel}+				newPosition'		= movePoint (scaleVector (unittime * newVel) (toRVector (direction newSpeed))) (pos fb)+				newPosition		= pointToRectangle ((zero),Position{px=(flength theField),py=(fwidth theField)}) newPosition'+				newFb				= fb { stamina = newStamina+									      , health  = newHealth+									      , speed   = newSpeed+									      , pos     = newPosition+									      , nose    = newNose+									      , effect  = Just (Moved newSpeed feasibleAngle)+									  }++		{-	Run has become deprecated.+			Rules for running:+			(1) you can't run through another player+			(2) you can't run faster than maximum velocity for a player (depends on Running and Dribbling skill)+			(3) you can't leave field+			(4) running fast lowers your stamina+			(5) running slow increases your stamina and health+			(6) poor health or poor stamina lowers your maximum velocity+			performAction' (Run speed,playerID) (seed,ball,team1,team2)+				| null bumpedInto	= runIdentity $ do -- no collision with other player+					newFb		← fb { pos     = newPosition+									      , speed   = newSpeed+									      , stamina = newStamina+									      , effect  = Just (Ran eventSpeed { direction = (direction eventSpeed) - (direction (speed fb))})+									  }+					(team1,team2)	← splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+					return $ (seed2,ball,team1,team2)+				| otherwise		= runIdentity $ do		-- collission with other player+					playerSpeed	← (speed fb) { direction=(direction newSpeed), velocity=(velocity 0.3*newSpeed)}+					newFb		← fb { speed   = playerSpeed+									      , stamina = newStamina+									      , effect  = Just (Ran (speed fb) { velocity=(velocity 0.3*newSpeed)})+									  }+					(team1,team2)	← splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+					(p3,seed3)	← random seed2+					(seed4,team1,team2)+									← moveBumpedPlayers newSpeed { velocity=(velocity 0.3*newSpeed), direction = (direction 0.4*p3*newSpeed)}+										bumpedInto (seed3,team1,team2)+					return $ (seed4,ball,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				(p1,seed1)			= random seed+				(p2,seed2)			= random seed1+				angleDifficulty 	= angleHowFarFromPi (direction speed)+				angleDifference		= if (isNothing (effect fb)) then (zero) else (case fromJust (effect fb) of+																	      Ran s	→ angleHowFarFromAngle (direction speed) (direction s)+																	      _		→ (zero))+				playerHasBall		= ballIsGainedBy playerID ball+				newStamina			= alterStamina ball fb    angleDifficulty angleDifference+				newHealth			= alterHealth  ball fb p1 angleDifficulty angleDifference+				healthFat			= getHealthStaminaFactor newHealth newStamina+				newVel				= healthFat * (velocity speed `boundedBy` (0, maxVelocity fb angleDifficulty angleDifference))+				newSpeed			= (speed fb) { velocity=newVel}+				newAngle			= if (p2 == (fromIntegral 1)) then ((direction (speed fb)) + (direction speed)) else+									 (if (p2 > 0.5) then  ((direction (speed fb)) + (0.85 + 0.15 * healthFat) * pi - pi + (direction speed)) else+									                 ((direction (speed fb)) + (1.15 - 0.15 * healthFat) * pi - pi + (direction speed)))+				eventSpeed			= (speed fb) { velocity=newVel, direction=newAngle}+				newPosition'		= movePoint (scaleVector (unittime * newVel) (toRVector newAngle)) (pos fb)+				newPosition		= pointToRectangle ((zero),{px=(flength theField),py=(fwidth theField)}) newPosition'+				bumpedInto			= (playerID [fb) | fb <- uneq1++uneq2 | inRadiusOfPlayer newPosition fb]+		-}+		{- Rotate has become deprecated:+			Rules for rotating:+			(1) Rotating with slow velocity increases your stamina and health+			(2) Rotating with high velocity lowers your stamina and health+			(3) poor health or poor stamina lowers your maximum velocity+			(4) poor health or poor stamina lowers your precision with turning+			(5) you can't leave field+			(6) you can't run faster than your maximum velocity+			(7) you can't run through another player+			performAction' (Rotate speed,playerID) (seed,ball,team1,team2)+				| not (null bumpedInto) = runIdentity $ do+					playerSpeed			← (speed fb) { direction=newAngle, velocity=(velocity 0.3*newSpeed)}+					newFb				← fb { speed   = playerSpeed+											      , stamina = newStamina+											      , effect  = Just (Rotated {direction=newAngle,velocity=(velocity 0.3*newSpeed)})+											  }+					(team1,team2)			← splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+					(p2,seed2)			← random seed1+					(seed3,team1,team2)	← moveBumpedPlayers newSpeed { velocity=(velocity 0.3*newSpeed), direction = (direction 0.4*p2*newSpeed)}+												bumpedInto (seed2,team1,team2)+					return $ (seed3,ball,team1,team2)+				| otherwise = runIdentity $ do+					newFb				← fb { pos     = newPosition+											      , speed   = newSpeed+											      , stamina = newStamina+											      , effect  = Just (Rotated newSpeed)+											  }+					(newTeam1,newTeam2)	← splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+					return $ (seed1,ball,newTeam1,newTeam2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				(p1,seed1)			= random seed+				newV'				= healthFat * (setbetween (velocity speed) (zero) (maxVelocity fb (zero) (zero)))+				newV				= if (newAngle >= maxRotateAngle fb { speed=(speed fb) { velocity=newV'}}) then (max (newV' - 0.5) (zero)) else newV'+				newAngle			= let lengthFactor	= if (elem Rotating skills) then ((height fb)-0.2) else (height fb)+									      healthFactor	= (healthFat/((direction 0.75*lengthFactor))*speed)+									   in if ((direction speed) > (zero)) then (min (  maxRotateAngle fb)  healthFactor) else+									                                  (max (~(maxRotateAngle fb)) healthFactor)+				skills				= skillsAsList fb+				playerHasBall		= ballIsGainedBy playerID ball+				newStamina			= alterStamina ball fb    (zero) (zero)+				newHealth			= alterHealth  ball fb p1 (zero) (zero)+				healthFat			= getHealthStaminaFactor newHealth newStamina+				newDirection		= (direction (speed fb)) + newAngle+				newSpeed			= (speed fb) { direction=newDirection, velocity=newV}+				newPosition'		= movePoint (scaleVector (unittime * newV) (toRVector newDirection)) (pos fb)+				newPosition		= pointToRectangle ((zero),{px=(flength theField),py=(fwidth theField)}) newPosition'+				bumpedInto			= (playerID [fb) | fb <- uneq1++uneq2 | inRadiusOfPlayer newPosition fb]+		-}+		{-	Rules for gaining ball:+			(1) ball obtains position and surface speed of obtaining player+		-}	performAction' (GainBall,playerID) (seed,ball,team1,team2) = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return $ (seed,GainedBy playerID,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				newFb				= fb { effect = Just (GainedBall Success)}++		{-	Rules for kicking ball:+			(1) kicking decreases stamina+			(2) kicking is more effective towards your direction, and least effective in opposite direction+			(3) being taller, you can kick harder+			(4) a low stamina/health lower your max kickspeed+			(5) todo: kicking a ball held/gained by a keeper, may damage the keeper+		-}	performAction' (KickBall (Speed3D{vxy=Speed{velocity=v,direction=d},vz=vz}),playerID) (seed,ball,team1,team2) = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return $ (seed2,Free newBall,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				(p1,seed1)			= random seed+				(p2,seed2)			= random   seed1+				newFb				= fb { stamina=newStamina,effect=Just (KickedBall (Just newSpeed))}+				theBall				= getBall ball (team1 ++ team2)+				skills				= skillsAsList fb+				fatHealth			= getHealthStaminaFactor (health fb) (stamina fb)+				maxV				= maxVelocityBallKick fb+				newV				= speedFactor * (v `boundedBy` (0,maxV))+				newVz				= speedFactor * (vz `boundedBy` (0, maxV))+				newSpeed			= Speed3D{vxy=Speed{velocity=newV,direction=newDirection},vz=newVz}+				newStamina			= kickingPenalty fb newV * (stamina fb)+				speedFactor		= oppositeKickPenalty fb d+				newBall			= theBall { ballSpeed=newSpeed}+				newDirection = runIdentity $ do+					if p2 == (fromIntegral 1)		then return d else do+						failure		← return $ (fromIntegral 1) - if (elem Kicking skills) then (makeRandomRealisticSkilled p2) else (makeRandomRealistic p2)+						if p1 `mod` (2::Int) ≡ 0 then do+								newD		← return $ d - failure * maxKickingDeviation fb+								return $ if (newD < (zero)) then (newD + 2.0*pi) else newD+							else do+								newD		← return $ d + failure * maxKickingDeviation fb+								return $ if (newD > 2.0*pi) then (newD - 2.0*pi) else newD++		{-	Rules for heading ball:+			(1) heading decreases stamina, but less than kicking+			(2) kicking is more effective towards your direction, and least effective in opposite direction+			(3) a low stamina/health lower your max headspeed, but less than kicking+			(4) heading is less harder than kicking, but is not effected by your length+			(5) todo: heading a ball held/gained by a keeper, may damage the keeper (less than with kicking)+		-}	performAction' (HeadBall (Speed3D{vxy=Speed{velocity=v,direction=d},vz=vz}),playerID) (seed,ballstate,team1,team2) = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return $ (seed2,Free newBall,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				(p1,seed1)			= random seed+				(p2,seed2)			= random   seed1+				skills				= skillsAsList fb+				fatHealth			= getHealthStaminaFactor (health fb) (stamina fb)+				ball				= getBall ballstate (team1 ++ team2)+				ballSpeed'			= (velocity (vxy (ballSpeed ball)))+				maxV				= maxVelocityBallHead fb ballSpeed'+				newV				= v `boundedBy` (zero, maxV)+				newVz				= 0.25 * (vz `boundedBy` (0, maxV))+				newDirection		 = runIdentity $ do+					if p2 == (fromIntegral 1)	 then return d else do+						failure		← return $ (fromIntegral 1) - if (elem Heading skills) then makeRandomRealisticSkilled p2 else makeRandomRealistic p2+						if p1 `mod` (2::Int) ≡ 0 then do+								newD		← return $ d - failure * maxHeadingDeviation fb+								return $ if (newD < (zero)) then (newD + 2.0*pi) else newD+							else do+								newD		← return $ d + failure * maxHeadingDeviation fb+								return $ if (newD > 2.0*pi) then (newD - 2.0*pi) else newD+				newSpeed			= Speed3D{vxy=Speed{velocity=newV,direction=newDirection},vz=newVz}+				newStamina			= headingPenalty fb newV ballSpeed' * (stamina fb)+				newFb				= fb { stamina=newStamina,effect=Just (HeadedBall (Just newSpeed))}+				newBall			= ball { ballSpeed=newSpeed}++		{-	Rules for feinting:+			(1) you must have velocity in order to feint manouvre.+			(2) a feint manouvre changes your position, and decreases your velocity (depends on Feinting skill)+		-}	performAction' (Feint d,playerID) (seed,ball,team1,team2) = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return $ (seed,ball,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				playerHasBall		= ballIsGainedBy playerID ball+				newStamina			= maxFatigueLossAtFeint fb * (stamina fb)+				fatHealth			= getHealthStaminaFactor (health fb) (stamina fb)+				newVelocity		= fatHealth * (velocity (speed fb)) * maxVelocityLossAtFeint fb+				newSpeed			= (speed fb) { velocity=newVelocity}+				(leftv,rightv)		= orthogonal (direction (speed fb))+				sidestep			= case d of FeintLeft → leftv; _ → rightv+				newPosition'		= movePoint ((scaleVector (maxFeintStep fb) (toRVector sidestep))+				                                                 ++				                                  (scaleVector (unittime * newVelocity) (toRVector (direction (speed fb))))+				                                 ) (pos fb)+				newPosition		= pointToRectangle ((zero),Position{px=(flength theField),py=(fwidth theField)}) newPosition'+				newFb				= fb { pos=newPosition,speed=newSpeed,stamina=newStamina,effect=Just (Feinted d)}++		{- Rules for Tackling+			(1) tackling may lower the health of the victim but increases his stamina (last is because he lies on the ground the next rounds)+			(2) tackling costs stamina+		-}	performAction' (Tackle victimID ve,playerID) (seed,ball,team1,team2) = runIdentity $ do+				return $ (seed1,newBall,team1T,team2T)+				where+				nrPlayersTeam1		= length team1+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				(team1N,team2N)		= splitAt nrPlayersTeam1 (unbreak1 (uneq1,newFb,uneq2))+				(uneq1T,fbT,uneq2T)	= break1 (identifyPlayer victimID) (team1N ++ team2N)+				(team1T,team2T)		= splitAt nrPlayersTeam1 (unbreak1 (uneq1T,newTarget,uneq2T))+				newStaminaSelf	= maxFatigueLossAtTackle fb * (stamina fb)+				fatHealthSelf		= getHealthStaminaFactor (health fb) (stamina fb)+				newFb				= fb { stamina = newStaminaSelf, effect = Just (Tackled victimID ve Success)}+				targetHasBall		= ballIsGainedBy victimID ball+				(p,seed1)			= random seed+				newV'				= min maxTackleVelocity ve+				maxTackleVelocity	= 10.0+				newV				= newV'/10.0+				healthDamageTarget	= newV * fatHealthSelf * (0.5*p + 0.1) + ((height fbT)-minLength)/2.0+				newHealthTarget	= max 0.0 (health fbT) - healthDamageTarget+				newTarget			= fbT { health = newHealthTarget, effect = Just (OnTheGround 3) }+				newBall			= if targetHasBall then (Free (mkBall (pos fbT) (speed fbT))) else ball++		{- Rules for Schwalbe+			(1) Schwalbe cures stamina+			(2) Performing a Schwalbe when ball was gained causes to lose ball+		-}	performAction' (Schwalbe,playerID) (seed,ball,team1,team2) = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return $ (seed,ball,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				newFb				= fb { effect = Just (OnTheGround 1)}++		{- Rules for catching+			(1) ball optains speed and distance of player+		-}	performAction' (CatchBall,playerID) (seed,ball,team1,team2) = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return $ (seed,GainedBy playerID,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				newFb				= fb { effect=Just (CaughtBall Success)}++		{- Rules for playing theater+			(1) playingTheater costs stamina+			(2) Performing a Schwalbe when ball was gained causes to lose ball+		-}	performAction' (PlayTheater,playerID) (seed,ball,team1,team2) = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return $ (seed,ball,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				e				= (effect fb)+				wasOnTheGround		= if (isNothing e) then False else (isOnTheGround (fromJust e))+				newEvent			= if (isOnTheGround (fromJust e)) then (fromJust e) else PlayedTheater+				newFb				= fb { effect = Just newEvent}++		moveBumpedPlayers ∷ Speed → [PlayerID] → (StdGen,[Player],[Player])+												  → (StdGen,[Player],[Player])+		moveBumpedPlayers newSpeed bumpedInto (seed,team1,team2)+			= foldl (moveBumpedPlayer newSpeed) (seed,team1,team2) bumpedInto+			where+			moveBumpedPlayer ∷ Speed → (StdGen,[Player],[Player]) → PlayerID+									 → (StdGen,[Player],[Player])+			moveBumpedPlayer newSpeed (seed,team1,team2) playerID = runIdentity $ do+				(team1,team2)		← return $ splitAt (length team1) (unbreak1 (uneq1,newFb,uneq2))+				return $ (seed1,team1,team2)+				where+				(uneq1,fb,uneq2)	= break1 (identifyPlayer playerID) (team1 ++ team2)+				(p,seed1)			= random seed+				newPos				= let a = p*2.0*pi in movePoint RVector {dx=0.5*cos a,dy=0.5*sin a} (pos fb)+				newFb				= fb { speed=newSpeed, pos=newPos}+++	{-	moveBall moves the ball (fromIntegral 1) unit, taking into account the surface and air resistance.+	-}	moveBall ∷ Field → [Player] → (BallState,StdGen) → (BallState,StdGen)+		moveBall _ _ gained@(GainedBy playerID,seed)+			= gained+		moveBall field allPlayers (Free ball@Ball{ballSpeed=Speed3D{vxy=Speed{velocity=v,direction=d},vz=vz},ballPos=ballPos},seed)+			= (Free ball { ballSpeed=newSpeed,ballPos=newBallpos},seed1)+			where+			inTheAir				= (pz ballPos) > (zero)+			resistance				= if inTheAir then airResistance else surfaceResistance+			surfaceMovement		= scaleVector (unittime * v) (toRVector d)+			newSpeed2D				= let newV = resistance*v in Speed{direction = d, velocity = if (newV <= 0.05) then (zero) else newV}+--			newVz'					= if inTheAir then (vz - unittime*accellerationSec) else (zero)+			newVz'					= vz - unittime*accellerationSec+			newHeight'				= (pz ballPos) + vz+			(newHeight,newVz)		= if (newHeight' < (zero)) then (0.5*(abs newHeight'),let newV = 0.33*(abs newVz') in if (newV <= 0.8) then (zero) else newV) else	-- ball bounces, loss of velocity+									                          (newHeight',newVz')+			newSpeed'				= Speed3D{vxy=newSpeed2D, vz=newVz}+			newBallpos				= Position3D{pxy=movePoint surfaceMovement (pxy ballPos),pz=newHeight}+			fieldDimensions		= ((zero),Position{px=(flength field),py=(fwidth field)})+			(newSpeed,seed1)		= ballBouncesAgainst field newBallpos newSpeed' allPlayers seed++			-- if the then ball else bounces against something, velocity will be reduced again and the direction will be changed.+			ballBouncesAgainst ∷ Field → Position3D → Speed3D → [Player] → StdGen → (Speed3D,StdGen)+			ballBouncesAgainst field newBallpos newSpeed@Speed3D{vxy=Speed{velocity=v,direction=d},vz=s3d} allPlayers seed+				-- the ball may hit (fromIntegral 1) of the poles of (fromIntegral 1) of the goal or (fromIntegral 1) of the players and bounce away+				-- ball hits (fromIntegral 1) of the goal poles+				| againstGoalWestNorthPole || againstGoalWestSouthPole || againstGoalEastNorthPole || againstGoalEastSouthPole+					-- 50% bounce left, 50% bounce right+					= (newSpeed { vxy = (vxy newSpeed) { direction = if (p1<=0.5) then (d-p2*pi) else (d+p2*pi), velocity = resistance*v}},seed2)+				-- ball hits the top of (fromIntegral 1) of the goals+				| againstGoalWestPoleUpper || againstGoalEastPoleUpper = runIdentity $ do+					forwardOrBack	← return $ if (p1<=0.5) then Forward else Back+					upOrDown		← return $ if ((pz newBallpos) < goalHeight+(goalPoleWidth/2.0)) then Down else Up+					return $ bounceBall upOrDown (bounceBall forwardOrBack (newSpeed,seed2))+				-- ball hits (fromIntegral 1) of the players+				| any (\fb → inRadiusOfPlayer (pxy newBallpos) fb && (height fb) >= (pz newBallpos)) allPlayers+					-- bounces pure at random (player might get ported)+					= (newSpeed { vxy = (vxy newSpeed) { direction = p2*2.0*pi, velocity = resistance*v}, vz=p1*s3d},seed2)+				-- ball hits nothing+				| otherwise+					= (newSpeed,seed2)+				where+				(p1,seed1)					= random seed+				(p2,seed2)					= random seed1+				(northPole,southPole)		= goalPoles field+				againstGoalWestNorthPole 	= inCircleRadiusOfPosition newBallpos (goalPoleWidth/2.0) goalHeight Position {px=0.0,          py=northPole - goalPoleWidth/2.0}+				againstGoalWestSouthPole	= inCircleRadiusOfPosition newBallpos (goalPoleWidth/2.0) goalHeight Position {px=0.0,          py=southPole + goalPoleWidth/2.0}+				againstGoalEastNorthPole	= inCircleRadiusOfPosition newBallpos (goalPoleWidth/2.0) goalHeight Position {px=(flength field),py=northPole - goalPoleWidth/2.0}+				againstGoalEastSouthPole	= inCircleRadiusOfPosition newBallpos (goalPoleWidth/2.0) goalHeight Position {px=(flength field),py=southPole + goalPoleWidth/2.0}+				againstGoalWestPoleUpper	= (isbetween (py (pxy newBallpos)) (northPole-goalPoleWidth/2.0) (southPole+goalPoleWidth/2.0))+													&&+											  (isbetween (pz newBallpos) goalHeight (goalHeight+goalPoleWidth))+													&&+											  ((px (pxy newBallpos)) <= (zero))+				againstGoalEastPoleUpper	= (isbetween (py (pxy newBallpos)) (northPole-goalPoleWidth/2.0) (southPole+goalPoleWidth/2.0))+													&&+											  (isbetween (pz newBallpos) goalHeight (goalHeight+goalPoleWidth))+													&&+											  ((px (pxy newBallpos)) >= (flength field))++	advanceTime ∷ Match → Match+	advanceTime match@Match{playingTime=playingTime, unittime=unittime}+		= match { playingTime = max (zero) ((playingTime*160.0 - unittime)/160.0)}+++{-|	Attribute altering functions depending on angles:+	params:+		Angle ∷ between (zero) and pi, how much the player is running backwards (pi is backwards).+		Angle ∷ between (zero) and pi, the difference between the desired angle and the angle the player previously ran to.+-}+alterStamina ∷ BallState → Player → Angle → Angle → Stamina+alterStamina ballState fb angleDifficulty angleDifference+	| v <= rfv											-- increase stamina+		= if s < minimumFatigue	then minimumFatigue else s**0.8+	| otherwise													-- lower stamina+		= if s > maximumFatigue	then maximumFatigue * ((fromIntegral 1) - angleDifficulty/(4.0*pi)) else fv * ((fromIntegral 1) - angleDifficulty/(4.0*pi))+	where+	v						= (velocity (speed fb))+	h							= (height fb)+	s							= (stamina fb)+	rfv								= restoreStaminaVelocity ballState fb angleDifficulty angleDifference+	diff							= v-rfv+	fv								= if (diff >= 6.0) then (s**(s**(1.6 + 2.0*h/100.0))) else+									 (if (diff >= 4.0) then (s**(1.5 + h/100.0)) else+									 (if (diff >= 2.0) then (s**(1.4 - h/100.0)) else+									                   (s**(1.3 - 2.0*h/100.0))))++alterHealth ∷ BallState → Player → Float → Angle → Angle → Health+alterHealth ballState fb p angleDifficulty angleDifference+	| (velocity (speed fb)) <= rfv		= min (h+p/10.0) 1.0	-- increase health+	| otherwise						= h+	where+	h							= (health fb)+	rfv								= restoreStaminaVelocity ballState fb angleDifficulty angleDifference++restoreStaminaVelocity ∷ BallState → Player → Angle → Angle → Velocity+restoreStaminaVelocity ballState fb angleDifficulty angleDifference+	| ballIsGainedBy (playerID fb) ballState+									= maxV / (if (elem Running   skills) then 1.6 else 2.6)+	| elem Running skills		= maxV / (if (elem Dribbling skills) then 2.0 else 3.0) * 1.22+	| otherwise						= maxV / (if (elem Dribbling skills) then 2.0 else 3.0)+	where+	skills							= skillsAsList fb+	maxV							= maxVelocity fb angleDifficulty angleDifference++maxVelocity ∷ Player → Angle → Angle → Velocity+maxVelocity fb angleDifficulty angleDifference+	= dribblingPenalty * runningPenalty * baseVelocity+	where+	skills							= skillsAsList fb+	baseVelocity					= 10.0+	dribblingPenalty				= if (elem Dribbling skills) then 0.95 else 0.85+	runningPenalty					= if (elem Running   skills) then 1.0 else  0.85++minimumFatigue						= 0.05+maximumFatigue						= 0.985+++{-|	The functions below defines the penalty factor: values between 0.0 and 1.0 that define the loss of an attribute of an action.+-}+type PenaltyFactor = Float			-- a value between 0.0 and 1.0++kickingPenalty ∷ Player → Velocity → PenaltyFactor+kickingPenalty fb newV				= 1.0 - (if (elem Kicking (skillsAsList fb)) then 0.3 else 0.6) * (newV/maxV)**2.0+	where+	maxV							= maxVelocityBallKick fb++headingPenalty ∷ Player → Velocity → Velocity → PenaltyFactor+headingPenalty fb newV ballV		= 1.0 - (if (elem Heading (skillsAsList fb)) then 0.08 else 0.13) * (newV/maxV)**2.0+	where+	maxV							= maxVelocityBallHead fb ballV++maxFatigueLossAtTackle ∷ Player → PenaltyFactor+maxFatigueLossAtTackle fb			= if (elem Tackling (skillsAsList fb)) then 0.99 else 0.9++maxFatigueLossAtFeint ∷ Player → PenaltyFactor+maxFatigueLossAtFeint fb			= if (elem Feinting (skillsAsList fb)) then 0.92 else 0.77++maxVelocityLossAtFeint ∷ Player → PenaltyFactor+maxVelocityLossAtFeint fb			= if (elem Feinting (skillsAsList fb)) then 0.99 else 0.75++oppositeKickPenalty ∷ Player → Angle → PenaltyFactor+oppositeKickPenalty fb kickTo		= 1.0 - skillPenaltyFactor * (angleHowFarFromPi angle)/pi+	where+	angle							= abs ((nose fb) - kickTo)+	skills							= skillsAsList fb+	skillPenaltyFactor				= if (all (`elem` skills) [Rotating,Kicking]) then 0.3+									 else (if (any (`elem` skills) [Rotating,Kicking]) then 0.5+									 else                                             0.9)

@@ -0,0 +1,350 @@+{-# LANGUAGE UnicodeSyntax #-}+module SoccerFun.MatchGame where++import SoccerFun.Types+import SoccerFun.MatchControl+import SoccerFun.Prelude+++showTime ∷ Minutes → String -- ^ display time in (mm:ss min) format+showTime minutes = show (fromIntegral seconds/60) ++ ":" ++ (if (seconds `mod` 60 < 10) then "0" else "") ++ show (seconds `mod` 60) ++ " min"+	where+	seconds = round (((fromIntegral (round (minutes * 100.0) ∷ Int))/100.0) * 60.0) ∷ Int+++logRefereeAction :: RefereeAction -> Maybe String+logRefereeAction (ReprimandPlayer tfp r) = Just $ "ReprimandPlayer " ++ show (playerNo tfp) ++ " " ++ show r+logRefereeAction (Hands tfp) = Just $ "Hands " ++ show (playerNo tfp)+logRefereeAction (TackleDetected tfp) = Just $ "TackleDetected " ++ show (playerNo tfp)+logRefereeAction (SchwalbeDetected tfp) = Just $ "SchwalbeDetected " ++ show (playerNo tfp)+logRefereeAction (TheaterDetected tfp) = Just $ "TheaterDetected " ++ show (playerNo tfp)+logRefereeAction (DangerousPlay tfp) = Just $ "DangerousPlay " ++ show (playerNo tfp)+logRefereeAction GameOver = Just $ "GameOver"+logRefereeAction PauseGame = Just $ "PauseGame"+logRefereeAction (AddTime t) = Just $ "AddTime " ++ (showTime t)+logRefereeAction EndHalf = Just $ "EndHalf"+logRefereeAction (Goal t) = Just $ "Goal " ++ show t+logRefereeAction (Offside tfp) = Just $ "Offside " ++ show (playerNo tfp)+logRefereeAction (DirectFreeKick t p) = Just $ "DirectFreeKick " ++ show t ++ " " ++ show p+logRefereeAction (GoalKick t) = Just $ "GoalKick " ++ show t+logRefereeAction (Corner t e) = Just $ "Corner " ++ show t ++ " " ++ show e+logRefereeAction (ThrowIn t p) = Just $ "ThrowIn " ++ show t ++ " " ++ show p+logRefereeAction (Penalty t) = Just $ "Penalty " ++ show t+logRefereeAction (CenterKick t) = Just $ "CenterKick " ++ show t+logRefereeAction (Advantage t) = Just $ "Advantage " ++ show t+logRefereeAction (OwnBallIllegally tfp) = Just $ "OwnBallIllegally" ++ show (playerNo tfp)+logRefereeAction (DisplacePlayers ds) = Just $ "DisplacePlayers"+logRefereeAction ContinueGame = Nothing+logRefereeAction (TellMessage txt) = Just $ "TellMessage " ++ show txt++{- This module defines the match and tournament data structures.+-}+--import MatchLog, GuiInterface++--data BallGame+--	= BallGame { match ∷ Match -- the ball match to be played+--		, actionPics ∷ ActionPics -- the action-images+--		, history ∷ History -- recent history of game+--		, frames ∷ Int -- nr of frames so far (reset to zero every second)+--		, options ∷ Options -- options of ball game+--		, logging ∷ WhatToLog -- logging options+--		}+--+--data Options+--	= Options { closeReferee ∷ Bool -- automatically close referee dialog after one second (True - default) or by user (False)+--		, showSplash ∷ Bool -- show splash screen at opening (False - default) or do (True)+--		, displaySpeed ∷ DisplaySpeed -- slow, normal or fast-play (Normal - default)+--		, showReferee ∷ Bool -- show referee-intermezzo (True - default) or not (False)+--		, playingTime ∷ PlayingTime -- default playingtime (defaultPlayingTime)+--		}+--instance show Options+--instance fromString Options+--instance == Options+--+--data History+--	= History { time ∷ Seconds -- time in seconds of length history+--		, past ∷ [Match] -- the recent history+--		}+--+--{- incFrames game increases the frames count of game.+---}+--incFrames ∷ BallGame → BallGame+--incFrames game@{frames} = game {frames=frames+1}+--+--{- defaultPlayingTime returns recommended playing time+---}+--defaultPlayingTime ∷ PlayingTime+--defaultPlayingTime ∷ PlayingTime+--defaultPlayingTime = 0.66--1.0+--+--{- defaultOptions returns default options.+---}+--defaultOptions ∷ Options+--defaultOptions+--	= { closeReferee = True+--	  , showSplash = False+--	  , displaySpeed = Normal+--	  , showReferee = True+--	  , playingTime = defaultPlayingTime+--	  }+--+--+--{- timeLeft is True if the game has not finished+---}+--timeLeft ∷ BallGame → Bool+--timeLeft game = game.match.Match.playingTime > zero+--+--{- getOptions env reads the options file (if present) and returns its content.+--		If no options file was found, it is created and filled with default values.+--	setOptions options stores the options in the options file.+---}+--getOptions ∷ *env → (Options,*env) | FileSystem env+--getOptions env+--	= case readFile optionsFile env of+--		(Just options,env) = (fromString options,env)+--		(nothing, env) = (defaultOptions, env)+--setOptions ∷ Options *env → *env | FileSystem env+--+--data Competition = Competition { results ∷ [[Maybe Score]] -- teams x teams matrix of match results (note: team x team → Nothing)+--type Ranking = AssocList ClubName Rank+--data Rank = Rank { matchpoints ∷ Int -- number of matchpoints (>= 0)+--								, goalsScored ∷ Int -- number of scored goals (>= 0)+--								, goalsAgainst ∷ Int -- number of goals against (>= 0)+--								}+--instance zero Rank+--instance == Rank+--instance < Rank+--instance + Rank+--								, west ∷ [ClubName] -- names of participating teams (west side)+--								, east ∷ [ClubName] -- names of participating teams (east side)+--								, usedRandomSeed∷ RandomSeed -- the seed that is used for computing the matches+--								}+--+--{- competition teams field referee time rs+--		computes an entire competition between all teams in teams.+--		Each match uses the same referee and same initial random seed value rs.+---}+--competition ∷ [Home Field → Team] Field Referee PlayingTime RandomSeed → Competition+--+--{- computeMatch match+--		computes an entire match between the currently selected team1 and team2.+---}+--computeMatch ∷ Match → Score+--+--{- ranking competition+--		computes the ranking of all teams that have participated in competition.+---}+--ranking ∷ Competition → Ranking+--ranking ∷ [ClubName] [Maybe Score] → Ranking+--+--{- checkCompetitionFile westTeamNames rs env+--		checks whether there is a competition backup file present for the current set+--		of teams (assuming they start on the West home side) and initial random seed value rs+--		for computing matches.+--		If not, then such a file is created, and the same random seed value and empty list of scores is returned.+--		If so, then the currently stored random seed value and list of scores is returned.+---}+--checkCompetitionFile ∷ [ClubName] RandomSeed *env → ((RandomSeed,[Maybe Score]),*env) | FileSystem env+--+--{- appendMatchToCompetitionFile west east env+--		appends an empty entry of a match between west versus east in the competition backup file.+--		It also returns the file pointer to allow a correct update in updateMatchToCompetitionFile.+---}+--appendMatchToCompetitionFile∷ ClubName ClubName *env → (Int,*env) | FileSystem env+--+--+--{- updateMatchToCompetitionFile west east score filepointer env+--		updates the line that starts at filepointer in the competition backup file with the result+--		of the match between west versus east.+---}+--updateMatchToCompetitionFile∷ ClubName ClubName (Maybe Score) Int *env → *env | FileSystem env+--+--import StdEnvExt, fileIO+--import guiInterface, matchControl+--pmort Parsers (parse, ∷ Parser, ∷ Result(..), ∷ SugPosition, ∷ Rose(..), ∷ RoseNode(..), ∷ SymbolTypes(..), ∷ SymbolType(..), yield, token, symbol, <&>, &>, <!>, <!+>, <!*>, number, digit)+--+--+--+--+--+--instance zero Rank where+--	zero = { matchpoints = zero, goalsScored = zero, goalsAgainst = zero }+--instance == Rank where+--	(==) r1 r2 = (r1.matchpoints,r1.goalsScored,r1.goalsAgainst) == (r2.matchpoints,r2.goalsScored,r2.goalsAgainst)+--instance < Rank where+--	(<) r1 r2 = r1.matchpoints < r2.matchpoints ||+--							  r1.matchpoints == r2.matchpoints && r1.goalsScored < r2.goalsScored ||+--							  r1.matchpoints == r2.matchpoints && r1.goalsScored == r2.goalsScored && r1.goalsAgainst > r2.goalsAgainst+--instance + Rank where+--	(+) r1 r2 = { matchpoints = r1.matchpoints + r2.matchpoints+--							  , goalsScored = r1.goalsScored + r2.goalsScored+--							  , goalsAgainst = r1.goalsAgainst + r2.goalsAgainst+--							  }+--+--competition ∷ [Home Field → Team] Field Referee PlayingTime RandomSeed → Competition+--competition teams field referee playingtime rs+--	= { results = [ [ if (nrWest == nrEast)+--									  Nothing+--									  (Just (computeMatch (setMatchStart (teamWest West field) (teamEast East field) field referee playingtime rs)))+--								| (nrEast,teamEast) <- zip2 [1..] teams+--								]+--							  | (nrWest,teamWest) <- zip2 [1..] teams+--							  ]+--	  , west = map (\f → nameOf (f West field)) teams+--	  , east = map (\f → nameOf (f East field)) teams+--	  , usedRandomSeed = rs+--	  }+--++computeMatch ∷ Match → Score+computeMatch match+	| playingTime match > zero+							= computeMatch (snd (stepMatch match))+	| otherwise = score match++{-+ranking ∷ [ClubName] [Maybe Score] → Ranking+ranking names scores = foldl upd [(t,zero) | t <- names] (zip2 [(tw,te) | tw <- names, te <- names] scores)+	where+	upd ranking (_,Nothing)+		= ranking+	upd ranking ((west,east),Just (goalsWest,goalsEast))+		= updkeyvalue west ((+) rankWest) (updkeyvalue east ((+) rankEast) ranking)+		where+		(mpsWest, mpsEast) = if (goalsWest > goalsEast) (3,0) (if (goalsWest < goalsEast) (0,3) (1,1))+		(rankWest,rankEast) = ({matchpoints=mpsWest,goalsScored=goalsWest,goalsAgainst=goalsEast}+								  ,{matchpoints=mpsEast,goalsScored=goalsEast,goalsAgainst=goalsWest}+								  )++instance show Options where+	show {closeReferee,showSplash,displaySpeed,showReferee,playingTime}+							= "{closeReferee=" ++ show closeReferee ++ show+							  ",showSplash=" ++ show showSplash ++ show+							  ",displaySpeed=" ++ show displaySpeed ++ show+							  ",showReferee=" ++ show showReferee ++ show+							  ",playingTime=" ++ show playingTime ++ show+							  "}"+instance fromString Options where+	fromString str+	= case parse optionsP (fromString str) optionsFile "char" of+		Succ [opt:_] = opt+		_ = defaultOptions+		where+		optionsP ∷ Parser Char Options Options+		optionsP = token ['{closeReferee='] &>+							  boolP <&> \closeReferee →+							  token [',showSplash='] &>+							  boolP <&> \showSplash →+							  token [',displaySpeed='] &>+							  displaySpeedP <&> \displaySpeed →+							  token [',showReferee='] &>+							  boolP <&> \showReferee →+							  token [',playingTime='] &>+							  realP <&> \playingTime →+							  symbol '}' &>+							  yield { closeReferee = closeReferee+									, showSplash = showSplash+									, displaySpeed = displaySpeed+									, showReferee = showReferee+									, playingTime = playingTime+									}+		boolP = (token ['True'] &> yield True) <!> (token ['False'] &> yield False)+		realP = <!*> (symbol '-') <&> \minuss →+							  <!*> digit <&> \digits1 →+							  <!*> (symbol '.') <&> \dots →+							  <!*> digit <&> \digits2 →+							  yield (toReal (show (minuss ++ digits1 ++ dots ++ digits2)))+		displaySpeedP = (token ['Slow'] &> yield Slow) <!>+							  (token ['Target'] &> yield Target) <!>+							  (token ['Normal'] &> yield Normal) <!>+							  (token ['Faster'] &> yield Faster) <!>+							  (token ['Fastest'] &> yield Fastest)++instance == Options where+	(==) o1 o2 = o1.closeReferee == o2.closeReferee &&+							  o1.showSplash == o2.showSplash &&+							  o1.displaySpeed == o2.displaySpeed &&+							  o1.showReferee == o2.showReferee &&+							  o1.Options.playingTime == o2.Options.playingTime+++setOptions ∷ Options *env → *env | FileSystem env+setOptions options env = writeFile False optionsFile (show options) env++optionsFile = "SoccerFunOptions.txt"++checkCompetitionFile ∷ [ClubName] RandomSeed *env → ((RandomSeed,[Maybe Score]),*env) | FileSystem env+checkCompetitionFile west rs env+# (ok,cf,env) = fopen competitionFile FReadText env+| not ok = ((rs,[]), createCompetitionFile west rs env) -- competition file does not exist: create it+# (ok,frs,fwest,cf) = header cf+| not ok || fwest <> teamsLine west+							= ((rs,[]), createCompetitionFile west rs (snd (fclose cf env))) -- competition file ill-formatted or different set of teams: create it+# (scores,cf) = readScores cf -- competition file exists, and for this competition+# (ok,env) = fclose cf env+| not ok = abort ("Could not close competition file after reading scores.\n" ++++								show (length scores)+								)+| otherwise = ((frs,scores),env)+	where+	readScores ∷ *File → ([Maybe Score],*File)+	readScores cf+	# (end,cf) = fend cf+	| end = ([],cf)+	# (line,cf) = freadline cf+	# score = if (line.[0] == 'x') Nothing+							 (let (i1,l1) = span ((<>) ' ') [c | c<-:line]+								  (i2,l2) = span ((<>) ' ') (tl l1)+							   in Just (toInt (show i1),toInt (show i2))+							 )+	# (scores,cf) = readScores cf+	= ([score:scores],cf)++appendMatchToCompetitionFile∷ ClubName ClubName *env → (Int,*env) | FileSystem env+appendMatchToCompetitionFile west east env+# (ok,cf,env) = fopen competitionFile FAppendText env+| not ok = abort "Could not open competition file for appending data.\n"+# (pos,cf) = fposition cf+# (ok,env) = fclose (cf <<< "x " <<< west <<< " vs " <<< east <<< '\n') env+| not ok = abort "Could not close competition file after appending data.\n"+| otherwise = (pos,env)++updateMatchToCompetitionFile∷ ClubName ClubName (Maybe Score) Int *env → *env | FileSystem env+updateMatchToCompetitionFile west east score pos env+# (ok,cf,env) = fopen competitionFile FAppendText env+| not ok = abort "Could not open competition file for appending data.\n"+# (ok,cf) = fseek cf pos FSeekSet+| not ok = abort "Could not seek in competition file for updating data.\n"+# (ok,env) = fclose (cf <<< result <<< ' ' <<< west <<< " vs " <<< east <<< '\n') env+| not ok = abort "Could not close competition file after appending data.\n"+| otherwise = env+	where+	result = case score of+								Nothing = "x"+								Just (gw,ge) = gw +++> (" " ++ show ge)++createCompetitionFile ∷ [ClubName] RandomSeed *env → *env | FileSystem env+createCompetitionFile west rs env+# (ok,cf,env) = fopen competitionFile FWriteText env+| not ok = abort "Could not create competition file.\n"+# (ok,env) = fclose (cf <<< seedLine rs <<< '\n' <<< teamsLine west <<< '\n') env+| not ok = abort "Could not close competition file.\n"+| otherwise = env++header ∷ *File → (Bool,RandomSeed,String,*File)+header file+# (rsLine, file) = freadline file+# (teamsLine,file) = freadline file+= (size rsLine > 1 && size teamsLine > 1, fromString (rsLine%(0,size rsLine-2)), teamsLine%(0,size teamsLine-2),file)++seedLine ∷ RandomSeed → String+seedLine rs = show rs++teamsLine ∷ [ClubName] → String+teamsLine west = foldl (\t ts → t +++ "," +++ ts) "" west++competitionFile = "competition.txt"++------------------------------------------------------------------------------++-}

@@ -0,0 +1,517 @@+{-# 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-}

@@ -0,0 +1,124 @@+{-# LANGUAGE UnicodeSyntax, Rank2Types #-}+-- | Collection of functions of more general purpose.+module SoccerFun.Prelude 	where++import Data.Maybe+import Control.Monad.Identity+++fst3 (x,y,z) = x+snd3 (x,y,z) = y+thd3 (x,y,z) = z++avg ∷ Fractional a ⇒ [a] → a+avg xs = sum xs / fromIntegral (length xs)++zero ∷ Num a ⇒ a+zero = fromIntegral 0++one ∷ Num a ⇒ a+one = fromIntegral 1++iterateStn ∷ Int → (s → (a,s)) → s → ([a],s)+iterateStn 0 _ s	= ([],s)+iterateStn n f s = runIdentity $ do+	(a, s)		← return $ f s+	(as,s)		← return $ iterateStn (n-1) f s+	return $ ((a:as),s)++singleOutElems ∷ [a] → [(a,[a])]+singleOutElems as = singleOut [] as where+	singleOut ∷ [a] → [a] → [(a,[a])]+	singleOut _ [] = []+	singleOut prefix (a:as)= ((a,prefix++as) : singleOut (prefix++[a]) as)++-- | spanfilter cond xs = (filter cond xs, filter (not . cond) xs)+spanfilter ∷ (a → Bool) → [a] → ([a],[a])+spanfilter cond []+	= ([],[])+spanfilter cond (x:xs)+	| cond x	= ((x:yes),no)+	| otherwise	= (yes,(x:no))+	where+	(yes,no)	= spanfilter cond xs++spanfilterSt ∷ (a → s → (Bool,s)) → [a] → s → (([a],[a]),s)+spanfilterSt cond [] s+	= (([],[]),s)+spanfilterSt cond (x:xs) s = runIdentity $ do+	(ok,s)		← return $ cond x s+	((yes,no),s)	← return $ spanfilterSt cond xs s+	return $ if ok	then (((x:yes),no),s) else ((yes,(x:no)),s)++{-| break cond (A ++ B ++ C) = (A,B,C)+		where for each x in A: not cond x     /\+	      for each x in B:     cond x     /\+	      if C=(x:_):      not cond x+-}+break' ∷ (a → Bool) → [a] → ([a],[a],[a])+break' c xs = let+		(no,yes)	 = span (not . c) xs+		(yes',no') = span c yes+	in (no,yes',no')++{-| break1 cond (A ++ [B] ++ C) = (A,B,C)+		where for each x in A: not cond x     /\+	                           cond B     /\+	      if C=(x:_):      not cond x+-}+break1 ∷ (a → Bool) → [a] → ([a],a,[a])+break1 c xs+	= case break' c xs of+		(a,[b],c)	→ (a,b,c)+		(a,b,c)		→ error ("break1: [B] is of length: " ++ show (length b) ++ "\n")++-- | unbreak (a,b,c) = a ++ b ++ c+unbreak ∷ ([a],[a],[a]) → [a]+unbreak (a,b,c) = a ++ b ++ c+++-- | unbreak1 (a,b,c) = a ++ [b] ++ c+unbreak1 ∷ ([a],a,[a]) → [a]+unbreak1 (a,b,c) = a ++ [b] ++ c++{- [a1..x..aN] x = i+		where+		aJ /= x for all j<i+		aJ == x for j==i+-}+--(??) infixl 9 ∷ [a] → a → Int | == a+--(??) ys x = search ((==) x) ys 0+--+--(???) infixl 9 ∷ [a] → (a → Bool) → Int+--(???) ys c = search c ys 0++type AssocList k v = [(k,v)]++boundedBy ∷ Ord a ⇒ a → (a,a) → a+boundedBy x (low,up)+	| low > x	= low+	| x > up	= up+	| otherwise	= x++{-| isbetween x low up+		returns True iff low <= x <= up+-}+isbetween ∷ Ord a ⇒ a → a → a → Bool+isbetween x low up+	= low <= x && x <= up++-- | minmax (a,b) = (a,b) if a<=b; (b,a) otherwise+minmax ∷ Ord a ⇒ (a,a) → (a,a)+minmax (a,b)+	| a<=b		= (a,b)+	| otherwise	= (b,a)++-- | perhaps p Nothing = False, and perhaps p (Just a) = p a+perhaps ∷ (a → Bool) → (Maybe a) → Bool+perhaps p = maybe False p++removeMember ∷ (Eq a) ⇒ a → [a] → [a]+removeMember x = filter (/= x)++removeMembers ∷ (Eq a) ⇒ [a] → [a] → [a]+removeMembers xs ys = foldr removeMember xs ys

@@ -0,0 +1,8 @@+{-# LANGUAGE UnicodeSyntax #-}+module SoccerFun.Random where++makeRandomRealistic ∷ Floating f ⇒ f → f+makeRandomRealistic r = 1.0-r**4.0++makeRandomRealisticSkilled ∷ Floating f ⇒ f → f+makeRandomRealisticSkilled r= 1.0-r**10.0

@@ -0,0 +1,130 @@+{-# LANGUAGE UnicodeSyntax, ExistentialQuantification #-}+{-| The referee data type, and all available referees within Soccer-Fun.+-}+module SoccerFun.Referee where++import SoccerFun.Player+import SoccerFun.Team+import SoccerFun.Types+import SoccerFun.Ball+import System.Random+import Control.Monad.State+import Control.Monad.Identity++data Referee = ∀memory. Referee { rname ∷ String+							, rbrain ∷ Brain (RefereeAI (memory,StdGen)) memory+--							, refActionPics ∷ [FilePath]+							}++instance Show Referee where+	show r = rname r++cloneReferee ∷ Brain (RefereeAI (m,StdGen)) m → Referee → Referee+cloneReferee brain (Referee rname rbrain {-refActionPics-})+	= Referee rname brain {-refActionPics-}++type RefereeBrain memory = (memory,RefereeAI (memory,StdGen))+type RefereeAI state = PlayingTime → TimeUnit+							→ BallState+							→ Half+							→ Team+							→ Team+							→ state+							→ ([RefereeAction],state)++defaultReferee ∷ Referee+defaultReferee = Referee { rname = "Default"+						  , rbrain = Brain {m = undefined, ai = \_ _ _ _ _ _ st → ([ContinueGame],st)}+--						  , refActionPics = []+						  }++--allAvailableReferees∷ [Field → Referee]+--allAvailableReferees = [ ivanovReferee ]+-- When coding for all referees, use following list:+--							+++--						  [ RefereeCoachslalom+--						  , RefereeCoachpassing+--						  , RefereeCoachdeepPass+--						  , RefereeCoachkeeper+--						  ]+--defaultImage ∷ FileSystem env ⇒ Match → RefereeAction → env → (Bitmap,env)+--defaultSoundFile ∷ RefereeAction → Maybe String++{-| Wrapper functions for simpler referee brains:+-}+randomlessRefereeAI ∷ (RefereeAI memory) → RefereeAI (memory,StdGen)+randomlessRefereeAI brainf = randomless brainf where+	randomless brainf playingtime unit maybeBall half team1 team2 (memory,seed) = runIdentity $ do+		(decisions,memory)    ← return $ brainf playingtime unit maybeBall half team1 team2 memory+		return $ (decisions,(memory,seed))++amnesiaRefereeAI ∷ (RefereeAI StdGen) → RefereeAI (memory,StdGen)+amnesiaRefereeAI brainf = amnesia brainf where+	amnesia brainf playingtime unit maybeBall half team1 team2 (memory,seed) = runIdentity $ do+		(decisions,seed)      ← return $ brainf playingtime unit maybeBall half team1 team2 seed+		return (decisions,(memory,seed))+++witlessRefereeAI ∷ (RefereeAI a) → RefereeAI (memory,StdGen)+witlessRefereeAI brainf = witless brainf where+	witless brainf playingtime unit maybeBall half team1 team2 state =+		(fst (brainf playingtime unit maybeBall half team1 team2 undefined),state)+++--import matchGame+--import Ivanov (ivanovReferee)+-- When coding for all referees, include following modules:+--import RefereeCoachslalomassignment+--import RefereeCoachpassingassignment+--import RefereeCoachdeepPassassignment+--import RefereeCoachkeeperassignment+++instance NameOf Referee where nameOf r = rname r+++--defaultImage ∷  FileSystem env ⇒ Match RefereeAction env → (Bitmap,env)+--defaultImage match rev env = let bitmapf = case rev of+--							(ReprimandPlayer _ Warning) → "ivanovWarning.bmp"+--							(ReprimandPlayer _ YellowCard) → "ivanovYellow.bmp"+--							(ReprimandPlayer _ RedCard) → "ivanovRed.bmp"+--							(Hands _) → "hands.bmp"+--							(OwnBallIllegally _) → "ivanovBadluck.bmp"+--							(TellMessage _) → "ivanovLook.bmp"+--							(DirectFreeKick _ p) → if (p.px < match.theField.flength/2.0) "ivanovWijstLinks.bmp" "ivanovWijstRechts.bmp"+--							(GoalKick t) → if (pointLeft match t) "ivanovWijstLinks.bmp" "ivanovWijstRechts.bmp"+--							(Corner t _) → if (pointLeft match t) "ivanovWijstLinks.bmp" "ivanovWijstRechts.bmp"+--							(ThrowIn t _) → if (pointLeft match t) "ivanovWijstLinks.bmp" "ivanovWijstRechts.bmp"+--							(Penalty t) → if (pointLeft match t) "ivanovWijstLinks.bmp" "ivanovWijstRechts.bmp"+--							(Advantage _) → "ivanovBadluck.bmp"+--							(TheaterDetected _) → "ivanovTheater.bmp"+--							_ → "ivanovFluit.bmp"+--	in case openBitmap ("afbeeldingen\\"+++bitmapf) env of+--		(Just bm,env) = (bm,env)+--		nothing = abort "defaultImage: unable to load default picture.\n"+--	where+--	pointLeft match t = match.playingHalf == FirstHalf && t == Team1 || match.playingHalf == SecondHalf && t == Team2++--defaultSoundFile ∷ RefereeAction → Maybe String+--defaultSoundFile rev = if (soundfilename == "") Nothing (Just ("sound\\"+++soundfilename))+--	where+--	soundfilename = defaultSoundFileName rev+--+--	defaultSoundFileName (Hands _) = "stopBecauseOfFoul.wav"+--	defaultSoundFileName (TheaterDetected _) = "tacklesEd.wav"+--	defaultSoundFileName (TackleDetected _) = "tacklesEd.wav"+--	defaultSoundFileName (SchwalbeDetected _) = "tacklesEd.wav"+--	defaultSoundFileName (DangerousPlay _) = "tacklesEd.wav"+--	defaultSoundFileName GameOver = "endGameOrHalf.wav"+--	defaultSoundFileName EndHalf = "endGameOrHalf.wav"+--	defaultSoundFileName (Offside _) = "offside.wav"+--	defaultSoundFileName (GoalKick _) = "ballOut.wav"+--	defaultSoundFileName (Corner _ _) = "ballOut.wav"+--	defaultSoundFileName (ThrowIn _ _) = "ballOut.wav"+--	defaultSoundFileName (Goal _) = "CenterKick.wav"+--	defaultSoundFileName (OwnBallIllegally _) = "wrongPosition2restartFrom.wav"+--	defaultSoundFileName _ = ""++++

@@ -0,0 +1,945 @@+{-# LANGUAGE UnicodeSyntax, NamedFieldPuns #-}+module SoccerFun.Referee.Ivanov where++import SoccerFun.Prelude+import SoccerFun.Ball+import SoccerFun.Geometry+import SoccerFun.MatchControl+import SoccerFun.Player+import System.Random+import SoccerFun.Referee+import SoccerFun.Team+import SoccerFun.Types+import Data.List+import Control.Monad.Identity+import Data.Maybe+import SoccerFun.Field+++chanceOfPenaltySuccess	= 0.3+chanceOfSchwalbeSuccess	= 0.7+chanceOfTheaterSuccess	= 0.8+chanceOfCatchSuccess	= 0.5+healthInaccurateFactor	= 1.0 -- (is multiplied with 0.5)+nearEventRadius			= 10.0+replaceDistance			= 5.0++--ivanovPics ∷ [Path]+--ivanovPics		= map inDir [ "IvanovWarning"+--	                        , "ivanovYellow"+--	                        , "ivanovRed"+--	                        , "ivanovBadluck"+--	                        , "ivanovWijstLinks"+--	                        , "ivanovWijstRechts"+--	                        , "ivanovBadluck"+--	                        , "ivanovFluit"+--	                        , "ivanovFluit"+--	                        , "ivanovTheater"+--	                        ]+--	where+--	inDir img	= "afbeeldingen|"<+++img<+++".bmp"++ivanovReferee ∷ Field → Team → Team → Referee+ivanovReferee field t1 t2 = Referee { rname  = "Ivanov"+				      , rbrain = Brain { m   = mkIvanovLongTermMemory t1 t2+				                , ai  = refBrainIvanov field+				                }+--				      , refActionPics = ivanovPics+				      }++--	Memory that is passed around for the referee+data IvanovLongTermMemory =	IvanovLongTermMemory { lastRoundTackles			∷ [TackleAction]+							, inOffsidePosition			∷ [PlayerID]+							, keeper1HadBall			∷ Bool							-- True iff keeper of Team1 had ball in previous round+							, keeper2HadBall			∷ Bool							-- True iff keeper of Team2 had ball in previous round+							, prevHealthPlayers			∷ AssocList PlayerID Health	-- the health of the players in previous round+							, lastKickedTheBall			∷ Maybe PlayerID+							, ballIsFor					∷ Maybe ATeam+							, offsidePossible			∷ FreeKickCountdownForOffside -- because of a certain type of free kick+							, typeOfKickoff				∷ Maybe RefereeAction+							, waitingForSideSkipping	∷ (Bool,Int)+							, firstKick					∷ Maybe ATeam+							, gameLength				∷ Maybe Float+							, receivedYellow			∷ [PlayerID]+							, initialTeams ∷ (Team,Team) -- to restore initial positions after kick-off.+							}+type TackleAction		= (Victim,Offender,Velocity)+type Victim				= (PlayerID,Position,Health)	-- Victim   of a tackle+type Offender			= (PlayerID,Position,Health)	-- Offender of a tackle++{-	KickForcedByReferee : The next kick should be a kick that is appointed by the referee and therefor can not be offside+	FreeToKick :          The first gain or kick after a free kick; can not be offside+	OffsidePossible :     It is possible that you are standing offside+-}+data FreeKickCountdownForOffside+	= OffsidePossible+	| FreeToKick+	| KickForcedByReferee+instance Eq FreeKickCountdownForOffside where+	(==) OffsidePossible     OffsidePossible		= True+	(==) FreeToKick          FreeToKick				= True+	(==) KickForcedByReferee KickForcedByReferee	= True+	(==) _                   _						= False++lowerOffsideCounter ∷ IvanovLongTermMemory → IvanovLongTermMemory+lowerOffsideCounter longMem+	= (longMem) { typeOfKickoff   = Nothing+	           , offsidePossible = if ((offsidePossible longMem) == KickForcedByReferee) then FreeToKick else OffsidePossible+	  }++--	Memory used within one timeslice. Is discarded every round.+data IvanovShortTermMemory =	IvanovShortTermMemory { gameStoppedForTackle	∷ Bool+							, punished				∷ [PunishedPlayer]+							, penalty				∷ [(ATeam,Reason)]+							, thisRoundTackles		∷ [TackleAction]+							, myMood				∷ Mood+							, offsideAndTouchedBall	∷ Maybe PlayerID+							, ballKickedOrHeaded	∷ Bool+							}+type PunishedPlayer		= (PlayerID,PunishedScore,[Reason])+type PunishedScore		= Int 	-- < 0 points is probably nothing+									-- 1-2 points is probably warning+									-- 3-4 points is probably yellow+									-- > 4 points is probably red++--	Reason of punishments+data Reason				= Rtackle+						| Roffside+						| Rtheater+						| Rschwalbe+						| Rhands+						| RdangerousPlay+						| RillegalBallPossession+	deriving Eq++mkIvanovShortTermMemory ∷ Mood → IvanovShortTermMemory+mkIvanovShortTermMemory m = IvanovShortTermMemory { gameStoppedForTackle  = False+							, punished              = []+							, penalty               = []+							, thisRoundTackles      = []+							, myMood                = m+							, offsideAndTouchedBall = Nothing+							, ballKickedOrHeaded    = False+							}++type Mood		= Float			-- Random factor used to randomly pick action when Ivanov is not sure about what happened+++mkIvanovLongTermMemory ∷ Team → Team → IvanovLongTermMemory+mkIvanovLongTermMemory t1 t2 = IvanovLongTermMemory { lastRoundTackles			= []+						 , inOffsidePosition		= []+						 , keeper1HadBall			= False+						 , keeper2HadBall			= False+						 , prevHealthPlayers		= []+						 , lastKickedTheBall		= Nothing+						 , ballIsFor				= Nothing+						 , offsidePossible			= OffsidePossible+						 , typeOfKickoff			= Nothing+						 , waitingForSideSkipping	= (False, zero)+						 , firstKick				= Nothing+						 , gameLength				= Nothing+						 , receivedYellow			= []+						 , initialTeams = (t1,t2)+						 }++--	Has #param2 done something naughty? In other words, is #param2 known in the list provided as #param1?+getNaughtyPlayer ∷ [PunishedPlayer] → PlayerID → Maybe PunishedPlayer+getNaughtyPlayer punished fbID'+	= case [pun | pun@(fbID,_,_) ← punished, fbID == fbID'] of+		(pun:_)		→ Just pun+		_			→ Nothing++--	Punish baller, if he then was else already punished before, punish him more, otherwise just punish him. Do not make duplicates.+punishMore ∷ Reason → Player → PunishedScore → IvanovShortTermMemory → IvanovShortTermMemory+punishMore reason fb score shortMem+	= (shortMem) { punished = newPunished}+	where+	newPunished	= case break' (\(fbID,_,_) → identifyPlayer fbID fb) (punished shortMem) of+						(before,[p],after)	→ unbreak (before,[addPunishScore reason score p],after)+						(before,[],[])		→ before ++ [((playerID fb),score,[reason])]+						otherwise			→ error "punishMore: short term memory (punished) contains duplicate entries.\n"++--	Give the baller a higher punishscore and add the reason if he then was else not punished before for the same reason+addPunishScore ∷ Reason → PunishedScore → PunishedPlayer → PunishedPlayer+addPunishScore reason newScore (fbID,score,reasons)+	= (fbID,score+newScore,nub (reasons ++ [reason]))++successfulActions ∷ Team → [PlayerWithEffect]+successfulActions players				= map (\Player {effect,playerID} → (effect,playerID)) players++--	How this referee thinks about the match and come to his conclusions.+refBrainIvanov ∷ Field → PlayingTime → TimeUnit → BallState → Half → Team → Team → (IvanovLongTermMemory,StdGen)+                                                                     → ([RefereeAction], (IvanovLongTermMemory,StdGen))+refBrainIvanov field time dt ballState half team1 team2 (longTermMemory,seed) = runIdentity $ do+	longTermMemory					← return $ if (isJust (gameLength longTermMemory)) then longTermMemory else (longTermMemory) { gameLength = Just time}+	-- filter actions (what mean actions do I notice and what not)+	(team1Actions,seed)				← return $ filterOutMeanActions allPlayers (successfulActions team1) seed+	-- filter actions team2+	(team2Actions,seed)				← return $ filterOutMeanActions allPlayers (successfulActions team2) seed+	-- look into the consequences of last round tackles+	(p,seed)							← return $ random (seed ∷ StdGen)+	(shortTermMemory, seed)			← return $ analyseTackles (mkIvanovShortTermMemory p) team1Actions team2Actions (lastRoundTackles longTermMemory) seed+	-- analyse the taken actions+	(shortTermMemory,longTermMemory)	← return $ analyseActions Team1 team1Actions shortTermMemory longTermMemory+	(shortTermMemory,longTermMemory)	← return $ analyseActions Team2 team2Actions shortTermMemory longTermMemory++	-- check for other people who are on the ground (for some mysterious reason)+	shortTermMemory					← return $ analysePeopleOnTheGround (receivedYellow longTermMemory) shortTermMemory team1 team2++	-- give end-verdict of this round+	(conclusions,longTermMemory)		← return $ drawConclusions shortTermMemory longTermMemory+	return (conclusions,(longTermMemory,seed))+	where+	allPlayers							= team1 ++ team2+	theBall								= getBall ballState allPlayers++	-- though teams are returned, only positions AND directions will be altered by a Displace-action+	replacePlayers ∷ Team → Team → RefereeAction → Field → Ball → IvanovLongTermMemory → Displacements+	replacePlayers team1 team2 kickAction field theBall longTermMemory+		| isForKeeper kickAction Team1				= replaceFielders team1 posi ++ replaceTeam     team2 posi+		| isForKeeper kickAction Team2				= replaceTeam     team1 posi ++ replaceFielders team2 posi+		| isCenterKick kickAction = let+				kickOffTeam1 = [(playerID,pos) | Player {playerID,pos} ← fst (initialTeams longTermMemory)]+				kickOffTeam2 = [(playerID,pos) | Player {playerID,pos} ← snd (initialTeams longTermMemory)]+			in let ng+				| half == FirstHalf						= kickOffTeam1 ++ kickOffTeam2+				| otherwise								= map (\(fbID,pos) → (fbID,mirror field pos)) (kickOffTeam1 ++ kickOffTeam2)+			in ng+		| isForTeam kickAction Team1				= replaceExceptPlayerCloseToPos team1 posi ++ replaceTeam team2 posi+		| otherwise									= replaceTeam team1 posi ++ replaceExceptPlayerCloseToPos team2 posi+		where+		posi											= case getKickPos field half kickAction of+														Just p	→ p+														nothing	→ (pxy (ballPos theBall))++		replaceTeam ∷ Team → Position → Displacements+		replaceTeam team posi						= replacePlayers' posi replaceDistance team++		replaceFielders ∷ Team → Position → Displacements+		replaceFielders team posi					= replacePlayers' posi replaceDistance (filter isFielder team)++		replaceExceptPlayerCloseToPos ∷ Team → Position → Displacements+		replaceExceptPlayerCloseToPos team posi		= replacePlayers' posi replaceDistance (filter (not . (identifyPlayer (playerID closestPlayer))) team)+			where+			closestPlayer							= getClosestPlayer team posi (nameOf team)++		isForKeeper ∷ RefereeAction → ATeam → Bool+		isForKeeper (GoalKick team) theTeam			= team==theTeam+		isForKeeper _ _								= False++		isForTeam ∷ RefereeAction → ATeam → Bool+		isForTeam (DirectFreeKick team1 _) team2	= team1==team2+		isForTeam (GoalKick       team1)   team2	= team1==team2+		isForTeam (Corner         team1 _) team2	= team1==team2+		isForTeam (ThrowIn        team1 _) team2	= team1==team2+		isForTeam (Penalty        team1)   team2	= team1==team2+		isForTeam (CenterKick     team1)   team2	= team1==team2+		isForTeam _ _								= True++		getClosestPlayer ∷ [Player] → Position → String → Player+		getClosestPlayer []  posi err  				= error ("getClosestPlayer: no player to pick from " ++ err)+		getClosestPlayer fbs posi error				= foldr1 (isCloser posi) fbs+			where+			isCloser ∷ Position → Player → Player → Player+			isCloser posi fb1@Player {pos=pos1} fb2@Player {pos=pos2}+				| dist posi pos1 <= dist posi pos2	= fb1+				| otherwise							= fb2++		replacePlayers' ∷ Position → Float → [Player] → Displacements+		replacePlayers' posi radius players			= [displace (dist (pos fb) posi) fb | fb ← players, dist (pos fb) posi < radius]+			where+			displace dist fb						= ((playerID fb),newPos)+				where+				newPos								= if (dist <= 0.1*radius)+													     then (alterPos (movePoint (scaleVector radius RVector {dx=cos (dist*2.0*pi),dy=sin (dist*2.0*pi)}) posi))+													     else (alterPos (movePoint (scaleVector radius RVector {dx=cos angle,        dy=sin angle})         posi))+				angle								= atan (((py (pos fb)) - (py posi)) / ((px (pos fb)) - (px posi)))++		--	corrects when players are placed beyond the borders of the field+			alterPos ∷ Position → Position+			alterPos mypos+				| (px mypos) >= (flength field)			= alterPos' (Just ((flength field) - one)) Nothing mypos posi+				| (px mypos) <= zero					= alterPos' (Just one) Nothing mypos posi+				| (py mypos) >= (fwidth field)			= alterPos' Nothing (Just ((fwidth field) - one)) mypos posi+				| (py mypos) <= zero					= alterPos' Nothing (Just one) mypos posi+				| otherwise							= mypos+				where+				alterPos' ∷ (Maybe XPos) → (Maybe YPos) → Position → Position → Position+				alterPos' xpos ypos myPos middlePos+					| isJust xpos && isJust ypos	= Position { px = fromJust xpos, py = fromJust ypos }+					| isJust xpos					= let amount = abs (fromJust xpos - (px myPos)) in Position { px = fromJust xpos+													  , py = if ((py myPos) > (py middlePos))+													            then (if ((py myPos) < (fwidth field) - amount)+													                then ((py myPos) + amount)+													                else ((py myPos) - amount - 2.0*distY)+													            )+													            else (if ((py myPos) > amount)+													                then ((py myPos) - amount)+													                else ((py myPos) + amount + 2.0*distY)+													            )+													  }+					| isJust ypos					= let amount = abs (fromJust ypos - (py myPos)) in Position { py = fromJust ypos+													  , px = if ((px myPos) > (px middlePos))+													            then (if ((px myPos) + amount < (flength field))+													                then ((px myPos) + amount)+													                else ((px myPos) - amount - 2.0*distX)+													            )+													            else (if ((px myPos) > amount)+													                then ((px myPos) - amount)+													                else ((px myPos) + amount + 2.0*distX)+													            )+													  }+					| otherwise						= myPos+					where+					distY							= abs ((py myPos) - (py middlePos))+					distX							= abs ((px myPos) - (px middlePos))++	analyseTackles ∷ IvanovShortTermMemory → [PlayerWithEffect] → [PlayerWithEffect] → [TackleAction] → StdGen → (IvanovShortTermMemory,StdGen)+	--	were there any tackles in the last round?? NO+	analyseTackles shortTermMemory _ _ [] seed+		= (shortTermMemory,seed)+	--	YES: there were tackles last round, whistle for that and ignore all other irrelative events+	analyseTackles shortTermMemory team1Actions team2Actions (((victim@PlayerID {playerNo=vNmbr},victimPos,victimHealth), (offender@PlayerID {clubName=oCn,playerNo=oNmbr},offenderPos,offenderHealth), velo) : _) seed = runIdentity $ do	-- PA: hmmm, tl of tackles are ignored here.+		offendersTeam					← return $ if (nameOf team1 == oCn) then Team1 else Team2+		Just victimNow					← return $ find (identifyPlayer victim)   allPlayers+		Just offenderNow					← return $ find (identifyPlayer offender) allPlayers+		shortTermMemory				← return $ (shortTermMemory) { gameStoppedForTackle = True}+	--	was the ball near the tackle event(s)+		punishScore					← return $ if (dist (pxy (ballPos theBall)) offenderPos <= 6.0) then 2 else 1				-- ball was near tackle event(s)+										    ++										  if (vNmbr==1) then 5 else (if (velo >= 6.0) then 3 else 2)							-- penalty for keeper victim is highest+	--	victim is playing theater?+		actionOfVictim				← return $ case concat [maybeToList fa | (fa,fbId) ← if (offendersTeam==Team1) then team2Actions else team1Actions, identifyPlayer fbId victimNow] of+											(fa:_)	→ Just fa+											_		→ Nothing+	--	what is the damage to the victim?+		healthDrop					← return $ victimHealth - (health victimNow) + (p-0.5)* healthInaccurateFactor+	--	is the victim making theater?+		victimPunishScore				← return $ if (isJust actionOfVictim) then (if (isPlayedTheater (fromJust actionOfVictim)) then 3 else 0) else 0+	--	victim is not playing theater?+		punishScore					← return $ if (victimPunishScore == 0)+											then (definePunishmentOnHealthDrop healthDrop punishScore)+											else punishScore+	--	was the ball on 20% part of the field to the offender's own goal?+		ballWasNearGoal				← return $  half == FirstHalf  && oCn == nameOf team1 && ((px (pxy (ballPos theBall))) >= 0.8 * (flength field) || (px (pxy (ballPos theBall))) <= 0.2 * (flength field))+										|| half == SecondHalf && oCn == nameOf team2 && ((px (pxy (ballPos theBall))) >= 0.8 * (flength field) || (px (pxy (ballPos theBall))) <= 0.2 * (flength field))+		ballWasInPenaltyArea			← return $  oCn == nameOf team1 && inPenaltyArea field (opponentHome Team2 half) (pxy (ballPos theBall))+										|| oCn == nameOf team2 && inPenaltyArea field (opponentHome Team1 half) (pxy (ballPos theBall))+		punishScore					← return $ punishScore + if ballWasNearGoal then 1 else 0+		shortTermMemory				← return $ if ballWasInPenaltyArea+											then (shortTermMemory) { penalty = (penalty shortTermMemory) ++ [(offendersTeam,Rtackle)]}+											else shortTermMemory+		offenderFromSMemory			← return $ getNaughtyPlayer (punished shortTermMemory) offender+		victimFromSMemory				← return $ getNaughtyPlayer (punished shortTermMemory) victim+		offenderVerdict				← return $ if (isJust offenderFromSMemory)+											then (addPunishScore Rtackle punishScore (fromJust offenderFromSMemory))+											else (offender,punishScore,[Rtackle])+		victimVerdict					← return $ if (isJust victimFromSMemory)+											then (addPunishScore Rtheater victimPunishScore (fromJust victimFromSMemory))+											else (victim,victimPunishScore,[Rtheater])+		return $ if (snd3 offenderVerdict == 0)+			then if (snd3 victimVerdict == 0)+				then (shortTermMemory,seed1)+				else ((shortTermMemory) { punished = (punished shortTermMemory) ++ [victimVerdict]},seed1)+			else if (snd3 victimVerdict == 0)+				then ((shortTermMemory) { punished = (punished shortTermMemory) ++ [offenderVerdict]},seed1)+				else ((shortTermMemory) { punished = (punished shortTermMemory) ++ [offenderVerdict,victimVerdict]},seed1)+		where+		(p,seed1)						= random seed++		definePunishmentOnHealthDrop ∷ Float → Int → Int+		definePunishmentOnHealthDrop healthDrop punishScore+			| healthDrop < 0.5			= punishScore+			| 0.5 <= healthDrop && healthDrop <= 1.5+										= punishScore + 1+			| 1.5 < healthDrop && healthDrop <= 3.5+										= punishScore + 2+			| otherwise					= punishScore + 3++	analyseActions ∷ ATeam → [PlayerWithEffect] → IvanovShortTermMemory → IvanovLongTermMemory+	                                             → (IvanovShortTermMemory,IvanovLongTermMemory)+	analyseActions team [] shortTermMemory longTermMemory+		= (shortTermMemory,(longTermMemory) { lastRoundTackles = []})+	analyseActions team (action@(fa,PlayerID {clubName=cn,playerNo=nmbr}):actions) shortTermMemory longTermMemory+	--	Am I in the pause between the first and the second half (long enough to allow switching of sides)+		| fst (waitingForSideSkipping longTermMemory) = runIdentity $ do+			let ng+				| snd (waitingForSideSkipping longTermMemory) <= zero+					= (shortTermMemory,(longTermMemory) { waitingForSideSkipping = (False,zero)})+				| otherwise+					= (shortTermMemory,(longTermMemory) { waitingForSideSkipping = (True,snd (waitingForSideSkipping longTermMemory)-one)})+			return ng+	--	did I stop the game because of tackle-actions?+		| (gameStoppedForTackle shortTermMemory) = runIdentity $ do+			let ng+			--	No more analysing game, but still look at mean actions with a connection to the tackle(s)+				| perhaps isSchwalbed fa+					= let ng+						|  isTackleVictim   (playerID taf) (lastRoundTackles longTermMemory)	-- was he victim+						|| isTackleOffender (playerID tef) (lastRoundTackles longTermMemory)	-- or offender+						|| nearLastRoundTackle (pos fb) (lastRoundTackles longTermMemory)		-- or near a tackle?+							= let ng+								| inPenaltyArea field (opponentHome team half) (pos fb)			-- was it in penaltyarea?+									= analyseActions team actions (shortTermMemory) { penalty = (penalty shortTermMemory) ++ [(team,Rschwalbe)]} longTermMemory+								| otherwise														-- punish him or punish him more+									= analyseActions team actions (punishMore Rschwalbe tef 1 shortTermMemory) longTermMemory+							in ng+						| otherwise															-- otherwise ignore+							= analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+					in ng+				| perhaps isPlayedTheater fa+					= let ng+						|  isTackleOffender (playerID tef) (lastRoundTackles longTermMemory)	-- was he offender+						|| nearLastRoundTackle (pos fb) (lastRoundTackles longTermMemory)		-- or near a tackle+						&& not (isTackleVictim (playerID taf) (lastRoundTackles longTermMemory))-- and is not a victim+							= let ng+								| inPenaltyArea field (opponentHome team half) (pos fb)			-- was it in penaltyarea?+									= analyseActions team actions (shortTermMemory) { penalty = (penalty shortTermMemory) ++ [(team,Rtheater)]} longTermMemory+								| otherwise+									= analyseActions team actions (punishMore Rtheater tef 1 shortTermMemory) longTermMemory+							in ng+					--	victims are already scanned during tackle analyses to see if it then was else worth to check the health of the victim+						| otherwise															-- otherwise ignore+							= analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+					in ng+				| perhaps isTackled fa+					= let ng+						|  isTackleVictim   (playerID taf) ((lastRoundTackles longTermMemory))	-- was he victim+						|| isTackleOffender (playerID tef) ((lastRoundTackles longTermMemory))	-- or offender+						|| nearLastRoundTackle (pos fb) (lastRoundTackles longTermMemory)		-- or near a tackle?+							= let ng+								| inPenaltyArea field (opponentHome team half) (pos fb)			-- was it in penaltyarea?+									= analyseActions team actions (shortTermMemory) { penalty = (penalty shortTermMemory) ++ [(team,Rschwalbe)]} longTermMemory+								| otherwise														-- punish him or punish him more+									= analyseActions team actions (punishMore Rtackle tef 2 shortTermMemory) longTermMemory+							in ng+						--otherwise ignore+					--	Usually ignore, but: a tackle is something serious... when I'm in a bad mood, I will not ignore this one+						| (myMood shortTermMemory) > 0.8+							= let ng+								| inPenaltyArea field (opponentHome team half) (pos fb)			-- was it in penaltyarea?+									= analyseActions team actions (shortTermMemory) { penalty = (penalty shortTermMemory) ++ [(team,Rschwalbe)]} longTermMemory+								| otherwise+									= analyseActions team actions (punishMore Rtackle tef 3 shortTermMemory) longTermMemory+							in ng+						| otherwise															-- player was lucky...+							= analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+					in ng+				| perhaps isCaughtBall fa+					= let ng+						| isKeeper tef && inKeeperSpot tef team1Name currHome field			-- is he a keeper?+							= analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+						|  isTackleVictim   (playerID taf) (lastRoundTackles longTermMemory)	-- was he victim+						|| isTackleOffender (playerID tef) (lastRoundTackles longTermMemory)	-- or offender+						|| nearLastRoundTackle (pos fb) (lastRoundTackles longTermMemory)		-- or near a tackle?+							= let ng+								| inPenaltyArea field (opponentHome team half) (pos fb)			-- was it in penaltyarea?+									= analyseActions team actions (shortTermMemory) { penalty = (penalty shortTermMemory) ++ [(team,Rschwalbe)]} longTermMemory+								| otherwise														-- punish him or punish him more+									= analyseActions team actions (punishMore Rhands tef 2 shortTermMemory) longTermMemory+							in ng+						| otherwise															-- otheriwse ignore+							= analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+					in ng+			--	All other kind of actions are ignored+				| otherwise+					= analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+			return ng+	--	There were no tackle-actions last round → Ivanov needs to keep thinking+	--	Everyone is free to move over the field+		| perhaps isMoved fa || perhaps isFeinted fa+			= analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+	--	Gainball is illegal when in offside position+	--	A legal gainBall causes no one to be in offside position (until a kick- or headball event)+		| perhaps isGainedBall fa = runIdentity $ do+			longTermMemory		← return $ if (isNothing (firstKick longTermMemory)) then (longTermMemory) { firstKick = Just team} else longTermMemory+		--	He was not allowed to get the ball (because of referee-action in the previous round)+			if not (wasAllowedToGetBall (ballIsFor longTermMemory) (nameOf team1) (nameOf team2) cn)+				then return $ analyseActions team actions (punishMore RillegalBallPossession tef 1 shortTermMemory) longTermMemory+				else do+					longTermMemory		← return $ (longTermMemory) { ballIsFor = Nothing}+				--	He was in offside position+					return $ if elem (playerID tef) (inOffsidePosition longTermMemory) && (offsidePossible longTermMemory) == OffsidePossible+					--	Detect offside for wistle+						then analyseActions team actions (punishMore Roffside tef 0 shortTermMemory) { offsideAndTouchedBall=Just (playerID tef)} longTermMemory+						else analyseActions team actions shortTermMemory (longTermMemory) { inOffsidePosition = []}+	--	{Kick/Head}Ball is illegal when in offside position (ball was not gained)+		| perhaps isKickedBall fa || perhaps isHeadedBall fa = runIdentity $ do+			longTermMemory		← return $ if (isNothing (firstKick longTermMemory)) then (longTermMemory) { firstKick = Just team} else longTermMemory+			shortTermMemory		← return $ (shortTermMemory) { ballKickedOrHeaded = True}+		--	He was not allowed to get the ball+			return $ if not (wasAllowedToGetBall (ballIsFor longTermMemory) (nameOf team1) (nameOf team2) cn)+				then analyseActions team actions (punishMore RillegalBallPossession tef 1 shortTermMemory) longTermMemory+				else runIdentity $ do+					longTermMemory		← return $ (longTermMemory) { ballIsFor = Nothing}+					return $ if elem (playerID tef) (inOffsidePosition longTermMemory) && (offsidePossible longTermMemory) == OffsidePossible	-- detect offside for wistle+						then analyseActions team actions (punishMore Roffside tef 0 shortTermMemory) { offsideAndTouchedBall=Just (playerID tef)} longTermMemory+						else runIdentity $ do+						--	A legal {Kick/Head}Ball may be illegal/dangerous play when ball was gained by keeper+							(team1Name,currHome)	← return $ if (half == FirstHalf) then (nameOf team1,West) else (nameOf team1,East)+							keeper1HadBall		← return $+								let keepers = filter isKeeper team1+								    keeper  = head keepers+								in not (null keepers) && ballIsGainedBy (playerID keeper) ballState && inKeeperSpot keeper team1Name currHome field && (keeper1HadBall longTermMemory)+							keeper2HadBall		← return $+								let keepers = filter isKeeper team2+								    keeper  = head keepers+								in not (null keepers) && ballIsGainedBy (playerID keeper) ballState && inKeeperSpot keeper team1Name currHome field && (keeper2HadBall longTermMemory)+							if keeper1HadBall && nmbr/=1 || keeper2HadBall && nmbr/=1+								then return $ analyseActions team actions (punishMore RdangerousPlay tef 5 shortTermMemory) longTermMemory+								else do+								--	A legal {Kick/Head}Ball may put people in a potential offside position+									longTermMemory				← return $ (longTermMemory) { lastKickedTheBall = Just (playerID tef)}+									(homeOfTeam1,homeOfTeam2)		← return $ if (half == FirstHalf) then (West,East) else (East,West)+									if team == Team1+										then do+											closestDefenderTeam2Xpos	← return $ offsideline field homeOfTeam2 theBall team2+											inOffsidePos				← return $ getOffsidePlayers field homeOfTeam1 closestDefenderTeam2Xpos (removeMember tef team1)+											return $ analyseActions team actions shortTermMemory (longTermMemory) { inOffsidePosition = inOffsidePos}+										else do+											closestDefenderTeam1Xpos	← return $ offsideline field homeOfTeam1 theBall team1+											inOffsidePos				← return $ getOffsidePlayers field homeOfTeam2 closestDefenderTeam1Xpos (removeMember tef team2)+											return $ analyseActions team actions shortTermMemory (longTermMemory) { inOffsidePosition = inOffsidePos}+		| perhaps isTackled fa = runIdentity $ do+		--	Store him, so we can look next round at the damage of the victim+			(victimID,ve)		← return $ case fromJust fa of (Tackled victimID ve _) → (victimID,ve)+			moreTackles		← return $ case filter (identifyPlayer victimID) (team1++team2) of+									(fb:_)	→ [(((playerID fb),(pos fb),(health fb)),((playerID tef),(pos tef),(health tef)),ve)]+									none	→ []+			shortTermMemory	← return $ (shortTermMemory) { thisRoundTackles = (thisRoundTackles shortTermMemory) ++ moreTackles}+			return $ analyseActions team actions shortTermMemory longTermMemory+		| perhaps isSchwalbed fa = runIdentity $ do+			opponents			← return $ if (team == Team1) then team2 else team1+			opponentNear		← return $ not (null [posi | Player {pos=posi} ← opponents, dist (pos fb) posi <= 5.0])+			ballNear			← return $ dist (zero) { pxy=(pos fb)} (ballPos theBall) <= 10.0+			shortTermMemory	← return $ if (inPenaltyArea field (opponentHome team half) (pos fb))	-- In penaltyarea?+									 then (shortTermMemory) { penalty = (penalty shortTermMemory) ++ [(team,Rschwalbe)]}+								 else (if (opponentNear && ballNear)								-- Was an opponent near and was the ball near? Then punish else 4+								     then (punishMore Rschwalbe tef 4 shortTermMemory)+								 else (if ballNear												-- Was the ball near? Then punish else 2+								     then (punishMore Rschwalbe tef 2 shortTermMemory)+								 else (if opponentNear											-- Was an opponent near? Then punish else 3+								     then (punishMore Rschwalbe tef 3 shortTermMemory)+								     else (punishMore Rschwalbe tef 1 shortTermMemory)+								 )))+			return $ analyseActions team actions shortTermMemory longTermMemory+		| perhaps isCaughtBall fa = runIdentity $ do+			longTermMemory	← return $ if (isNothing (firstKick longTermMemory)) then (longTermMemory) { firstKick = Just team} else longTermMemory+			return $ if isKeeper tef && inKeeperSpot tef team1Name currHome field		-- is he a keeper (todo: and located in his penaltyarea (for everything, gaining ball, etc.)+				then analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+				else runIdentity $ do+					shortTermMemory	← return $ if (inPenaltyArea field (opponentHome team half) (pxy (ballPos theBall)))+								     	  	  then (punishMore Rhands tef 2 shortTermMemory) { penalty = (penalty shortTermMemory) ++ [(team,Rhands)]}+								     	  	  else (punishMore Rhands tef 4 shortTermMemory)+					return $ analyseActions team actions shortTermMemory longTermMemory+	-- theater, but no tackle or schwalbe was seen, so theater will be punished lightly+		| perhaps isPlayedTheater fa+			= analyseActions team actions (punishMore Rtheater tef 1 shortTermMemory) longTermMemory+	-- unknown action+		| otherwise+			= analyseActions team actions shortTermMemory longTermMemory--ignoreThisAction+		where+		(team1Name,currHome)	= if (half==FirstHalf) then (nameOf team1,West) else (nameOf team1,East)+		Just tef						= find (identifyPlayer PlayerID {clubName=cn,playerNo=nmbr}) allPlayers+		taf						= tef+		fb						= taf++		ignoreThisAction		= analyseActions team actions shortTermMemory longTermMemory++		wasAllowedToGetBall ∷ (Maybe ATeam) → ClubName → ClubName → ClubName → Bool+		wasAllowedToGetBall Nothing _ _ _			= True+		wasAllowedToGetBall (Just team) team1 team2 myTeam+			| team == Team1		= team1 == myTeam+			| otherwise			= team2 == myTeam++	analysePeopleOnTheGround ∷ [PlayerID] → IvanovShortTermMemory → Team → Team → IvanovShortTermMemory+	analysePeopleOnTheGround receivedYellow shortMem team1 team2+		| (gameStoppedForTackle shortMem)		-- have I stopped the game already for a tackle+			= shortMem+		| otherwise+			= analysePeopleOnTheGround' receivedYellow shortMem [fb | fb ← team1 ++ team2, lastEventIsOnTheGround (effect fb)]+		where+		lastEventIsOnTheGround ∷ (Maybe PlayerEffect) → Bool+		lastEventIsOnTheGround es	= isJust es && isOnTheGround (fromJust es)++		analysePeopleOnTheGround' ∷ [PlayerID] → IvanovShortTermMemory → [Player] → IvanovShortTermMemory+		analysePeopleOnTheGround' _ shortMem []+											= shortMem+		analysePeopleOnTheGround' receivedYellow shortMem (fb@Player {playerID=PlayerID {clubName=cn}}:tefls) = runIdentity $ do+		--	how many opponents could have tackled him+			suspects						← return $ [s | s ← team1 ++ team2, dist (pos fb) (pos s) <= maxTackleReach s]+			healthDrop					← return $ case lookup (playerID fb) (prevHealthPlayers longTermMemory) of+												Just prevHealth		→ (health fb) - prevHealth+												none				→ zero+			motive4Schwalbe				← return $ ballDirectionIsTowardsGoal && ballNear+			goodMotive4Schwalbe			← return $ motive4Schwalbe && ballWasInPenaltyAreaOpponent+			schwalbeThreshold				← return $ if motive4Schwalbe+												then if goodMotive4Schwalbe+													then if victimReprimandedBefore then (0.5,0.4 ) else (0.3,0.25)+													else if victimReprimandedBefore then (0.2,0.17) else (0.1,0.08)+												else if victimReprimandedBefore     then (0.1,0.08) else (-999.0,-999.0)+			schwalbeThreshold				← return $ if (length suspects > 1)+											     then (fst schwalbeThreshold * 0.5, snd schwalbeThreshold * 0.5)+											     else schwalbeThreshold+			if not (null suspects)		-- tackle or schwalbe??+				then do+					primarySuspect			← return $ suspects !! ((length suspects * (round ((myMood shortMem) * 10.0))) `mod` (length suspects) )+					isNoOtherDefenderLeft		← return $ if (cn == nameOf team1 && half==FirstHalf || cn == nameOf team2 && half==SecondHalf)+												 	 then (null [fb | fb ← filter isFielder team2, (px (pos fb)) > (px (pos primarySuspect))])+												 	 else if (cn == nameOf team1 && half==SecondHalf || cn == nameOf team2 && half==FirstHalf)+												 	 	 then (null [fb | fb ← filter isFielder team2, (px (pos fb)) < (px (pos primarySuspect))])+													 	 else (error "primary suspect of possible tackle does not play in one of the teams")+					opponentReprimandedBefore	← return $ elem (playerID primarySuspect) receivedYellow -- not (null (reprimands (events primarySuspect))) || (gotYellow (events primarySuspect))+					motive4Tackle				← return $ ballDirectionIsTowardsGoal && ballNear || ballGoingTowardsVictim+					goodMotive4Tackle			← return $ motive4Tackle && (isNoOtherDefenderLeft || goalVeryNear)+					tackleThreshold			← return $ if motive4Tackle+													then if goodMotive4Tackle+														then if opponentReprimandedBefore then (0.5,0.6 ) else (0.7,0.75)+														else if opponentReprimandedBefore then (0.8,0.83) else (0.9,0.92)+													else if opponentReprimandedBefore     then (0.9,0.92) else (999.0,999.0)+					shortMem					← return $ if ((myMood shortMem) >= fst tackleThreshold && (myMood shortMem) < snd tackleThreshold && healthDrop > 0.1)	-- Give yellow for tackle+											     	  then (punishMore Rtackle primarySuspect 3 shortMem)+											 	 else (if ((myMood shortMem) >= fst tackleThreshold)																-- Warn for tackle+											     	  then (punishMore Rtheater primarySuspect 1 shortMem)+											 	 else (if ((myMood shortMem) <= fst schwalbeThreshold && (myMood shortMem) > snd schwalbeThreshold && healthDrop > 0.1)-- then Give else yellow for schwalbe+											     	  then (punishMore Rschwalbe fb 3 shortMem)+											 	 else (if ((myMood shortMem) <= fst schwalbeThreshold)																-- Warn for schwalbe+											     	  then (punishMore Rschwalbe fb 1 shortMem)+											     	  else shortMem+											 	 )))+					return $ analysePeopleOnTheGround' receivedYellow shortMem tefls+				else do+					shortMem						← return $ if ((myMood shortMem) <= fst schwalbeThreshold && (myMood shortMem) > snd schwalbeThreshold && healthDrop > 0.1)	-- Warn good for schwalbe+											     	  	  then (punishMore Rschwalbe fb 2 shortMem)+											 	 	 else (if ((myMood shortMem) <= fst schwalbeThreshold)																	-- Warn for schwalbe+											     	  	  then (punishMore Rschwalbe fb 1 shortMem)+											     	  	  else shortMem+											 	 	 )+					return $ analysePeopleOnTheGround' receivedYellow shortMem tefls+			where+			goalVeryNear					= if (cn == nameOf team1 && half == FirstHalf  || cn == nameOf team2 && half == SecondHalf)+											     then (dist (pos fb) Position {px=(flength field),py=(fwidth field)/2.0} <= 20.0)	-- east goal+											 else (if (cn == nameOf team1 && half == SecondHalf || cn == nameOf team2 && half == FirstHalf)+											     then (dist (pos fb) Position {px=zero,py=(fwidth field)/2.0} <= 20.0)			-- west goal+											     else (error "fallen player is not from one of the teams"))+			ballNear						= dist (zero) { pxy=(pos fb)} (ballPos theBall) <= 8.0+			victimReprimandedBefore			= elem (playerID fb) receivedYellow+			ballWasInPenaltyAreaOpponent	= cn == nameOf team1 && inPenaltyArea field (opponentHome Team1 half) (pxy (ballPos theBall))+												||+											  cn == nameOf team2 && inPenaltyArea field (opponentHome Team2 half) (pxy (ballPos theBall))+			ballWasInPenaltyAreaSelf		= cn == nameOf team1 && inPenaltyArea field (opponentHome Team2 half) (pxy (ballPos theBall))+												||+											  cn == nameOf team2 && inPenaltyArea field (opponentHome Team1 half) (pxy (ballPos theBall))+			ballDirectionIsTowardsGoal		= if (cn == nameOf team1 && half == FirstHalf || cn == nameOf team2 && half == SecondHalf)+											     then ((direction (vxy (ballSpeed theBall))) > 0.5*pi && (direction (vxy (ballSpeed theBall))) < 1.5*pi)	-- to east ..+											 else (if (cn == nameOf team1 && half == SecondHalf || cn == nameOf team2 && half == FirstHalf)+											     then ((direction (vxy (ballSpeed theBall))) < 0.5*pi || (direction (vxy (ballSpeed theBall))) > 1.5*pi)	-- to west .. PA: odd, why use ..||.. here and ..&&.. immediately above?+											     else (error "fallen player is not from one of the teams"))+			ballGoingTowardsVictim			= nextBallPos (ballPos theBall) (ballSpeed theBall) ((pos fb),5.0,(height fb))++	drawConclusions ∷ IvanovShortTermMemory → IvanovLongTermMemory → ([RefereeAction],IvanovLongTermMemory)+	drawConclusions shortMem longMem = runIdentity $ do+		longMem							← return $ (longMem) { keeper1HadBall		= ballIsGainedBy PlayerID {playerNo=1,clubName=nameOf team1} ballState--all hasBall (filter isKeeper team1)+											           , keeper2HadBall		= ballIsGainedBy PlayerID {playerNo=1,clubName=nameOf team2} ballState--all hasBall (filter isKeeper team2)+											           , prevHealthPlayers	= map (\fb → ((playerID fb), (health fb))) (team1 ++ team2)+											  }+		teamPenalty						← return $ firstPenalty (penalty shortMem)+		offencePenalty					← return $ getMostImportantKickAction basicActions+		(kickAction,longMem)				← return $ if (isJust teamPenalty)    then (let t = fromJust teamPenalty    in (Just (Penalty t),(longMem) { ballIsFor     = Just t+											                                                                                              , typeOfKickoff = Just (Penalty t)}))+											 else (if (isJust offencePenalty) then (let p = fromJust offencePenalty in (offencePenalty, (longMem) { ballIsFor     = Just (actionForWhichTeam p)+											                                                                                              , typeOfKickoff = offencePenalty}))+											 else ((Nothing,longMem)+											 ))+		noticedActions					← return $ map fst basicActions+		longMem							← return $ if (isJust kickAction)           then (longMem) { offsidePossible = KickForcedByReferee}+											 else (if ((ballKickedOrHeaded shortMem)) then (lowerOffsideCounter longMem)+												                               else longMem+											 )+		if not (gameStoppedForTackle shortMem)		-- We haven't analysed tackles this round, it was a normal round+			then do+				refActions					← return $ case kickAction of+													Just kick		→ noticedActions ++ [DisplacePlayers (replacePlayers team1 team2 kick field theBall longMem)]+													_				→ noticedActions+				let ng+					| time <= (fromJust (gameLength longMem))/2.0 && half == FirstHalf			 = runIdentity $ do-- is it time to change half?+						longMem					← return $ (longMem) { waitingForSideSkipping = (True,150)}+						teamThatMayStartAtSecondHalf+													← return $ if (isJust (firstKick longMem))+														then (if ((fromJust (firstKick longMem)) == Team1) then Team2 else Team1)+														else Team2+						centerKick				← return $ CenterKick teamThatMayStartAtSecondHalf+						ds						← return $ mirrorTeams (replacePlayers team1 team2 centerKick field theBall longMem)+						return (refActions ++ [ContinueGame] ++ [EndHalf,centerKick,DisplacePlayers ds],(longMem) { ballIsFor = Just teamThatMayStartAtSecondHalf})++					| time <= zero						-- is it time to stop the game?+						= (refActions ++ [GameOver],longMem)+				--	Is the ball out of the lines and do we have: a goal, a corner, a goal kick, or a throw in+					| otherwise = runIdentity $ do+						(behindLineActions,longMem) ← return $ getBehindLinesActions half theBall field longMem+					--	No matter what happened, ball behind the line is ball behind the line+						if length behindLineActions > zero+							then do+								displacements				← return $ replacePlayers team1 team2 (last behindLineActions) field theBall longMem+								refActions				← return $ refActions ++ [DisplacePlayers displacements]+								return (refActions ++ [ContinueGame] ++ behindLineActions,(longMem) { offsidePossible = KickForcedByReferee})+							else do+								longMem						← return $ (longMem) { lastRoundTackles = (thisRoundTackles shortMem)}+							--	We have no new tackles for the next round+								let ng+									| null (thisRoundTackles shortMem) = runIdentity $ do+										let ng+											| isJust kickAction = runIdentity $ do+												kick					← return $ fromJust kickAction+												goalArea				← return $ kickActionIsFreeKickInPenaltyArea kick+												if isJust goalArea+													then do+														displacements		← return $ replacePlayers team1 team2 (fromJust goalArea) field theBall longMem+														return (refActions ++ [ContinueGame,DisplacePlayers displacements,fromJust goalArea],longMem)+													else return (refActions ++ [ContinueGame,kick],longMem)+											| otherwise+												= (refActions ++ [ContinueGame],longMem)+										return ng+								--	We have new tackles for the next round+									| otherwise+									= (refActions ++ [PauseGame,AddTime (1.0/30.0)],longMem)+								return ng+				return ng+	--	We have analysed tackles this round+			else+			--	We have a position to restart the game from+				if isJust kickAction+					then do+						kick						← return $ fromJust kickAction+						goalArea					← return $ kickActionIsFreeKickInPenaltyArea kick+						if isJust goalArea+							then do+								displacements			← return $ replacePlayers team1 team2 (fromJust goalArea) field theBall longMem+								return ([ContinueGame] ++ noticedActions ++ [DisplacePlayers displacements,fromJust goalArea],longMem)+							else do+								displacements				← return $ replacePlayers team1 team2 kick field theBall longMem+								return ([ContinueGame] ++ noticedActions ++ [DisplacePlayers displacements,kick],longMem)+			--	I still have to think about a new place to restart the game from+					else error "should have a position to restart the game from"+		where+		basicActions						= getAllBasicActions (receivedYellow longMem) shortMem++		mirrorTeams ∷ Displacements → Displacements+		mirrorTeams ds						= map (\(fbID,pos) → (fbID,mirror field pos)) ds++		kickActionIsFreeKickInPenaltyArea ∷ RefereeAction → Maybe RefereeAction+		kickActionIsFreeKickInPenaltyArea (DirectFreeKick team pos)+			| inPenaltyArea field (opponentHome team half) pos+				= Just (Penalty team)+			| inPenaltyArea field (teamHome team half) pos+				= Just (GoalKick team)+			| otherwise+				= Nothing+		kickActionIsFreeKickInPenaltyArea _+			= Nothing++		getBehindLinesActions ∷ Half → Ball → Field → IvanovLongTermMemory → ([RefereeAction],IvanovLongTermMemory)+		getBehindLinesActions half theBall field longMem@IvanovLongTermMemory {lastKickedTheBall}+			| (pxy (ballPos theBall)) == p			-- ball is not behind (see definition of pointToRectangle)+				= ([],longMem)+			| isNothing lastKickedTheBall		-- the ball got behind by unknown forces+				= ([CenterKick Team1],longMem)+			| (px (pxy (ballPos theBall))) < zero = runIdentity $ do		-- behind line West?+				(team,homeTeamWest)	← return $ if (half == FirstHalf) then (Team1,nameOf team1) else (Team2,nameOf team2)				-- first half?+				let ng+					| isbetween (py (pxy (ballPos theBall))) ((fwidth field)/2.0 - goalWidth/2.0) ((fwidth field)/2.0 + goalWidth/2.0)	-- goal?+						&&+				  	  (pz (ballPos theBall)) < goalHeight+						= if (team==Team1) then ([Goal Team2,CenterKick Team1],(longMem) { ballIsFor=Just Team1})+					                   	 else ([Goal Team1,CenterKick Team2],(longMem) { ballIsFor=Just Team2})+					| clubName (fromJust lastKickedTheBall) == homeTeamWest	= runIdentity $ do	-- lastPlayerKicked Team1?+						corner			← return $ if ((py (pxy (ballPos theBall))) > (fwidth field)/2.0) then South else North+						return ([Corner (other team) corner],(longMem) { ballIsFor = Just (other team)})+					| otherwise													-- opponent team → goalkick+						= ([GoalKick team],(longMem) { ballIsFor = Just team})+				return ng+			| (px (pxy (ballPos theBall))) > (flength field)= runIdentity $ do						-- behind line East?+				(team,homeTeamEast)	← return $ if (half == FirstHalf) then (Team2,nameOf team2) else (Team1,nameOf team1)+				let ng+					| isbetween (py (pxy (ballPos theBall))) ((fwidth field)/2.0 - goalWidth/2.0) ((fwidth field)/2.0 + goalWidth/2.0)	-- goal?+						&&+				  	  (pz (ballPos theBall)) < goalHeight+						= if (team==Team1) then ([Goal Team2,CenterKick Team1],(longMem) { ballIsFor=Just Team1})+					                   	 else ([Goal Team1,CenterKick Team2],(longMem) { ballIsFor=Just Team2})+					| clubName (fromJust lastKickedTheBall) == homeTeamEast	= runIdentity $ do	-- lastPlayerKicked Team1?+						corner			← return $ if ((py (pxy (ballPos theBall))) > (fwidth field)/2.0) then South else North+						return ([Corner (other team) corner],(longMem) { ballIsFor = Just (other team)})+					| otherwise+						= ([GoalKick team],(longMem) { ballIsFor = Just team})+				return ng+			| otherwise = runIdentity $ do+				throwin					← return $ if (clubName (fromJust lastKickedTheBall) == nameOf team1) then Team2 else Team1+				return ([ThrowIn throwin p],(longMem) { ballIsFor = Just throwin})+			where+			p							= pointToRectangle (zero,Position {px=(flength field),py=(fwidth field)}) (pxy (ballPos theBall))++	{-	Most important (in given order): Tackle, OwnBallIllegally, Offside, DangerousPlay, Hands+		Even: the rest+	-}	getMostImportantKickAction ∷ [(RefereeAction,RefereeAction)] → Maybe RefereeAction+		getMostImportantKickAction actions+			| null actions			= Nothing+			| otherwise					= Just resumeAction+			where+			(_,resumeAction)			= minimumBy (\(a1,r1) (a2,r2) → priority a1 `compare` priority a2) actions+			priority action				= if (isTackleDetected   action) then 5+										 else (if (isOwnBallIllegally action) then 4+										 else (if (isOffside          action) then 3+										 else (if (isDangerousPlay    action) then 2+										 else (if (isHands            action) then 1+										                                 else 0+										 ))))++		actionForWhichTeam ∷ RefereeAction → ATeam+		actionForWhichTeam (DirectFreeKick t _)		= t+		actionForWhichTeam (GoalKick       t)		= t+		actionForWhichTeam (Corner         t _)		= t+		actionForWhichTeam (ThrowIn        t _)		= t+		actionForWhichTeam (Penalty        t)		= t+		actionForWhichTeam (CenterKick     t)		= t+		actionForWhichTeam _						= error "actionForWhichTeam: kick action expected"++		getAllBasicActions ∷ [PlayerID] → IvanovShortTermMemory → [(RefereeAction,RefereeAction)]+		getAllBasicActions receivedYellow shortMem		= getAllBasicPunishActions receivedYellow (punished shortMem)+			where+		--	PA: this should really be programmed as a map→+			getAllBasicPunishActions ∷ [PlayerID] → [PunishedPlayer] → [(RefereeAction,RefereeAction)]+			getAllBasicPunishActions _ []		= []+			getAllBasicPunishActions receivedYellow ((fbID@PlayerID{clubName=cn},punish,[]):pals)+				| punish > 4+					= ((ReprimandPlayer fbID RedCard,DirectFreeKick otherTeam kickPos) : rest)+				| punish >= 3 = runIdentity $ do+					yellow					← return $ (ReprimandPlayer fbID YellowCard,DirectFreeKick otherTeam kickPos)+					red						← return $ (ReprimandPlayer fbID RedCard,   DirectFreeKick otherTeam kickPos)+					let ng+						| elem fbID receivedYellow+													= (yellow : red : rest)+						| otherwise					= (yellow : rest)+					return ng+				| punish >= 1					= ((ReprimandPlayer fbID Warning,DirectFreeKick otherTeam kickPos) : rest)+				| otherwise						= rest+				where+				kickPosHome						= if (cn == nameOf team1 && half == FirstHalf || cn == nameOf team2 && half == SecondHalf) then East else West+				kickPosTeam						= if (cn == nameOf team1) then team2 else team1+				kickPos							= posForFreeKick kickPosHome (pxy (ballPos theBall)) kickPosTeam+				otherTeam						= if (cn == nameOf team1) then Team2 else Team1+				rest							= getAllBasicPunishActions receivedYellow pals+			getAllBasicPunishActions receivedYellow ((fbID@PlayerID{clubName=cn},punish,(r:rls)):pals)+				| r == Rtackle					= ((TackleDetected fbID,DirectFreeKick otherTeam kickPos) : rest)+				| r == Roffside && isJust (offsideAndTouchedBall shortMem) =+					let ng+						| fromJust (offsideAndTouchedBall shortMem) == fbID+													= ((Offside          fbID,DirectFreeKick otherTeam kickPos) : rest)+						| otherwise					= rest+					in ng+				| r == Rtheater				= ((TheaterDetected  fbID,DirectFreeKick otherTeam kickPos) : rest)+				| r == Rschwalbe				= ((SchwalbeDetected fbID,DirectFreeKick otherTeam kickPos) : rest)+				| r == Rhands					= ((Hands            fbID,DirectFreeKick otherTeam kickPos) : rest)+				| r == RdangerousPlay			= ((DangerousPlay    fbID,DirectFreeKick otherTeam kickPos) : rest)+				| r == RillegalBallPossession	= ((OwnBallIllegally fbID,DirectFreeKick otherTeam kickPos) : rest)+				| otherwise						= error "getAllBasicPunishActions: unknown reason of RefereeAction."+				where+				kickPosHome						= if (cn == nameOf team1 && half == FirstHalf || cn == nameOf team2 && half == SecondHalf) then East else West+				kickPosTeam						= if (cn == nameOf team1) then team2 else team1+				kickPos							= posForFreeKick kickPosHome (pxy (ballPos theBall)) kickPosTeam+				otherTeam						= if (cn == nameOf team1) then Team2 else Team1+				rest							= getAllBasicPunishActions receivedYellow ((fbID,punish,rls):pals)++		firstPenalty ∷ [(ATeam,Reason)] → Maybe ATeam+		firstPenalty []							= Nothing+		firstPenalty ((t,_):_)					= Just (other t)++isTackleVictim ∷ PlayerID → [TackleAction] → Bool+isTackleVictim fbID tackleEvents				= any (\((fbID',_,_),_,_) → fbID == fbID') tackleEvents++isTackleOffender ∷ PlayerID → [TackleAction] → Bool+isTackleOffender fbID tackleEvents				= any (\(_,(fbID',_,_),_) → fbID == fbID') tackleEvents++nearLastRoundTackle ∷ Position → [TackleAction] → Bool+nearLastRoundTackle pos tackleEvents			= all near tackleEvents+	where+	near ((_,vpos,_),(_,opos,_),_)				= dist pos vpos > nearEventRadius && dist pos opos > nearEventRadius++--	Used for offside, so we only look at the xposition+offsideline ∷ Field → Home → Ball → [Player] → Metre+offsideline field home ball fbs					= case sortBy cmp ((px (pxy (ballPos ball))) : [(px (pos fb)) | fb ← fbs]) of+													[]			→ edge+													[x]			→ x+													[_,x]		→ x+													(_:_:x:_)	→ x+	where+	(cmp,edge)								= if (home == West)+		then (compare,zero)+		else (\x y → compare y x,(flength field))++getOffsidePlayers ∷ Field → Home → XPos → [Player] → [PlayerID]+getOffsidePlayers field home line fbs = map playerIdentity (filter (\fb@Player{pos=Position{px=posx}} -> atOtherHalf posx && (cmp (px (pos fb)) line)) fbs)+	where+	(cmp,atOtherHalf)						= if (home == West) then ((>),(<) fieldhalf) else ((<),(>) fieldhalf)+	fieldhalf									= (flength field) / 2.0++--	A referee can not see everything correct.+filterOutMeanActions ∷ [Player] → [PlayerWithEffect] → StdGen → ([PlayerWithEffect],StdGen)+filterOutMeanActions allPlayers allActions seed+	= ([action | (p,action) ← zip ps allActions, noticeAction action p],seed1)+	where+	(ps,seed1)				= iterateStn (length allActions) random seed++	noticeAction ∷ PlayerWithEffect → Float → Bool+	noticeAction (fa,playerID) p+		| foul				= avg [p,1.0 - pa + if (elem skill (skillsAsList fb)) then 0.1 else 0.0] <= 0.5+		| otherwise			= True+		where+		Just fb					= find (identifyPlayer playerID) allPlayers+		(foul,pa,skill)		= if (perhaps isTackled       fa) then (True,chanceOfPenaltySuccess, Tackling)+							 else (if (perhaps isSchwalbed     fa) then (True,chanceOfSchwalbeSuccess,Schwalbing)+							 else (if (perhaps isPlayedTheater fa) then (True,chanceOfTheaterSuccess, PlayingTheater)+							 else (if (perhaps isCaughtBall    fa) then (True,chanceOfCatchSuccess,   Catching)+							                                  else (False,error "ASNTD",error "ISAONE")+							 )))++nextBallPos ∷ Position3D → Speed3D → (Position,XRadius,ZRadius) → Bool+nextBallPos item dir (target,radius,height)+							= isGettingToPos (iterate (nextPos dir) item)+	where+	targetAtGround		= (zero) { pxy=target}+	targetInAir			= Position3D {pxy=target, pz=height}++	nextPos ∷ Speed3D → Position3D → Position3D+	nextPos speed currentPosition+							= movePoint3D RVector3D {dxy=RVector{dx=(cos (direction (vxy speed)))*newV,dy=(sin (direction (vxy speed)))*newV},dz=newV3} currentPosition+		where+		resistance			= if ((pz currentPosition) > zero) then airResistance else surfaceResistance+		newV				= resistance * (velocity (vxy speed))+		newV3				= (vz speed) - 0.1*accellerationSec++	isGettingToPos ∷ [Position3D] → Bool+	isGettingToPos []		= False+	isGettingToPos [x]		= False+	isGettingToPos (x:y:xs)+		| dist x targetAtGround < radius || dist x targetInAir < radius+							= True+		| avg [dist x targetAtGround,dist x targetInAir] < avg [dist y targetAtGround,dist y targetInAir]	-- object is moving away+							= False+		| otherwise			= isGettingToPos (y:xs)																	-- object is coming closer+++--	Freekicks are granted from the pos of the player that is the most closest to the ball but not a position more forward to the goal+posForFreeKick ∷ Home → Position {-→ Position-} → [Player] → Position+posForFreeKick home ballPos {-victimPos-} []				= ballPos--victimPos+posForFreeKick home ballPos {-victimPos-} team+	= case [fb | fb ← team, (dist (pos fb) ballPos) <= 15.0 ] of+		[]												→ ballPos+		close											→ pos (foldr1 closer2ball close)+	where+	closer2ball ∷ Player → Player → Player+	closer2ball fb1 fb2+		| dist (pos fb1) ballPos < dist (pos fb2) ballPos	= fb1+		| otherwise										= fb2++inKeeperSpot ∷ Player → ClubName → Home → Field → Bool+inKeeperSpot fb clubName home field	= inPenaltyArea field (if (getClubName fb == clubName) then home else (other home)) (pos fb)

@@ -0,0 +1,74 @@+{-# LANGUAGE UnicodeSyntax, TypeSynonymInstances, ExistentialQuantification #-}+{-| This module defines the Soccer-Fun API that is concerned with teams.+	All available teams are collected in this module (allAvailableTeams).+-}+module SoccerFun.Team where++import SoccerFun.Player+import SoccerFun.Types+import SoccerFun.Geometry+import SoccerFun.Prelude+import Data.List ((\\), nub, sort)+import SoccerFun.Field++type Team = [Player] -- ^ the fielders are supposed to have different numbers, and all not equal to 1++validateTeam ∷ Team → Team+validateTeam team = map validatePlayer team+	where+--	validatePlayer ∷ Player → Player+	validatePlayer (fb@Player{height=height})+		= fb {height = height `boundedBy` (minHeight,maxHeight)+			  , stamina = maxStamina+			  , health = maxHealth+		  }+replaceInTeam ∷ [Player] → Team → Team+replaceInTeam fbs team = (team \\ fbs) ++ fbs++getTeam ∷ ClubName → [Team] → Team+getTeam cn teams = case [team | team<-teams, nameOf team==cn] of+	(team:_) → team+	_ → error ("Team " ++ show cn ++ " does not seem to exist.\n")++class Mirror a where mirror ∷ Field → a → a++instance NameOf Team where+	nameOf players+		= case players of+			(fb:_) → nameOf (playerID fb)+			none → error "nameOf[Team]: applied to empty team.\n"++isValidTeam ∷ Team → Bool+isValidTeam team = length clubNames == 1+							&&+						  (null keepers || isValidKeeper (head keepers))+							&&+						  all isValidPlayer players+							&&+						  sort (map nrOf players) == sort (nub (map nrOf players))+							&&+						  not (elem 1 (map nrOf fielders))+	where+	(keepers,fielders) = spanfilter isKeeper team+	clubNames = nub (map clubOf players)+	clubName' = head clubNames ∷ String+	players = keepers ++ fielders+	clubOf fb = clubName (playerID fb)+	nrOf fb = playerNo (playerID fb)+	isValidKeeper fb = (playerID fb) == PlayerID {clubName=clubName',playerNo=1}+	isValidPlayer fb = clubOf fb == clubName'++instance Other ATeam where+	other Team1 = Team2+	other Team2 = Team1++instance Mirror a ⇒ Mirror [a] where mirror field as = map (mirror field) as+instance Mirror Player where mirror field fb = fb {pos = mirror field (pos fb)+                                                              , nose = mirror field (nose fb)+                                                              , speed = mirror field (speed fb)+                                                          }+instance Mirror Position where mirror field pos = Position {px = (flength field) - (px pos)+                                                          ,py = (fwidth field) - (py pos)+                                                          }+instance Mirror Speed where mirror field speed = speed {direction = mirror field (direction speed)}+instance Mirror Angle where mirror field angle = if (angle >= pi) then (3.0*pi - angle) else (pi - angle)

@@ -0,0 +1,73 @@+{-# LANGUAGE UnicodeSyntax, Rank2Types, ExistentialQuantification #-}+module SoccerFun.Types where++import Control.Monad.State+import SoccerFun.Geometry++data Half = FirstHalf | SecondHalf deriving (Eq,Show)+type PlayingTime = Minutes++-- | type with an inverse value+class Other a where other ∷ a → a++type TimeUnit = Seconds -- ^ time unit in sec.+type Seconds = Float -- ^ zero < time unit++data Edge = North | South deriving (Eq,Show)++data PlayerID = PlayerID {clubName ∷ ClubName, playerNo ∷ PlayersNumber} deriving (Show,Eq)+type ClubName = String+type PlayersNumber = Int++--thinkS ∷ inp → State (Brain inp out) out+--thinkS i = do+--	Brain m ai ← get+--	let (o, m') = runState (ai i) m+--	put $ Brain m' ai+--	return o++--think ∷ Brain inp out → inp → (Brain inp out, out)+--think (Brain m ai) i = (Brain m' ai, o) where+--	(o, m') = runState (ai i) m+++-- | If the referee gives a second yellow he should add red to it himself+data Reprimand = Warning | YellowCard | RedCard deriving (Show, Eq)++data Success = Success | Fail deriving (Show, Eq)++type FramesToGo = Int -- ^ number of frames to go before event ends++data RefereeAction+	= ReprimandPlayer PlayerID Reprimand -- ^ player with given name receives reprimand+	| Hands PlayerID -- ^ person is seen for doing hands+	| TackleDetected PlayerID -- ^ person is seen for doing tackle+	| SchwalbeDetected PlayerID -- ^ person is seen for doing schwalbe+	| TheaterDetected PlayerID+	| DangerousPlay PlayerID -- ^ person is seen for doing dangerous actions+	| GameOver -- ^ end of game+	| PauseGame -- ^ game is paused+	| AddTime ExtraTime -- ^ extra time is added to the game+	| EndHalf -- ^ first half is over, teams go for a second half+	| Goal ATeam -- ^ team playing at home has scored+	| Offside PlayerID -- ^ player is offside at Home+	| DirectFreeKick ATeam Position -- ^ a direct free kick is granted for team home at given position+	| GoalKick ATeam -- ^ a goal kick is granted for team home+	| Corner ATeam Edge -- ^ a corner kick is granted for team home+	| ThrowIn ATeam Position -- ^ a throw in ball is granted for team home at given position+	| Penalty ATeam -- ^ penalty at homeside+	| CenterKick ATeam -- ^ team playing at home may start from the center+	| Advantage ATeam -- ^ referee gives advantages to home-team+	| OwnBallIllegally PlayerID -- ^ ball was for the other team+	| DisplacePlayers Displacements -- ^ displaces all players at the provided position (used with free kicks)+	| ContinueGame+	| TellMessage String -- ^ no effect on match, message is displayed by referee+	deriving (Show, Eq)++data ATeam = Team1 | Team2 deriving (Eq, Show)++type Displacements = [(PlayerID,Displacement)] -- ^ players that need to be displaced+type Displacement = Position -- ^ new position++type ExtraTime = Minutes+type Minutes = Float

@@ -0,0 +1,178 @@+{-# LANGUAGE UnicodeSyntax #-}+module SoccerFun.UI.GL where++import qualified Graphics.UI.GLUT as GL+import Graphics.UI.GLUT (($=), get)+import Data.IORef+import Control.Monad+import Unsafe.Coerce+--import Control.DeepSeq++import SoccerFun.MatchControl+import SoccerFun.Types+import SoccerFun.Geometry+import SoccerFun.Referee.Ivanov+import System.Random+import SoccerFun.MatchGame+import SoccerFun.Player+import SoccerFun.Team (Team)+import Data.Maybe+import SoccerFun.Field+import SoccerFun.Ball++runMatch ∷ (Home → Field → Team) → (Home → Field → Team) → IO ()+runMatch t1 t2 = do+	let+		field = Field 70 105+		team1 = t1 West field+		team2 = t2 East field+	match ← liftM (setMatchStart team1 team2 field (ivanovReferee field team1 team2) 5) newStdGen+	(prog,args) ← GL.getArgsAndInitialize+--	GL.initialDisplayCapabilities $= [GL.With GL.DisplayDouble, GL.With GL.DisplaySamples]+--	GL.multisample $= GL.Enabled+	GL.initialDisplayMode $= [GL.DoubleBuffered, GL.Multisampling]+	p ← get GL.displayModePossible+	when (not p) $ do+		GL.initialDisplayMode $= [GL.DoubleBuffered]+		p ← get GL.displayModePossible+		when (not p) $ GL.initialDisplayMode $= []+	window ← GL.createWindow "SoccerFun"+	GL.clearColor $= (GL.Color4 0 0.5 0 0 ∷ GL.Color4 GL.GLclampf) -- green+	aspect ← newIORef 1+	registerCallbacks window aspect =<< newIORef match+	GL.cursor $= GL.LeftArrow+	GL.mainLoop+	GL.exit++registerCallbacks ∷ GL.Window → IORef GL.GLdouble → IORef Match → IO ()+registerCallbacks window aspect match = do+	GL.displayCallback $= display+	GL.reshapeCallback $= Just reshape+	gameLoop+--	GL.keyboardMouseCallback $= Just inputCallback+	where++	gameLoop = do+		((refereeActions,playerWithActions),match') ← liftM stepMatch $ readIORef match+		writeIORef match match'+		GL.postRedisplay $ Just window+		let actions = mapMaybe logRefereeAction refereeActions+		if null actions+			then GL.addTimerCallback 50 gameLoop+			else GL.addTimerCallback 1000 gameLoop+		mapM_ putStrLn actions++	reshape s@(GL.Size w h) = do+		writeIORef aspect newAspect+		GL.viewport $= (GL.Position 0 0, s)+		GL.matrixMode $= GL.Projection+		GL.loadIdentity+		GL.perspective 0 newAspect (-1) 1+		GL.matrixMode $= GL.Modelview 0+		where newAspect = fromIntegral w / fromIntegral (max 1 h)++	display = do+		m@Match {theField = field, team1 = t1, team2 = t2, theBall = ball, score = score, playingTime = time} ← readIORef match+		GL.clear [GL.ColorBuffer]+		GL.loadIdentity+		a ← readIORef aspect+		if a < 1 then GL.ortho2D (-1) 1 (-1/a) (1/a) else GL.ortho2D (-1*a) (1*a) (-1) 1+		let zoom = convertFloat $ 2.1 / flength field+		GL.scale zoom zoom 1+		GL.translate $ vector2 (-flength field/2,-fwidth field/2)++		renderStatus m+		GL.lineWidth $= 3+		renderField field+		GL.lineWidth $= 2+		renderBall ball+		colorRGB (1,0,0) -- red+		mapM_ renderPlayer t1+		colorRGB (0,0,1) -- blue+		mapM_ renderPlayer t2++		GL.swapBuffers++	renderStatus Match {theField = field, team1 = t1, team2 = t2, theBall = ball, score = score, playingTime = time} = do+		colorRGB (0,0,0) -- black+		GL.preservingMatrix $ do+			GL.translate $ vector2 (0, fwidth field + 2)+			GL.lineWidth $= 2+			drawStatus $ show (fst score) ++ ":" ++ show (snd score) ++ "   " ++ show (fromIntegral (round (time * 100)) / 100)++	renderField Field {flength = l, fwidth = w} = do+		colorRGB (1,1,1) -- white+		GL.renderPrimitive GL.LineLoop $ do+			vertex2 (0,0)+			vertex2 (l,0)+			vertex2 (l,w)+			vertex2 (0,w)++	renderBall (Free Ball {ballPos = p}) = do+		colorRGB (1,1,1) -- white+		drawAt3D p $ GL.renderPrimitive GL.Polygon (circle 0.5 0.5 10)++	renderPlayer Player {pos = p, playerID = id} = drawAt p $ do+		square+		drawString $ show $ playerNo id++colorRGB ∷ (GL.GLfloat,GL.GLfloat,GL.GLfloat) → IO ()+colorRGB (r,g,b) = GL.color $ GL.Color3 r g b++--dot3D ∷ Position3D → IO ()+--dot3D pos3D = dot $ pxy pos3D++drawAt3D ∷ Position3D → IO () → IO ()+drawAt3D pos = drawAt (pxy pos)++drawAt ∷ Position → IO () → IO ()+drawAt pos draw = GL.preservingMatrix $ do+	GL.translate $ vector2 (px pos, py pos)+	draw++square ∷ IO ()+square = GL.preservingMatrix $ do+	GL.renderPrimitive GL.LineLoop $ do+		vertex2 (-0.7,-0.7)+		vertex2 (0.7,-0.7)+		vertex2 (0.7,0.7)+		vertex2 (-0.7,0.7)+--	GL.translate $ vector2 (px pos, py pos)+--	GL.renderObject GL.Solid $ GL.Cube 1++vector2 ∷ (Float,Float) → GL.Vector3 GL.GLfloat+vector2 (x,y) = GL.Vector3 (convertFloat x) (convertFloat y) 0++vertex2 ∷ (Float,Float) → IO ()+vertex2 (x,y) = GL.vertex $ GL.Vertex2 (convertFloat x) (convertFloat y)++circle r1 r2 step = mapM_ vertex2 vs where+	is = take (truncate step + 1) [0, i' .. ]+	i' = 2 * pi / step+	vs = [ (r1 * cos i, r2 * sin i) | i <- is ]++{-+drawPort pos = GL.preservingMatrix $ do+	GL.translate $ vector pos+	GL.renderPrimitive GL.Polygon (circle 0.15 0.15 10)++drawNode label = do+	GL.renderPrimitive GL.LineLoop (circle 1 1 20)+	drawString label+-}++drawString label = GL.preservingMatrix $ do+	GL.translate $ GL.Vector3 (-0.3) (-0.3) (0 ∷ GL.GLfloat)+	GL.scale 0.007 0.007 (0 ∷ GL.GLdouble)+	GL.renderString GL.MonoRoman label++drawStatus label = GL.preservingMatrix $ do+	GL.translate $ GL.Vector3 (-0.3) (-0.3) (0 ∷ GL.GLfloat)+	GL.scale 0.01 0.01 (0 ∷ GL.GLdouble)+	GL.renderString GL.MonoRoman label++convertDouble ∷ Double → GL.GLdouble+convertDouble = unsafeCoerce++convertFloat ∷ Float → GL.GLfloat+convertFloat = unsafeCoerce

@@ -0,0 +1,80 @@+{-# LANGUAGE UnicodeSyntax #-}+-- | A very simple minded player, that always chases after the ball and kicks the ball towards the opponent's goal.+module Child where++import SoccerFun.Player+import SoccerFun.Types+import SoccerFun.Geometry+import Control.Monad.State+import SoccerFun.Field+import SoccerFun.Ball+++-- Generate a child.+child ∷ ClubName → Home → Field → Position → PlayersNumber → Player+child club home field position no = Player+	{playerID = PlayerID {clubName = club, playerNo = no},+	 name     = "child." ++ show no,+	 height   = minHeight,+	 pos      = position,+	 nose     = 0,+	 speed    = 0,+	 skills   = (Running, Kicking, Rotating),+	 effect   = Nothing,+	 stamina  = maxStamina,+	 health   = maxHealth,+	 -- The only thing the child remembers is on which side it belongs to+	 brain    = Brain {m = Memory {myHome = home}, ai = minibrain field}}++-- The child remembers nothing but which side it is playing on.+data Memory = Memory {myHome ∷ Home}++-- A stateful computation, with the memory serving as a state.+type Think = State Memory++-- | Based on the perceived surroundings (BrainInput) and the memories, make a decision (BrainOutput) and update the memory.+minibrain ∷ Field → PlayerAI Memory+--        = Field → BrainInput → Think PlayerAction+minibrain field BrainInput {referee=refereeActions, me=me, ball=ballState, others=others} = do+	mem ← get+	let home = myHome mem+	when (any isEndHalf refereeActions) (put mem {myHome = other home})+	if ballIsClose+		then let goal = centerOfGoal (other home) field in kick goal+		else trackBall $ maxKickReach me+	where+	ball = getBall ballState (me : others) ∷ Ball+	ballXY = pxy $ ballPos ball ∷ Position+	ballIsClose = dist (pos me) ballXY < maxKickReach me++	move ∷ Speed → Angle → Think PlayerAction+	move speed angle = return $ Move speed angle++	centerOfGoal ∷ Home → Field → Position+	centerOfGoal home field = Position+		{py = let (n,s) = goalPoles field in (n+s)/2,+		 px = if home == West then 0 else flength field}++	kick ∷ Position → Think PlayerAction+	kick point = let+			angle = angleWithObject (pos me) point+			v = 2.0*dist (pos me) point+		in if (dist (pos me) (ballPos ball) <= maxKickReach me)+			then return $ KickBall Speed3D {vxy = Speed {direction=angle,velocity=v},vz=1.0}+			else halt++	trackBall ∷ Metre → Think PlayerAction+	trackBall eps = fix ballXY eps++	halt ∷ Think PlayerAction+	halt = move 0 0++	-- run towards a position+	fix ∷ Position → Metre → Think PlayerAction+	fix point eps = let+			distance = dist            (pos me) point+			angle    = angleWithObject (pos me) point+			v        = max 6.0 distance+		in if (distance <= eps)+			then halt+			else move Speed {direction=angle,velocity=v} (angle - (nose me))

@@ -0,0 +1,31 @@+{-# LANGUAGE UnicodeSyntax #-}+module Children where++import Child+import SoccerFun.Types+import SoccerFun.Geometry+import SoccerFun.Team+import SoccerFun.Player+import SoccerFun.Field++children ∷ Home → Field → Team+children home field = if home == West then players else mirror field players where++	clubname = "Children" ++ show home+	players  = [child clubname home field (placeOnField pos) nr | (nr,pos) ← zip [1..] playerPositions]++	placeOnField (dx,dy) = Position {px = dx * middleX, py = dy * fwidth field} +	middleX = flength field / 2.0++	playerPositions =+		[(0.00,0.50),+		 (0.20,0.30),+		 (0.20,0.70),+		 (0.23,0.50),+		 (0.50,0.05),+		 (0.50,0.95),+		 (0.60,0.50),+		 (0.70,0.15),+		 (0.70,0.85),+		 (0.90,0.45),+		 (0.90,0.55)]

@@ -0,0 +1,8 @@+{-# LANGUAGE UnicodeSyntax #-}+module Main where++import SoccerFun.UI.GL+import Children++main ∷ IO ()+main = runMatch children children

@@ -0,0 +1,10 @@+run: build+	./Main++build: Main++Main: *.hs+	ghc --make Main.hs++clean:+	rm -f *.o *.hi Main