Scid  4.6.5
gamelist.tcl
Go to the documentation of this file.
1 ########################################################################
2 ### Games list window
3 # Copyright (C) 2011-2014 Fulvio Benini
4 #
5 # This file is part of Scid (Shane's Chess Information Database).
6 # Scid is free software: you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation.
9 
10 proc ::windows::gamelist::Open { {base ""} {filter ""} } {
11  if {$base == ""} { set base [sc_base current]}
12  if { $filter == "" } {
13  set filter "dbfilter"
14  foreach glwin $::windows::gamelist::wins {
15  set b [::windows::gamelist::GetBase $glwin]
16  if {$b == $base && $::gamelistFilter($glwin) == "dbfilter"} {
17  set filter [sc_filter new $base]
18  }
19  }
20  }
21  if { $base != $::clipbase_db } {
22  foreach glwin $::windows::gamelist::wins {
23  set b [::windows::gamelist::GetBase $glwin]
24  if {$b == $::clipbase_db && [sc_base numGames $b] == 0 } {
25  if {[info exists ::recentSort]} {
26  set idx [lsearch -exact $::recentSort "[sc_base filename $base]"]
27  if {$idx != -1} {
28  set ::glist_Sort(ly$glwin) [lindex $::recentSort [expr $idx +1]]
30  }
31  }
32  ::windows::gamelist::SetBase $glwin $base $filter
33  ##TODO: this is a hack to raise the gamelist window
34  createToplevel $glwin
35  focus $glwin.games.glist
36  return
37  }
38  }
39  }
40 
41  set i 1
42  set closeto ""
43  while {[winfo exists .glistWin$i]} {
44  set closeto .glistWin$i
45  incr i
46  }
47  set w .glistWin$i
48  ::createToplevel $w $closeto
49 
50  set ::gamelistTitle($w) "[tr WindowsGList]:"
51  ::windows::gamelist::createWin_ $w $base $filter
52  focus $w
53 }
54 
55 proc ::windows::gamelist::OpenTreeBest { {base} {w} } {
56  if {[::createToplevel $w] == "already_exists"} {
57  focus .
58  destroy $w
59  return
60  }
61  set ::gamelistTitle($w) "[tr TreeBestGames]:"
62  ::windows::gamelist::createWin_ $w $base "tree"
63 
64  grid forget $w.buttons
65  set ::gamelistPosMask($w) 1
66 }
67 
68 proc ::windows::gamelist::Refresh {{moveup 1} {wlist ""}} {
69  if {$wlist == ""} { set wlist $::windows::gamelist::wins}
70  foreach w $wlist {
71  set err [catch {sc_base inUse $::gamelistBase($w)} inUse]
72  if {$err !=0 || $inUse == 0} {
74  continue
75  }
77  }
78 }
79 
80 proc ::windows::gamelist::DatabaseModified {{dbase} {filter -1}} {
81  set wlist $::windows::gamelist::wins
82  foreach w $wlist {
83  if {$::gamelistBase($w) == $dbase} {
84  if {$filter == -1} {
86  } elseif {$filter == $::gamelistFilter($w) || \
87  $filter == [sc_filter compose $::gamelistBase($w) $::gamelistFilter($w) ""]} {
89  }
91  }
92  }
93 }
94 
95 proc ::windows::gamelist::PosMaskProgress {} {
96  update
97  if { $::gamelistUpdating != 1 } { break}
98 }
99 
100 proc ::windows::gamelist::PosChanged {{wlist ""}} {
101  if { [info exists ::gamelistUpdating] } {
102  incr ::gamelistUpdating
103  return
104  }
105  set ::gamelistUpdating 1
106 
107  set bases {}
108  if {$wlist == ""} { set wlist $::windows::gamelist::wins}
109  foreach w $wlist {
110  if { $::gamelistPosMask($w) != 0 } {
111  $w.games.glist tag configure fsmall -foreground #bababa
112  $w.buttons.boardFilter configure -image tb_BoardMaskBusy
113  if { [lsearch -exact $bases $::gamelistBase($w)] == -1 } {
114  lappend bases $::gamelistBase($w)
115  }
116  }
117  }
118 
119  foreach base $bases {
120  update idletasks
121  #TODO: [sc_filter release $base $f]
122  set f [sc_filter new $base FEN]
123  if { $::gamelistUpdating != 1 } {
124  after idle {
125  unset ::gamelistUpdating
126  ::windows::gamelist::PosChanged
127  }
128  return
129  }
130  if {$f != ""} {
131  foreach w $::windows::gamelist::wins {
132  if { $::gamelistBase($w) == $base && $::gamelistPosMask($w) != 0 } {
133  $w.games.glist tag configure fsmall -foreground ""
134  $w.buttons.boardFilter configure -image tb_BoardMask
135  set ::gamelistFilter($w) [sc_filter compose $::gamelistBase($w) $::gamelistFilter($w) $f]
136  ::notify::DatabaseModified $base $::gamelistFilter($w)
137  }
138  }
139  }
140  }
141  unset ::gamelistUpdating
142 }
143 
144 proc ::windows::gamelist::FilterReset {{w} {base}} {
145  set f "dbfilter"
146  if {$w != "" && $base == $::gamelistBase($w)} { set f $::gamelistFilter($w)}
147  sc_filter reset $base $f full
149 }
150 
151 proc ::windows::gamelist::FilterNegate {{w} {base}} {
152  set f "dbfilter"
153  if {$w != "" && $base == $::gamelistBase($w)} { set f $::gamelistFilter($w)}
154  sc_filter negate $base $f
156 }
157 
158 proc ::windows::gamelist::FilterExport {{w}} {
159  set ftype {
160  { {PGN} {.pgn} }
161  { {LaTeX} {.tex .ltx} }
162  }
163  set fName [tk_getSaveFile -initialdir $::initialDir(base) \
164  -filetypes $ftype \
165  -typevariable ::gamelistExport \
166  -title [tr ToolsExpFilter]]
167  if {$fName == ""} { return}
168  progressWindow "Scid" "Exporting games..." $::tr(Cancel)
169  if {$::gamelistExport == "LaTeX"} {
170  if {[file extension $fName] == ""} { append fName ".tex"}
171  set err [catch {sc_filter export $::gamelistBase($w) $::gamelistFilter($w) \
172  $::glistSortStr($w.games.glist) $fName $::gamelistExport \
173  $::exportStartFile(LaTeX) $::exportEndFile(LaTeX)}]
174  } else {
175  if {[file extension $fName] == ""} { append fName ".pgn"}
176  set err [catch {sc_filter export $::gamelistBase($w) $::gamelistFilter($w) \
177  $::glistSortStr($w.games.glist) $fName $::gamelistExport}]
178  }
180  if {$err && $::errorCode != $::ERROR::UserCancel} { ERROR::MessageBox}
181 }
182 
183 # Returns text describing state of filter for specified
184 # database, e.g. "no games" or "all / 400" or "1,043 / 2,057"
185 proc ::windows::gamelist::filterText {{w ""} {base -1}} {
186  if {$base == -1} { set base [sc_base current]}
187  set f "dbfilter"
188  if {$w != "" && $base == $::gamelistBase($w)} {
189  set f $::gamelistFilter($w)
190  }
191 
192  foreach {filterSz gameSz mainSz} [sc_filter sizes $base $f] {}
193  return [formatFilterText $filterSz $gameSz]
194 }
195 
196 # Returns text describing state of filter for specified
197 # database, e.g. "no games" or "all / 400" or "1,043 / 2,057"
198 proc ::windows::gamelist::formatFilterText {filterSz gameSz} {
199  if {$gameSz == 0} { return $::tr(noGames)}
200  if {$gameSz == $filterSz} {
201  return "$::tr(all) / [::utils::thousands $gameSz 100000]"
202  }
203  return "[::utils::thousands $filterSz 100000] / [::utils::thousands $gameSz 100000]"
204 }
205 
206 proc ::windows::gamelist::GetBase {{w}} {
207  if {[info exists ::gamelistBase($w)]} { return $::gamelistBase($w)}
208  return ""
209 }
210 
211 proc ::windows::gamelist::SetBase {{w} {base} {filter "dbfilter"}} {
212  if {[lsearch -exact $::windows::gamelist::wins $w] == -1} { return}
213  after idle "::windows::gamelist::filterRelease_ $::gamelistBase($w) $::gamelistFilter($w)"
214  set ::gamelistBase($w) $base
215  set ::gamelistFilter($w) $filter
216  busyCursor $w
217  update idletasks
218  if { $::gamelistPosMask($w) != 0 } {
220  } else {
221  ::windows::gamelist::DatabaseModified $::gamelistBase($w) $::gamelistFilter($w)
222  }
223  unbusyCursor $w
224 }
225 
226 #Examples
227 # Search the games played by Carlsen: carlsen
228 # Search the games played by Magnus Carlsen: carlsen,magnus
229 # Search the games _not_ played by Carlsen: !carlsen
230 # Search only the games played as white: white carlsen
231 # Search only the games played as black: black carlsen
232 # Search games with players with elo above 2500: >2500
233 # Search games with a white player with elo above 2500: welo >2500
234 # Search games with a white player with elo under 2500: welo <2500
235 # Search games with a black player with elo between 2100-2500: belo 2100-2500
236 # Search games with a black player with elo between 2100-2500 or 0: belo 2100-2500 + belo 0
237 # Search games with a specific ECO: A00-A99
238 # Search games with ECO A00-B99 or D00-D99: A00-B99 + D00-D99
239 # Search games with ECO A00-B99 or D00-D99: A00-D99 !C00-C99
240 # Search games played after a specific year: >2013
241 # Search games played in a specific period: 2012.09.01-2013.05.31
242 # Search game number 2000: gnum 2000
243 # Search games where Carlsen played as white against Kramnik: white carlsen kramnik
244 # Search a specific game: carlsen kramnik 2013.06.13
245 #
246 # An empty search will reset the filter
247 #
248 proc ::windows::gamelist::Awesome {{w} {txt}} {
249  if {[lsearch -exact $::windows::gamelist::wins $w] == -1} { return}
250 
251  set filter [sc_filter compose $::gamelistBase($w) $::gamelistFilter($w) ""]
252  if {$txt == ""} {
253  # Quick way to reset the filter: search an empty string
254  sc_filter reset "$::gamelistBase($w)" $filter full
255  } else {
256  sc_filter reset "$::gamelistBase($w)" $filter empty
257  #Split the string using " + "
258  foreach {dummy sub} [regexp -all -inline {(.+?)(?:\s\+\s|$)} $txt] {
259  set cmd "sc_filter search $::gamelistBase($w) $filter header -filter OR"
260  progressWindow "Scid" "$::tr(HeaderSearch)..." $::tr(Cancel)
261  set res [eval "$cmd [AweParse $sub]"]
263  }
264  }
265  ::notify::DatabaseModified $::gamelistBase($w) $::gamelistFilter($w)
266 }
267 
268 proc ::windows::gamelist::AweInit {} {
269  global awe_guess awe_min awe_max
270  set awe_guess {}
271  set awe_min(-gnum) {0}
272  set awe_max(-gnum) {999999999}
273  set awe_min(-welo) {0}
274  set awe_max(-welo) {3999}
275  set awe_min(-belo) {0}
276  set awe_max(-belo) {3999}
277  set awe_min(-elo) {0}
278  set awe_max(-elo) {3999}
279  set awe_min(-eco) {A00}
280  set awe_max(-eco) {E99z4}
281  set awe_min(-date) {0000.00.00}
282  set awe_max(-date) {2047.12.31}
283 
284  set ranged {}
285  # date: YYYY.MM.GG
286  lappend ranged [list "-date" \
287  {(?:\d\d\d\d\.(?:0[0-9]|1[0-2])\.(?:[012][0-9]|3[01]))}]
288  # date: 4digits between 1801 2099, excluding 1900 and 2000
289  lappend ranged [list "-date" \
290  {(?:1[89](?!00)\d\d|20(?!00)\d\d)}]
291  # elo: 4digits between 1000 3999 or 0
292  lappend ranged [list "-elo" \
293  {(?:(?:[123]\d\d\d)|0)}]
294  # game number: all digits
295  lappend ranged [list "-gnum" \
296  {(?:\d+)}]
297  # eco: a letter [A-E] plus 2digits and optional scid subcode
298  lappend ranged [list "-eco" \
299  {(?:[A-E]\d\d(?:[a-z](?:[1-4])?)?)}]
300 
301  foreach guess $ranged {
302  set prefix {^(?:(.*?)\s+)??(}
303  set suffix {)(?:\s+(.*))?$}
304 
305  set r {[<>!]?}
306  append r [lindex $guess 1]
307  lappend awe_guess [list [lindex $guess 0] "$prefix$r$suffix"]
308 
309  set r {[!]?}
310  append r [lindex $guess 1]
311  append r {(?:-}
312  append r [lindex $guess 1]
313  append r {)?}
314  lappend awe_guess [list [lindex $guess 0] "$prefix$r$suffix"]
315  }
316 
317  #default
318  lappend awe_guess [list "-player" \
319  {^(?:(.*?)\s+)??([!]?[_,%"[:alnum:]]+)(?:\s+(.*))?$}]
320 }
321 
322 proc ::windows::gamelist::AweGuess {{txt}} {
323  global awe_guess
324  if {![info exists awe_guess]} { AweInit}
325 
326  # Remove extra spaces around ><!
327  regsub -all {(^|\s)>\s} $txt { >} txt
328  regsub -all {(^|\s)<\s} $txt { <} txt
329  regsub -all {(^|\s)!\s} $txt { !} txt
330 
331  # Replace all spaces inside "" with %%
332  regsub -all {(".*?) (.*?")} $txt {\1%%\2} txt
333 
334  # Search for explicit params
335  set param(0) ""
336  set val(0) ""
337  set extra(0) "$txt"
338  for {set np 1} {
339  [regexp \
340  {^(?:(.*?)\s+)??(gnum|white|black|welo|belo|elo|eco|date|event|site)\s+(.+?)(?:\s+(.*))?$} \
341  $extra([expr $np -1]) -> extra([expr $np -1]) param($np) val($np) extra($np)]
342  } {incr np} {}
343 
344  #Guess extras
345  set res {}
346  for {set i 0} {$i < $np} { incr i} {
347  if {$param($i) != ""} {
348  lappend res [list "-$param($i)" $val($i)]
349  }
350  if {$extra($i) == ""} { continue}
351  foreach guess $awe_guess {
352  if {[regexp [lindex $guess 1] $extra($i) -> prefix value suffix]} {
353  lappend res [list [lindex $guess 0] $value]
354  set param($np) ""
355  set extra($np) $prefix
356  incr np
357  set param($np) ""
358  set extra($np) $suffix
359  incr np
360  break
361  }
362  }
363  }
364 
365  return $res
366 }
367 
368 proc ::windows::gamelist::AweParse {{txt}} {
369  global awe_min awe_max
370  set res {}
371  foreach op [AweGuess $txt] {
372  set param [lindex $op 0]
373  set value [lindex $op 1]
374  #Restore spaces inside ""
375  regsub -all {%%} $value { } value
376  catch {
377  regsub {^<} $value "$awe_min($param) " value
378  regsub {^>} $value "$awe_max($param) " value
379  regsub {(\w*?\d+)-(\w*?\d+)} $value {\1 \2} value
380  }
381  if {[regsub {^!} $value {} value]} {
382  append param "!"
383  }
384  lappend res [list $param $value]
385  }
386 
387  return [join $res]
388 }
389 
390 proc ::windows::gamelist::CopyGames {{w} {srcBase} {dstBase}} {
391  set filter "dbfilter"
392  if {$w != "" && $srcBase == $::gamelistBase($w)} { set filter $::gamelistFilter($w)}
393 
394  set fromName [file tail [sc_base filename $srcBase]]
395  set targetName [file tail [sc_base filename $dstBase]]
396  set nGamesToCopy [sc_filter count $srcBase $filter]
397  set targetReadOnly [sc_base isReadOnly $dstBase]
398  set err ""
399  if {$nGamesToCopy == 0} {
400  set err "$::tr(CopyErrSource) $::tr(CopyErrNoGames)."
401  } elseif {$targetReadOnly} {
402  set err "$::tr(CopyErrTarget) ($targetName) $::tr(CopyErrReadOnly)."
403  }
404  if {$err != ""} {
405  tk_messageBox -type ok -icon info -title "Scid" \
406  -message "$::tr(CopyErr) \n\"$fromName\" -> \"$targetName\": \n$err"
407  return
408  }
409  # If copying to the clipbase, do not bother asking for confirmation:
410  if {$dstBase != $::clipbase_db} {
411  set confirm [tk_messageBox -type "okcancel" -icon question -title "Scid: $::tr(CopyGames)" \
412  -message [subst $::tr(CopyConfirm)]]
413  if {$confirm != "ok"} { return}
414  }
415 
416  progressWindow "Scid" "$::tr(CopyGames)..." $::tr(Cancel)
417  set copyErr [catch {sc_base copygames $srcBase $filter $dstBase} result]
419  if {$copyErr} { ERROR::MessageBox "$result"}
421 }
422 
423 proc ::windows::gamelist::ClearClipbase {} {
424  foreach w $::windows::gamelist::wins {
425  if {$::gamelistBase($w) == $::clipbase_db} {
426  ::windows::gamelist::SetBase $w $::gamelistBase($w)
427  }
428  }
429  sc_clipbase clear
430  ::notify::DatabaseModified $::clipbase_db
431  if {[sc_base current] == $::clipbase_db} { ::notify::GameChanged}
432 }
433 
434 #Private:
435 set ::windows::gamelist::wins {}
436 
437 proc ::windows::gamelist::createWin_ { {w} {base} {filter} } {
438  set ::gamelistBase($w) $base
439  set ::gamelistFilter($w) $filter
440  set ::gamelistPosMask($w) 0
441  set ::gamelistMenu($w) ""
444  if {[info exists ::recentSort]} {
445  set idx [lsearch -exact $::recentSort "[sc_base filename $base]"]
446  if {$idx != -1} { set ::glist_Sort(ly$w) [lindex $::recentSort [expr $idx +1]]}
447  }
449  grid rowconfigure $w 0 -weight 1
450  grid columnconfigure $w 0 -weight 0
451  grid columnconfigure $w 1 -weight 0
452  grid columnconfigure $w 2 -weight 1
453  bind $w <Destroy> {
454  if { [winfo class %W] == "Toplevel" } {
455  set idx [lsearch -exact $::windows::gamelist::wins %W]
456  set ::windows::gamelist::wins [lreplace $::windows::gamelist::wins $idx $idx]
457  ::windows::gamelist::filterRelease_ $::gamelistBase(%W) $::gamelistFilter(%W)
458  }
459  }
460  setWinLocation $w
461  setWinSize $w
462  bind $w <Configure> "recordWinSize $w"
463  bind $w <Control-l> "::windows::gamelist::Open \$::gamelistBase($w)"
465  lappend ::windows::gamelist::wins $w
467 }
468 
469 proc ::windows::gamelist::createMenu_ {w} {
470  ttk::frame $w.buttons -padding {5 5 2 5}
471  ttk::button $w.buttons.database -image tb_CC_book -command "::windows::gamelist::menu_ $w database"
472  ttk::button $w.buttons.filter -image tb_search_on -command "::windows::gamelist::menu_ $w filter"
473  ttk::button $w.buttons.layout -image tb_Layout -command "::windows::gamelist::menu_ $w layout"
474  ttk::button $w.buttons.stats -image tb_Stats -command "::windows::gamelist::menu_ $w stats; ::windows::gamelist::updateStats_ $w"
475  ttk::button $w.buttons.boardFilter -image tb_BoardMask -command "::windows::gamelist::searchpos_ $w"
476  #TODO:
477  #ttk::button $w.buttons.stats -image b_bargraph
478  #TODO: translate
479  ::utils::tooltip::Set $w.buttons.database "Show/Hide databases"
480  ::utils::tooltip::Set $w.buttons.filter "Change filter"
481  ::utils::tooltip::Set $w.buttons.layout "Load/Save/Change sorting criteria and column layout"
482  ::utils::tooltip::Set $w.buttons.stats "Show/Hide statistics"
483  ::utils::tooltip::Set $w.buttons.boardFilter "Show only games that matches the current board position"
484  grid $w.buttons.database -row 0
485  grid $w.buttons.filter -row 1
486  grid $w.buttons.layout -row 2
487  grid $w.buttons.stats -row 3
488  grid $w.buttons.boardFilter -row 4
489  grid $w.buttons -row 0 -column 0 -sticky news
490 
491  ttk::frame $w.database -padding {0 5 6 2}
492  ::windows::switcher::Create $w.database $w
493 
494  ttk::frame $w.filter -padding {4 5 6 0}
495  ttk::frame $w.filter.b -borderwidth 2 -relief groove
496  grid $w.filter.b -sticky news
497  grid rowconfigure $w.filter 0 -weight 1
498  grid columnconfigure $w.filter 0 -weight 1
499  set bgcolor [ttk::style lookup Button.label -background]
500  button $w.filter.b.rfilter -image tb_rfilter -background $bgcolor \
501  -command "::windows::gamelist::filter_ $w r" -width 24 -height 24
502  button $w.filter.b.bsearch -image tb_bsearch -background $bgcolor \
503  -command "::windows::gamelist::filter_ $w b" -width 24 -height 24
504  button $w.filter.b.hsearch -image tb_hsearch -background $bgcolor \
505  -command "::windows::gamelist::filter_ $w h" -width 24 -height 24
506  button $w.filter.b.msearch -image tb_msearch -background $bgcolor \
507  -command "::windows::gamelist::filter_ $w m" -width 24 -height 24
508  button $w.filter.b.tmt -image tb_tmt -background $bgcolor \
509  -command ::tourney::toggle -width 24 -height 24
510  button $w.filter.b.crosst -image tb_crosst -background $bgcolor \
511  -command toggleCrosstabWin -width 24 -height 24
512  #TODO: rewrite the tooltip system (most tooltip are not translated when you change language)
513  ::utils::tooltip::Set "$w.filter.b.rfilter" "$::helpMessage($::language,SearchReset)"
514  ::utils::tooltip::Set "$w.filter.b.bsearch" "$::helpMessage($::language,SearchCurrent)"
515  ::utils::tooltip::Set "$w.filter.b.hsearch" "$::helpMessage($::language,SearchHeader)"
516  ::utils::tooltip::Set "$w.filter.b.msearch" "$::helpMessage($::language,SearchMaterial)"
517  ::utils::tooltip::Set "$w.filter.b.tmt" "$::helpMessage($::language,WindowsTmt)"
518  ::utils::tooltip::Set "$w.filter.b.crosst" "$::helpMessage($::language,ToolsCross)"
519  grid $w.filter.b.rfilter
520  grid $w.filter.b.hsearch
521  grid $w.filter.b.bsearch
522  grid $w.filter.b.msearch
523  grid $w.filter.b.crosst
524 
525  ttk::frame $w.layout -padding {0 5 6 2}
526  ttk::frame $w.layout.b -borderwidth 2 -relief groove
527  grid $w.layout.b -sticky news
528  grid rowconfigure $w.layout 0 -weight 1
529  grid columnconfigure $w.layout 0 -weight 1
531 
532  ttk::frame $w.stats -padding {0 5 6 2}
533  ttk::frame $w.stats.b -borderwidth 2 -relief groove
534  grid $w.stats.b -sticky news
535  grid rowconfigure $w.stats 0 -weight 1
536  grid columnconfigure $w.stats 0 -weight 1
537  autoscrollframe -bars y $w.stats.b canvas $w.stats.b.c -highlightthickness 0 -background white
538 }
539 
540 proc ::windows::gamelist::createGList_ {{w}} {
541  if {[winfo exists $w.games]} { destroy $w.games}
542  ttk::frame $w.games -borderwidth 0 -padding {8 5 5 2}
543  glist.create $w.games "ly$w"
544  grid $w.games -row 0 -column 2 -sticky news
545 }
546 
547 proc ::windows::gamelist::menu_ {{w} {button}} {
548  if {$::gamelistMenu($w) != ""} {
549  $w.buttons.$::gamelistMenu($w) state !pressed
550  grid forget $w.$::gamelistMenu($w)
551  if {$button == "filter"} { event generate $w.games.find.hide <ButtonPress-1>}
552  }
553  if {$::gamelistMenu($w) != $button} {
554  $w.buttons.$button state pressed
555  set ::gamelistMenu($w) $button
556  grid $w.$button -row 0 -column 1 -sticky news
557  if {$button == "filter"} { event generate $w <Control-f>}
558  } else {
559  set ::gamelistMenu($w) ""
560  }
561 }
562 
563 proc ::windows::gamelist::filter_ {{w} {type}} {
564  if {$type == "r"} {
565  ::windows::gamelist::FilterReset $w $::gamelistBase($w)
566  } elseif {$type == "b"} {
567  ::search::board $::gamelistBase($w)
568  } elseif {$type == "h"} {
569  ::search::header $::gamelistBase($w) $::gamelistFilter($w)
570  } elseif {$type == "m"} {
571  ::search::material $::gamelistBase($w)
572  }
573 }
574 
575 proc ::windows::gamelist::update_ {{w} {moveUp}} {
576  set f $::gamelistFilter($w)
577  foreach {filterSz gameSz mainSz} [sc_filter sizes $::gamelistBase($w) $f] {}
578 
579  if {$gameSz == $mainSz} {
580  $w.buttons.filter configure -image tb_search_on
581  } else {
582  $w.buttons.filter configure -image tb_search_off
583  }
584 
585  set fr [::windows::gamelist::formatFilterText $filterSz $gameSz]
586  set fn [file tail [sc_base filename $::gamelistBase($w)]]
587  ::setTitle $w "$::gamelistTitle($w) $fn ($fr)"
588  if {$moveUp} {
589  #Reset double-click behavior
590  set ::glistClickOp($w.games.glist) 0
591  }
592  glist.update $w.games $::gamelistBase($w) $::gamelistFilter($w) $moveUp
593 }
594 
595 proc ::windows::gamelist::searchpos_ {{w}} {
596  if {$::gamelistPosMask($w) == 0} {
597  set ::gamelistPosMask($w) 1
598  $w.buttons.boardFilter state pressed
600  } else {
601  set ::gamelistPosMask($w) 0
602  $w.buttons.boardFilter state !pressed
603  set ::gamelistFilter($w) [sc_filter compose $::gamelistBase($w) $::gamelistFilter($w) ""]
604  $w.games.glist tag configure fsmall -foreground ""
605  $w.buttons.boardFilter configure -image tb_BoardMask
606  ::notify::DatabaseModified $::gamelistBase($w) $::gamelistFilter($w)
607  }
608 }
609 
610 proc ::windows::gamelist::filterRelease_ {{base} {filter}} {
611  set used 0
612  foreach win $::windows::gamelist::wins {
613  if { $::gamelistBase($win) == $base && $::gamelistFilter($win) == $filter } {
614  incr used
615  }
616  }
617  if {! $used} { catch {sc_filter release $base $filter}}
618 }
619 
620 proc ::windows::gamelist::updateStats_ { {w} } {
621  if {$::gamelistMenu($w) != "stats"} { return}
622  set stats {}
623  set stats [sc_filter treestats $::gamelistBase($w) $::gamelistFilter($w)]
624  set lineH [expr { round(1.8 * [font metrics font_Regular -linespace]) }]
625  set rectW [expr { round([font metrics font_Regular -ascent] *0.5) }]
626  set rectB [expr { [font metrics font_Regular -descent] + int($rectW*0.25) }]
627  set rectH [expr { $rectW + $rectB }]
628  incr rectW 4
629  set moveW 0
630  foreach move $stats {
631  set m [font measure font_Regular "..[lindex $move 0]"]
632  set n [font measure font_Italic [lindex $move 1]]
633  set s [expr { $m + $n + int($rectW*2) }]
634  if {$s > $moveW} { set moveW $s}
635  }
636  set barW [expr { $moveW + 6 }]
637  set percW [expr { [font measure font_Small 99%] / 2 }]
638  set winW [expr { $barW + 10 * $percW + 4 }]
639  if {[info exists ::gamelistLastTreeW($w)]} {
640  set diff [expr { $::gamelistLastTreeW($w) - $winW }]
641  if {$diff > -5 && $diff < [expr 4 * $rectW]} {
642  set winW $::gamelistLastTreeW($w)
643  incr barW $diff
644  incr moveW $diff
645  }
646  }
647  set ::gamelistLastTreeW($w) $winW
648  set coeff [expr $percW / 10.0]
649  set line $lineH
650  $w.stats.b.c delete all
651  set i_add 0
652  foreach move $stats {
653  set performance [lindex $move 5]
654  set n_ratedgames [lindex $move 6]
655  set toMove [lindex $move 7]
656  set pColor "#707070"
657  set perfCmd ""
658  if { $n_ratedgames > 5 } {
659  if { $toMove == "B" } { set performance [expr { $performance * -1 }]}
660  set rate [expr { $performance / $n_ratedgames }]
661  if { $rate > 0.1 } { set pColor "#47a148"}
662  if { $rate < -0.1 } { set pColor "#f40000"}
663  #TODO:
664  set perfCmd "tk_messageBox -message \"$rate ($performance / $n_ratedgames)\" "
665  }
666  $w.stats.b.c create rectangle 4 [expr { $line - $rectH }] $rectW [expr { $line -$rectB }] \
667  -fill $pColor -outline "" -tag perf$i_add
668  $w.stats.b.c bind perf$i_add <ButtonPress-1> "$perfCmd"
669 
670  set moveSAN [lindex $move 0]
671  $w.stats.b.c bind add$i_add <ButtonPress-1> "
672  if {\[addSanMove \{$moveSAN\}\] && \$::gamelistPosMask($w) == 0} {
673  $w.buttons.boardFilter invoke
674  }
675  "
676  if { $toMove == "B" } { set moveSAN "..$moveSAN"}
677  $w.stats.b.c create text [expr int($rectW*1.5)] $line -anchor sw \
678  -text $moveSAN -fill black -font font_Regular -tag add$i_add
679 
680  incr i_add
681  $w.stats.b.c create text $moveW $line -anchor se \
682  -text [lindex $move 1] -fill #707070 -font font_Italic
683  set barh1 [expr { $line - 2*$rectB }]
684  set barh2 [expr { $line - $rectB }]
685  set n_white [lindex $move 2]
686  set n_draw [lindex $move 3]
687  set n_black [lindex $move 4]
688  set n_tot [expr { $n_white + $n_draw + $n_black }]
689  if {$n_tot != 0} {
690  set p_white [expr { 100.0 * $n_white / $n_tot }]
691  set p_draw [expr { 100.0 * $n_draw / $n_tot }]
692  set p_black [expr { 100.0 - $p_white - $p_draw }]
693  if {$n_tot > 99} {
694  set t_white "[expr { round($p_white) }]%"
695  set t_draw "[expr { round($p_draw) }]%"
696  set t_black "[expr { round($p_black) }]%"
697  } else {
698  set t_white "$n_white "
699  set t_draw "$n_draw "
700  set t_black "$n_black "
701  }
702 
703  set win [expr { int($barW + $coeff * $p_white) }]
704  $w.stats.b.c create rectangle $barW $barh1 $win $barh2 -fill white -outline ""
705  set draw [expr { int($win + $coeff * $p_draw) }]
706  $w.stats.b.c create rectangle $win $barh1 $draw $barh2 -fill #707070 -outline ""
707  set loss [expr { $barW + $percW * 10 }]
708  $w.stats.b.c create rectangle $draw $barh1 $loss $barh2 -fill black -outline ""
709 
710  $w.stats.b.c create rectangle $barW $barh1 $loss $barh2
711 
712  $w.stats.b.c create text [expr { $barW + $percW * 3 }] $barh1 \
713  -font font_Small -anchor se -fill black -text "$t_white"
714  $w.stats.b.c create text [expr { $barW + $percW * 6 }] $barh1 \
715  -font font_Small -anchor se -fill black -text "$t_draw"
716  $w.stats.b.c create text [expr { $barW + $percW * 9 }] $barh1 \
717  -font font_Small -anchor se -fill black -text "$t_black"
718  }
719 
720  incr line $lineH
721  }
722  incr line -$lineH
723  $w.stats.b.c configure -scrollregion [list 0 0 $winW $line] -width $winW
724 }
725 
726 namespace eval ::glist_Ly {
727  proc Create {w} {
728  if {! [info exists ::glist_Layouts] } { set ::glist_Layouts {}}
729  options.save ::glist_Layouts
730  set ::gamelistNewLayout [::glist_Ly::createName_]
731  set bgcolor [ttk::style lookup Button.label -background]
732  autoscrollframe -bars y $w.layout.b canvas $w.layout.b.c -highlightthickness 0 -background $bgcolor
733  bind $w.layout.b.c <Configure> { ::glist_Ly::AdjScrollbar_ %W }
735  }
736  proc UpdateAll_ {} {
737  foreach w $::windows::gamelist::wins {
738  if {[winfo exists $w]} { Update_ $w}
739  }
740  }
741  proc Update_ {w} {
742  if {[winfo exists $w.layout.b.c.f]} { destroy $w.layout.b.c.f}
743  ttk::frame $w.layout.b.c.f -padding 5
744  $w.layout.b.c create window 0 0 -window $w.layout.b.c.f -anchor nw
745  tk::entry $w.layout.b.c.f.text_new -textvariable ::gamelistNewLayout -font font_Small
746  tk::button $w.layout.b.c.f.new -image tb_new -command "::glist_Ly::New_ $w"
747  grid $w.layout.b.c.f.text_new $w.layout.b.c.f.new
748  ttk::frame $w.layout.b.c.f.sep -padding { 0 4 0 4 }
749  ttk::separator $w.layout.b.c.f.sep.line
750  grid rowconfigure $w.layout.b.c.f.sep 0 -weight 1
751  grid columnconfigure $w.layout.b.c.f.sep 0 -weight 1
752  grid $w.layout.b.c.f.sep.line -sticky news
753  grid $w.layout.b.c.f.sep -columnspan 2 -sticky we
754  for {set i 0} {$i < [llength $::glist_Layouts]} {incr i} {
755  set name [lindex $::glist_Layouts $i]
756  tk::button $w.layout.b.c.f.layout$i -text $name -font font_Small -width 20 -command "::glist_Ly::Change_ $w $i" -bg lightSteelBlue
757  tk::button $w.layout.b.c.f.layoutDel$i -image tb_CC_delete -command "::glist_Ly::Del_ $w $i"
758  grid $w.layout.b.c.f.layout$i $w.layout.b.c.f.layoutDel$i -sticky we
759  }
760  after idle "::glist_Ly::AdjScrollbar_ $w.layout.b.c"
761  }
762  proc New_ {w} {
763  set newLy $::gamelistNewLayout
764  Copy_ $newLy ly$w
765  options.save ::glist_ColOrder($newLy)
766  options.save ::glist_ColWidth($newLy)
767  options.save ::glist_ColAnchor($newLy)
768  options.save ::glist_Sort($newLy)
769  options.save ::glist_FindBar($newLy)
770  set replaced [lsearch -exact $::glist_Layouts $newLy]
771  if {$replaced == -1 } { lappend ::glist_Layouts $newLy}
772  set ::gamelistNewLayout [::glist_Ly::createName_]
774  }
775  proc Del_ {w idx} {
776  set old_layout [lindex $::glist_Layouts $idx]
777  options.save_cancel ::glist_ColOrder($old_layout)
778  options.save_cancel ::glist_ColWidth($old_layout)
779  options.save_cancel ::glist_ColAnchor($old_layout)
780  options.save_cancel ::glist_Sort($old_layout)
781  options.save_cancel ::glist_FindBar($old_layout)
782  set ::glist_Layouts [lreplace $::glist_Layouts $idx $idx]
784  }
785  proc Change_ {w idx} {
786  Copy_ ly$w [lindex $::glist_Layouts $idx]
789  }
790  proc Copy_ {{oldLy} {newLy}} {
791  set ::glist_ColOrder($oldLy) $::glist_ColOrder($newLy)
792  set ::glist_ColWidth($oldLy) $::glist_ColWidth($newLy)
793  set ::glist_ColAnchor($oldLy) $::glist_ColAnchor($newLy)
794  set ::glist_Sort($oldLy) $::glist_Sort($newLy)
795  set ::glist_FindBar($oldLy) $::glist_FindBar($newLy)
796  }
797  proc createName_ {} {
798  set i 1
799  set prefix "NewLayout"
800  while {[lsearch -exact $::glist_Layouts "$prefix$i"] != -1} { incr i}
801  return "$prefix$i"
802  }
803  proc AdjScrollbar_ {w} {
804  set l [winfo reqwidth $w.f]
805  set h [winfo reqheight $w.f]
806  $w configure -scrollregion [list 0 0 $l $h] -width $l
807  }
808 }
809 
810 
811 
812 
813 
814 ##########################################################################
815 # June 2011: A new reusable and simplified gamelist widget
816 # glist.create
817 # Create a gamelist widget
818 # w: parent window of the gamelist widget
819 # layout: a string name that will be assigned to columns layout.
820 # layout will be saved and restored in successive glist.create calls.
821 proc glist.create {{w} {layout}} {
822  # Default values
823  if {! [info exists ::glist_ColOrder($layout)] } {
824  set ::glist_ColOrder($layout) {{7} {1} {2} {3} {4} {5} {6} {23} {22} {8} {9} {10} {11} {12} {13} {14} {15} {16} {0}}
825  }
826  if {! [info exists ::glist_ColWidth($layout)] } {
827  set ::glist_ColWidth($layout) {{50} {50} {50} {120} {40} {120} {40} {80} {200} {30} \
828  {200} {30} {20} {20} {20} {20} {35} {50} {30} {100} {40} {40} {50} {140}}
829  }
830  if {! [info exists ::glist_ColAnchor($layout)] } {
831  set ::glist_ColAnchor($layout) {{e} {c} {c} {w} {c} {w} {c} {w} {w} {e} \
832  {w} {c} {c} {c} {c} {c} {c} {c} {c} {c} {c} {c} {c} {w}}
833  }
834  if {! [info exists ::glist_Sort($layout)] } {
835  set ::glist_Sort($layout) { {22} {-} {7} {-} }
836  }
837  if {! [info exists ::glist_FindBar($layout)] } {
838  set ::glist_FindBar($layout) 0
839  }
840 
841  ttk::treeview $w.glist -columns $::glist_Headers -show headings -selectmode browse
842  $w.glist tag configure current -background lightSteelBlue
843  $w.glist tag configure fsmall -font font_Small
844  set lineH [expr { round(1.4 * [font metrics font_Small -linespace]) }]
845  ttk::style configure Treeview -rowheight $lineH
846  $w.glist tag configure deleted -foreground #a5a2ac
847  menu $w.glist.header_menu
848  menu $w.glist.header_menu.addcol
849  menu $w.glist.game_menu
850  bind $w.glist <Configure> {
851  set hWin [winfo height %W]
852  set hHeading 18
853  set space [expr double($hWin - $hHeading)]
854  set hRow [expr {int(1.8*[font metrics font_Small -ascent])} ]
855  ttk::style configure Treeview -rowheight $hRow
856  set ::glistVisibleLn(%W) [expr int(ceil($space / $hRow)) ]
857  after 100 "glist.loadvalues_ %W"
858  }
859  if {$::windowsOS} {
860  bind $w.glist <App> "glist.popupmenu_ %W %x %y %X %Y $layout"
861  } else {
862  bind $w.glist <Menu> "glist.popupmenu_ %W %x %y %X %Y $layout"
863  }
864  bind $w.glist <2> "glist.popupmenu_ %W %x %y %X %Y $layout"
865  bind $w.glist <3> "glist.popupmenu_ %W %x %y %X %Y $layout"
866  bind $w.glist <ButtonRelease-1> "glist.release_ %W %x %y $layout"
867  bind $w.glist <Double-ButtonRelease-1> "glist.doubleclick_ %W %x %y $layout"
868  bind $w.glist <KeyPress-Up> {glist.movesel_ %W prev -1 0; break}
869  bind $w.glist <KeyPress-Down> {glist.movesel_ %W next +1 end; break}
870  bind $w.glist <KeyPress-Right> {continue}
871  bind $w.glist <KeyPress-Left> {continue}
872  bind $w.glist <KeyPress-Prior> {glist.ybar_ %W scroll -1 pages; break}
873  bind $w.glist <KeyPress-Next> {glist.ybar_ %W scroll 1 pages; break}
874  bind $w.glist <KeyPress-Return> {
875  foreach {idx ply} [split [%W selection] "_"] {}
876  if {[info exists idx]} {
877  ::file::SwitchToBase $::glistBase(%W) 0
878  ::game::Load $idx $ply
879  }
880  break
881  }
882  bind $w.glist <Delete> {
883  foreach {idx ply} [split [%W selection] "_"] {}
884  if {[info exists idx]} {
885  glist.delflag_ %W $idx
886  glist.movesel_ %W next +1 end
887  }
888  break
889  }
890  bind $w.glist <Control-Delete> {
891  foreach {idx ply} [split [%W selection] "_"] {}
892  if {[info exists idx]} {
893  glist.movesel_ %W next +1 end;
894  sc_filter remove $::glistBase(%W) $::glistFilter(%W) $idx
895  ::notify::DatabaseModified $::glistBase(%W)
896  }
897  break
898  }
899  bind $w.glist <Destroy> "glist.destroy_ $w.glist"
900 
901  set i 0
902  foreach col $::glist_Headers {
903  $w.glist heading $col -text $::tr($col)
904  $w.glist column $col -stretch 0 \
905  -width [lindex $::glist_ColWidth($layout) $i]\
906  -anchor [lindex $::glist_ColAnchor($layout) $i]
907  incr i
908  }
909  $w.glist configure -displaycolumns $::glist_ColOrder($layout)
910 
911  autoscrollframe -bars both $w "" $w.glist
912  set ::glistYScroll($w.glist) [$w.glist cget -yscrollcommand]
913  $w.glist configure -yscrollcommand "glist.yscroll_ $w.glist"
914  $w.ybar configure -command "glist.ybar_ $w.glist"
915  bind $w.ybar <ButtonRelease-1> "+glist.ybar_ $w.glist buttonrelease"
916  bindMouseWheel $w.glist "glist.ybar_ $w.glist"
917 
918  # Find widget
919  ttk::frame $w.find
920  ttk::label $w.find.hide -image "tb_close hover tb_close_hover"
921  bind $w.find.hide <ButtonPress-1> "set ::glist_FindBar($layout) 0; glist.showfindbar_ $w.glist $layout"
922  ttk::frame $w.find.t
923  ttk::label $w.find.t_text -text $::tr(Search)
924  entry $w.find.text -width 20 -bg white
925  ttk::button $w.find.filter -image tb_search16 -command "glist.findgame_ $w awe"
926  ttk::button $w.find.b1_text -image tb_down -command \
927  "after cancel glist.findgame_ $w 1; after idle glist.findgame_ $w 1"
928  ttk::button $w.find.b2_text -image tb_up -command \
929  "after cancel glist.findgame_ $w 0; after idle glist.findgame_ $w 0"
930  bind $w.find.text <Escape> "set ::glist_FindBar($layout) 0; glist.showfindbar_ $w.glist $layout"
931  bind $w.find.text <Return> "$w.find.filter invoke"
932  bind $w.find.text <KeyPress-Down> "$w.find.b1_text invoke; break"
933  bind $w.find.text <KeyPress-Up> "$w.find.b2_text invoke; break"
934  #TODO: -from 0 -to 100
935  #TODO: set scale position when normal ybar is used
936  ttk::scale $w.find.scale -command "glist.ybar_ $w.glist moveto"
937  grid $w.find.t_text $w.find.text $w.find.filter $w.find.b2_text $w.find.b1_text -in $w.find.t -padx 2
938  grid $w.find.hide
939  grid $w.find.t -row 0 -column 1 -padx 6
940  grid $w.find.scale -row 0 -column 3 -sticky ew
941  grid columnconfigure $w.find 3 -weight 1
942  set ::glistFindBar($w.glist) $w.find
943  glist.showfindbar_ $w.glist $layout
944  bind [winfo toplevel $w] <Control-f> "set ::glist_FindBar($layout) 1; glist.showfindbar_ $w.glist $layout"
945 
946  # On exit save layout in options.dat
947  options.save ::glist_ColOrder($layout)
948  options.save ::glist_ColWidth($layout)
949  options.save ::glist_ColAnchor($layout)
950  options.save ::glist_Sort($layout)
951  options.save ::glist_FindBar($layout)
952 
953  set ::glistLoaded($w.glist) 0
954  set ::glistTotal($w.glist) 0
955  set ::glistVisibleLn($w.glist) 0
956  glist.sortInit_ $w.glist $layout
957 }
958 
959 # glist.update
960 # Retrieve values from database and update the widget
961 # w: the parent windows of the widget that was passed to glist.create
962 # base: the database from which retrieve values
963 # filter: returns only values in the specified filter
964 # moveUp: reset glist to show the first results
965 proc glist.update {{w} {base} {filter} {moveUp 1}} {
966  set w $w.glist
967  if {! [winfo exists $w]} { return}
968 
969  set ::glistFilter($w) $filter
970  set ::glistTotal($w) [sc_filter count $base $filter]
971  if {$moveUp == 1} { set ::glistFirst($w) 0}
972 
973  glist.update_ $w $base
974 }
975 
976 
977 ##########################################################################
978 #private:
979 
980 set glist_Headers {"GlistNumber" "GlistResult" "GlistLength" "GlistWhite" "GlistWElo"
981  "GlistBlack" "GlistBElo" "GlistDate" "GlistEvent" "GlistRound"
982  "GlistSite" "GlistAnnos" "GlistComments" "GlistVars" "GlistDeleted"
983  "GlistFlags" "GlistECO" "GlistEndMaterial" "GlistStart" "GlistEDate"
984  "GlistYear" "GlistAverageElo" "GlistRating" "GlistMoveField" }
985 
986 set glist_DefaultOrder {+ + - + - + - - + + + - - - - - + + - - - - - +}
987 
988 set glist_SortShortcuts { "N" "r" "m" "w" "W"
989  "b" "B" "d" "e" "n"
990  "s" "A" "C" "V" "D"
991  "???" "o" "???" "???" "E"
992  "y" "R" "i" "???" }
993 
994 proc glist.destroy_ {{w}} {
995  if {[info exists ::glistSortCache($w)]} {
996  catch { sc_base sortcache $::glistBase($w) release $::glistSortCache($w)}
997  unset ::glistSortCache($w)
998  }
999  unset ::glistSortStr($w)
1000  catch { unset ::glistBase($w)}
1001  catch { unset ::glistFilter($w)}
1002  catch { unset ::glistFirst($w)}
1003  catch { unset ::glistClickOp($w)}
1004  catch { unset ::glistVisibleLn($w)}
1005  unset ::glistLoaded($w)
1006  unset ::glistTotal($w)
1007  unset ::glistYScroll($w)
1008  unset ::glistFindBar($w)
1009 }
1010 
1011 proc glist.update_ {{w} {base}} {
1012  if {! [info exists ::glistBase($w)] } {
1013  #Create a sortcache to speed up sorting
1014  sc_base sortcache $base create $::glistSortStr($w)
1015  set ::glistFirst($w) 0
1016  } elseif {$::glistBase($w) != $base || $::glistSortCache($w) != $::glistSortStr($w)} {
1017  #Create a new sortcache
1018  catch { sc_base sortcache $::glistBase($w) release $::glistSortCache($w)}
1019  sc_base sortcache $base create $::glistSortStr($w)
1020  set ::glistFirst($w) 0
1021  }
1022  set ::glistSortCache($w) $::glistSortStr($w)
1023  set ::glistBase($w) $base
1025 }
1026 
1027 proc glist.loadvalues_ {{w}} {
1028  set sel [$w selection]
1029  $w delete [$w children {}]
1030  set base $::glistBase($w)
1031  if {$base == [sc_base current]} {
1032  set current_game [sc_game number]
1033  } else {
1034  set current_game -1
1035  }
1036  set i 0
1037  foreach {idx line deleted} [sc_base gameslist $base $::glistFirst($w) $::glistVisibleLn($w)\
1038  $::glistFilter($w) $::glistSortStr($w)] {
1039  if {[lindex $line 1] == "=-="} { set line [lreplace $line 1 1 "\u00BD-\u00BD"]}
1040  $w insert {} end -id $idx -values $line -tag fsmall
1041  if {$deleted == "D"} { $w item $idx -tag {fsmall deleted}}
1042  foreach {n ply} [split $idx "_"] {
1043  if {$n == $current_game} { $w item $idx -tag "[$w item $idx -tag] current"}
1044  }
1045  incr i
1046  }
1047  set ::glistLoaded($w) $i
1048  catch {$w selection set $sel}
1049 
1051 }
1052 
1053 proc glist.showfindbar_ {{w} {layout}} {
1054  if {$::glist_FindBar($layout) == 0} {
1055  grid forget $::glistFindBar($w)
1056  focus $w
1057  } else {
1058  grid $::glistFindBar($w) -row 2 -columnspan 2 -sticky news
1059  focus $::glistFindBar($w).text
1060  $::glistFindBar($w).text selection range 0 end
1061  }
1062 }
1063 
1064 proc glist.findcurrentgame_ {{w} {gnum}} {
1065  set r [sc_base gamelocation $::glistBase($w) $::glistFilter($w) $::glistSortStr($w) $gnum]
1066  if {$r != "none"} {
1067  set ::glistFirst($w) $r
1068  glist.ybar_ $w scroll
1069  }
1070 }
1071 
1072 proc glist.findgame_ {{w_parent} {dir}} {
1073  set w $w_parent.glist
1074  set w_entryT $w_parent.find.text
1075  set txt [$w_entryT get]
1076  $w_entryT configure -bg white
1077  if { $dir == "awe" } {
1078  ::windows::gamelist::Awesome [winfo toplevel $w_parent] "$txt"
1079  $w_entryT selection range 0 end
1080  return
1081  }
1082  if { $txt == "" } { return}
1083  busyCursor $w_parent
1084  update idletasks
1085 
1086  if { [string is integer $txt] } {
1087  set r [sc_base gamelocation $::glistBase($w) $::glistFilter($w) $::glistSortStr($w) $txt]
1088  } else {
1089  set gstart [expr int($::glistFirst($w))]
1090  foreach {n ply} [split [$w selection] "_"] {
1091  if {$n != ""} {
1092  set gstart [sc_base gamelocation $::glistBase($w) $::glistFilter($w) $::glistSortStr($w) $n]
1093  }
1094  }
1095  if {$dir == "1"} { incr gstart}
1096  set r [sc_base gamelocation $::glistBase($w) $::glistFilter($w) $::glistSortStr($w) 0\
1097  $txt $gstart $dir]
1098  }
1099  if {$r == "none"} {
1100  $w_entryT configure -bg red
1101  } else {
1102  if {$r >= [expr $::glistFirst($w) + $::glistVisibleLn($w)] || $r < $::glistFirst($w)} {
1103  set ::glistFirst($w) $r
1104  glist.ybar_ $w scroll
1105  }
1106  after idle glist.select_ $w [expr $r +1]
1107  }
1108  unbusyCursor $w_parent
1109 }
1110 
1111 proc glist.select_ {w {idx 0}} {
1112  if {$idx != "end" && $idx > 0} {
1113  set idx [expr int($idx - $::glistFirst($w) -1)]
1114  }
1115  $w selection set [lindex [$w children {}] $idx]
1116 }
1117 
1118 proc glist.movesel_ {{w} {cmd} {scroll} {select}} {
1119  set sel [$w selection]
1120  if {$sel == ""} { glist.select_ $w; return}
1121  set newsel [$w $cmd $sel]
1122  if {$newsel == "" || [$w bbox $newsel] == ""} {
1123  glist.ybar_ $w scroll $scroll
1124  }
1125  if {$newsel == ""} {
1126  after idle glist.select_ $w $select
1127  } else {
1128  $w selection set $newsel
1129  }
1130 }
1131 
1132 proc glist.delflag_ {{w} {idx}} {
1133  sc_base gameflag $::glistBase($w) $idx invert del
1134  ::notify::DatabaseModified $::glistBase($w)
1135 }
1136 
1137 proc glist.doubleclick_ {{w} {x} {y} {layout}} {
1138  lassign [$w identify $x $y] what
1139  if {$what == "heading"} {
1140  glist.sortClickHandle_ $w $x $y $layout 1
1141  } else {
1142  foreach {idx ply} [split [$w identify item $x $y] "_"] {}
1143  if {[info exists idx]} {
1144  if {[info exists ::glistClickOp($w)]} {
1145  if {$::glistClickOp($w) == 1} {
1146  glist.delflag_ $w $idx;
1147  $w selection set {};
1148  return
1149  }
1150  if {$::glistClickOp($w) == 2} {
1151  glist.removeFromFilter_ $w $idx
1152  return
1153  }
1154  }
1155  ::file::SwitchToBase $::glistBase($w) 0
1156  ::game::Load $idx $ply
1157  }
1158  }
1159 }
1160 
1161 proc glist.removeFromFilter_ {{w} {idx} {dir ""}} {
1162  if {$dir == ""} {
1163  sc_filter remove $::glistBase($w) $::glistFilter($w) $idx
1164  } else {
1165  sc_filter remove $::glistBase($w) $::glistFilter($w) $idx $dir $::glistSortStr($w)
1166  }
1167  ::notify::DatabaseModified $::glistBase($w) $::glistFilter($w)
1168  if {$dir == "+"} { glist.ybar_ $w moveto 1}
1169 }
1170 
1171 proc glist.popupmenu_ {{w} {x} {y} {abs_x} {abs_y} {layout}} {
1172 # identify region requires at least tk 8.5.9
1173 # identify row have scrollbar problems
1174  if { 0 != [catch {set region [$w identify region $x $y]}] } {
1175  if {[$w identify row $x $y] == "" } {
1176  set region "heading"
1177  } else {
1178  set region ""
1179  }
1180  }
1181  if { $region != "heading" } {
1182 # if {[$w identify region $x $y] != "heading" }
1183  event generate $w <ButtonPress-1> -x $x -y $y
1184  foreach {idx ply} [split [$w selection] "_"] {}
1185  if {[info exists idx]} {
1186  if { [winfo exists $w.game_menu.merge] } { destroy $w.game_menu.merge}
1187  if { [winfo exists $w.game_menu.copy] } { destroy $w.game_menu.copy}
1188  if { [winfo exists $w.game_menu.filter] } { destroy $w.game_menu.filter}
1189  $w.game_menu delete 0 end
1190  #LOAD/BROWSE/MERGE GAME
1191  $w.game_menu add command -label $::tr(LoadGame) \
1192  -command "::file::SwitchToBase $::glistBase($w) 0; ::game::Load $idx $ply"
1193  $w.game_menu add command -label $::tr(BrowseGame) \
1194  -command "::gbrowser::new $::glistBase($w) $idx $ply"
1195  $w.game_menu add command -label $::tr(MergeGame) \
1196  -command "mergeGame $::glistBase($w) $idx"
1197  menu $w.game_menu.merge
1198  menu $w.game_menu.copy
1199  foreach i [sc_base list] {
1200  if { $i == $::glistBase($w) || [sc_base isReadOnly $i] } { continue}
1201  set fname [file tail [sc_base filename $i]]
1202  $w.game_menu.merge add command -label "$i $fname" -command "::game::mergeInBase $::glistBase($w) $i $idx"
1203  $w.game_menu.copy add command -label "$i $fname" \
1204  -command "sc_base copygames $::glistBase($w) $idx $i; ::notify::DatabaseModified $i"
1205  }
1206  $w.game_menu add cascade -label $::tr(GlistMergeGameInBase) -menu $w.game_menu.merge
1207  #TODO: translate label
1208  $w.game_menu add cascade -label "Copy Game to" -menu $w.game_menu.copy
1209 
1210  #GOTO GAME
1211  $w.game_menu add separator
1212  #TODO: translate label
1213  $w.game_menu add checkbutton -variable ::glist_FindBar($layout) \
1214  -label "Find Bar" -command "glist.showfindbar_ $w $layout"
1215  if {$::glistBase($w) == [sc_base current] && [sc_game number] != 0} {
1216  #TODO: translate label
1217  $w.game_menu add command -label "Find current game" -command "glist.findcurrentgame_ $w [sc_game number]"
1218  } else {
1219  #TODO: translate label
1220  $w.game_menu add command -label "Find current game" -state disabled
1221  }
1222  $w.game_menu add separator
1223  menu $w.game_menu.filter
1224  $w.game_menu.filter add command -label "Export" -command "::windows::gamelist::FilterExport [winfo toplevel $w]"
1225  $w.game_menu.filter add separator
1226  $w.game_menu.filter add command -label [tr SearchReset] \
1227  -command "::windows::gamelist::FilterReset [winfo toplevel $w] $::glistBase($w)"
1228  $w.game_menu.filter add command -label [tr SearchNegate] \
1229  -command "::windows::gamelist::FilterNegate [winfo toplevel $w] $::glistBase($w)"
1230  $w.game_menu.filter add separator
1231  $w.game_menu.filter add command -label $::tr(GlistRemoveGameAndAboveFromFilter) \
1232  -command "glist.removeFromFilter_ $w $idx -"
1233  $w.game_menu.filter add command -label $::tr(GlistRemoveThisGameFromFilter) \
1234  -command "glist.removeFromFilter_ $w $idx"
1235  $w.game_menu.filter add command -label $::tr(GlistRemoveGameAndBelowFromFilter) \
1236  -command "glist.removeFromFilter_ $w $idx +"
1237  $w.game_menu.filter add separator
1238  $w.game_menu.filter add command -label $::tr(GlistDeleteAllGames) \
1239  -command "sc_base gameflag $::glistBase($w) $::glistFilter($w) set del; ::notify::DatabaseModified $::glistBase($w)"
1240  $w.game_menu.filter add command -label $::tr(GlistUndeleteAllGames) \
1241  -command "sc_base gameflag $::glistBase($w) $::glistFilter($w) unset del; ::notify::DatabaseModified $::glistBase($w)"
1242  $w.game_menu add cascade -label $::tr(Filter) -menu $w.game_menu.filter
1243  $w.game_menu add separator
1244  #TODO: translate labels
1245  set dellabel "Delete game"
1246  if {[sc_base gameflag $::glistBase($w) $idx get del]} { set dellabel "Undelete game"}
1247  $w.game_menu add command -label $dellabel -command "glist.delflag_ $w $idx; $w selection set {};"
1248  tk_popup $w.game_menu $abs_x $abs_y
1249  }
1250  } else {
1251  set col [$w identify column $x $y]
1252  set col_idx [lsearch -exact $::glist_Headers [$w column $col -id]]
1253  $w.header_menu delete 0 end
1254 
1255  #CHANGE ALIGNMENT
1256  set cur_a [lindex $::glist_ColAnchor($layout) $col_idx]
1257  if {$cur_a != "w"} {
1258  $w.header_menu add command -label $::tr(GlistAlignL) \
1259  -command "$w column $col -anchor w; lset ::glist_ColAnchor($layout) $col_idx w"
1260  }
1261  if {$cur_a != "e"} {
1262  $w.header_menu add command -label $::tr(GlistAlignR) \
1263  -command "$w column $col -anchor e; lset ::glist_ColAnchor($layout) $col_idx e"
1264  }
1265  if {$cur_a != "c"} {
1266  $w.header_menu add command -label $::tr(GlistAlignC) \
1267  -command "$w column $col -anchor c; lset ::glist_ColAnchor($layout) $col_idx c"
1268  }
1269 
1270  #ADD/REMOVE COLUMN
1271  $w.header_menu add separator
1272  $w.header_menu.addcol delete 0 end
1273  set empty disabled
1274  set i 0
1275  foreach h $::glist_Headers {
1276  if {[lsearch -exact $::glist_ColOrder($layout) $i] == -1} {
1277  set empty normal
1278  $w.header_menu.addcol add command -label $::tr($h) -command "glist.insertcol_ $w $layout $i $col"
1279  }
1280  incr i
1281  }
1282  $w.header_menu add cascade -label $::tr(GlistAddField) -menu $w.header_menu.addcol -state $empty
1283  $w.header_menu add command -label $::tr(GlistDeleteField) -command "glist.removecol_ $w $layout $col"
1284 
1285  #RESET SORT
1286  $w.header_menu add separator
1287  #TODO: translate label
1288  $w.header_menu add command -label "Reset sort" -command "glist.sort_ $w 0 $layout 1"
1289 
1290  #BARS
1291  $w.header_menu add separator
1292  #TODO: translate label
1293  $w.header_menu add checkbutton -variable ::glist_FindBar($layout) \
1294  -label "Find Bar" -command "glist.showfindbar_ $w $layout"
1295 
1296  tk_popup $w.header_menu $abs_x $abs_y
1297  }
1298 }
1299 
1300 # Sorting
1301 proc glist.sortInit_ {w {layout}} {
1302  set ::glistSortStr($w) ""
1303  set i 0
1304  foreach {c dir} $::glist_Sort($layout) {
1305  set arrow_idx [expr $i *2]
1306  if {$dir == "-"} { incr arrow_idx}
1307  $w heading $c -image ::glist_Arrows($arrow_idx)
1308  append ::glistSortStr($w) [lindex $::glist_SortShortcuts $c] $dir
1309  incr i
1310  }
1311 }
1312 
1313 proc glist.sortClickHandle_ {{w} {x} {y} {layout} {clear 0}} {
1314  set col [$w identify column $x $y]
1315  set col_idx [lsearch -exact $::glist_Headers [$w column $col -id]]
1316  if {"???" == [lindex $::glist_SortShortcuts $col_idx]} {
1317  # TODO: notify the user that the column cannot be used for sorting
1318  return
1319  }
1320  glist.sort_ $w $col_idx $layout $clear
1321 }
1322 
1323 proc glist.sort_ {{w} {col_idx} {layout} {clear 0}} {
1324  if {[lindex $::glist_Sort($layout) 0] == 0 && $col_idx != 0} { set clear 1; }
1325  if {$clear} {
1326  foreach {c dir} $::glist_Sort($layout) { $w heading $c -image ""}
1327  set ::glist_Sort($layout) {}
1328  }
1329 
1330  set exists [lsearch -exact $::glist_Sort($layout) $col_idx]
1331  if {$exists == -1} {
1332  set order [lindex $::glist_DefaultOrder $col_idx]
1333  lappend ::glist_Sort($layout) $col_idx $order
1334  } else {
1335  incr exists
1336  if {[lindex $::glist_Sort($layout) $exists] == "+"} {
1337  lset ::glist_Sort($layout) $exists {-}
1338  } else {
1339  lset ::glist_Sort($layout) $exists {+}
1340  }
1341  }
1342  busyCursor $w
1343  update idletasks
1344  glist.sortInit_ $w $layout
1345  set file [sc_base filename $::glistBase($w)]
1346  if {[info exists ::recentSort]} {
1347  set idx [lsearch -exact $::recentSort "$file"]
1348  if {$idx != -1} {
1349  set ::recentSort [lreplace $::recentSort $idx [expr $idx +1]]
1350  }
1351  while {[llength $::recentSort] > 20} {
1352  set ::recentSort [lreplace $::recentSort 0 1]
1353  }
1354  }
1355  lappend ::recentSort "$file" "$::glist_Sort($layout)"
1356  glist.update_ $w $::glistBase($w)
1357  unbusyCursor $w
1358 }
1359 
1360 # Scrollbar
1361 proc glist.ybar_ {w cmd {n 0} {units ""}} {
1362  if { $cmd == "-1" || $cmd == "+1" } {
1363  #MouseWheel
1364  set n $cmd
1365  set units "units"
1366  set cmd scroll
1367  }
1368  if { $cmd == "scroll" || $cmd == "moveto"} {
1369  if {$cmd == "moveto"} {
1370  set ::glistFirst($w) [expr int(ceil($n * $::glistTotal($w)))]
1371  } else {
1372  if {$units == "pages"} {
1373  set ::glistFirst($w) [expr $::glistFirst($w) + $n * ($::glistVisibleLn($w) -1)]
1374  } else {
1375  set ::glistFirst($w) [expr $::glistFirst($w) + $n]
1376  }
1377  }
1378 
1379  set d [expr $::glistTotal($w) - $::glistVisibleLn($w) +1]
1380  if {$::glistFirst($w) > $d } { set ::glistFirst($w) $d}
1381  if { $::glistFirst($w) < 0 } { set ::glistFirst($w) 0}
1382 
1383  after cancel glist.loadvalues_ $w
1384  after idle glist.loadvalues_ $w
1385  }
1386 }
1387 
1388 proc glist.ybarupdate_ {w} {
1389  if { $::glistLoaded($w) != $::glistTotal($w) } {
1390  set first [expr double($::glistFirst($w)) / $::glistTotal($w)]
1391  set last [expr double($::glistFirst($w) + $::glistVisibleLn($w)) / $::glistTotal($w)]
1392  eval $::glistYScroll($w) $first $last
1393  }
1394 }
1395 
1396 proc glist.yscroll_ {w first last} {
1397  if { $::glistLoaded($w) == $::glistTotal($w) } {
1398  eval $::glistYScroll($w) $first $last
1399  }
1400 }
1401 
1402 #Drag and drop and changes in column's layout
1403 proc glist.insertcol_ {{w} {layout} {col} {after}} {
1404  set b [expr [string trimleft $after {#}]]
1405  set ::glist_ColOrder($layout) [linsert $::glist_ColOrder($layout) $b $col]
1406  $w configure -displaycolumns $::glist_ColOrder($layout)
1407 }
1408 
1409 proc glist.removecol_ {{w} {layout} {col}} {
1410  set d [expr [string trimleft $col {#}] -1]
1411  set ::glist_ColOrder($layout) [lreplace $::glist_ColOrder($layout) $d $d]
1412  $w configure -displaycolumns $::glist_ColOrder($layout)
1413 }
1414 
1415 proc glist.release_ {{w} {x} {y} {layout}} {
1416  switch $::ttk::treeview::State(pressMode) {
1417  resize {
1418  set col_id [$w column $::ttk::treeview::State(resizeColumn) -id]
1419  set i [lsearch -exact $::glist_Headers $col_id]
1420  if {$i != -1} {
1421  lset ::glist_ColWidth($layout) $i [$w column $::ttk::treeview::State(resizeColumn) -width]
1422  }
1423  }
1424  heading {
1425  lassign [$w identify $x $y] what
1426  if {$what == "heading"} {
1427  set new_col [$w identify column $x $y]
1428  set from [expr [string trimleft $::ttk::treeview::State(heading) {#}] -1]
1429  set to [expr [string trimleft $new_col {#}] -1]
1430  set val [lindex $::glist_ColOrder($layout) $from]
1431  if {$from != $to} {
1432  set ::glist_ColOrder($layout) [lreplace $::glist_ColOrder($layout) $from $from]
1433  set ::glist_ColOrder($layout) [linsert $::glist_ColOrder($layout) $to $val]
1434  $w configure -displaycolumns $::glist_ColOrder($layout)
1435  } else {
1436  glist.sortClickHandle_ $w $x $y $layout
1437  }
1438  }
1439  }
1440  }
1441  ttk::treeview::Release $w $x $y
1442 }
1443 
1444 image create bitmap ::glist_Arrows(0) -foreground blue -data {
1445  #define arrows_width 12
1446  #define arrows_height 10
1447  static unsigned char arrows_bits[] = {
1448  0x00, 0x00, 0x00, 0x03, 0x00, 0x02, 0x00, 0x02, 0x00, 0x02, 0x10, 0x02,
1449  0x38, 0x07, 0x7c, 0x00, 0xfe, 0x00, 0x00, 0x00 };
1450 }
1451 image create bitmap ::glist_Arrows(1) -foreground blue -data {
1452  #define arrows_width 12
1453  #define arrows_height 10
1454  static unsigned char arrows_bits[] = {
1455  0x00, 0x00, 0x00, 0x03, 0x00, 0x02, 0x00, 0x02, 0x00, 0x02, 0xfe, 0x02,
1456  0x7c, 0x07, 0x38, 0x00, 0x10, 0x00, 0x00, 0x00 };
1457 }
1458 image create bitmap ::glist_Arrows(2) -foreground blue -data {
1459  #define arrows_width 12
1460  #define arrows_height 10
1461  static unsigned char arrows_bits[] = {
1462  0x00, 0x00, 0x80, 0x03, 0x00, 0x04, 0x00, 0x04, 0x00, 0x02, 0x08, 0x01,
1463  0x9c, 0x07, 0x3e, 0x00, 0x7f, 0x00, 0x00, 0x00 };
1464 }
1465 image create bitmap ::glist_Arrows(3) -foreground blue -data {
1466  #define arrows_width 12
1467  #define arrows_height 10
1468  static unsigned char arrows_bits[] = {
1469  0x00, 0x00, 0x80, 0x03, 0x00, 0x04, 0x00, 0x04, 0x00, 0x02, 0x7f, 0x01,
1470  0xbe, 0x07, 0x1c, 0x00, 0x08, 0x00, 0x00, 0x00 };
1471 }
1472 image create bitmap ::glist_Arrows(4) -foreground blue -data {
1473  #define arrows_width 12
1474  #define arrows_height 10
1475  static unsigned char arrows_bits[] = {
1476  0x00, 0x00, 0x80, 0x03, 0x00, 0x04, 0x00, 0x04, 0x00, 0x03, 0x08, 0x04,
1477  0x9c, 0x07, 0x3e, 0x00, 0x7f, 0x00, 0x00, 0x00 };
1478 }
1479 image create bitmap ::glist_Arrows(5) -foreground blue -data {
1480  #define arrows_width 12
1481  #define arrows_height 10
1482  static unsigned char arrows_bits[] = {
1483  0x00, 0x00, 0x80, 0x03, 0x00, 0x04, 0x00, 0x04, 0x00, 0x03, 0x7f, 0x04,
1484  0xbe, 0x03, 0x1c, 0x00, 0x08, 0x00, 0x00, 0x00 };
1485 }
1486 image create bitmap ::glist_Arrows(6) -foreground blue -data {
1487  #define arrows_width 12
1488  #define arrows_height 10
1489  static unsigned char arrows_bits[] = {
1490  0x00, 0x00, 0x00, 0x02, 0x00, 0x03, 0x00, 0x03, 0x80, 0x02, 0x88, 0x07,
1491  0x1c, 0x02, 0x3e, 0x00, 0x7f, 0x00, 0x00, 0x00 };
1492 }
1493 image create bitmap ::glist_Arrows(7) -foreground blue -data {
1494  #define arrows_width 12
1495  #define arrows_height 10
1496  static unsigned char arrows_bits[] = {
1497  0x00, 0x00, 0x00, 0x02, 0x00, 0x03, 0x00, 0x03, 0x80, 0x02, 0xff, 0x07,
1498  0x3e, 0x02, 0x1c, 0x00, 0x08, 0x00, 0x00, 0x00 };
1499 }
1500 image create bitmap ::glist_Arrows(8) -foreground blue -data {
1501  #define arrows_width 12
1502  #define arrows_height 10
1503  static unsigned char arrows_bits[] = {
1504  0x00, 0x00, 0x80, 0x07, 0x80, 0x00, 0x80, 0x03, 0x00, 0x04, 0x08, 0x04,
1505  0x9c, 0x03, 0x3e, 0x00, 0x7f, 0x00, 0x00, 0x00 };
1506 }
1507 image create bitmap ::glist_Arrows(9) -foreground blue -data {
1508  #define arrows_width 12
1509  #define arrows_height 10
1510  static unsigned char arrows_bits[] = {
1511  0x00, 0x00, 0x80, 0x07, 0x80, 0x00, 0x80, 0x03, 0x00, 0x04, 0x7f, 0x04,
1512  0xbe, 0x03, 0x1c, 0x00, 0x08, 0x00, 0x00, 0x00 };
1513 }
1514 image create bitmap ::glist_Arrows(10) -foreground blue -data {
1515  #define arrows_width 12
1516  #define arrows_height 10
1517  static unsigned char arrows_bits[] = {
1518  0x00, 0x00, 0x00, 0x07, 0x80, 0x00, 0x80, 0x00, 0x80, 0x03, 0x88, 0x04,
1519  0x1c, 0x07, 0x3e, 0x00, 0x7f, 0x00, 0x00, 0x00 };
1520 }
1521 image create bitmap ::glist_Arrows(11) -foreground blue -data {
1522  #define arrows_width 12
1523  #define arrows_height 10
1524  static unsigned char arrows_bits[] = {
1525  0x00, 0x00, 0x00, 0x07, 0x80, 0x01, 0x80, 0x00, 0x80, 0x07, 0xff, 0x04,
1526  0x3e, 0x03, 0x1c, 0x00, 0x08, 0x00, 0x00, 0x00 };
1527 }
1528 image create bitmap ::glist_Arrows(12) -foreground blue -data {
1529  #define arrows_width 12
1530  #define arrows_height 10
1531  static unsigned char arrows_bits[] = {
1532  0x00, 0x00, 0x80, 0x07, 0x00, 0x04, 0x00, 0x02, 0x00, 0x02, 0x08, 0x02,
1533  0x1c, 0x01, 0x3e, 0x00, 0x7f, 0x00, 0x00, 0x00 };
1534 }
1535 image create bitmap ::glist_Arrows(13) -foreground blue -data {
1536  #define arrows_width 12
1537  #define arrows_height 10
1538  static unsigned char arrows_bits[] = {
1539  0x00, 0x00, 0x80, 0x07, 0x00, 0x04, 0x00, 0x02, 0x00, 0x02, 0x7f, 0x02,
1540  0x3e, 0x01, 0x1c, 0x00, 0x08, 0x00, 0x00, 0x00 };
1541 }
1542 image create bitmap ::glist_Arrows(14) -foreground blue -data {
1543  #define arrows_width 12
1544  #define arrows_height 10
1545  static unsigned char arrows_bits[] = {
1546  0x00, 0x00, 0x00, 0x03, 0x80, 0x04, 0x80, 0x04, 0x00, 0x03, 0x88, 0x04,
1547  0x9c, 0x07, 0x3e, 0x00, 0x7f, 0x00, 0x00, 0x00 };
1548 }
1549 image create bitmap ::glist_Arrows(15) -foreground blue -data {
1550  #define arrows_width 12
1551  #define arrows_height 10
1552  static unsigned char arrows_bits[] = {
1553  0x00, 0x00, 0x00, 0x03, 0x80, 0x04, 0x80, 0x04, 0x00, 0x03, 0xff, 0x04,
1554  0xbe, 0x07, 0x1c, 0x00, 0x08, 0x00, 0x00, 0x00 };
1555 }
1556 image create bitmap ::glist_Arrows(16) -foreground blue -data {
1557  #define arrows_width 12
1558  #define arrows_height 10
1559  static unsigned char arrows_bits[] = {
1560  0x00, 0x00, 0x00, 0x03, 0x80, 0x04, 0x80, 0x07, 0x00, 0x04, 0x08, 0x06,
1561  0x9c, 0x03, 0x3e, 0x00, 0x7f, 0x00, 0x00, 0x00 };
1562 }
1563 image create bitmap ::glist_Arrows(17) -foreground blue -data {
1564  #define arrows_width 12
1565  #define arrows_height 10
1566  static unsigned char arrows_bits[] = {
1567  0x00, 0x00, 0x00, 0x03, 0x80, 0x04, 0x80, 0x07, 0x00, 0x04, 0x7f, 0x06,
1568  0xbe, 0x03, 0x1c, 0x00, 0x08, 0x00, 0x00, 0x00 };
1569 }
1570 
1571 ##########################################################################