Scid  4.6.5
crosstab.tcl
Go to the documentation of this file.
1 
2 ######################################################################
3 ### Crosstable window
4 
5 namespace eval ::crosstab {}
6 
7 set crosstab(sort) score
8 set crosstab(type) auto
9 set crosstab(ages) "+ages"
10 set crosstab(colors) "+colors"
11 set crosstab(ratings) "+ratings"
12 set crosstab(countries) "+countries"
13 set crosstab(titles) "+titles"
14 set crosstab(groups) "-groups"
15 set crosstab(breaks) "-breaks"
16 set crosstab(deleted) "-deleted"
17 set crosstab(cnumbers) "-numcolumns"
18 set crosstab(text) hypertext
19 
20 proc ::crosstab::ConfigMenus {{lang ""}} {
21  if {! [winfo exists .crosstabWin]} { return}
22  if {$lang == ""} { set lang $::language}
23  set m .crosstabWin.menu
24  foreach idx {0 1 2 3 4 5} tag {File Edit Opt Sort Color Help} {
25  configMenuText $m $idx Crosstab$tag $lang
26  }
27  foreach idx {0 1 2 4} tag {Text Html LaTeX Close} {
28  configMenuText $m.file $idx CrosstabFile$tag $lang
29  }
30  foreach idx {0 1 2} tag {Event Site Date} {
31  configMenuText $m.edit $idx CrosstabEdit$tag $lang
32  }
33  foreach idx {0 1 2 3 5 6 7 8 9 10 12 13 15} tag {All Swiss Knockout Auto Ages Nats Ratings Titles Breaks Deleted Colors ColumnNumbers Group} {
34  configMenuText $m.opt $idx CrosstabOpt$tag $lang
35  }
36  foreach idx {0 1 2} tag {Name Rating Score} {
37  configMenuText $m.sort $idx CrosstabSort$tag $lang
38  }
39  foreach idx {0 1} tag {Plain Hyper} {
40  configMenuText $m.color $idx CrosstabColor$tag $lang
41  }
42  foreach idx {0 1} tag {Cross Index} {
43  configMenuText $m.helpmenu $idx CrosstabHelp$tag $lang
44  }
45 }
46 
47 proc toggleCrosstabWin {} {
48  set w .crosstabWin
49  if {[winfo exists $w]} {
50  destroy $w
51  } else {
53  }
54 }
55 
56 proc ::crosstab::RefreshIfOpen {} {
57  set w .crosstabWin
58  if {[winfo exists $w]} { crosstabWin}
59 }
60 
61 proc ::crosstab::Open {} {
62  global crosstab
63  set ::crosstab(dbase) [sc_base current]
64  set w .crosstabWin
65  if {[::createToplevel $w] == "already_exists"} {
67  return
68  }
69 
70  ::setTitle $w "Scid: [tr ToolsCross]"
71  wm minsize $w 50 5
73 
74  menu $w.menu
75  $w configure -menu $w.menu
76  $w.menu add cascade -label CrosstabFile -menu $w.menu.file
77  $w.menu add cascade -label CrosstabEdit -menu $w.menu.edit
78  $w.menu add cascade -label CrosstabOpt -menu $w.menu.opt
79  $w.menu add cascade -label CrosstabSort -menu $w.menu.sort
80  $w.menu add cascade -label CrosstabText -menu $w.menu.color
81  $w.menu add cascade -label CrosstabHelp -menu $w.menu.helpmenu
82  foreach i {file edit opt sort color helpmenu} {
83  menu $w.menu.$i -tearoff 0
84  }
85 
86  $w.menu.file add command -label CrosstabFileText -command {
87  set ftype {
88  { "Text files" {".txt"} }
89  { "All files" {"*"} }
90  }
91  set fname [tk_getSaveFile -initialdir [pwd] -filetypes $ftype -title "Save Crosstable"]
92  if {$fname != ""} {
93  if {[catch {set tempfile [open $fname w]}]} {
94  tk_messageBox -title "Scid: Error saving file" -type ok -icon warning -message "Unable to save the file: $fname\n\n"
95  } else {
96  puts -nonewline $tempfile [.crosstabWin.f.text get 1.0 end]
97  close $tempfile
98  }
99  }
100  }
101  $w.menu.file add command -label CrosstabFileHtml -command {
102  set ftype {
103  { "HTML files" {".html" ".htm"} }
104  { "All files" {"*"} }
105  }
106  set fname [tk_getSaveFile -initialdir $::initialDir(html) -filetypes $ftype -title "Save Crosstable as HTML"]
107  if {$fname != ""} {
108  if {[file extension $fname] != ".html" && [file extension $fname] != ".htm" } {
109  append fname ".html"
110  }
111  if {[catch {set tempfile [open $fname w]}]} {
112  tk_messageBox -title "Scid: Error saving file" -type ok -icon warning -message "Unable to save the file: $fname\n\n"
113  } else {
114  catch {sc_game crosstable html $crosstab(sort) $crosstab(type) \
115  $crosstab(ratings) $crosstab(countries) $crosstab(titles) \
116  $crosstab(colors) $crosstab(groups) $crosstab(ages) \
117  $crosstab(breaks) $crosstab(cnumbers) $crosstab(deleted)} \
118  result
119  puts $tempfile $result
120  close $tempfile
121  }
122  }
123  }
124  $w.menu.file add command -label CrosstabFileLaTeX -command {
125  set ftype {
126  { "LaTeX files" {".tex" ".ltx"} }
127  { "All files" {"*"} }
128  }
129  set fname [tk_getSaveFile -initialdir $::initialDir(tex) -filetypes $ftype -title "Save Crosstable as LaTeX"]
130  if {$fname != ""} {
131  if {[file extension $fname] != ".tex" && [file extension $fname] != ".ltx" } {
132  append fname ".tex"
133  }
134  if {[catch {set tempfile [open $fname w]}]} {
135  tk_messageBox -title "Scid: Error saving file" \
136  -type ok -icon warning \
137  -message "Unable to save the file: $fname\n\n"
138  } else {
139  catch {sc_game crosstable latex $crosstab(sort) $crosstab(type) \
140  $crosstab(ratings) $crosstab(countries) $crosstab(titles) \
141  $crosstab(colors) $crosstab(groups) $crosstab(ages) \
142  $crosstab(breaks) $crosstab(cnumbers) $crosstab(deleted)} \
143  result
144  puts $tempfile $result
145  close $tempfile
146  }
147  }
148  }
149  $w.menu.file add separator
150  $w.menu.file add command -label CrosstabFileClose \
151  -command { .crosstabWin.b.cancel invoke } -accelerator Esc
152 
153  $w.menu.edit add command -label CrosstabEditEvent -command {
154  makeNameEditor
155  setNameEditorType event
156  set editName [sc_game info event]
157  set editNameNew ""
158  set editNameSelect crosstable
159  }
160  $w.menu.edit add command -label CrosstabEditSite -command {
161  makeNameEditor
162  setNameEditorType site
163  set editName [sc_game info site]
164  set editNameNew ""
165  set editNameSelect crosstable
166  }
167  $w.menu.edit add command -label CrosstabEditDate -command {
168  makeNameEditor
169  setNameEditorType date
170  set editNameNew " "
171  set editDate [sc_game info date]
172  set editDateNew [sc_game info date]
173  set editNameSelect crosstable
174  }
175 
176  $w.menu.opt add radiobutton -label CrosstabOptAll \
177  -variable crosstab(type) -value allplay -command crosstabWin
178  $w.menu.opt add radiobutton -label CrosstabOptSwiss \
179  -variable crosstab(type) -value swiss -command crosstabWin
180  $w.menu.opt add radiobutton -label CrosstabOptKnockout \
181  -variable crosstab(type) -value knockout -command crosstabWin
182  $w.menu.opt add radiobutton -label CrosstabOptAuto \
183  -variable crosstab(type) -value auto -command crosstabWin
184  $w.menu.opt add separator
185  $w.menu.opt add checkbutton -label CrosstabOptAges \
186  -variable crosstab(ages) -onvalue "+ages" \
187  -offvalue "-ages" -command crosstabWin
188  $w.menu.opt add checkbutton -label CrosstabOptNats \
189  -variable crosstab(countries) -onvalue "+countries" \
190  -offvalue "-countries" -command crosstabWin
191  $w.menu.opt add checkbutton -label CrosstabOptRatings \
192  -variable crosstab(ratings) -onvalue "+ratings" -offvalue "-ratings" \
193  -command crosstabWin
194  $w.menu.opt add checkbutton -label CrosstabOptTitles \
195  -variable crosstab(titles) -onvalue "+titles" -offvalue "-titles" \
196  -command crosstabWin
197  $w.menu.opt add checkbutton -label CrosstabOptBreaks \
198  -variable crosstab(breaks) -onvalue "+breaks" \
199  -offvalue "-breaks" -command crosstabWin
200  $w.menu.opt add checkbutton -label CrosstabOptDeleted \
201  -variable crosstab(deleted) -onvalue "+deleted" \
202  -offvalue "-deleted" -command crosstabWin
203  $w.menu.opt add separator
204  $w.menu.opt add checkbutton -label CrosstabOptColors \
205  -underline 0 -variable crosstab(colors) \
206  -onvalue "+colors" -offvalue "-colors" -command crosstabWin
207  $w.menu.opt add checkbutton -label CrosstabOptColumnNumbers \
208  -underline 0 -variable crosstab(cnumbers) \
209  -onvalue "+numcolumns" -offvalue "-numcolumns" -command crosstabWin
210  $w.menu.opt add separator
211  $w.menu.opt add checkbutton -label CrosstabOptGroup \
212  -underline 0 -variable crosstab(groups) \
213  -onvalue "+groups" -offvalue "-groups" -command crosstabWin
214 
215  $w.menu.sort add radiobutton -label CrosstabSortName \
216  -variable crosstab(sort) -value name -command crosstabWin
217  $w.menu.sort add radiobutton -label CrosstabSortRating \
218  -variable crosstab(sort) -value rating -command crosstabWin
219  $w.menu.sort add radiobutton -label CrosstabSortScore \
220  -variable crosstab(sort) -value score -command crosstabWin
221 
222  $w.menu.color add radiobutton -label CrosstabColorPlain \
223  -variable crosstab(text) -value plain -command crosstabWin
224  $w.menu.color add radiobutton -label CrosstabColorHyper \
225  -variable crosstab(text) -value hypertext -command crosstabWin
226 
227  $w.menu.helpmenu add command -label CrosstabHelpCross \
228  -accelerator F1 -command {helpWindow Crosstable}
229  $w.menu.helpmenu add command -label CrosstabHelpIndex \
230  -command {helpWindow Index}
231 
233 
234  frame $w.b
235  pack $w.b -side bottom -fill x
236  frame $w.f
237  pack $w.f -side top -fill both -expand true
238  text $w.f.text -width $::winWidth($w) -height $::winHeight($w) \
239  -wrap none -font font_Fixed \
240  -background white -yscroll "$w.f.ybar set" \
241  -xscroll "$w.f.xbar set" -setgrid 1 -cursor top_left_arrow
242  ::htext::init $w.f.text
243  $w.f.text tag configure bgGray -background gray95
244  scrollbar $w.f.ybar -command "$w.f.text yview"
245  scrollbar $w.f.xbar -orient horizontal -command "$w.f.text xview"
246  grid $w.f.text -row 0 -column 0 -sticky nesw
247  grid $w.f.ybar -row 0 -column 1 -sticky nesw
248  grid $w.f.xbar -row 1 -column 0 -sticky nesw
249  grid rowconfig $w.f 0 -weight 1 -minsize 0
250  grid columnconfig $w.f 0 -weight 1 -minsize 0
251  button $w.b.stop -textvar ::tr(Stop) -state disabled \
252  -command { set ::htext::interrupt 1 }
253  menubutton $w.b.type -text "" -menu $w.b.type.menu \
254  -relief raised -bd 2 -indicatoron 1
255  menu $w.b.type.menu
256  $w.b.type.menu add radiobutton -label [tr CrosstabOptAll] \
257  -variable crosstab(type) -value allplay -command crosstabWin
258  $w.b.type.menu add radiobutton -label [tr CrosstabOptSwiss] \
259  -variable crosstab(type) -value swiss -command crosstabWin
260  $w.b.type.menu add radiobutton -label [tr CrosstabOptKnockout] \
261  -variable crosstab(type) -value knockout -command crosstabWin
262  $w.b.type.menu add radiobutton -label [tr CrosstabOptAuto] \
263  -variable crosstab(type) -value auto -command crosstabWin
264  button $w.b.update -textvar ::tr(Update) -command crosstabWin
265  button $w.b.cancel -textvar ::tr(Close) -command {
266  focus .
267  destroy .crosstabWin
268  }
269  button $w.b.setfilter -textvar ::tr(SetFilter) -command "
270  sc_filter reset $::crosstab(dbase) dbfilter empty
271  $w.b.addfilter invoke
272  "
273  button $w.b.addfilter -textvar ::tr(AddToFilter) -command {
274  set curr_base [sc_base current]
275  sc_base switch $::crosstab(dbase)
276  sc_game crosstable filter
277  sc_base switch $curr_base
278  ::notify::DatabaseModified $::crosstab(dbase) dbfilter
279  }
280  pack $w.b.cancel $w.b.update $w.b.type \
281  -side right -pady 3 -padx 5
282  pack $w.b.setfilter $w.b.addfilter -side left -pady 3 -padx 5
283 
284  bind $w <Configure> "recordWinSize $w"
285  bind $w <F1> { helpWindow Crosstable }
286  bind $w <Return> { .crosstabWin.b.update invoke }
287  bind $w <Escape> { .crosstabWin.b.cancel invoke }
288  bind $w <Up> { .crosstabWin.f.text yview scroll -1 units }
289  bind $w <Down> { .crosstabWin.f.text yview scroll 1 units }
290  bind $w <Prior> { .crosstabWin.f.text yview scroll -1 pages }
291  bind $w <Next> { .crosstabWin.f.text yview scroll 1 pages }
292  bind $w <Left> { .crosstabWin.f.text xview scroll -1 units }
293  bind $w <Right> { .crosstabWin.f.text xview scroll 1 units }
294  bind $w <Key-Home> {
295  .crosstabWin.f.text xview moveto 0
296  }
297  bind $w <Key-End> {
298  .crosstabWin.f.text xview moveto 0.99
299  }
301 
304 }
305 
306 proc crosstabWin {} {
308 }
309 
310 proc ::crosstab::Refresh {} {
311  global crosstab
312  set w .crosstabWin
313  if {! [winfo exists $w]} { return}
314 
315  switch $crosstab(type) {
316  allplay { $w.b.type configure -text [tr CrosstabOptAll]}
317  swiss { $w.b.type configure -text [tr CrosstabOptSwiss]}
318  knockout { $w.b.type configure -text [tr CrosstabOptKnockout]}
319  auto { $w.b.type configure -text [tr CrosstabOptAuto]}
320  }
321  $w.f.text configure -state normal
322  $w.f.text delete 1.0 end
323  busyCursor .
324  $w.f.text configure -state disabled
325  update idle
326  $w.b.stop configure -state normal
327  foreach button {update cancel setfilter addfilter type} {
328  $w.b.$button configure -state disabled
329  }
330  pack $w.b.stop -side right -padx 5 -pady 3
331  catch {grab $w.b.stop}
332  update
333  catch {sc_game crosstable $crosstab(text) $crosstab(sort) $crosstab(type) \
334  $crosstab(ratings) $crosstab(countries) $crosstab(titles) \
335  $crosstab(colors) $crosstab(groups) $crosstab(ages) \
336  $crosstab(breaks) $crosstab(cnumbers) $crosstab(deleted)} result
337  $w.f.text configure -state normal
338  if {$crosstab(text) == "plain"} {
339  $w.f.text insert end $result
340  } else {
341  ::htext::display $w.f.text $result
342  }
343  # Shade every second line to help readability:
344  set lastLineNum [expr {int([$w.f.text index end])}]
345  for {set i 2} {$i <= $lastLineNum} {incr i 2} {
346  $w.f.text tag add bgGray $i.0 "$i.0 lineend +1c"
347  }
348  unbusyCursor .
349  catch {grab release $w.b.stop}
350  $w.b.stop configure -state disabled
351  pack forget $w.b.stop
352  foreach button {update cancel setfilter addfilter type} {
353  $w.b.$button configure -state normal
354  }
355  $w.f.text configure -state disabled
356  raiseWin $w
357 }
358