src/Gui/Gui2D.icl

   1 implementation module Gui2D
   2
   3 import StdEnvExt, StdIOExt
   4 import fileIO
   5 import digitdisplay, textdisplay, render, matchGame, RangeSlider
   6 import StdDebug
   7
   8 SoccerFunGUI2D                                          :: !*World -> *World
   9 SoccerFunGUI2D world
  10 # (theGame, world)                                      = getBeginMatch world
  11 # (ids,     world)                                      = openIds 4 world
  12 # (displIds,world)                                      = sseqList (repeatn 2 openDigitDisplayId) world
  13 # (teamdIds,world)                                      = sseqList (repeatn 5 openTextDisplayId)  world
  14 # (frameId, world)                                      = openTextDisplayId world
  15 = startIO SDI theGame (initGUI (ids,displIds,teamdIds,frameId)) [ProcessClose closeProcess] world
  16 where
  17         getBeginMatch                                   :: !*env -> (!FootballGame,!*env) | TimeEnv, FileSystem env
  18         getBeginMatch env
  19         | isEmpty teams                                 = abort "There are no teams.\nPlease add teams to \"allAvailableTeams\" in the \"Team\"-module\n"
  20         | isEmpty referees                              = abort "There are no referees.\nPlease add referees to \"allAvailableReferees\" in the \"Referee\"-module\n"
  21         # (whatToLog,env)                               = getWhatToLog     env
  22         # (options,  env)                               = getOptions       env
  23         # (seed,     env)                               = getNewRandomSeed env
  24         # match                                                 = setMatchStart (hd teams West field) (hd teams East field) field (hd referees field) options.Options.playingTime seed
  25         = ( { match                                             = match
  26                 , actionPics                            = {refereePics=[]}
  27                 , history                                       = {time=s 2.0,past=[]}
  28                 , frames                                        = 0
  29                 , options                                       = options
  30                 , logging                                       = whatToLog
  31                 }
  32           , env
  33           )
  34         where
  35                 teams                                           = allAvailableTeams
  36                 referees                                        = allAvailableReferees
  37                 field                                           = getDefaultField
  38
  39         initGUI                                                 :: !(![Id],![DigitDisplayId],![TextDisplayId],!TextDisplayId) !(PSt FootballGame) -> (PSt FootballGame)
  40         initGUI ([timerId,fieldId,windowId,splashId],[westId,eastId],[team1Id,team2Id,halfId,timeId,refId],framesId) pSt=:{ls=ls=:{match=matchAtStart,options}}
  41         # (penAtts,  pSt)                               = accPIO renderAttributes pSt
  42         # (penFont,  pSt)                               = accPIO (accScreenPicture (openFont {fName="Courier New",fSize=32,fStyles=[BoldStyle]})) pSt
  43         # (frameFont,pSt)                               = accPIO (accScreenPicture (openFont {fName="Courier New",fSize=16,fStyles=[BoldStyle]})) pSt
  44         # (underFont,pSt)                               = accPIO (accScreenPicture (openFont {fName="Courier New",fSize=12,fStyles=[BoldStyle]})) pSt
  45         # refsName                                              = nameOf matchAtStart.Match.theReferee
  46         # wDef                                                  = Window "SoccerFun: Van Gaal's Electronic Notebook"
  47                                                                                 (       LayoutControl
  48                                                                                         (           teamName team1Id (nameOf matchAtStart.Match.team1) (snd penFont) WestColour
  49                                                                                                 :+: DigitDisplay  westId (IntegerFormat 2) digitDisplaySize WestColour []
  50                                                                                                 :+: DigitDisplay  eastId (IntegerFormat 2) digitDisplaySize EastColour []
  51                                                                                                 :+: teamName team2Id (nameOf matchAtStart.Match.team2) (snd penFont) EastColour
  52                                                                                         )       [ ControlPos (Center,zero) ]
  53                                                                                         :+: fpsDisplay framesId frameRatePrefix (snd frameFont) Green
  54                                                                                         :+:     CustomControl footballFieldDisplaySize (options.renderStyle.look ls.match)
  55                                                                                                         [ ControlId     fieldId
  56                                                                                                         , ControlPen    penAtts
  57                                                                                                         , ControlPos    (Center,zero)
  58                                                                                                         , ControlResize (\_ _ wViewSize=:{h} -> {wViewSize & h=h-digitDisplaySize.h-60})
  59                                                                                                         ]
  60                                                                                         :+: TextDisplay halfId (showHalf matchAtStart.Match.playingHalf) {w=80,h=15}
  61                                                                                                         [ ControlPen [PenColour White,PenBack Black,PenFont (snd underFont)]
  62                                                                                                         //, ControlResize (\_ _ size -> {size & h=size.h-digitDisplaySize.h})
  63                                                                                                         , ControlPos (LeftBottom,OffsetVector {vx=10,vy=(~7)})
  64                                                                                                         ]
  65                                                                                         :+: TextDisplay timeId (toString matchAtStart.Match.playingTime) {w=100,h=15}
  66                                                                                                         [ ControlPen [PenColour White,PenBack Black,PenFont (snd underFont)]
  67                                                                                                         , ControlPos (Center,OffsetVector {vx=zero,vy=zero})
  68                                                                                                         ]
  69                                                                                         :+: TextDisplay refId refsName {w=80+(12*(size refsName)),h=15}
  70                                                                                                         [ ControlPen [PenColour White,PenBack Black,PenFont (snd underFont)]
  71                                                                                                         , ControlPos (RightBottom,OffsetVector {vx=zero,vy=(~7)})//(3*(size "test"))
  72                                                                                                         ]
  73                                                                                 )
  74                                                                                 [ WindowViewSize        {w=footballFieldDisplaySize.w-1, h=footballFieldDisplaySize.h+digitDisplaySize.h}
  75                                                                                 , WindowLook False      stdUnfillNewFrameLook
  76                                                                                 , WindowPen                     [PenBack Black]
  77                                                                                 , WindowId                      windowId
  78                                                                                 ]
  79         # (error,pSt)                                   = openWindow undef wDef pSt
  80         # pSt                                                   = setDigitDisplayValue westId (fst ls.match.score) pSt
  81         # pSt                                                   = setDigitDisplayValue eastId (snd ls.match.score) pSt
  82         | error<>NoError                                = abort "Could not create window.\n"
  83         # speed                                                 = intervalFactor ls.options.displaySpeed
  84         # tDef                                                  = Timer (toInt ((toReal ticksPerSecond)*(toReal matchAtStart.Match.unittime)*speed)) NilLS
  85                                                                                 [ TimerFunction    (noLS1 (const (nextstep timerId fieldId westId eastId)))
  86                                             , TimerId          timerId
  87                                                     , TimerSelectState Unable
  88                                                 ]
  89         # (error,pSt)                                   = openTimer undef tDef pSt
  90         | error<>NoError                                = abort "Could not create step timer.\n"
  91         # tDef                                                  = Timer ticksPerSecond NilLS        [TimerFunction (noLS1 (const (frameRatef timeId halfId framesId)))]
  92         # (error,pSt)                                   = openTimer undef tDef pSt
  93         | error<>NoError                                = abort "Could not open frame rate timer.\n"
  94         # mDef                                                  = Menu "&File"
  95                                                                                 (       MenuItem "E&xit"            [MenuShortKey 'q',MenuFunction (noLS quitf)]
  96                                                                                 )       []
  97         # (error,pSt)                                   = openMenu undef mDef pSt
  98         | error<>NoError                                = abort "Could not create File menu.\n"
  99         # mDef2                                                 = Menu "&Game"
 100                                                                                 (   MenuItem "&Match"           [MenuShortKey 'm',MenuFunction (noLS (matchDialogf westId eastId fieldId timerId refId team1Id team2Id))]
 101                                                                                 :+: MenuItem "Competition"      [MenuShortKey 'u',MenuFunction (noLS (competitionDialogf timerId refId))]
 102                                                                                 :+: MenuSeparator               []
 103                                                                                 :+: MenuItem "&Run"             [MenuShortKey 'r',MenuFunction (noLS (continuef timerId))]
 104                                                                                 :+:     MenuItem "&Step"            [MenuShortKey 's',MenuFunction (noLS (stepf timerId fieldId westId eastId))]
 105                                                                                 :+:     MenuItem "&Halt"            [MenuShortKey 'h',MenuFunction (noLS (haltf timerId))]
 106                                                                                 :+: MenuSeparator               []
 107                                                                                 :+: SubMenu "&Mode"             ( RadioMenu [ ("&Realistic",  Nothing,Nothing,noLS realisticf)
 108                                                                                                                             , ("&Predictable",Nothing,Nothing,noLS predictablef)
 109                                                                                                                             ] 0 []
 110                                                                                                                 ) []
 111                                                                                 :+: SubMenu "Sp&eed"            ( RadioMenu [ ("&Slowest",Nothing, Just '1', noLS (changeSpeedf timerId Slowest))
 112                                                                                                                                 , ("S&lower", Nothing, Just '2', noLS (changeSpeedf timerId Slower))
 113                                                                                                                                 , ("N&ormal", Nothing, Just '3', noLS (changeSpeedf timerId Normal))
 114                                                                                                                                 , ("&Faster", Nothing, Just '4', noLS (changeSpeedf timerId Faster))
 115                                                                                                                                 , ("Fas&test",Nothing, Just '5', noLS (changeSpeedf timerId Fastest))
 116                                                                                                                                 ] ([Slowest,Slower,Normal,Faster,Fastest]??options.displaySpeed+1) []
 117                                                                                                                     ) []
 118                                                                                 :+: SubMenu "Re&feree"          ( RadioMenu [ ("&Show",   Nothing, Just '+', noLS (showReff True))
 119                                                                                                                                 , ("&NoShow", Nothing, Just '-', noLS (showReff False))
 120                                                                                                                                 ] ([True,False]??options.showReferee+1) []
 121                                                                                                                                     ) []
 122                                                                                 :+: SubMenu "R&ender"           ( RadioMenu [ (nameOf style, Nothing, Nothing, noLS (setfieldlook fieldId style))
 123                                                                                                                             \\ style <- allRenderStyles
 124                                                                                                                             ] ((map nameOf allRenderStyles)??(nameOf options.renderStyle)+1) []
 125                                                                                                                 ) []
 126                                                                                 :+: MenuItem "&Playing Time..." [MenuFunction (noLS (playtimef westId eastId fieldId timeId)), MenuShortKey 't']
 127                                                                                 :+: MenuItem "Splash screen"    [MenuFunction (noLS (setSplashScreenf splashId)),MenuMarkState (if options.showSplash Mark NoMark),MenuId splashId]
 128                                                                                 )       []
 129         # (error,pSt)                                   = openMenu undef mDef2 pSt
 130         | error<>NoError                                = abort "Could not create Game menu.\n"
 131         # pSt                                                   = appPIO (setWindowViewSize windowId {w=640,h=550}) pSt
 132         # pSt                                                   = showSplashScreen pSt
 133         = pSt
 134
 135         showSplashScreen                                :: !(PSt FootballGame) -> PSt FootballGame
 136         showSplashScreen pSt=:{ls=game}
 137         | not game.options.showSplash   = pSt
 138         # (spls,pSt)                                    = getSplashImageForGui pSt
 139         # splashDef                                             = Dialog "The Footballer's Mind"
 140                                                                                 (       CompoundControl
 141                                                                                         (       ButtonControl "&Close" [ControlFunction (noLS closeActiveWindow)]
 142                                                                                         )
 143                                                                                         [       ControlLook True (const2 (drawAt zero spls.img))
 144                                                                                         ,       ControlViewSize  (getBitmapSize spls.img)
 145                                                                                         ]
 146                                                                                 ) []
 147         # ((error,_),pSt)                               = openModalDialog undef splashDef pSt
 148         | error<>NoError                                = abort "Could not open splash screen.\n"
 149         | otherwise                                             = pSt
 150
 151
 152 //      Constants for the GUI:
 153 digitDisplaySize                                        = { w=24, h=36 }
 154 footballFieldDisplaySize                        = { w=640,h=400}
 155 frameRatePrefix                                         :== "Rounds/sec: "
 156
 157 //      GUI elements:
 158
 159 /** teamName id name font colour
 160                 describes a TextDisplay that is identified by id, has text content name, uses the given font in the given colour.
 161 */
 162 teamName                                                        :: TextDisplayId String Font Colour -> TextDisplay .ls .pst
 163 teamName id name penFont colour         = TextDisplay id name (teamSize footballFieldDisplaySize)
 164                                                                                 [ ControlPen [PenColour colour,PenBack Black,PenFont penFont]
 165                                                                                 , ControlResize (const2 teamSize)
 166                                                                                 ]
 167 where teamSize {w}                                      = {digitDisplaySize & w=(w-digitDisplaySize.w*4)/2}
 168
 169 /** fpsDisplay id name font colour
 170                 describes a TextDisplay that is used to display the frame rate of a match.
 171 */
 172 fpsDisplay                                                      :: TextDisplayId String Font Colour -> TextDisplay .ls .pst
 173 fpsDisplay id name penFont colour       = TextDisplay id name {digitDisplaySize & w=300}
 174                                                                                 [ ControlPen [PenColour colour, PenBack Black, PenFont penFont]
 175                                                                         , ControlPos (Center,zero)
 176                                                                                 ]
 177
 178
 179 //      The callback functions of the GUI:
 180
 181 /** setSplashScreenf splashId pSt
 182                 sets the check mark of the menu item that controls the splash screen option, and updates the Options record in the state accordingly.
 183 */
 184 setSplashScreenf                                        :: !Id !(PSt FootballGame) -> PSt FootballGame
 185 setSplashScreenf splashId pSt=:{ls=game}
 186 | game.options.showSplash                       = appPIO (unmarkMenuItems [splashId]) {pSt & ls={game & options={game.options & showSplash = False}}}
 187 | otherwise                                                     = appPIO (markMenuItems   [splashId]) {pSt & ls={game & options={game.options & showSplash = True}}}
 188
 189 /** quitf pSt
 190                 stores the current options to disk and terminates the parent interactive process.
 191 */
 192 quitf                                                           :: !(PSt FootballGame) -> PSt FootballGame
 193 quitf pSt=:{ls=game}
 194         # pSt                                                   = setOptions game.options pSt
 195         # pSt                                                   = closeProcess pSt
 196         = pSt
 197
 198 /** continuef timerId pSt
 199                 continues the simulation of the current match.
 200 */
 201 continuef                                                       :: !Id !(PSt FootballGame) -> PSt FootballGame
 202 continuef timerId pSt                           = appPIO (enableTimer timerId) pSt
 203
 204 /** haltf timerId pSt
 205                 stops the simulation of the current match.
 206 */
 207 haltf                                                           :: !Id !(PSt FootballGame) -> PSt FootballGame
 208 haltf timerId pSt                                       = appPIO (disableTimer timerId) pSt
 209
 210 /** stepf timerId fieldId westId eastId pSt
 211                 stops the simulation of the current match, and computes a single step of the current match.
 212 */
 213 stepf :: !Id !Id !DigitDisplayId !DigitDisplayId -> IdFun (PSt FootballGame)
 214 stepf timerId fieldId westId eastId     = nextstep timerId fieldId westId eastId o haltf timerId
 215
 216 /** nextstep timerId fieldId westId eastId pSt
 217                 computes a single step for the current match, renders the new state of the match, and displays the referee dialog if required.
 218 */
 219 nextstep                                                        :: !Id !Id !DigitDisplayId !DigitDisplayId !(PSt FootballGame) -> PSt FootballGame
 220 nextstep timerId fieldId westId eastId pSt=:{ls=game,io}
 221         # (refEvents,game,io)                   = stepMatchForGui game io
 222         # pSt                                                   = {pSt & io = setControlLook fieldId True (False,game.options.renderStyle.look game.match) io
 223                                                                                , ls = incFrames game
 224                                                                           }
 225         = analyseRefEvents refEvents pSt
 226 where
 227         analyseRefEvents                                :: ![RefereeAction] !(PSt FootballGame) -> PSt FootballGame
 228         analyseRefEvents refEvents pSt  = foldl analyseRefEvent pSt refEvents
 229         where
 230                 analyseRefEvent :: !(PSt FootballGame) !RefereeAction -> PSt FootballGame
 231                 analyseRefEvent pSt=:{ls=ls=:{FootballGame | match={score,playingHalf}}} rev
 232                 | or (apply rev [isContinueGame,isDisplacePlayers,isDirectFreeKick,isCenterKick,isPauseGame,isAddTime])
 233                                                                         = pSt
 234                 # pSt                                           = refereeDialog rev pSt
 235                 # pSt                                           = if (isGameOver rev) (appPIO (disableTimer timerId) pSt) pSt
 236                 = case rev of
 237                         Goal h                                  = if (h == West && playingHalf == FirstHalf || h == East && playingHalf == SecondHalf)
 238                                                                              (setDigitDisplayValue westId (fst score) pSt)
 239                                                                              (setDigitDisplayValue eastId (snd score) pSt)
 240                         no_goal                                 = pSt
 241
 242                 refereeDialog                           :: !RefereeAction !(PSt FootballGame) -> PSt FootballGame
 243                 refereeDialog rev pSt=:{ls=ls=:{match=match=:{theReferee=referee=:{Referee | name}}}}
 244                 | not pSt.ls.options.showReferee
 245                                                                         = pSt
 246                 # pSt                                           = case defaultSoundFile rev of
 247                                                                                 Just sound      = appPIO (makeSound sound) pSt
 248                                                                                 nothing         = pSt
 249                 # pSt                                           = haltf timerId pSt
 250                 # (image,pSt)                           = accPIO (defaultImage match rev) pSt
 251                 # (closeId, pSt)                        = openId pSt
 252                 # (dialogId,pSt)                        = openId pSt
 253                 # tDef                                          = Timer (3*ticksPerSecond) NilLS [ TimerFunction (noLS1 (const ((continuef timerId) o (closeWindow dialogId) o (appPIO (closeTimer closeId)))))
 254                                                                                                          , TimerId       closeId
 255                                                                                                          ]
 256                 # (error,  pSt)                         = openTimer undef tDef pSt
 257                 | error<>NoError                        = abort "Could not open referee dialog timer.\n"
 258                 # refereeDef                            = Dialog ("Referee " <+++ name)
 259                                                                                 (       TextControl (showSuccintRefereeAction rev) []
 260                                                                                 :+: CustomControl (getBitmapSize image) (const2 (drawAt zero image)) []
 261                                                                                 )       [WindowId dialogId]
 262                 # ((error,_),pSt)                       = openModalDialog undef refereeDef pSt
 263                 | error<>NoError                        = abort "Could not open referee dialog.\n"
 264                 | otherwise                                     = pSt
 265
 266 /** showReff show pSt
 267                 sets the option to show the referee during simulation.
 268 */
 269 showReff                                                        :: !Bool !(PSt FootballGame) -> PSt FootballGame
 270 showReff show pSt                                       = {pSt & ls = {pSt.ls & options = {pSt.ls.options & showReferee = show}}}
 271
 272 /** playtimef westId eastId fieldId timeId pSt
 273                 opens the dialog to alter the play time of a match.
 274 */
 275 playtimef                                                       :: !DigitDisplayId !DigitDisplayId !Id !TextDisplayId !(PSt FootballGame) -> PSt FootballGame
 276 playtimef westId eastId fieldId timeId pSt=:{ls=game=:{options={Options | playingTime}}}
 277         # (dialogId,pSt)                                = openId pSt
 278         # (textId,  pSt)                                = openId pSt
 279         # (sliderId,pSt)                                = openRangeSliderId pSt
 280         # playingtimeDef                                = Dialog "Playing Time"
 281                                                                                 (   TextControl (toString playingTime) [ControlId textId, ControlPos (Center,zero),ControlWidth (ContentWidth (toString (maxList times)))]
 282                                                                                 :+: RangeSlider sliderId Horizontal (PixelWidth 16) {values=times,index=times??playingTime} (noLS1 (setPlayingTime westId eastId textId)) []
 283                                                                                 :+: ButtonControl "Close" [ControlFunction (noLS (closeWindow dialogId)),ControlPos (Right,zero)]
 284                                                                                 )
 285                                                                                 [ WindowClose (noLS (closeWindow dialogId))
 286                                                                                 , WindowId dialogId
 287                                                                                 ]
 288         # ((error,_),pSt)                               = openModalDialog undef playingtimeDef pSt
 289         | error <> NoError                              = abort "Could not open Playing Time dialog.\n"
 290         | otherwise                                             = pSt
 291 where
 292         times                                                   = map minutes [0.5, 1.0 .. 10.0]
 293
 294         setPlayingTime westId eastId textId newtime pSt=:{ls=game}
 295                 # pSt                                           = setTextDisplayText timeId display_time pSt
 296                 # pSt                                           = appPIO (setControlText textId display_time) pSt
 297                 # pSt                                           = {pSt & ls = {game & options = {Options | game.options & playingTime=newtime}
 298                                                                                             , match   = {Match   | game.match   & playingTime=newtime}
 299                                                                           }           }
 300                 # pSt                                           = restartf westId eastId fieldId pSt
 301                 = pSt
 302         where
 303                 display_time                            = toString newtime
 304
 305 /** changeteamf fieldId team1Id team2Id home team pSt
 306                 replaces the current team at home with the given team. The display name of the team is adapted, and the match is to the beginning of the first half.
 307 */
 308 changeteamf                                                     :: !DigitDisplayId !DigitDisplayId !Id !TextDisplayId !TextDisplayId !Home !Team !(PSt FootballGame) -> PSt FootballGame
 309 changeteamf westId eastId fieldId team1Id team2Id home team pSt=:{ls=game=:{match,options},io}
 310         # match                                                 = {Match | match & team1 = if (home == West) team match.Match.team1, team2 = if (home == East) team match.Match.team2}
 311         # pSt                                                   = {pSt   & ls = {game & match=match}}
 312         # pSt                                                   = setTextDisplayText (if (home == West) team1Id team2Id) (nameOf team) pSt
 313         # pSt                                                   = restartf westId eastId fieldId pSt
 314         = pSt
 315
 316 /** changereff timerId refId referee pSt
 317                 replaces the current referee with the given referee and adapts the display name of the new referee.
 318 */
 319 changereff                                                      :: !Id !TextDisplayId !Referee !(PSt FootballGame) -> PSt FootballGame
 320 changereff timerId refId ref=:{Referee | name} pSt
 321         # pSt                                                   = setTextDisplayText refId name pSt //todo: de positionering moet aangepast worden
 322         = appPIO (disableTimer timerId) {pSt & ls={pSt.ls & match = {pSt.ls.match & theReferee = ref}}}
 323
 324 /** restartf fieldId pSt
 325                 makes sure that the current match is reinitialized to the initial teams, referee, and ball position.s
 326 */
 327 restartf                                                        :: !DigitDisplayId !DigitDisplayId !Id !(PSt FootballGame) -> PSt FootballGame
 328 restartf westId eastId fieldId pSt=:{ls=game=:{match,options},io}
 329         # match                                                 = {match & theBall     = Free zero
 330                                                                                  , playingHalf = FirstHalf
 331                                                                                  , playingTime = options.Options.playingTime
 332                                                                                  , score       = (0,0)
 333                                                                                  , theReferee  = getRefereeFresh   match.Match.theField (nameOf match.Match.theReferee)
 334                                                                                  , team1       = getTeamFresh West match.Match.theField (nameOf match.Match.team1)
 335                                                                                  , team2       = getTeamFresh East match.Match.theField (nameOf match.Match.team2)
 336                                                                           }
 337         # pSt                                                   = setDigitDisplayValue westId 0 pSt
 338         # pSt                                                   = setDigitDisplayValue eastId 0 pSt
 339         = {pSt & ls = {game & match=match}
 340                , io = setControlLook fieldId True (False,options.renderStyle.look match) io
 341           }
 342 where
 343         getRefereeFresh                                 :: !FootballField !String -> Referee
 344         getRefereeFresh field name              = hd [r field \\ r <- allAvailableReferees | nameOf (r field) == name]
 345
 346         getTeamFresh                                    :: !Home !FootballField !String -> Team
 347         getTeamFresh home field name    = hd [t \\ t <- getAllTeamsOfHome home field | nameOf t == name]
 348
 349 /**     setfieldlook fieldId style pSt
 350                 sets a new rendering style for the football field
 351 */
 352 setfieldlook                                            :: !Id !RenderStyle !(PSt FootballGame) -> PSt FootballGame
 353 setfieldlook fieldId style=:{look} pSt=:{ls=game=:{match,options},io}
 354         = {pSt & ls = {game & options = {options & renderStyle = style}}
 355                , io = setControlLook fieldId True (False,look match) io
 356           }
 357
 358
 359 /** changeSpeedf timerId speed pSt
 360                 modifies the current simulation speed of a match.
 361 */
 362 changeSpeedf                                            :: !Id !DisplaySpeed !(PSt FootballGame) -> PSt FootballGame
 363 changeSpeedf timerId speed pSt=:{ls}
 364         # timerInterval                                 = toInt ((toReal ticksPerSecond)*(toReal ls.match.Match.unittime)*(intervalFactor speed))
 365         # pSt                                                   = {pSt & ls = {FootballGame | ls & options = {Options | ls.options & displaySpeed = speed}}}
 366         = appPIO (setTimerInterval timerId timerInterval) pSt
 367
 368 /** realisticf pSt
 369                 sets a true pseudo-random generating function.
 370 */
 371 realisticf                                                      :: !(PSt FootballGame) -> PSt FootballGame
 372 realisticf pSt=:{ls=ls=:{match}}        = {pSt & ls={FootballGame | ls & match={match & nextRandomP=nextRandomP}}}
 373
 374 /** predictablef pSt
 375                 sets a 'random-generating' function that always yields 1.0.
 376 */
 377 predictablef                                            :: !(PSt FootballGame) -> PSt FootballGame
 378 predictablef pSt=:{ls=ls=:{match}}      = {pSt & ls={FootballGame | ls & match={match & nextRandomP=next1}}}
 379
 380 /** frameRatef timeId halfId framesId pSt
 381                 updates the current playing time and playing half information, as well as the frame rate counter, which is reset every second.
 382 */
 383 frameRatef                                                      :: !TextDisplayId !TextDisplayId !TextDisplayId !(PSt FootballGame) -> PSt FootballGame
 384 frameRatef timeId halfId framesId pSt=:{ls=ls=:{frames,match={Match | playingTime,playingHalf}}}
 385         # pSt                                                   = setTextDisplayText timeId (toString playingTime) pSt
 386         # pSt                                                   = setTextDisplayText halfId (showHalf playingHalf) pSt
 387         = setTextDisplayText framesId (frameRatePrefix <+++ frames) {pSt & ls={ls & frames=0}}
 388
 389 /** matchDialogf westId eastId fieldId timerId refId team1Id team2Id pSt
 390                 opens a dialog in which the user can select two teams that play a match, and a referee to control the match.
 391 */
 392 matchDialogf                                            :: DigitDisplayId DigitDisplayId Id Id TextDisplayId TextDisplayId TextDisplayId (PSt FootballGame) -> PSt FootballGame
 393 matchDialogf westId eastId fieldId timerId refId team1Id team2Id pSt=:{ls=game}
 394         # (dialogId,pSt)                                = openId pSt
 395         # dialog                                                = Dialog "Choose Match"
 396                                                                                 (       LayoutControl
 397                                                                                     (   TextControl "Choose Team West" [ControlPos (Center,zero)]
 398                                                                                     :+: LayoutControl
 399                                                                                         (   RadioControl [  (nameOf t,Nothing,noLS (changeteamf westId eastId fieldId team1Id team2Id West t))
 400                                                                                                          \\ t <- teams West
 401                                                                                                          ] (Columns 1) ((map nameOf (teams West)) ?? (nameOf game.match.Match.team1)+1) []
 402                                                                                         ) [ControlPos (Center,zero)]
 403                                                                                     ) [ControlPos (Left,zero)]
 404                                                                                 :+: LayoutControl
 405                                                                                     (   TextControl "Choose Team East" [ControlPos (Center,zero)]
 406                                                                                     :+: LayoutControl
 407                                                                                         (   RadioControl [  (nameOf t,Nothing,noLS (changeteamf westId eastId fieldId team1Id team2Id East t))
 408                                                                                                          \\ t <- teams East
 409                                                                                                          ] (Columns 1) ((map nameOf (teams East)) ?? (nameOf game.match.Match.team2)+1) []
 410                                                                                         ) [ControlPos (Center,zero)]
 411                                                                                     ) [ControlPos (RightToPrev,zero)]
 412                                                                                 :+: LayoutControl
 413                                                                                     (   TextControl "Choose Referee" [ControlPos (Center,zero)]
 414                                                                                     :+: LayoutControl
 415                                                                                         (   RadioControl [  (nameOf r,Nothing,noLS (changereff timerId refId r))
 416                                                                                                          \\ r <- apply field allAvailableReferees
 417                                                                                                          ] (Columns 1) ((map nameOf (apply field allAvailableReferees)) ?? (nameOf game.match.theReferee)+1) []
 418                                                                                         ) [ControlPos (Center,zero)]
 419                                                                                     ) [ControlPos (RightToPrev,zero)]
 420                                                                                 :+: ButtonControl "Ok" [ControlFunction (closef dialogId),ControlPos (Right,zero)]
 421                                                                                 )
 422                                                                                 [ WindowClose (closef dialogId)
 423                                                                                 , WindowId    dialogId
 424                                                                                 ]
 425         # ((error,_),pSt)                               = openModalDialog undef dialog pSt
 426         | error <> NoError                              = abort "Could not open match dialog.\n"
 427         | otherwise                                             = pSt
 428 where
 429         teams home                                              = getAllTeamsOfHome home field
 430         field                                                   = game.match.theField
 431         closef dialogId                                 = noLS (restartf westId eastId fieldId o closeWindow dialogId)
 432
 433 /** competitionDialogf timerId refId pSt
 434                 opens a dialog in which the user can select the teams that participate in a full competition; i.e. each team plays against each other at either home side of
 435                 the football field. Once the teams and referee are selected, all matches are computed, and the final ranking is displayed.
 436 */
 437 competitionDialogf                                      :: Id TextDisplayId (PSt FootballGame) -> PSt FootballGame
 438 competitionDialogf timerId refId pSt=:{ls=game}
 439         # (dialogId,pSt)                                = openId pSt
 440         # (teamsId, pSt)                                = openId pSt
 441         # dialog                                                = Dialog "Competition"
 442                                                                                 (       LayoutControl
 443                                                                                         (       TextControl "Choose Teams West" [ControlPos (Center,zero)]
 444                                                                                         :+: LayoutControl
 445                                                                                                 (       CheckControl [(nameOf t,Nothing,Mark,id) \\ t <- teams_west] (Columns 1) [ControlId teamsId]
 446                                                                                         ) [ControlPos (Center,zero)]
 447                                                                                     :+: ButtonControl "Select &All"
 448                                                                                                 [ControlFunction (noLS (selectTeams teamsId (index_all_teams,index_no_teams))),ControlPos (Left,zero)]
 449                                                                                     :+: ButtonControl "Cl&ear All"
 450                                                                                                 [ControlFunction (noLS (selectTeams teamsId (index_no_teams,index_all_teams))),ControlPos (RightToPrev,zero)]
 451                                                                                     ) [ControlPos (Left,zero)]
 452                                                                                 :+: LayoutControl
 453                                                                                     (   TextControl "Choose Referee" [ControlPos (Center,zero)]
 454                                                                                     :+: LayoutControl
 455                                                                                         (   RadioControl [(nameOf r,Nothing,noLS (changereff timerId refId r)) \\ r <- apply field allAvailableReferees] (Columns 1) 1 []
 456                                                                                         ) [ControlPos (Center,zero)]
 457                                                                                     ) [ControlPos (RightToPrev,zero)]
 458                                                                                 :+: ButtonControl "Ok" [ControlFunction (noLS (startCompetition teamsId dialogId)),ControlPos (Right,zero)]
 459                                                                                 )
 460                                                                                 [ WindowClose (noLS (closeWindow dialogId))
 461                                                                                 , WindowId    dialogId
 462                                                                                 , WindowPos   (Center,OffsetVector {zero & vy=100})
 463                                                                                 ]
 464         # ((error,_),pSt)                               = openModalDialog undef dialog pSt
 465         | error <> NoError                              = abort "Could not open competition dialog.\n"
 466         | otherwise                                             = pSt
 467 where
 468         teams home                                              = getAllTeamsOfHome home field
 469         teams_west                                              = teams West
 470         index_all_teams                                 = [1 .. length teams_west]
 471         index_no_teams                                  = []
 472         field                                                   = game.match.theField
 473
 474         selectTeams checkId (set,clear) = appPIO (markCheckControlItems checkId set o unmarkCheckControlItems checkId clear)
 475
 476         startCompetition checkId dialogId pSt=:{ls=game}
 477         = case accPIO (getWindow dialogId) pSt of
 478                 (Nothing, pSt)                          = abort "Fatal error: could not retrieve competition dialog data.\n"    // should be impossible, because the dialog has not been closed yet
 479                 (Just wSt,pSt=:{ls=game})
 480                 = case getCheckControlSelection checkId wSt of
 481                         (_,Nothing)                             = closeWindow dialogId pSt
 482                         (_,Just idxs)
 483                                 # (teams,names)         = unzip [(t,nameOf (t West game.match.theField)) \\ t <- allAvailableTeams & i <- [1..] | isMember i idxs]
 484                                 # ((rs,scores),pSt)     = checkCompetitionFile names game.match.seed pSt
 485                                 # compete                       = competition teams game.match.theField game.match.theReferee game.match.Match.playingTime rs
 486                                 = showMatches dialogId compete scores {pSt & ls={game & match = {game.match & seed=rs}}}
 487
 488         showMatches dialogId compete=:{west,east} scores pSt
 489                 # pSt                                           = appPIO (closeAllControls dialogId) pSt
 490                 # (textId,    pSt)                      = openId pSt
 491                 # (progressId,pSt)                      = openId pSt
 492                 # (matchId,   pSt)                      = openId pSt
 493                 # (error,     pSt)                      = openControls dialogId undef
 494                                                                                 (   TextControl "" [ ControlWidth (ContentWidth (result (longest west) (longest east) (Just (99,99))))
 495                                                                                                    , ControlId    textId
 496                                                                                                    , ControlPos   (Center,OffsetVector {zero & vy=100})
 497                                                                                                    ]
 498                                                                                 :+: TextControl "" [ ControlWidth (ContentWidth (progress nr_of_matches nr_of_matches))
 499                                                                                                    , ControlId    progressId
 500                                                                                                    , ControlPos   (BelowPrev,zero)
 501                                                                                                    ]
 502                                                                                 ) pSt
 503                 # (error, pSt)                          = openTimer ([(i,j) \\ i <- [0..length compete.west-1], j <- [0 .. length compete.east-1]],scores)
 504                                                                             (Timer 0 NilLS [TimerFunction (showNextMatch textId progressId matchId compete),TimerId matchId]) pSt
 505                 | error <> NoError                      = abort "Could not open timer to display matches.\n"
 506                 | otherwise                                     = pSt
 507         where
 508                 longest texts                           = hd (sortBy (\t1 t2 -> size t1 > size t2) texts)
 509                 nr_of_matches                           = length west * length east
 510
 511                 result teamw teame score        = teamw +++ "-" +++ teame +++": " <+++ if (isNothing score) "no result" (toString (fromJust score))
 512                 progress i total                        = i +++> (" out of "<+++ total)
 513
 514                 showNextMatch textId progressId matchId compete dt (([_:ms],[_:cs]),pSt)                                                // match has already been computed: skip it
 515                         = showNextMatch textId progressId matchId compete dt ((ms,cs),pSt)
 516                 showNextMatch textId progressId matchId compete=:{results,west,east} dt (([(tw,te):ms],cs),pSt) // match has not yet been computed: compute and backup
 517                         # (pos,pSt)                             = appendMatchToCompetitionFile westt eastt pSt                                          // create an empty entry in the competition backup file
 518                         # pSt                                   = updateMatchToCompetitionFile westt eastt score pos pSt                        // after computing match, store in the competition backup file
 519                         # pSt                                   = appPIO (setControlText textId (result westt eastt score) o            // show user which match was successfully computed
 520                                                                                 setControlText progressId (progress (tw*length west + te) nr_of_matches)) pSt
 521                         = ((ms,cs),pSt)
 522                 where
 523                         (westt,eastt,score)             = ( west!!tw, east!!te, results!!tw!!te )
 524                 showNextMatch textId progressId matchId compete _ (ls,pSt)
 525                         # pSt                                   = appPIO (closeTimer matchId) pSt
 526                         # ((_,scores),pSt)              = checkCompetitionFile compete.west compete.usedRandomSeed pSt
 527                         = (ls,showRanking dialogId (ranking compete.west scores) pSt)
 528
 529         showRanking dialogId ranking pSt
 530                 # pSt                                           = rankingToFile pSt
 531                 # pSt                                           = appPIO (closeAllControls dialogId) pSt
 532                 # (error,pSt)                           = openControls dialogId undef resultlist pSt
 533                 | error <> NoError                      = abort "Could not refill dialog with result list.\n"
 534                 | otherwise                                     = pSt
 535         where
 536                 sorted_ranking                          = sortBy (\(_,r1) (_,r2) -> r1 > r2) ranking            // sort ranked list in descending order
 537                 resultlist                                      =     LayoutControl
 538                                                                           (   ListLS [TextControl (toString i) [ControlPos (Left,zero)] \\ i        <- [1..length sorted_ranking]]
 539                                                                           )   [ControlPos (LeftTop,zero),ControlItemSpace 4 0]
 540                                                                           :+: LayoutControl
 541                                                                           (   ListLS [TextControl club         [ControlPos (Left,zero)] \\ (club,_) <- sorted_ranking]
 542                                                                           )   [ControlPos (RightToPrev,zero),ControlItemSpace 4 0]
 543                                                                           :+: LayoutControl
 544                                                                           (   ListLS [TextControl (toString r.matchpoints) [ControlPos (Left,zero)] \\ (_,r) <- sorted_ranking]
 545                                                                           )   [ControlPos (RightToPrev,zero),ControlItemSpace 4 0]
 546                                                                           :+: LayoutControl
 547                                                                           (   ListLS [TextControl (toString r.goals_scored) [ControlPos (Left,zero)] \\ (_,r) <- sorted_ranking]
 548                                                                           )   [ControlPos (RightToPrev,zero),ControlItemSpace 4 0]
 549                                                                           :+: LayoutControl
 550                                                                           (   ListLS [TextControl (toString r.goals_against) [ControlPos (Left,zero)] \\ (_,r) <- sorted_ranking]
 551                                                                           )   [ControlPos (RightToPrev,zero),ControlItemSpace 4 0]
 552                                                                           :+: ButtonControl "Ok" [ControlFunction (noLS (closeWindow dialogId)),ControlPos (Right,zero)]
 553
 554                 rankingToFile env
 555                         # (ok,file,env)                 = fopen "ranking.txt" FWriteText env
 556                         | not ok                                = trace_n "Could not output ranking to ranking.txt" env
 557                         # file                                  = foldl (\file (club,{matchpoints,goals_scored,goals_against}) -> fwrites (club <+++ "\t" <+++ matchpoints <+++ "\t" <+++ goals_scored <+++ "\t" <+++ goals_against <+++ "\n") file) file sorted_ranking
 558                         # (ok,env)                              = fclose file env
 559                         | not ok                                = trace_n "Could not close ranking.txt" env
 560                         | otherwise                             = env
 561
 562 //      Utility functions:
 563 showHalf                                                        :: !Half -> String
 564 showHalf FirstHalf                                      = "1st half"
 565 showHalf SecondHalf                                     = "2nd half"
 566
 567 /** getAllTeamsOfHome home field
 568                 yields all teams that start playing at given home and given football field dimensions.
 569 */
 570 getAllTeamsOfHome                                       :: !Home !FootballField -> [Team]
 571 getAllTeamsOfHome home field            = apply field (apply home allAvailableTeams)