Scid  4.7.0
tourney.tcl
Go to the documentation of this file.
1 
2 ####################
3 # Tournament window
4 
5 namespace eval ::tourney {}
6 
7 foreach {n v} {start 0000.00.00 end 2047.12.31 minPlayers 2 maxPlayers 999 \
8  minGames 1 maxGames 9999 minElo 0 maxElo 4000 sort Date \
9  country "" site "" event "" player "" size 50} {
10  set ::tourney::$n $v
11 }
12 
13 trace variable ::tourney::start w ::utils::validate::Date
14 trace variable ::tourney::end w ::utils::validate::Date
15 foreach {n v} {minPlayers 999 maxPlayers 999 minGames 9999 maxGames 9999 \
16  minElo [sc_info limit elo] maxElo [sc_info limit elo]} {
17  trace variable ::tourney::$n w [list ::utils::validate::Integer $v 0]
18 }
19 
20 set tourneyWin 0
21 
22 proc ::tourney::toggle {} {
23  set w .tourney
24  if {[winfo exists $w]} {
25  destroy $w
26  } else {
28  }
29 }
30 
31 proc ::tourney::Open {} {
32  global tourneyWin
33  set w .tourney
34  if {[winfo exists $w]} { return}
35  set tourneyWin 1
36 
37  if {! [info exists ::tourney::_defaults]} { ::tourney::defaults}
38 
40 # $w configure -background [ttk::style lookup . -background]
41  ::setTitle $w "Scid: [tr WindowsTmt]"
42  wm title $w "Scid: [tr WindowsTmt]"
43 
44  bind $w <F1> {helpWindow Tmt}
45  bind $w <Escape> "$w.b.close invoke"
46  bind $w <Return> ::tourney::refresh
47  bind $w <Destroy> { set tourneyWin 0 }
48  bind $w <Up> "$w.t.text yview scroll -1 units"
49  bind $w <Down> "$w.t.text yview scroll 1 units"
50  bind $w <Prior> "$w.t.text yview scroll -1 pages"
51  bind $w <Next> "$w.t.text yview scroll 1 pages"
52  bind $w <Key-Home> "$w.t.text yview moveto 0"
53  bind $w <Key-End> "$w.t.text yview moveto 0.99"
54 
55  foreach i {t o1 o2 o3 b} {ttk::frame $w.$i}
56  text $w.t.text -width 75 -height 22 -font font_Small -wrap none \
57  -fg black -bg white -yscrollcommand "$w.t.ybar set" -setgrid 1 \
58  -cursor top_left_arrow -xscrollcommand "$w.t.xbar set"
59  autoscrollBars both $w.t $w.t.text
60  set xwidth [font measure [$w.t.text cget -font] "0"]
61  set tablist {}
62  foreach {tab justify} {3 r 4 l 18 r 23 r 30 r 32 l 55 l} {
63  set tabwidth [expr {$xwidth * $tab}]
64  lappend tablist $tabwidth $justify
65  }
66  $w.t.text configure -tabs $tablist
67  $w.t.text tag configure date -foreground darkRed
68  $w.t.text tag configure np -foreground darkBlue
69  $w.t.text tag configure elo -foreground darkGreen
70  $w.t.text tag configure best -foreground steelBlue
71  $w.t.text tag configure event -foreground darkRed
72  $w.t.text tag configure title -font font_SmallBold
73 
74  set font font_Small
75  set fbold font_SmallBold
76  set f $w.o1
77  ttk::label $f.from -text "[tr TmtSortDate]:" -font $fbold
78  ttk::entry $f.efrom -textvariable ::tourney::start -width 10 -font $font
79  bindFocusColors $f.efrom
80  ttk::label $f.to -text "-" -font $font
81  ttk::entry $f.eto -textvariable ::tourney::end -width 10 -font $font
82  bindFocusColors $f.eto
83  pack $f.from $f.efrom $f.to $f.eto -side left
84 
85  ttk::label $f.cn -text " $::tr(Country):" -font $fbold
86  ttk::combobox $f.ecn -width 4 -textvar ::tourney::country -values {{} AUT CZE DEN ENG ESP FRA GER GRE HUN ITA NED POL RUS \
87  SCG SUI SWE USA YUG}
88 
89  bindFocusColors $f.ecn
90  pack $f.cn $f.ecn -side left
91 
92  ttk::label $f.size -text $::tr(TmtLimit:) -font $fbold
93  ttk::combobox $f.esize -width 4 -justify right -textvar ::tourney::size -values {10 20 50 100 200 500 1000}
94  trace variable ::tourney::size w {::utils::validate::Integer 1000 0}
95  bindFocusColors $f.esize
96 
97  pack $f.esize $f.size -side right -pady "2 0"
98 
99  set f $w.o2
100  ttk::label $f.players -text "[tr TmtSortPlayers]:" -font $fbold
101  ttk::entry $f.pmin -textvariable ::tourney::minPlayers \
102  -width 3 -justify right -font $font
103  bindFocusColors $f.pmin
104  ttk::label $f.pto -text "-"
105  ttk::entry $f.pmax -textvariable ::tourney::maxPlayers \
106  -width 3 -justify right -font $font
107  bindFocusColors $f.pmax
108  pack $f.players $f.pmin $f.pto $f.pmax -side left -pady "2 0"
109 
110  ttk::label $f.games -text " [tr TmtSortGames]:" -font $fbold
111  ttk::entry $f.gmin -textvariable ::tourney::minGames \
112  -width 4 -justify right -font $font
113  bindFocusColors $f.gmin
114  ttk::label $f.gto -text "-" -font $font
115  ttk::entry $f.gmax -textvariable ::tourney::maxGames \
116  -width 4 -justify right -font $font
117  bindFocusColors $f.gmax
118  pack $f.games $f.gmin $f.gto $f.gmax -side left -pady "2 0"
119  ttk::label $f.elolab -text "$::tr(TmtMeanElo):" -font $fbold
120  ttk::entry $f.elomin -textvariable ::tourney::minElo \
121  -width 5 -justify right -font $font
122  bindFocusColors $f.elomin
123  ttk::label $f.eto -text "-" -font $font
124  ttk::entry $f.elomax -textvariable ::tourney::maxElo \
125  -width 5 -justify right -font $font
126  bindFocusColors $f.elomax
127  pack $f.elomax $f.eto $f.elomin $f.elolab -side right
128 
129  set f $w.o3
130  ttk::label $f.sitelab -text "$::tr(Site):" -font $fbold
131  ttk::combobox $f.site -textvariable ::tourney::site -width 12
132  ::utils::history::SetCombobox ::tourney::site $f.site
133  bindFocusColors $f.site
134  pack $f.sitelab $f.site -side left
135 
136  ttk::label $f.eventlab -text " $::tr(Event):" -font $fbold
137  ttk::combobox $f.event -textvariable ::tourney::event -width 12
138  ::utils::history::SetCombobox ::tourney::event $f.event
139  bindFocusColors $f.event
140  pack $f.eventlab $f.event -side left -pady "2 0"
141 
142  ttk::label $f.playerlab -text "$::tr(Player):" -font $fbold
143  ttk::combobox $f.player -textvariable ::tourney::player -width 12
144  ::utils::history::SetCombobox ::tourney::player $f.player
145  bindFocusColors $f.player
146  pack $f.player $f.playerlab -side right
147  focus $f.site
148 
149  dialogbutton $w.b.defaults -textvar ::tr(Defaults) -command ::tourney::defaults
150  dialogbutton $w.b.help -textvar ::tr(Help) -command {helpWindow Tmt}
151  dialogbutton $w.b.update -textvar ::tr(Search) -command ::tourney::refresh
152  packbuttons right $w.b.update $w.b.help
153  packbuttons left $w.b.defaults
154  grid $w.o1 -sticky news
155  grid $w.o2 -sticky news
156  grid $w.o3 -sticky news
157  grid $w.b -sticky news
158  grid $w.t -sticky news
159  grid rowconfigure $w 4 -weight 1
160  grid columnconfigure $w 0 -weight 1
161 
164 }
165 
166 proc ::tourney::defaults {} {
167  set ::tourney::_defaults 1
168  set ::tourney::start ""
169  set ::tourney::end ""
170  set ::tourney::size 50
171  set ::tourney::minPlayers ""
172  set ::tourney::maxPlayers ""
173  set ::tourney::minGames ""
174  set ::tourney::maxGames ""
175  set ::tourney::minElo ""
176  set ::tourney::maxElo ""
177  set ::tourney::country ""
178  set ::tourney::site ""
179  set ::tourney::event ""
180  set ::tourney::player ""
181 }
182 
183 proc ::tourney::refresh {{option ""}} {
184  set w .tourney
185  if {! [winfo exists $w]} { return}
186 
187  busyCursor $w
188  ::utils::history::AddEntry ::tourney::site $::tourney::site
189  ::utils::history::AddEntry ::tourney::event $::tourney::event
190  ::utils::history::AddEntry ::tourney::player $::tourney::player
191 
192  set t $w.t.text
193  $t configure -state normal
194  $t delete 1.0 end
196  update
197 
198  set ::curr_db [sc_base current]
199  set filter [sc_filter new $::curr_db]
200  set start $::tourney::start
201  set end $::tourney::end
202  if { $start eq "" } { set start "1800.01.01"}
203  if { $end eq "" } { set year [::utils::date::today year]; set start "$year.12.31"}
204  sc_filter search $::curr_db $filter header \
205  -filter RESET \
206  -date [list $start $end] \
207  -site $::tourney::site \
208  -sitecountry [string toupper $::tourney::country] \
209  -event $::tourney::event
210  set err [catch {sc_base tournaments $::curr_db $filter {*}[::tourney::getSearchOptions]} tlist]
211  sc_filter release $::curr_db $filter
212  unbusyCursor .
213 
214  if {$err} {
216  return
217  }
218 
219  if {[llength $tlist] > 0} {
220  foreach i {Date Players Games Elo Site Event} {
221  $t tag configure s$i -font font_SmallBold
222  $t tag bind s$i <1> "set ::tourney::sort $i; ::tourney::refresh"
223  $t tag bind s$i <Any-Enter> "$t tag config s$i -foreground red"
224  $t tag bind s$i <Any-Leave> "$t tag config s$i -foreground {}"
225  }
226  $t tag configure sWinner -font font_SmallBold
227  $t insert end "\t\t"
228  $t insert end [tr TmtSortDate] sDate
229  $t insert end "\t"
230  $t insert end [tr TmtSortPlayers] sPlayers
231  $t insert end "\t"
232  $t insert end [tr TmtSortGames] sGames
233  $t insert end "\t"
234  $t insert end [tr TmtSortElo] sElo
235  $t insert end "\t"
236  $t insert end [tr TmtSortSite] sSite
237  $t insert end ": "
238  $t insert end [tr TmtSortEvent] sEvent
239  $t insert end "\t"
240  $t insert end [tr TmtSortWinner] sWinner
241  $t insert end "\n"
242  } else {
243  $t insert end $::tr(TmtNone)
244  }
245 
246  set hc yellow
247  set count 0
248  foreach tmt $tlist {
249  incr count
250  if {$count > $::tourney::size} { break}
251  set date [lindex $tmt 0]
252  set site [lindex $tmt 1]
253  set event [lindex $tmt 2]
254  set np [lindex $tmt 3]
255  set ng [lindex $tmt 4]
256  set elo [lindex $tmt 5]
257  set g [lindex $tmt 6]
258  set white [::utils::string::Surname [lindex $tmt 7]]
259  set welo [lindex $tmt 8]
260  set wscore [lindex $tmt 9]
261  set black [::utils::string::Surname [lindex $tmt 10]]
262  set belo [lindex $tmt 11]
263  set bscore [lindex $tmt 12]
264  if {$welo > 0} { append white "($welo)"}
265  if {$belo > 0} { append black "($belo)"}
266  append white " $wscore"
267  append black " $bscore"
268  set one "1."
269  set two "2."
270  if {$wscore == $bscore} {
271  set one "1="; set two "1="
272  }
273  set best "$one $white, $two $black, ..."
274  if {$np == 2} { set best "$one $white, $two $black"}
275 
276  $t tag bind g$count <ButtonPress-1> [list ::tourney::select $g]
277  $t tag bind g$count <ButtonPress-$::MB3> [list ::tourney::select $g]
278  $t tag bind g$count <Any-Enter> \
279  "$t tag configure g$count -background $hc"
280  $t tag bind g$count <Any-Leave> \
281  "$t tag configure g$count -background {}"
282  $t insert end "\n"
283  $t insert end "\t$count\t" g$count
284  $t insert end $date [list date g$count]
285  $t insert end "\t" g$count
286  $t insert end $np [list np g$count]
287  $t insert end "\t" g$count
288  $t insert end $ng [list ng g$count]
289  $t insert end "\t" g$count
290  $t insert end $elo [list elo g$count]
291  $t insert end "\t" g$count
292  $t insert end "$site: " [list site g$count]
293  $t insert end "$event" [list event g$count]
294  $t insert end "\t$best" [list best g$count]
295  }
296  $t insert end "\n"
297  $t configure -state disabled
298 }
299 
300 proc ::tourney::check {} {
301  set start $::tourney::start
302  set end $::tourney::end
303  if {[string length $start] == 4} { append start ".??.??"}
304  if {[string length $end] == 4} { append end ".12.31"}
305  if {[string length $start] == 7} { append start ".??"}
306  if {[string length $end] == 7} { append end ".31"}
307  set ::tourney::start $start
308  set ::tourney::end $end
309  set s $::tourney::country
310  set s [string toupper [string trim $s]]
311  if {[string length $s] > 3} { set s [string range $s 0 2]}
312  set ::tourney::country $s
313  if {$::tourney::country == "---"} {
314  set ::tourney::country ""
315  }
316  if { $::tourney::maxGames ne "" && $::tourney::minGames > $::tourney::maxGames} {
317  set help $::tourney::maxGames
318  set ::tourney::maxGames $::tourney::minGames
319  set ::tourney::minGames $help
320  }
321  if {$::tourney::maxElo ne "" && $::tourney::minElo > $::tourney::maxElo} {
322  set help $::tourney::maxElo
323  set ::tourney::maxElo $::tourney::minElo
324  set ::tourney::minElo $help
325  }
326  if {$::tourney::maxPlayers ne "" && $::tourney::minPlayers > $::tourney::maxPlayers} {
327  set help $::tourney::maxPlayers
328  set ::tourney::maxPlayers $::tourney::minPlayers
329  set ::tourney::minPlayers $help
330  }
331 }
332 
333 proc ::tourney::select {gnum} {
334  if {[catch {::game::Load $gnum} result]} {
335  tk_messageBox -type ok -icon info -title "Scid" -message $result
336  return
337  }
338  updateBoard -pgn
341 }
342 
343 proc ::tourney::getSearchOptions {} {
344  set options [list $::tourney::size]
345  if {$::tourney::player ne ""} {
346  lappend options "-player" $::tourney::player
347  }
348  if {$::tourney::sort ne ""} {
349  lappend options "-sort" $::tourney::sort
350  }
351  if {$::tourney::minPlayers ne "" || $::tourney::maxPlayers ne ""} {
352  set minp 2
353  set maxp 999
354  if {$::tourney::minPlayers ne ""} {
355  set minp $::tourney::minPlayers
356  }
357  if {$::tourney::maxPlayers ne ""} {
358  set maxp $::tourney::maxPlayers
359  }
360  lappend options "-n_players" [list $minp $maxp]
361  }
362  if {$::tourney::minGames ne "" || $::tourney::maxGames ne ""} {
363  set ming 1
364  set maxg 9999
365  if {$::tourney::minGames ne ""} {
366  set ming $::tourney::minGames
367  }
368  if {$::tourney::maxGames ne ""} {
369  set maxg $::tourney::maxGames
370  }
371  lappend options "-n_games" [list $ming $maxg]
372  }
373  if {$::tourney::minElo ne "" || $::tourney::maxElo ne ""} {
374  set mine 0
375  set maxe 4000
376  if {$::tourney::minElo ne ""} {
377  set mine $::tourney::minElo
378  }
379  if {$::tourney::maxElo ne ""} {
380  set maxe $::tourney::maxElo
381  }
382  lappend options "-avgelo" [list $mine $maxe]
383  }
384  return $options
385 }