src/Game/matchGame.icl

   1 implementation module matchGame
   2
   3 import StdEnvExt, fileIO
   4 import guiInterface, matchControl, render
   5 from   Parsers import parse, :: Parser, :: Result(..), :: SugPosition, :: Rose(..), :: RoseNode(..), :: SymbolTypes(..),
   6                       :: SymbolType(..),
   7                       fail, yield, token, symbol, <&>, &>, <!>, <!+>, <!*>, number, digit
   8
   9 timeLeft                                        :: !FootballGame -> Bool
  10 timeLeft game                           = game.match.Match.playingTime > zero
  11
  12 defaultPlayingTime                      :: PlayingTime
  13 defaultPlayingTime                      = minutes 1.0
  14
  15 incFrames                                       :: !FootballGame -> FootballGame
  16 incFrames game=:{frames}        = {game & frames=frames+1}
  17
  18
  19 instance zero Rank where
  20         zero                                    = { matchpoints = zero, goals_scored = zero, goals_against = zero }
  21 instance == Rank where
  22         (==) r1 r2                              = (r1.matchpoints,r1.goals_scored,r1.goals_against) == (r2.matchpoints,r2.goals_scored,r2.goals_against)
  23 instance < Rank where
  24         (<) r1 r2                               = r1.matchpoints <  r2.matchpoints ||
  25                                                           r1.matchpoints == r2.matchpoints && r1.goals_scored <  r2.goals_scored ||
  26                                                           r1.matchpoints == r2.matchpoints && r1.goals_scored == r2.goals_scored && r1.goals_against > r2.goals_against
  27 instance + Rank where
  28         (+) r1 r2                               = { matchpoints   = r1.matchpoints   + r2.matchpoints
  29                                                           , goals_scored  = r1.goals_scored  + r2.goals_scored
  30                                                           , goals_against = r1.goals_against + r2.goals_against
  31                                                           }
  32
  33 competition                                     :: ![Home FootballField -> Team] !FootballField !Referee !PlayingTime !RandomSeed -> Competition
  34 competition teams field referee playingtime rs
  35         = { results                             = [ [  if (nr_west == nr_east)
  36                                                                   Nothing
  37                                                                   (Just (computeMatch (setMatchStart (team_west West field) (team_east East field) field referee playingtime rs)))
  38                                                             \\ (nr_east,team_east) <- zip2 [1..] teams
  39                                                             ]
  40                                                           \\ (nr_west,team_west) <- zip2 [1..] teams
  41                                                           ]
  42           , west                                = map (\f -> nameOf (f West field)) teams
  43           , east                                = map (\f -> nameOf (f East field)) teams
  44           , usedRandomSeed              = rs
  45           }
  46
  47 computeMatch                            :: !Match -> Score
  48 computeMatch match
  49 | match.Match.playingTime > zero
  50                                                         = computeMatch (snd (stepMatch match))
  51 | otherwise                                     = match.score
  52
  53 ranking                                         :: ![ClubName] ![Maybe Score] -> Ranking
  54 ranking names scores            = foldl upd [(t,zero) \\ t <- names] (zip2 [(tw,te) \\ tw <- names, te <- names] scores)
  55 where
  56         upd ranking (_,Nothing)
  57                 = ranking
  58         upd ranking ((west,east),Just (goals_west,goals_east))
  59                 = updkeyvalue west ((+) rank_west) (updkeyvalue east ((+) rank_east) ranking)
  60         where
  61                 (mps_west, mps_east)    = if (goals_west > goals_east) (3,0) (if (goals_west < goals_east) (0,3) (1,1))
  62                 (rank_west,rank_east)   = ({matchpoints=mps_west,goals_scored=goals_west,goals_against=goals_east}
  63                                                                   ,{matchpoints=mps_east,goals_scored=goals_east,goals_against=goals_west}
  64                                                                   )
  65
  66 instance toString Options where
  67         toString {closeReferee,showSplash,displaySpeed,showReferee,playingTime,renderStyle}
  68                                                         = "{closeReferee=" <+++ closeReferee       <+++
  69                                                           ",showSplash="   <+++ showSplash         <+++
  70                                                           ",displaySpeed=" <+++ displaySpeed       <+++
  71                                                           ",showReferee="  <+++ showReferee        <+++
  72                                                           ",playingTime="  <+++ playingTime        <+++
  73                                                           ",renderStyle="  <+++ nameOf renderStyle <+++
  74                                                           "}"
  75 instance fromString Options where
  76         fromString str
  77         = case parse optionsP (fromString str) optionsFile "char" of
  78                 Succ [opt:_]            = opt
  79                 _                                       = defaultOptions
  80         where
  81                 optionsP                        :: Parser Char Options Options
  82                 optionsP                        = token ['{closeReferee=']  &>
  83                                                           boolP                    <&> \closeReferee ->
  84                                                           token [',showSplash=']    &>
  85                                                           boolP                    <&> \showSplash   ->
  86                                                           token [',displaySpeed=']  &>
  87                                                           displaySpeedP            <&> \displaySpeed ->
  88                                                           token [',showReferee=']   &>
  89                                                           boolP                    <&> \showReferee  ->
  90                                                           token [',playingTime=']   &>
  91                                                           timeP                    <&> \playingTime  ->
  92                                                           token [',renderStyle=']   &>
  93                                                           renderP                  <&> \renderStyle  ->
  94                                                           symbol '}'                &>
  95                                                           yield { closeReferee = closeReferee
  96                                                                 , showSplash   = showSplash
  97                                                                 , displaySpeed = displaySpeed
  98                                                                 , showReferee  = showReferee
  99                                                                 , playingTime  = playingTime
 100                                                                 , renderStyle  = renderStyle
 101                                                                 }
 102                 boolP                           = (token ['True'] &> yield True) <!> (token ['False'] &> yield False)
 103                 renderP                         = firstP [token (fromString (nameOf style)) &> yield style \\ style <- allRenderStyles] <!> yield (hd allRenderStyles)
 104                 firstP []                       = fail
 105                 firstP [p:ps]           = p <!> firstP ps
 106                 timeP                           = <!+> digit        <&> \mts   ->
 107                                                               (symbol ':')  <&> \colon ->
 108                                                           <!+> digit        <&> \secs  ->
 109                                                           (token [' min'])  <&> \_     ->
 110                                                           yield (minutes ((toReal (toInt (toString mts))) + (toReal (toInt (toString secs)))/60.0))
 111                 displaySpeedP           = (token ['Slowest'] &> yield Slowest) <!>
 112                                                           (token ['Slower']  &> yield Slower)  <!>
 113                                                           (token ['Normal']  &> yield Normal)  <!>
 114                                                           (token ['Faster']  &> yield Faster)  <!>
 115                                                           (token ['Fastest'] &> yield Fastest)
 116
 117 instance == Options where
 118         (==) o1 o2                              = o1.closeReferee                  == o2.closeReferee                 &&
 119                                                           o1.showSplash                    == o2.showSplash                   &&
 120                                                           o1.displaySpeed                  == o2.displaySpeed                 &&
 121                                                           o1.showReferee                   == o2.showReferee                  &&
 122                                                           o1.Options.playingTime           == o2.Options.playingTime          &&
 123                                                           o1.renderStyle.RenderStyle.name  == o2.renderStyle.RenderStyle.name
 124
 125 getOptions                                      :: !*env -> (!Options,!*env)    | FileSystem env
 126 getOptions env
 127         = case readFile optionsFile env of
 128                 (Just options,env)      = (fromString options,env)
 129                 (nothing,     env)      = (defaultOptions,    env)
 130
 131 setOptions                                      :: !Options !*env -> *env               | FileSystem env
 132 setOptions options env          = writeFile False optionsFile (toString options) env
 133
 134 optionsFile                                     :== "SoccerFun_options.txt"
 135
 136 defaultOptions                          :: Options
 137 defaultOptions
 138         = { closeReferee                = True
 139           , showSplash                  = False
 140           , displaySpeed                = Normal
 141           , showReferee                 = True
 142           , playingTime                 = defaultPlayingTime
 143           , renderStyle                 = hd allRenderStyles
 144           }
 145
 146 checkCompetitionFile            :: ![ClubName] !RandomSeed !*env -> (!(!RandomSeed,![Maybe Score]),!*env) | FileSystem env
 147 checkCompetitionFile west rs env
 148 # (ok,cf,env)                           = fopen competitionFile FReadText env
 149 | not ok                                        = ((rs,[]), createCompetitionFile west rs env)                                          // competition file does not exist: create it
 150 # (ok,frs,fwest,cf)                     = header cf
 151 | not ok || fwest <> teams_line west
 152                                                         = ((rs,[]), createCompetitionFile west rs (snd (fclose cf env)))        // competition file ill-formatted or different set of teams: create it
 153 # (scores,cf)                           = readScores cf                                                                                                         // competition file exists, and for this competition
 154 # (ok,env)                                      = fclose cf env
 155 | not ok                                        = abort ("Could not close competition file after reading scores.\n" <+++ length scores)
 156 | otherwise                                     = ((frs,scores),env)
 157 where
 158         readScores                              :: !*File -> (![Maybe Score],!*File)
 159         readScores cf
 160         # (end,cf)                              = fend cf
 161         | end                                   = ([],cf)
 162         # (line,cf)                             = freadline cf
 163         # score                                 = if (line.[0] == 'x') Nothing
 164                                                          (let (i1,l1)   = span ((<>) ' ') [c \\ c<-:line]
 165                                                               (i2,l2)   = span ((<>) ' ') (tl l1)
 166                                                            in Just (toInt (toString i1),toInt (toString i2))
 167                                                          )
 168         # (scores,cf)                   = readScores cf
 169         = ([score:scores],cf)
 170
 171 appendMatchToCompetitionFile:: !ClubName !ClubName !*env -> (!Int,!*env) | FileSystem env
 172 appendMatchToCompetitionFile west east env
 173 # (ok,cf,env)                           = fopen competitionFile FAppendText env
 174 | not ok                                        = abort "Could not open competition file for appending data.\n"
 175 # (pos,cf)                                      = fposition cf
 176 # (ok,env)                                      = fclose (cf <<< "x " <<< west <<< " vs " <<< east <<< '\n') env
 177 | not ok                                        = abort "Could not close competition file after appending data.\n"
 178 | otherwise                                     = (pos,env)
 179
 180 updateMatchToCompetitionFile:: !ClubName !ClubName !(Maybe Score) !Int !*env -> *env | FileSystem env
 181 updateMatchToCompetitionFile west east score pos env
 182 # (ok,cf,env)                           = fopen competitionFile FAppendText env
 183 | not ok                                        = abort "Could not open competition file for appending data.\n"
 184 # (ok,cf)                                       = fseek cf pos FSeekSet
 185 | not ok                                        = abort "Could not seek in competition file for updating data.\n"
 186 # (ok,env)                                      = fclose (cf <<< result <<< ' ' <<< west <<< " vs " <<< east <<< '\n') env
 187 | not ok                                        = abort "Could not close competition file after appending data.\n"
 188 | otherwise                                     = env
 189 where
 190         result                                  = case score of
 191                                                                 Nothing      = "x"
 192                                                                 Just (gw,ge) = gw +++> (" " <+++ ge)
 193
 194 createCompetitionFile           :: ![ClubName] !RandomSeed !*env -> *env | FileSystem env
 195 createCompetitionFile west rs env
 196 # (ok,cf,env)                           = fopen competitionFile FWriteText env
 197 | not ok                                        = abort "Could not create competition file.\n"
 198 # (ok,env)                                      = fclose (cf <<< seed_line rs <<< '\n' <<< teams_line west <<< '\n') env
 199 | not ok                                        = abort "Could not close competition file.\n"
 200 | otherwise                                     = env
 201
 202 header                                          :: !*File -> (!Bool,!RandomSeed,!String,!*File)
 203 header file
 204 # (rs_line,   file)                     = freadline file
 205 # (teams_line,file)                     = freadline file
 206 = (size rs_line > 1 && size teams_line > 1, fromString (rs_line%(0,size rs_line-2)), teams_line%(0,size teams_line-2),file)
 207
 208 seed_line                                       :: !RandomSeed -> String
 209 seed_line rs                            = toString rs
 210
 211 teams_line                                      :: ![ClubName] -> String
 212 teams_line west                         = foldl (\t ts -> t +++ "," +++ ts) "" west
 213
 214 competitionFile                         :== "competition.txt"