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