SoccerFun 0.4.1 → 0.4.2

raw patch · 8 files changed

+95/−21 lines, 8 filesdep +directorydep +pluginsdep +processnew-component:exe:sfRecord

Dependencies added: directory, plugins, process, zlib

Files

• SoccerFun.cabal +9/−2
• SoccerFun/Field.hs +4/−3
• SoccerFun/MatchGame.hs +39/−2
• SoccerFun/Player.hs +3/−2
• SoccerFun/Referee/Ivanov.hs +1/−1
• SoccerFun/Tape.hs +5/−3
• SoccerFun/Tape/Record.hs +31/−0
• template/Makefile +3/−8

@@ -1,5 +1,5 @@ Name:           SoccerFun-Version:        0.4.1+Version:        0.4.2 Copyright:      (c) 2010, Jan Rochel License:        BSD3 License-File:   LICENSE@@ -29,7 +29,11 @@     random >= 1.0 && < 1.1,     mtl >= 1.1 && < 1.2,     derive >= 2.3 && < 2.4,-    binary >= 0.5 && < 0.6+    binary >= 0.5 && < 0.6,+    plugins >= 1.5 && < 1.6,+    process >= 1.0 && < 1.1,+    directory >= 1.0 && < 1.1,+    zlib >= 0.5 && < 0.6   Exposed-Modules:     SoccerFun.Ball     SoccerFun.Types@@ -46,3 +50,6 @@     SoccerFun.Referee     SoccerFun.Random     SoccerFun.Prelude++Executable sfRecord+  Main-Is: SoccerFun/Tape/Record.hs

@@ -1,13 +1,14 @@-{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable #-} module SoccerFun.Field where  import SoccerFun.Geometry import SoccerFun.Types (Other (other))+import Data.Typeable  data Field = Field 	{fwidth ∷ FieldWidth, -- ^ width of ball field (64m <=width <=75m) 	 flength ∷ FieldLength -- ^ height of ball field (100m<=height<=110m)-	} deriving Show+	} deriving (Show, Typeable)  type FieldWidth = Metre type FieldLength = Metre@@ -22,7 +23,7 @@ 	westEdge = penaltyAreaDepth 	eastEdge = (flength field) - penaltyAreaDepth -data Home = West | East deriving (Eq,Show)+data Home = West | East deriving (Eq,Show,Typeable)  instance Other Home where 	other West = East

@@ -12,6 +12,11 @@ import SoccerFun.Referee.Ivanov import Control.Monad import System.Random+import System.Exit+import System.Directory+import System.Eval.Haskell+import System.Process+import Data.List (findIndices)   showTime ∷ Minutes → String -- ^ display time in (mm:ss min) format@@ -52,6 +57,39 @@ 		team2 = t2 East field 	in liftM (setMatchStart team1 team2 field (ivanovReferee field team1 team2) 1) newStdGen +-- also returns the team names+dynSetupMatch ∷ String → String → IO (String, String, Match)+dynSetupMatch t1 t2 = do+	(t1name, team1) ← loadTeam t1+	(t2name, team2) ← loadTeam t2+	match ← setupMatch team1 team2+	return (t1name, t2name, match)++loadTeam ∷ String → IO (String, Home → Field → Team)+loadTeam t = do+	t ← return $ removeTrailingSlashes t+	let (loc,name) = case findIndices isSlash t of+		[ ] → (".", t)+		ixs → let (loc,slash:name) = splitAt (last ixs) t in (loc, name)+	waitForProcess =<< runProcess "ghc" ["--make", name ⧺ ".Team"] (Just loc) Nothing Nothing Nothing Nothing+	oldLoc ← getCurrentDirectory+	setCurrentDirectory loc+	putStrLn $ "Loading module " ⧺ name ⧺ ".Team from " ⧺ loc+	team ← eval_ (name ⧺ ".Team.team") [name ⧺ ".Team"] [] [] [loc] -- the [loc] doesn't seem to have any effect+	setCurrentDirectory oldLoc+	case team of+		Left errors → mapM_ putStrLn ("Failed to load team. Errors:" : errors) >> exitFailure+		Right Nothing → do+			putStrLn "Failed to load team due to type error."+			putStrLn "Remember that <TeamName>.Team has to export a function with signature"+			putStrLn "team :: Home -> Field -> Team"+			exitFailure+		Right (Just t) → return (name, t)+	where+	removeTrailingSlashes str = if isSlash (last str) then removeTrailingSlashes (init str) else str+	isSlash = flip elem ['/','\\']++ {- This module defines the match and tournament data structures. -} --import MatchLog, GuiInterface@@ -213,8 +251,7 @@  computeMatch ∷ Match → Score computeMatch match-	| playingTime match > zero-							= computeMatch (snd (stepMatch match))+	| playingTime match > zero = computeMatch (snd (stepMatch match)) 	| otherwise = score match  {-

@@ -1,4 +1,4 @@-{-# LANGUAGE UnicodeSyntax, Rank2Types, ExistentialQuantification #-}+{-# LANGUAGE UnicodeSyntax, Rank2Types, ExistentialQuantification, DeriveDataTypeable #-} -- | This module defines the part of the SoccerFun API that is concerned with the player data types. module SoccerFun.Player where @@ -10,6 +10,7 @@ import Control.Monad.State import SoccerFun.Field import Data.List (find)+import Data.Typeable  data Player = ∀m. Player  	{playerID ∷ PlayerID,         -- ^ must be unique@@ -23,7 +24,7 @@ 	 stamina ∷ Stamina,           -- ^ current stamina of a player: 1.0 is optimal, 0.0 is worst 	 health ∷ Health,             -- ^ current health of a player: 1.0 is optimal, 0.0 is worst 	 brain ∷ Brain (PlayerAI m) m -- ^ The precious asset: use and update the memory and make decisions-	}+	} deriving Typeable  instance Eq Player where f1 == f2 = playerID f1 == playerID f2 instance Show Player where show (Player {playerID = pid}) = show pid

@@ -76,7 +76,7 @@ 	| FreeToKick 	| KickForcedByReferee instance Eq FreeKickCountdownForOffside where-	(==) OffsidePossible     OffsidePossible		= True+	(==) OffsidePossible     OffsidePossible		= False -- disable offside since it is buggy 	(==) FreeToKick          FreeToKick				= True 	(==) KickForcedByReferee KickForcedByReferee	= True 	(==) _                   _						= False

@@ -13,6 +13,7 @@ import SoccerFun.Ball import SoccerFun.RefereeAction import Control.Monad+import Codec.Compression.GZip  instance Binary Match where 	put m = do@@ -104,19 +105,20 @@ data Tape = Tape [Step]  magic = "SoccerFun tape"-version = "0.3.7"+version = "0.4.2" +-- TODO: include framerate instance Binary Tape where 	put (Tape steps) = do 		put magic 		put version-		put steps+		put $ compress $ encode steps 	get = do 		let checkMagic m = when (not $ m ≡ magic) (error "This file does not contain a SoccerFun tape!") 		checkMagic =<< get 		let checkVersion v = when (not $ v ≡ version) (error $ "Incompatible tape version: " ⧺ show v) 		checkVersion =<< get-		liftM Tape get+		liftM (Tape ∘ decode ∘ decompress) get  recordMatch ∷ Match → Tape recordMatch m = Tape $ recordMatch' (([],[]), m) where

@@ -0,0 +1,31 @@+{-# LANGUAGE UnicodeSyntax #-}+-- | Usage: Hit /q/ to abort the match+module Main where++import Control.Monad+import System.Exit+import Prelude.Unicode+import Data.Binary+import SoccerFun.Tape+import SoccerFun.MatchControl+import SoccerFun.MatchGame+import System.Environment++main ∷ IO ()+main = do+	prog ← getProgName+	args ← getArgs+	let (t1,t2) = case args of+		[t1,t2] → (t1,t2)+		notTwo → error $ unlines+			["Record a match between two teams <Team1> and <Team2>",+			 "Usage: " ⧺ prog ⧺ " <dir1> <dir2>",+			 "  where both arguments are paths to directories containing a team module."]++	(t1name,t2name,match) ← dynSetupMatch t1 t2+	let tape = recordMatch match+	encodeFile (t1name ⧺ "-" ⧺ t2name ⧺ ".sft") tape+	let Tape steps = tape+	    endOfMatch = snd (last steps)+	    finalScore = score endOfMatch+	putStrLn $ show (fst finalScore) ⧺ " / " ⧺ show (snd finalScore)

@@ -1,10 +1,5 @@-run: build-	./Main--build: Main--Main: *.hs-	ghc ${GHC_ARGS} --make Main.hs+run:+	sfRunMatch Children Children  clean:-	rm -f *.o *.hi */*.o */*.hi Main+	rm -f */*.o */*.hi