1 implementation module Gui2D
3 import StdEnvExt, StdIOExt
5 import digitdisplay, textdisplay, render, matchGame, RangeSlider
8 SoccerFunGUI2D :: !*World -> *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
17 getBeginMatch :: !*env -> (!FootballGame,!*env) | TimeEnv, FileSystem 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
26 , actionPics = {refereePics=[]}
27 , history = {time=s 2.0,past=[]}
35 teams = allAvailableTeams
36 referees = allAvailableReferees
37 field = getDefaultField
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"
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)
57 , ControlPos (Center,zero)
58 , ControlResize (\_ _ wViewSize=:{h} -> {wViewSize & h=h-digitDisplaySize.h-60})
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)})
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})
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"))
74 [ WindowViewSize {w=footballFieldDisplaySize.w-1, h=footballFieldDisplaySize.h+digitDisplaySize.h}
75 , WindowLook False stdUnfillNewFrameLook
76 , WindowPen [PenBack Black]
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)))
87 , TimerSelectState Unable
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"
95 ( MenuItem "E&xit" [MenuShortKey 'q',MenuFunction (noLS quitf)]
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))]
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))]
107 :+: SubMenu "&Mode" ( RadioMenu [ ("&Realistic", Nothing,Nothing,noLS realisticf)
108 , ("&Predictable",Nothing,Nothing,noLS predictablef)
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) []
119 :+: SubMenu "Re&feree" ( RadioMenu [ ("&Show", Nothing, Just '+', noLS (showReff True))
120 , ("&NoShow", Nothing, Just '-', noLS (showReff False))
121 ] ([True,False]??options.showReferee+1) []
123 :+: SubMenu "R&ender" ( RadioMenu [ (nameOf style, Nothing, Nothing, noLS (setfieldlook fieldId style))
124 \\ style <- allRenderStyles
125 ] ((map nameOf allRenderStyles)??(nameOf options.renderStyle)+1) []
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]
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
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"
142 ( ButtonControl "&Close" [ControlFunction (noLS closeActiveWindow)]
144 [ ControlLook True (const2 (drawAt zero spls.img))
145 , ControlViewSize (getBitmapSize spls.img)
148 # ((error,_),pSt) = openModalDialog undef splashDef pSt
149 | error<>NoError = abort "Could not open splash screen.\n"
153 // Constants for the GUI:
154 digitDisplaySize = { w=24, h=36 }
155 footballFieldDisplaySize = { w=640,h=400}
156 frameRatePrefix :== "Rounds/sec: "
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.
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)
168 where teamSize {w} = {digitDisplaySize & w=(w-digitDisplaySize.w*4)/2}
170 /** fpsDisplay id name font colour
171 describes a TextDisplay that is used to display the frame rate of a match.
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)
180 // The callback functions of the GUI:
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.
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}}}
191 stores the current options to disk and terminates the parent interactive process.
193 quitf :: !(PSt FootballGame) -> PSt FootballGame
195 # pSt = setOptions game.options pSt
196 # pSt = closeProcess pSt
199 /** continuef timerId pSt
200 continues the simulation of the current match.
202 continuef :: !Id !(PSt FootballGame) -> PSt FootballGame
203 continuef timerId pSt = appPIO (enableTimer timerId) pSt
205 /** haltf timerId pSt
206 stops the simulation of the current match.
208 haltf :: !Id !(PSt FootballGame) -> PSt FootballGame
209 haltf timerId pSt = appPIO (disableTimer timerId) pSt
211 /** stepf timerId fieldId westId eastId pSt
212 stops the simulation of the current match, and computes a single step of the current match.
214 stepf :: !Id !Id !DigitDisplayId !DigitDisplayId -> IdFun (PSt FootballGame)
215 stepf timerId fieldId westId eastId = nextstep timerId fieldId westId eastId o haltf timerId
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.
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
226 = analyseRefEvents refEvents pSt
228 analyseRefEvents :: ![RefereeAction] !(PSt FootballGame) -> PSt FootballGame
229 analyseRefEvents refEvents pSt = foldl analyseRefEvent pSt refEvents
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])
235 # pSt = refereeDialog rev pSt
236 # pSt = if (isGameOver rev) (appPIO (disableTimer timerId) pSt) pSt
238 Goal h = if (h == West && playingHalf == FirstHalf || h == East && playingHalf == SecondHalf)
239 (setDigitDisplayValue westId (fst score) pSt)
240 (setDigitDisplayValue eastId (snd score) pSt)
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
247 # pSt = case defaultSoundFile rev of
248 Just sound = appPIO (makeSound sound) 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)))))
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"
267 /** showReff show pSt
268 sets the option to show the referee during simulation.
270 showReff :: !Bool !(PSt FootballGame) -> PSt FootballGame
271 showReff show pSt = {pSt & ls = {pSt.ls & options = {pSt.ls.options & showReferee = show}}}
273 /** playtimef westId eastId fieldId timeId pSt
274 opens the dialog to alter the play time of a match.
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)]
286 [ WindowClose (noLS (closeWindow dialogId))
289 # ((error,_),pSt) = openModalDialog undef playingtimeDef pSt
290 | error <> NoError = abort "Could not open Playing Time dialog.\n"
293 times = map minutes [0.5, 1.0 .. 10.0]
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}
301 # pSt = restartf westId eastId fieldId pSt
304 display_time = toString newtime
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.
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
317 /** changereff timerId refId referee pSt
318 replaces the current referee with the given referee and adapts the display name of the new referee.
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}}}
325 /** restartf fieldId pSt
326 makes sure that the current match is reinitialized to the initial teams, referee, and ball position.s
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
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)
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
344 getRefereeFresh :: !FootballField !String -> Referee
345 getRefereeFresh field name = hd [r field \\ r <- allAvailableReferees | nameOf (r field) == name]
347 getTeamFresh :: !Home !FootballField !String -> Team
348 getTeamFresh home field name = hd [t \\ t <- getAllTeamsOfHome home field | nameOf t == name]
350 /** setfieldlook fieldId style pSt
351 sets a new rendering style for the football field
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
360 /** changeSpeedf timerId speed pSt
361 modifies the current simulation speed of a match.
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
370 sets a true pseudo-random generating function.
372 realisticf :: !(PSt FootballGame) -> PSt FootballGame
373 realisticf pSt=:{ls=ls=:{match}} = {pSt & ls={FootballGame | ls & match={match & nextRandomP=nextRandomP}}}
376 sets a 'random-generating' function that always yields 1.0.
378 predictablef :: !(PSt FootballGame) -> PSt FootballGame
379 predictablef pSt=:{ls=ls=:{match}} = {pSt & ls={FootballGame | ls & match={match & nextRandomP=next1}}}
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.
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}}
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.
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"
398 ( TextControl "Choose Team West" [ControlPos (Center,zero)]
400 ( RadioControl [ (nameOf t,Nothing,noLS (changeteamf westId eastId fieldId team1Id team2Id West t))
402 ] (Columns 1) ((map nameOf (teams West)) ?? (nameOf game.match.Match.team1)+1) []
403 ) [ControlPos (Center,zero)]
404 ) [ControlPos (Left,zero)]
406 ( TextControl "Choose Team East" [ControlPos (Center,zero)]
408 ( RadioControl [ (nameOf t,Nothing,noLS (changeteamf westId eastId fieldId team1Id team2Id East t))
410 ] (Columns 1) ((map nameOf (teams East)) ?? (nameOf game.match.Match.team2)+1) []
411 ) [ControlPos (Center,zero)]
412 ) [ControlPos (RightToPrev,zero)]
414 ( TextControl "Choose Referee" [ControlPos (Center,zero)]
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)]
423 [ WindowClose (closef dialogId)
426 # ((error,_),pSt) = openModalDialog undef dialog pSt
427 | error <> NoError = abort "Could not open match dialog.\n"
430 teams home = getAllTeamsOfHome home field
431 field = game.match.theField
432 closef dialogId = noLS (restartf westId eastId fieldId o closeWindow dialogId)
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.
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"
444 ( TextControl "Choose Teams West" [ControlPos (Center,zero)]
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)]
454 ( TextControl "Choose Referee" [ControlPos (Center,zero)]
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)]
461 [ WindowClose (noLS (closeWindow dialogId))
463 , WindowPos (Center,OffsetVector {zero & vy=100})
465 # ((error,_),pSt) = openModalDialog undef dialog pSt
466 | error <> NoError = abort "Could not open competition dialog.\n"
469 teams home = getAllTeamsOfHome home field
470 teams_west = teams West
471 index_all_teams = [1 .. length teams_west]
473 field = game.match.theField
475 selectTeams checkId (set,clear) = appPIO (markCheckControlItems checkId set o unmarkCheckControlItems checkId clear)
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
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}}}
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))))
497 , ControlPos (Center,OffsetVector {zero & vy=100})
499 :+: TextControl "" [ ControlWidth (ContentWidth (progress nr_of_matches nr_of_matches))
500 , ControlId progressId
501 , ControlPos (BelowPrev,zero)
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"
509 longest texts = hd (sortBy (\t1 t2 -> size t1 > size t2) texts)
510 nr_of_matches = length west * length east
512 result teamw teame score = teamw +++ "-" +++ teame +++": " <+++ if (isNothing score) "no result" (toString (fromJust score))
513 progress i total = i +++> (" out of "<+++ total)
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
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)
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"
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]
542 ( ListLS [TextControl club [ControlPos (Left,zero)] \\ (club,_) <- sorted_ranking]
543 ) [ControlPos (RightToPrev,zero),ControlItemSpace 4 0]
545 ( ListLS [TextControl (toString r.matchpoints) [ControlPos (Left,zero)] \\ (_,r) <- sorted_ranking]
546 ) [ControlPos (RightToPrev,zero),ControlItemSpace 4 0]
548 ( ListLS [TextControl (toString r.goals_scored) [ControlPos (Left,zero)] \\ (_,r) <- sorted_ranking]
549 ) [ControlPos (RightToPrev,zero),ControlItemSpace 4 0]
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)]
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
563 // Utility functions:
564 showHalf :: !Half -> String
565 showHalf FirstHalf = "1st half"
566 showHalf SecondHalf = "2nd half"
568 /** getAllTeamsOfHome home field
569 yields all teams that start playing at given home and given football field dimensions.
571 getAllTeamsOfHome :: !Home !FootballField -> [Team]
572 getAllTeamsOfHome home field = apply field (apply home allAvailableTeams)