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