Scid  4.6.5
main.tcl
Go to the documentation of this file.
1 # Copyright (C) 1999-2004 Shane Hudson
2 # Copyright (C) 2006-2009 Pascal Georges
3 # Copyright (C) 2008-2011 Alexander Wagner
4 # Copyright (C) 2013-2016 Fulvio Benini
5 #
6 # This file is part of Scid (Shane's Chess Information Database).
7 #
8 # Scid is free software: you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation.
11 #
12 # Scid is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Scid. If not, see <http://www.gnu.org/licenses/>.
19 
20 ###
21 ### main.tcl: Routines for creating and updating the main window.
22 ###
23 
24 ############################################################
25 # Keyboard move entry:
26 # Handles letters, digits and BackSpace/Delete keys.
27 # Note that king- and queen-side castling moves are denoted
28 # "OK" and "OQ" respectively.
29 # The letters n, r, q, k, o and l are promoted to uppercase
30 # automatically. A "b" can match to a b-pawn or Bishop move,
31 # so in some rare cases, a capital B may be needed for the
32 # Bishop move to distinguish it from the pawn move.
33 
34 set moveEntry(Text) ""
35 set moveEntry(List) {}
36 
37 proc moveEntry_Clear {} {
38  global moveEntry
39  set moveEntry(Text) ""
40  set moveEntry(List) {}
41 }
42 
43 proc moveEntry_Complete {} {
44  global moveEntry
45  set len [llength $moveEntry(List)]
46  if {$len > 0} {
47  set move [lindex $moveEntry(List) 0]
48  if {$move == "OK"} { set move "O-O"}
49  if {$move == "OQ"} { set move "O-O-O"}
51  addSanMove $move
52  }
53 }
54 
55 proc moveEntry_Backspace {} {
56  global moveEntry
57  set moveEntry(Text) [string range $moveEntry(Text) 0 \
58  [expr {[string length $moveEntry(Text)] - 2}]]
59  set moveEntry(List) [sc_pos matchMoves $moveEntry(Text) $moveEntry(Coord)]
61 }
62 
63 proc moveEntry_Char {ch} {
64  global moveEntry
65  set oldMoveText $moveEntry(Text)
66  set oldMoveList $moveEntry(List)
67  append moveEntry(Text) $ch
68  set moveEntry(List) [sc_pos matchMoves $moveEntry(Text) $moveEntry(Coord)]
69  set len [llength $moveEntry(List)]
70  if {$len == 0} {
71  # No matching moves, so do not accept this character as input:
72  set moveEntry(Text) $oldMoveText
73  set moveEntry(List) $oldMoveList
74  } elseif {$len == 1} {
75  # Exactly one matching move, so make it if AutoExpand is on,
76  # or if it equals the move entered. Note the comparison is
77  # case insensitive to allow for 'b' to match both pawn and
78  # Bishop moves.
79  set move [string tolower [lindex $moveEntry(List) 0]]
80 
81  if {$moveEntry(AutoExpand) > 0 ||
82  ![string compare [string tolower $moveEntry(Text)] $move]} {
83  return [moveEntry_Complete]
84  }
85  } elseif {$len == 2} {
86  # Check for the special case where the user has entered a b-pawn
87  # capture that clashes with a Bishop move (e.g. bxc4 and Bxc4):
88  set first [string tolower [lindex $moveEntry(List) 0]]
89  set second [string tolower [lindex $moveEntry(List) 1]]
90  if {[string equal $first $second]} {
91  set moveEntry(List) [list $moveEntry(Text)]
92  return [moveEntry_Complete]
93  }
94  }
96 }
97 
98 # updateMainGame:
99 # Updates the main board with games's info
100 #
101 proc updateMainGame {} {
102  global gamePlayers
103  set gamePlayers(nameW) [sc_game info white]
104  set gamePlayers(nameB) [sc_game info black]
105  set eloW [sc_game info welo]
106  set gamePlayers(eloW) [expr {$eloW == 0 ? "" : "($eloW)"}]
107  set eloB [sc_game info belo]
108  set gamePlayers(eloB) [expr {$eloB == 0 ? "" : "($eloB)"}]
109  set gamePlayers(clockW) ""
110  set gamePlayers(clockB) ""
111 }
112 
113 # updateTitle:
114 # Updates the main Scid window title.
115 #
116 proc updateTitle {} {
117  set title "Scid - "
118  set fname [sc_base filename $::curr_db]
119  set fname [file tail $fname]
120  append title "$fname ($::tr(game) "
121  append title "[::utils::thousands [sc_game number]] / "
122  append title "[::utils::thousands [sc_base numGames $::curr_db]])"
123  ::setTitle . $title
124  set white [sc_game info white]
125  set black [sc_game info black]
126  if {[string length $white] > 2 && [string length $black] > 2} {
127  if {$fname == {[clipbase]} } { set fname clipbase}
128  set altered ""
129  if {[sc_game altered]} { set altered "*"}
130  ::setTitle .main "($fname$altered): $white -- $black"
131  } else {
132  ::setTitle .main $title
133  }
134 }
135 
136 # updateStatusBar:
137 # Updates the main Scid window status bar.
138 #
139 proc updateStatusBar {} {
140  # Check if translations have not been set up yet:
141  if {! [info exists ::tr(Database)]} { return}
142 
143  if {$::menuHelpMessage != ""} {
144  ::board::setInfoAlert .main.board "[tr Help]:" "$::menuHelpMessage" "black" ""
145  return
146  }
147 
148  if {$::autoplayMode == 1} {
149  ::board::setInfoAlert .main.board "Autoplay:" [tr Stop] "red" "cancelAutoplay"
150  return
151  }
152 
153  if {[info exists ::playMode]} {
154  set pInfo [eval "$::playMode info"]
155  if {[llength $pInfo] != 4} {
156  ::board::setInfoAlert .main.board "Playing..." [tr Stop] "red" {eval "$::playMode stop"}
157  } else {
158  ::board::setInfoAlert .main.board {*}pInfo
159  }
160  return
161  }
162 
163  # show [%clk] command (if we are not playing)
164  set toMove [sc_pos side]
165  set comment [sc_pos getComment]
166  if { ![gameclock::isRunning] } {
167  set ::gamePlayers(clockW) ""
168  set ::gamePlayers(clockB) ""
169  set clkExp {.*?\[%clk\s*(.*?)\s*\].*}
170  set prevCom [sc_pos getPrevComment]
171  if {$toMove == "white"} {
172  regexp $clkExp $comment -> ::gamePlayers(clockB)
173  regexp $clkExp $prevCom -> ::gamePlayers(clockW)
174  } else {
175  regexp $clkExp $comment -> ::gamePlayers(clockW)
176  regexp $clkExp $prevCom -> ::gamePlayers(clockB)
177  }
178  }
179 
180  if {[info exists ::guessedAddMove]} {
181  set ::gameLastMove [lindex $::guessedAddMove 1]
182  ::board::setInfoAlert .main.board [lindex $::guessedAddMove 0] "\[click to change\]" "blue" ".main.menuaddchoice"
183  unset ::guessedAddMove
184  return
185  }
186 
187  global moveEntry
188  if {$moveEntry(Text) != ""} {
189  set msg "\[ $moveEntry(Text) \] "
190  foreach thisMove $moveEntry(List) {
191  append msg "$thisMove "
192  }
193  ::board::setInfoAlert .main.board "Enter Move:" "$msg" "blue" ""
194  return
195  }
196 
197  # remove technical comments, notify only human readable ones
198  regsub -all {\[%.*\]} $comment {} comment
199 
200  if {$comment != ""} {
201  ::board::setInfoAlert .main.board "Comment:" "$comment" "green" "::makeCommentWin"
202  return
203  }
204 
205 
206  set statusBar ""
207  set move [sc_game info previousMoveNT]
208  if {$move != ""} {
209  regsub {K} $move "\u2654" move
210  regsub {Q} $move "\u2655" move
211  regsub {R} $move "\u2656" move
212  regsub {B} $move "\u2657" move
213  regsub {N} $move "\u2658" move
214  set number "[sc_pos moveNumber]"
215  if {$toMove == "white"} {
216  incr number -1
217  append number ".."
218  }
219  append statusBar "Last move"
220  if {[sc_var level] != 0} { append statusBar " (var)"}
221  append statusBar ": $number.$move\n"
222  }
223 
224  set result [sc_game info result]
225  if {$result == "=-="} { set result "\u00BD-\u00BD"}
226  append statusBar "[sc_game info date] - [sc_game info event] ($result)"
227  ::board::setInfo .main.board "$statusBar"
228 }
229 
230 proc updateMainToolbar {} {
231  if {[sc_pos isAt start]} {
232  ::board::setButtonCmd .main.board back ""
233  catch { unset ::gameInfoBar(tb_BD_Start)}
234  } else {
235  ::board::setButtonCmd .main.board back "::move::Back"
236  set ::gameInfoBar(tb_BD_Start) "::move::Start"
237  }
238  if {[sc_pos isAt end] || [sc_pos isAt vend]} {
239  ::board::setButtonCmd .main.board forward ""
240  catch { unset ::gameInfoBar(tb_BD_End)}
241  catch { unset ::gameInfoBar(tb_BD_Autoplay)}
242  } else {
243  ::board::setButtonCmd .main.board forward "::move::Forward"
244  set ::gameInfoBar(tb_BD_End) "::move::End"
245  set ::gameInfoBar(tb_BD_Autoplay) "startAutoplay"
246  }
247 
248  if {[sc_var level] == 0} {
249  catch { unset ::gameInfoBar(tb_BD_VarDelete)}
250  catch { unset ::gameInfoBar(tb_BD_VarPromote)}
251  catch { unset ::gameInfoBar(tb_BD_VarLeave)}
252  catch { unset ::gameInfoBar(tb_BD_BackToMainline)}
253  } else {
254  set ::gameInfoBar(tb_BD_VarDelete) { ::pgn::deleteVar [sc_var number] }
255  set ::gameInfoBar(tb_BD_VarPromote) { ::pgn::mainVar }
256  set ::gameInfoBar(tb_BD_VarLeave) { ::move::ExitVar }
257  set ::gameInfoBar(tb_BD_BackToMainline) { while {[sc_var level] != 0} {::move::ExitVar} }
258  }
259 
260  set canChange [expr {![sc_base isReadOnly $::curr_db]}]
261  if {$canChange && [sc_game number] != 0} {
262  set ::gameInfoBar(tb_BD_Save) "gameReplace"
263  } else {
264  catch { unset ::gameInfoBar(tb_BD_Save)}
265  }
266  set ::gameInfoBar(tb_BD_SaveAs) "gameSave 0"
267 
268  if {[sc_game undo size] > 0} {
269  set ::gameInfoBar(tb_BD_Undo) "undoFeature undo"
270  set ::gameInfoBar(tb_BD_Revert) "undoFeature undoAll"
271  } else {
272  catch { unset ::gameInfoBar(tb_BD_Undo)}
273  catch { unset ::gameInfoBar(tb_BD_Revert)}
274  }
275  if {[sc_game redo size] > 0} {
276  set ::gameInfoBar(tb_BD_Redo) "undoFeature redo"
277  } else {
278  catch { unset ::gameInfoBar(tb_BD_Redo)}
279  }
280 
281  set ::gameInfoBar(tb_BD_SetupBoard) "setupBoard"
282 }
283 
284 
285 
286 proc toggleRotateBoard {} {
287  ::board::flip .main.board
288 }
289 
290 
291 
292 
293 ############################################################
294 ### The board:
295 
296 proc toggleShowMaterial {} {
297  board::toggleMaterial .main.board
298 }
299 
300 # MouseWheel in main window:
301 proc main_mousewheelHandler {direction} {
302  if {$direction < 0} {
304  } else {
306  }
307 }
308 
309 ################################################################################
310 # added by Pascal Georges
311 # returns a list of num moves from main line following current position
312 ################################################################################
313 proc getNextMoves { {num 4} } {
314  set tmp ""
315  set count 0
316  while { [sc_game info nextMove] != "" && $count < $num} {
317  append tmp " [sc_game info nextMove]"
318  sc_move forward
319  incr count
320  }
321  sc_move back $count
322  return $tmp
323 }
324 ################################################################################
325 # displays a box with main line and variations for easy selection with keyboard
326 ################################################################################
327 proc showVars {} {
328  if {$::autoplayMode == 1} { return}
329 
330  # No need to display an empty menu
331  if {[sc_var count] == 0} {
332  return
333  }
334 
335  if {[sc_var count] == 1 && [sc_game info nextMove] == ""} {
336  # There is only one variation and no main line, so enter it
337  sc_var moveInto 0
339  return
340  }
341 
342  set w .variations
343  if {[winfo exists $w]} { return}
344 
345  set varList [sc_var list]
346  set numVars [sc_var count]
347 
348  # Present a menu of the possible variations
349  toplevel $w
350  ::setTitle $w $::tr(Variations)
351  setWinLocation $w
352  set h [expr $numVars + 1]
353  if { $h> 19} { set h 19}
354  listbox $w.lbVar -selectmode browse -height $h -width 20
355  pack $w.lbVar -expand yes -fill both -side top
356 
357  #insert main line
358  set move [sc_game info nextMove]
359  if {$move == ""} {
360  set move "($::tr(empty))"
361  } else {
362  $w.lbVar insert end "0: [getNextMoves 5]"
363  }
364 
365  # insert variations
366  for {set i 0} {$i < $numVars} {incr i} {
367  set move [::trans [lindex $varList $i]]
368  if {$move == ""} {
369  set move "($::tr(empty))"
370  } else {
371  sc_var moveInto $i
372  append move [getNextMoves 5]
373  sc_var exit
374  }
375  set str "[expr {$i + 1}]: $move"
376  $w.lbVar insert end $str
377  }
378  $w.lbVar selection set 0
379  # bindings
380  bind $w <Configure> "recordWinSize $w"
381  bind .variations <Return> {catch { event generate .variations <Right> } }
382  bind .variations <ButtonRelease-1> {catch { event generate .variations <Right> } }
383  bind .variations <Right> {
384  set cur [.variations.lbVar curselection]
385  destroy .variations
386  if {$cur == 0} {
387  sc_move forward; updateBoard -animate
388  } else {
389  sc_var moveInto [expr $cur - 1]; updateBoard -animate
390  }
391  }
392  bind .variations <Up> { set cur [.variations.lbVar curselection] ; .variations.lbVar selection clear $cur
393  set sel [expr $cur - 1]
394  if {$sel < 0} { set sel 0 }
395  .variations.lbVar selection set $sel ; .variations.lbVar see $sel}
396  bind .variations <Down> { set cur [.variations.lbVar curselection] ; .variations.lbVar selection clear $cur
397  set sel [expr $cur + 1]
398  if {$sel >= [.variations.lbVar index end]} { set sel end }
399  .variations.lbVar selection set $sel ; .variations.lbVar see $sel}
400  bind .variations <Left> { destroy .variations }
401  bind .variations <Escape> { catch { event generate .variations <Destroy> } }
402  # in order to have the window always on top : this does not really work ...
403  bind .variations <Visibility> {
404  if { "%s" != "VisibilityUnobscured" } {
405  focus .variations
406  raise .variations
407  }
408  }
409  bind .variations <FocusOut> {
410  focus .variations
411  raise .variations
412  }
413 
414  # Needed or the main window loses the focus
415  if { $::docking::USE_DOCKING } {
416  bind .variations <Destroy> { focus -force .main }
417  }
418 
419  catch { focus .variations}
420  catch { grab $w}
421  update
422 }
423 ################################################################################
424 #
425 ################################################################################
426 
427 # updateBoard:
428 # Updates the main board.
429 # If a parameter "-pgn" is specified, the PGN text is also regenerated.
430 # If a parameter "-animate" is specified, board changes are animated.
431 #
432 proc updateBoard {args} {
433  ::notify::PosChanged {*}$args
434 }
435 
436 
437 # updateGameInfo:
438 # Update the game status window .main.gameInfo
439 #
440 proc updateGameInfo {} {
441  global gameInfo
442 
443  .main.gameInfo.text configure -state normal
444  .main.gameInfo.text delete 0.0 end
445  ::htext::display .main.gameInfo.text [sc_game info -hide $gameInfo(hideNextMove) \
446  -material $gameInfo(showMaterial) \
447  -cfull $gameInfo(fullComment) \
448  -fen $gameInfo(showFEN) -tb $gameInfo(showTB)]
449  if {$gameInfo(wrap)} {
450  .main.gameInfo.text configure -wrap word
451  .main.gameInfo.text tag configure wrap -lmargin2 10
452  .main.gameInfo.text tag add wrap 1.0 end
453  } else {
454  .main.gameInfo.text configure -wrap none
455  }
456  .main.gameInfo.text configure -state disabled
458 }
459 
460 set photosMinimized 0
461 proc togglePhotosSize {{toggle 1}} {
462  place forget .main.photoW
463  place forget .main.photoB
464  if {! $::gameInfo(photos)} { return}
465 
467  if {$toggle} { set ::photosMinimized [expr !$::photosMinimized]}
468 
469  set distance [expr {[image width photoB] + 2}]
470  if { $distance < 10 } { set distance 82}
471 
472  if {$::photosMinimized} {
473  place .main.photoW -in .main.gameInfo.text -x -17 -relx 1.0 -relheight 0.15 -width 15 -anchor ne
474  place .main.photoB -in .main.gameInfo.text -x -1 -relx 1.0 -relheight 0.15 -width 15 -anchor ne
475  } else {
476  place .main.photoW -in .main.gameInfo.text -x -$distance -relx 1.0 -relheight 1 -width [image width photoW] -anchor ne
477  place .main.photoB -in .main.gameInfo.text -x -1 -relx 1.0 -relheight 1 -width [image width photoB] -anchor ne
478  }
479 }
480 
481 
482 # readPhotoFile executed once at startup for each SPF file. Loads SPI file if it exists.
483 # Otherwise it generates index information and tries to write SPI file to disk (if it can be done)
484 proc readPhotoFile {fname} {
485  set count 0
486  set writespi 0
487 
488  if {! [regsub {\.spf$} $fname {.spi} spi]} {
489  # How does it happend?
490  return
491  }
492 
493  # If SPI file was found then just source it and exit
494  if { [file readable $spi]} {
495  set count [array size ::unsafe::spffile]
496  safeSource $spi fname $fname
497  set newcount [array size ::unsafe::spffile]
498  if {[expr $newcount - $count] > 0} {
499  ::splash::add "Found [expr $newcount - $count] player photos in [file tail $fname]"
500  ::splash::add "Loading information from index file [file tail $spi]"
501  return [expr $newcount - $count]
502  } else {
503  set count 0
504  }
505  }
506 
507  # Check for the absence of the SPI file and check for the write permissions
508  if { ![file exists $spi] && ![catch {open $spi w} fd_spi]} {
509  # SPI file will be written to disk by scid
510  set writespi 1
511  }
512 
513  if {! [file readable $fname]} { return}
514 
515  set fd [open $fname]
516  while {[gets $fd line] >= 0} {
517  # search for the string photo "Player Name"
518  if { [regexp {^photo \"(.*)\" \{$} $line -> name] } {
519  set count [expr $count + 1]
520  set begin [tell $fd]
521  # skip data block
522  while {1} {
523  set end [tell $fd]
524  gets $fd line
525  if {[regexp {.*\}.*} $line]} {break}
526  }
527  set trimname [trimString $name]
528  set size [expr $end - $begin]
529  set ::unsafe::photobegin($trimname) $begin
530  set ::unsafe::photosize($trimname) $size
531  set ::unsafe::spffile($trimname) $fname
532  if { $writespi } {
533  # writing SPI file to disk
534  puts $fd_spi "set \"photobegin($trimname)\" $begin"
535  puts $fd_spi "set \"photosize($trimname)\" $size"
536  puts $fd_spi "set \"spffile($trimname)\" \"\$fname\""
537  }
538  }
539  }
540  if {$count > 0 && $writespi} {
541  ::splash::add "Found $count player photos in [file tail $fname]"
542  ::splash::add "Index file [file tail $spi] was generated succesfully"
543  }
544  if {$count > 0 && !$writespi} {
545  ::splash::add "Found $count player photos in [file tail $fname]"
546  ::splash::add "Could not generate index file [file tail $spi]"
547  ::splash::add "Use spf2spi script to generate [file tail $spi] file "
548  }
549 
550  if { $writespi } { close $fd_spi}
551  close $fd
552  return $count
553 }
554 
555 
556 #convert $data string tolower case and strip the first two blanks.
557 proc trimString {data} {
558  set data [string tolower $data]
559  set strindex [string first "\ " $data]
560  set data [string replace $data $strindex $strindex]
561  set strindex [string first "\ " $data]
562  set data [string replace $data $strindex $strindex]
563  return $data
564 }
565 
566 
567 # retrieve photo from the SPF file using index information
568 proc getphoto {name} {
569  set data ""
570  if {[info exists ::unsafe::spffile($name)]} {
571  set fd [open $::unsafe::spffile($name)]
572  seek $fd $::unsafe::photobegin($name) start
573  set data [read $fd $::unsafe::photosize($name)]
574  close $fd
575  }
576  return $data
577 }
578 
579 
580 proc loadPlayersPhoto {} {
581  set ::gamePlayers(photoW) {}
582  set ::gamePlayers(photoB) {}
583  image create photo photoW
584  image create photo photoB
585 
586  # Directories where Scid searches for the photo files
587  set photodirs [list $::scidDataDir $::scidUserDir $::scidConfigDir [file join $::scidShareDir "photos"]]
588  if {[info exists ::scidPhotoDir]} { lappend photodirs $::scidPhotoDir}
589 
590  # Read all Scid photo (*.spf) files in the Scid data/user/config directories:
591  set nImg 0
592  set nFiles 0
593  foreach dir $photodirs {
594  foreach photofile [glob -nocomplain -directory $dir "*.spf"] {
595  set n [readPhotoFile $photofile]
596  if {$n > 0} {
597  incr nFiles
598  incr nImg $n
599  }
600  }
601  }
602 
603  return [list $nImg $nFiles]
604 }
606 
607 # Try to change the engine name: ignore version number, try to ignore blanks
608 # TODO: rename this function (spellcheck playernames, converts to lower case and remove spaces)
609 proc trimEngineName { engine } {
610  catch {
611  set spell_name [sc_name retrievename $engine]
612  if {$spell_name != ""} { set engine $spell_name}
613  }
614  set engine [string tolower $engine]
615 
616  if { [string first "deep " $engine] == 0 } {
617  # strip "deep "
618  set engine [string range $engine 5 end]
619  }
620  # delete two first blank to make "The King" same as "TheKing"
621  # or "Green Light Chess" as "Greenlightchess"
622  set strindex [string first "\ " $engine]
623  set engine [string replace $engine $strindex $strindex]
624  set strindex [string first "\ " $engine]
625  set engine [string replace $engine $strindex $strindex]
626  set strindex [string first "," $engine]
627  set slen [string len $engine]
628  if { $strindex == -1 && $slen > 2 } {
629  #seems to be a engine name:
630  # search until longest name matches an engine name
631  set slen [string len $engine]
632  for { set strindex $slen} {![info exists ::unsafe::spffile([string range $engine 0 $strindex])]\
633  && $strindex > 2 } {set strindex [expr {$strindex - 1}]} { }
634  set engine [string range $engine 0 $strindex]
635  }
636  return $engine
637 }
638 
639 
640 # updatePlayerPhotos
641 # Updates the images photoW and photoB for the two players of the current game.
642 #
643 proc updatePlayerPhotos {{force ""}} {
644  foreach {name img} {nameW photoW nameB photoB} {
645  set spellname $::gamePlayers($name)
646  if {$::gamePlayers($img) != $spellname} {
647  set ::gamePlayers($img) $spellname
648  catch { set spellname [trimEngineName $spellname]}
649  image create photo $img -data [getphoto $spellname]
650  }
651  }
652 }
653 
654 #########################################################
655 ### Chess move input
656 
657 # Globals for mouse-based move input:
658 
659 set selectedSq -1
660 set bestSq -1
661 
662 set EMPTY 0
663 set KING 1
664 set QUEEN 2
665 set ROOK 3
666 set BISHOP 4
667 set KNIGHT 5
668 set PAWN 6
669 
670 ################################################################################
671 #
672 ################################################################################
673 proc getPromoPiece {} {
674  set w .promoWin
675  set ::result 2
676  toplevel $w
677  # wm transient $w .main
678  ::setTitle $w "Scid"
679  wm resizable $w 0 0
680  set col "w"
681  if { [sc_pos side] == "black" } { set col "b"}
682  ttk::button $w.bq -image ${col}q45 -command "set ::result 2 ; destroy $w"
683  ttk::button $w.br -image ${col}r45 -command "set ::result 3 ; destroy $w"
684  ttk::button $w.bb -image ${col}b45 -command "set ::result 4 ; destroy $w"
685  ttk::button $w.bn -image ${col}n45 -command "set ::result 5 ; destroy $w"
686  pack $w.bq $w.br $w.bb $w.bn -side left
687  bind $w <Escape> "set ::result 2 ; destroy $w"
688  bind $w <Return> "set ::result 2 ; destroy $w"
689  update
690  catch { grab $w}
691  tkwait window $w
692  return $::result
693 }
694 
695 # TODO: remove this
696 # confirmReplaceMove:
697 # Asks the user what to do when adding a move when a move already
698 # exists.
699 # Returns a string value:
700 # "replace" to replace the move, truncating the game.
701 # "var" to add the move as a new variation.
702 # "cancel" to do nothing.
703 #
704 
705 proc confirmReplaceMove {} {
706  if {[winfo exists $::reviewgame::window]} {
707  return "var"
708  }
709  if {! $::askToReplaceMoves} {
710  return "replace"
711  }
712 
713  option add *Dialog.msg.wrapLength 4i interactive
714  catch {tk_dialog .dialog "Scid: $::tr(ReplaceMove)?" \
715  $::tr(ReplaceMoveMessage) "" 0 \
716  $::tr(ReplaceMove) $::tr(NewMainLine) \
717  $::tr(AddNewVar) $::tr(Cancel)} answer
718  option add *Dialog.msg.wrapLength 3i interactive
719  if {$answer == 0} { return "replace"}
720  if {$answer == 1} { return "mainline"}
721  if {$answer == 2} { return "var"}
722  return "cancel"
723 }
724 
725 proc addNullMove {} {
726  addMove null null
727 }
728 
729 proc addMove { sq1 sq2 {animate "-animate"}} {
730  global EMPTY
731  set nullmove 0
732  if {$sq1 == "null" && $sq2 == "null"} { set nullmove 1}
733  if {!$nullmove && [sc_pos isLegal $sq1 $sq2] == 0} {
734  # Illegal move, but if it is King takes king then treat it as
735  # entering a null move:
736  set board [sc_pos board]
737  set k1 [string tolower [string index $board $sq1]]
738  set k2 [string tolower [string index $board $sq2]]
739  if {$k1 == "k" && $k2 == "k"} { set nullmove 1} else { return}
740  }
741  if {$nullmove} {
742  if {[sc_pos isCheck]} { return}
743  set moveUCI "0000"
744  } else {
745  set moveUCI [::board::san $sq2][::board::san $sq1]
746  }
747  addMoveUCI $moveUCI "" $animate
748 }
749 
750 proc addSanMove { {san} } {
751  set err [catch { sc_game SANtoUCI $san} moveUCI]
752  if {! $err} { addMoveUCI $moveUCI}
753  return $err
754 }
755 
756 # addMoveUCI:
757 # Adds the move indicated if it is legal.
758 # If the move is a promotion, getPromoPiece will be called
759 # to get the promotion piece from the user.
760 #
761 proc addMoveUCI {{moveUCI} {action ""} {animate "-animate"}} {
762  set sq1 [::board::sq [string range $moveUCI 0 1]]
763  set sq2 [::board::sq [string range $moveUCI 2 3]]
764  if { [::fics::setPremove $sq1 $sq2] || ! [::fics::playerCanMove] || ! [::reviewgame::playerCanMove]} { return} ;# not player's turn
765 
766  if { [string length $moveUCI] == 4 && $sq1 != $sq2 && [sc_pos isPromotion $sq1 $sq2] } {
767  switch -- [getPromoPiece] {
768  2 { set promoLetter "q"}
769  3 { set promoLetter "r"}
770  4 { set promoLetter "b"}
771  5 { set promoLetter "n"}
772  default {set promoLetter ""}
773  }
774  append moveUCI $promoLetter
775  }
776 
777  if {! $::annotateMode} {
778  if {[::move::Follow $moveUCI]} { return [updateBoard $animate]}
779  }
780 
781 
782  if {![sc_pos isAt vend]} {
783  if {$action == ""} {
784  set replacedmove ""
785  set n [sc_var count]
786  if {$n == 0} {
787  sc_move forward
788  if {[sc_pos isAt vend]} {
789  set replacedmove [sc_game info previousMoveNT]
790  }
791  sc_move back
792  }
793  if {$replacedmove != ""} {
794  set ::guessedAddMove [list "Replaced Move $replacedmove"]
795  } else {
796  set action "var"
797  }
798  }
799 
800  switch -- $action {
801  mainline { set ::guessedAddMove [list "New Main Line"]}
802  var { set ::guessedAddMove [list "New Variation"]}
803  replace { set ::guessedAddMove [list "Replaced Main Line"]}
804  }
805  lappend ::guessedAddMove $moveUCI
806  }
807 
808  undoFeature save
809  if {($action == "mainline" || $action == "var") && ![sc_pos isAt vend]} {
810  sc_var create
811  }
812 
813  if {$moveUCI == "0000"} {
814  sc_move addSan null
815  } else {
816  sc_move addUCI $moveUCI
817  }
818  if {$action == "mainline"} {
819  sc_var promote
820  sc_move forward 1
821  }
822 
823  set ::sergame::lastPlayerMoveUci ""
824  if {[winfo exists ".serGameWin"]} {
825  set ::sergame::lastPlayerMoveUci "$moveUCI"
826  }
827 
828  if {[winfo exists .fics]} {
829  if { [::fics::playerCanMove] } {
830  if { [string length $moveUCI] == 5 } {
831  set promoletter [ string tolower [ string index $moveUCI end]]
832  ::fics::writechan "promote $promoletter"
833  }
834  ::fics::writechan [ string range [sc_game info previousMoveUCI] 0 3]
835  }
836  }
837 
838  if {$::novag::connected} {
839  ::novag::addMove "$moveUCI"
840  }
841 
842  set san [sc_game info previous]
843  after idle [list ::utils::sound::AnnounceNewMove $san]
844 
845  ::notify::PosChanged -pgn $animate
846 }
847 
848 proc suggestMove {} {
849  if {! $::suggestMoves} { return 0}
850  if {[info exists ::playMode]} {
851  return [eval "$::playMode suggestMove"]
852  }
853  if {$::fics::playing != 0} { return 0}
854  return 1
855 }
856 
857 # enterSquare:
858 # Called when the mouse pointer enters a board square.
859 # Finds the best matching square for a move (if there is a
860 # legal move to or from this square), and colors the squares
861 # to indicate the suggested move.
862 #
863 proc enterSquare { square } {
864  global bestSq bestcolor selectedSq
865  if {$selectedSq == -1} {
866  set bestSq -1
867  if {[::suggestMove]} {
868  set bestSq [sc_pos bestSquare $square]
869  if {$bestSq != -1} {
870  ::board::colorSquare .main.board $square $bestcolor
871  ::board::colorSquare .main.board $bestSq $bestcolor
872  }
873  }
874  }
875 }
876 
877 # leaveSquare:
878 # Called when the mouse pointer leaves a board square.
879 # Recolors squares to normal (lite/dark) color.
880 #
881 proc leaveSquare { square } {
882  global selectedSq bestSq
883  if {$selectedSq == -1} {
884  ::board::colorSquare .main.board $bestSq
885  ::board::colorSquare .main.board $square
886  }
887 }
888 
889 # pressSquare:
890 # Called when the left mouse button is pressed on a square. Sets
891 # that square to be the selected square.
892 #
893 proc pressSquare { square } {
894  global selectedSq highcolor
895 
896  if { ![::fics::playerCanMove] || ![::reviewgame::playerCanMove] } { return} ;# not player's turn
897 
898  # if training with calculations of var is on, just log the event
899  if { [winfo exists .calvarWin] } {
900  ::calvar::pressSquare $square
901  return
902  }
903 
904  if {$selectedSq == -1} {
905  set selectedSq $square
906  ::board::colorSquare .main.board $square $highcolor
907  # Drag this piece if it is the same color as the side to move:
908  set c [string index [sc_pos side] 0] ;# will be "w" or "b"
909  set p [string index [::board::piece .main.board $square] 0] ;# "w", "b" or "e"
910  if {$c == $p} {
911  ::board::setDragSquare .main.board $square
912  }
913  } else {
914  ::board::setDragSquare .main.board -1
915  ::board::colorSquare .main.board $selectedSq
916  ::board::colorSquare .main.board $square
917  set tmp $selectedSq
918  set selectedSq -1
919  if {$square != $tmp} {
920  addMove $square $tmp
921  }
922  enterSquare $square
923  }
924 }
925 
926 # releaseSquare:
927 # Called when the left mouse button is released over a square.
928 # If the square is different to that the button was pressed on, it
929 # is a dragged move; otherwise it is just selecting this square as
930 # part of a move.
931 #
932 proc releaseSquare { w x y } {
933  if { [winfo exists .calvarWin] } { return}
934 
935  global selectedSq bestSq
936 
938  set square [::board::getSquare $w $x $y]
939  if {$square < 0} {
940  set selectedSq -1
941  return
942  }
943 
944  if {$square == $selectedSq} {
945  if {[::suggestMove]} {
946  # User pressed and released on same square, so make the
947  # suggested move if there is one:
948  set selectedSq -1
949  ::board::colorSquare $w $bestSq
950  ::board::colorSquare $w $square
951  addMove $square $bestSq
952  enterSquare $square
953  } else {
954  # Current square is the square user pressed the button on,
955  # so we do nothing.
956  }
957  } elseif {$selectedSq != -1} {
958  # User has dragged to another square, so try to add this as a move:
959  set tmp $selectedSq
960  set selectedSq -1
961  addMove $square $tmp ""
962  ::board::colorSquare $w $square
963  ::board::colorSquare $w $tmp
964  }
965 }
966 
967 
968 # backSquare:
969 # Handles the retracting of a move (when the right mouse button is
970 # clicked on a square). Recolors squares to normal color also.
971 # If the move is the last in the game or variation, is is removed
972 # by truncating the game after retracting the move.
973 #
974 proc backSquare {} {
975  global selectedSq bestSq
976  set lastMoveInLine 0
977  if {[sc_pos isAt vend]} {
978  set lastMoveInLine 1
979  }
980  sc_move back
981 
982  # RMB used to delete the move if it was the last in a line. Removed it as there is no undo.
983  # if {[sc_pos isAt vstart] && [sc_var level] != 0} {
984  # ::pgn::deleteVar [sc_var number]
985  # } elseif {$lastMoveInLine} {
986  # sc_game truncate
987  # }
988 
989  set selectedSq -1
990  set bestSq -1
991  # update the board without -pgn option because of poor performance with long games
992  updateBoard -animate
994 }
995 
996 # addMarker:
997 # add/delete square markers and arrows to the current position
998 #
999 proc addMarker {w x y} {
1000  set sq [::board::getSquare $w $x $y]
1001  if {! [info exists ::markStartSq]} {
1002  set ::markStartSq [::board::san $sq]
1003  return
1004  }
1005 
1006  set from $::markStartSq
1007  unset ::markStartSq
1008  set to [::board::san $sq]
1009  if {$from == "" || $to == ""} { return}
1010 
1011  if {$from == $to } {
1012  set cmd "$::markType,$to,$::markColor"
1013  set cmd_erase "\[a-z\]*,$to,\[a-z\]*"
1014  } else {
1015  set cmd "arrow,$from,$to,$::markColor"
1016  set cmd_erase "arrow,$from,$to,\[a-z\]*"
1017  }
1018  set oldComment [sc_pos getComment]
1019  regsub -all " *\\\[%draw $cmd\\\]" $oldComment "" newComment
1020  if {$newComment == $oldComment} {
1021  regsub -all " *\\\[%draw $cmd_erase\\\]" $oldComment "" newComment
1022  append newComment " \[%draw $cmd\]"
1023  }
1024 
1025  sc_pos setComment $newComment
1027 }
1028 
1029 # addNag:
1030 # add a Nag to the current position
1031 #
1032 proc addNag {nag} {
1033  undoFeature save
1034  sc_pos addNag "$nag"
1036 }
1037 
1038 ################################################################################
1039 #
1040 ################################################################################
1041 proc undoFeature {action} {
1042  if {$action == "save"} {
1043  sc_game undoPoint
1044  } elseif {$action == "undo"} {
1045  sc_game undo
1047  } elseif {$action == "redo"} {
1048  sc_game redo
1050  } elseif {$action == "undoAll"} {
1051  sc_game undoAll
1053  }
1054 }
1055 
1056 proc setPlayMode { callback } {
1057  set ::playMode "$callback"
1058  if {$::playMode == ""} { unset ::playMode}
1060 }
1061 
1062 ################################################################################
1063 # In docked mode, resize board automatically
1064 ################################################################################
1065 proc resizeMainBoard {} {
1066  if { ! $::docking::USE_DOCKING } { return}
1067 
1068  if { $::autoResizeBoard } {
1069  update idletasks
1070  set availw [winfo width .fdockmain]
1071  set availh [winfo height .fdockmain]
1072  if {$::showGameInfo} {
1073  set availh [expr $availh - [winfo height .main.gameInfo]]
1074  }
1075  if { [llength [pack slaves .main.tb]] != 0 } {
1076  set availh [expr $availh - [winfo height .main.tb]]
1077  }
1078  set ::boardSize [::board::resizeAuto .main.board "0 0 $availw $availh"]
1079  }
1080 }
1081 ################################################################################
1082 # sets visibility of gameInfo panel at the bottom of main board
1083 proc toggleGameInfo {} {
1084  if {$::showGameInfo} {
1085  grid .main.gameInfo -row 3 -column 0 -sticky news
1086  } else {
1087  grid forget .main.gameInfo
1088  }
1090  update idletasks
1091 }
1092 ################################################################################
1093 
1094 proc CreateMainBoard { {w} } {
1095  setTitle $w [ ::tr "Board"]
1097 
1098  ::board::new $w.board $::boardSize
1099  ::board::showMarks $w.board 1
1100  for {set i 0} {$i < $::boardCoords} {incr i} { ::board::coords $w.board}
1101  if {$::gameInfo(showMaterial)} { ::board::toggleMaterial $w.board}
1102 
1103  ::board::addNamesBar $w.board gamePlayers
1104  ::board::addInfoBar $w.board gameInfoBar
1105 
1106  set ::gameInfoBar(tb_BD_Coords) "set ::boardCoords \[::board::coords $w.board\]"
1107  set ::gameInfoBar(tb_BD_Material) "set ::gameInfo(showMaterial) \[::board::toggleMaterial $w.board\]"
1108 
1109  menu .main.menuaddchoice -bg white -font font_Regular
1110  .main.menuaddchoice add command -label " Undo" -image tb_BD_Undo -compound left \
1111  -command {undoFeature undo}
1112  .main.menuaddchoice add command -label " $::tr(ReplaceMove)" -image tb_BD_Replace -compound left \
1113  -command {sc_game undo; addMoveUCI $::gameLastMove replace}
1114  .main.menuaddchoice add command -label " $::tr(NewMainLine)" -image tb_BD_NewMainline -compound left \
1115  -command {sc_game undo; addMoveUCI $::gameLastMove mainline}
1116  .main.menuaddchoice add command -label " $::tr(AddNewVar)" -image tb_BD_NewVar -compound left \
1117  -command {sc_game undo; addMoveUCI $::gameLastMove var}
1118 
1119  InitToolbar .main.tb
1120 
1121  for {set i 0} { $i < 64 } { incr i} {
1122  ::board::bind $w.board $i <Enter> "enterSquare $i"
1123  ::board::bind $w.board $i <Leave> "leaveSquare $i"
1124  ::board::bind $w.board $i <ButtonPress-1> "pressSquare $i"
1125  ::board::bind $w.board $i <Control-ButtonPress-1> "addMarker $w.board %X %Y"
1126  ::board::bind $w.board $i <Control-ButtonRelease-1> "addMarker $w.board %X %Y"
1127  ::board::bind $w.board $i <B1-Motion> "::board::dragPiece $w.board %X %Y"
1128  ::board::bind $w.board $i <ButtonRelease-1> "releaseSquare $w.board %X %Y"
1129  ::board::bind $w.board $i <ButtonPress-$::MB3> backSquare
1130  }
1131 
1132  foreach i {o q r n k O Q R B N K} {
1133  bind $w <$i> "moveEntry_Char [string toupper $i]"
1134  bind $w <Alt-$i> { continue }
1135 
1136  }
1137  foreach i {a b c d e f g h 1 2 3 4 5 6 7 8} {
1138  bind $w <Key-$i> "moveEntry_Char $i"
1139  bind $w <Alt-$i> { continue }
1140  }
1141 
1142  bind $w <Control-BackSpace> backSquare
1143  bind $w <Control-Delete> backSquare
1144  bind $w <BackSpace> moveEntry_Backspace
1145  bind $w <Delete> moveEntry_Backspace
1146  bind $w <space> moveEntry_Complete
1147  bind $w <ButtonRelease> "focus $w"
1148  bind $w <Configure> {+::resizeMainBoard }
1149  bind $w <Return> { #TODO: improve this
1150  if {[winfo exists .analysisWin1] && $analysis(analyzeMode1)} {
1151  .analysisWin1.b1.move invoke
1152  }
1153  }
1154 
1155  bindMouseWheel $w "main_mousewheelHandler"
1156 
1157  if { $::docking::USE_DOCKING} {
1158  ttk::frame $w.space
1159  grid $w.space -row 4 -column 0 -columnspan 3 -sticky nsew
1160  grid rowconfigure $w 3 -weight 0
1161  grid rowconfigure $w 4 -weight 1
1162  } else {
1163  grid rowconfigure $w 3 -weight 1
1164  wm resizable $w 0 1
1165  wm withdraw .
1166  bind $w <Destroy> { destroy . }
1167  }
1168  grid columnconfigure $w 0 -weight 1
1169  grid $w.board -row 2 -column 0 -sticky we ;# -padx 5 -pady 5
1170 
1174  updateTitle
1175 }
1176 
1177 proc CreateGameInfo {} {
1178  # .gameInfo is the game information widget:
1179  #
1180  autoscrollframe .main.gameInfo text .main.gameInfo.text
1181  .main.gameInfo.text configure -width 20 -height 6 -fg black -bg white -wrap none -state disabled -cursor top_left_arrow -setgrid 1
1182  ::htext::init .main.gameInfo.text
1183 
1184  # Set up player photos:
1185  label .main.photoW -background white -image photoW -anchor ne
1186  label .main.photoB -background white -image photoB -anchor ne
1187  bind .main.photoW <ButtonPress-1> "togglePhotosSize"
1188  bind .main.photoB <ButtonPress-1> "togglePhotosSize"
1189 
1190  # Right-mouse button menu for gameInfo frame:
1191  menu .main.gameInfo.menu -tearoff 0
1192 
1193  .main.gameInfo.menu add checkbutton -label GInfoHideNext \
1194  -variable gameInfo(hideNextMove) -offvalue 0 -onvalue 1 -command updateBoard
1195 
1196  .main.gameInfo.menu add checkbutton -label GInfoMaterial -variable gameInfo(showMaterial) -offvalue 0 -onvalue 1 \
1197  -command { toggleShowMaterial }
1198 
1199  .main.gameInfo.menu add checkbutton -label GInfoFEN \
1200  -variable gameInfo(showFEN) -offvalue 0 -onvalue 1 -command updateBoard
1201 
1202  .main.gameInfo.menu add checkbutton -label GInfoMarks \
1203  -variable gameInfo(showMarks) -offvalue 0 -onvalue 1 -command updateBoard
1204 
1205  .main.gameInfo.menu add checkbutton -label GInfoWrap \
1206  -variable gameInfo(wrap) -offvalue 0 -onvalue 1 -command updateBoard
1207 
1208  .main.gameInfo.menu add checkbutton -label GInfoFullComment \
1209  -variable gameInfo(fullComment) -offvalue 0 -onvalue 1 -command updateBoard
1210 
1211  .main.gameInfo.menu add checkbutton -label GInfoPhotos \
1212  -variable gameInfo(photos) -offvalue 0 -onvalue 1 \
1213  -command {togglePhotosSize 0}
1214 
1215  .main.gameInfo.menu add separator
1216 
1217  .main.gameInfo.menu add radiobutton -label GInfoTBNothing \
1218  -variable gameInfo(showTB) -value 0 -command updateBoard
1219 
1220  .main.gameInfo.menu add radiobutton -label GInfoTBResult \
1221  -variable gameInfo(showTB) -value 1 -command updateBoard
1222 
1223  .main.gameInfo.menu add radiobutton -label GInfoTBAll \
1224  -variable gameInfo(showTB) -value 2 -command updateBoard
1225 
1226  .main.gameInfo.menu add separator
1227 
1228  .main.gameInfo.menu add command -label GInfoDelete -command {
1229  sc_base gameflag [sc_base current] [sc_game number] invert del
1230  ::notify::DatabaseModified [sc_base current]
1231  }
1232 
1233  menu .main.gameInfo.menu.mark
1234  .main.gameInfo.menu add cascade -label GInfoMark -menu .main.gameInfo.menu.mark
1235 
1236  bind .main.gameInfo.text <ButtonPress-$::MB3> {
1237  .main.gameInfo.menu.mark delete 0 end
1238  set ::curr_db [sc_base current]
1239  set ::curr_game [sc_game number]
1240  set i 0
1241  foreach flag $::maintFlaglist {
1242  if {$i < 12} {
1243  set tmp "$::tr($::maintFlags($flag)) ($flag)"
1244  } else {
1245  set tmp [sc_base extra $::curr_db flag$flag]
1246  if {$tmp == "" } { set tmp $::maintFlags($flag) }
1247  }
1248  incr i
1249  .main.gameInfo.menu.mark add command -label "$tmp" \
1250  -command "sc_base gameflag $::curr_db $::curr_game invert $flag; ::notify::DatabaseModified $::curr_db"
1251  }
1252  tk_popup .main.gameInfo.menu %X %Y
1253  }
1254 
1255  storeMenuLabels .main.gameInfo.menu
1256 }
1257 
1258 proc InitToolbar {{tb}} {
1259  ttk::frame $tb -relief raised -border 1
1260  button $tb.new -image tb_new -command ::file::New
1261  button .main.tb.open -image tb_open -command ::file::Open
1262  button .main.tb.save -image tb_save -command {
1263  if {[sc_game number] != 0} {
1264  #busyCursor .
1265  gameReplace
1266  # catch {.save.buttons.save invoke}
1267  #unbusyCursor .
1268  } else {
1269  gameAdd
1270  }
1271  }
1272  button .main.tb.close -image tb_close -command ::file::Close
1273  button .main.tb.finder -image tb_finder -command ::file::finder::Open
1274  menubutton .main.tb.bkm -image tb_bkm -menu .main.tb.bkm.menu
1275  menu .main.tb.bkm.menu
1276  bind .main.tb.bkm <ButtonPress-1> "+.main.tb.bkm configure -relief flat"
1277 
1278  ttk::frame .main.tb.space1 -width 12
1279  button .main.tb.cut -image tb_cut -command ::game::Clear
1280  button .main.tb.copy -image tb_copy -command ::gameAddToClipbase
1281  button .main.tb.paste -image tb_paste \
1282  -command {catch {sc_clipbase paste}; updateBoard -pgn}
1283  ttk::frame .main.tb.space2 -width 12
1284  button .main.tb.gprev -image tb_gprev -command {::game::LoadNextPrev previous}
1285  button .main.tb.gnext -image tb_gnext -command {::game::LoadNextPrev next}
1286  ttk::frame .main.tb.space3 -width 12
1287  button .main.tb.rfilter -image tb_rfilter -command ::search::filter::reset
1288  button .main.tb.bsearch -image tb_bsearch -command ::search::board
1289  button .main.tb.hsearch -image tb_hsearch -command ::search::header
1290  button .main.tb.msearch -image tb_msearch -command ::search::material
1291  ttk::frame .main.tb.space4 -width 12
1292  button .main.tb.switcher -image tb_switcher -command ::windows::switcher::Open
1293  button .main.tb.glist -image tb_glist -command ::windows::gamelist::Open
1294  button .main.tb.pgn -image tb_pgn -command ::pgn::OpenClose
1295  button .main.tb.tmt -image tb_tmt -command ::tourney::toggle
1296  button .main.tb.maint -image tb_maint -command ::maint::OpenClose
1297  button .main.tb.eco -image tb_eco -command ::windows::eco::OpenClose
1298  button .main.tb.tree -image tb_tree -command ::tree::make
1299  button .main.tb.crosst -image tb_crosst -command toggleCrosstabWin
1300  button .main.tb.engine -image tb_engine -command makeAnalysisWin
1301  button .main.tb.help -image tb_help -command {helpWindow Index}
1302 
1303  foreach i {new open save close finder bkm cut copy paste gprev gnext \
1304  rfilter bsearch hsearch msearch \
1305  switcher glist pgn tmt maint eco tree crosst engine help} {
1306  .main.tb.$i configure -takefocus 0 -relief flat -border 1 -anchor n -highlightthickness 0
1307  bind .main.tb.$i <Any-Enter> "+.main.tb.$i configure -relief groove"
1308  bind .main.tb.$i <Any-Leave> "+.main.tb.$i configure -relief flat; break"
1309  }
1310 
1311  # Set toolbar help status messages:
1312  foreach {b m} {
1313  new FileNew open FileOpen finder FileFinder
1314  save GameReplace close FileClose bkm FileBookmarks
1315  gprev GamePrev gnext GameNext
1316  cut GameNew copy EditCopy paste EditPaste
1317  bsearch SearchCurrent
1318  hsearch SearchHeader msearch SearchMaterial
1319  switcher WindowsSwitcher glist WindowsGList pgn WindowsPGN tmt WindowsTmt
1320  maint WindowsMaint eco WindowsECO tree WindowsTree crosst ToolsCross
1321  engine ToolsAnalysis
1322  } {
1323  set helpMessage(.main.tb.$b) $m
1324  ::utils::tooltip::Set $tb.$b $m
1325  }
1327 }
1328 
1329 proc configToolbar {} {
1330  set w .tbconfig
1331  toplevel $w
1332  wm title $w "Scid: [tr OptionsToolbar]"
1333 
1334  array set ::toolbar_temp [array get ::toolbar]
1335  pack [ttk::frame $w.f1] -side top -fill x
1336  foreach i {new open save close finder bkm} {
1337  checkbutton $w.f1.$i -indicatoron 1 -image tb_$i -height 20 -width 22 \
1338  -variable toolbar_temp($i) -relief solid -borderwidth 1
1339  pack $w.f1.$i -side left -ipadx 2 -ipady 2
1340  }
1341  pack [ttk::frame $w.f2] -side top -fill x
1342  foreach i {gprev gnext} {
1343  checkbutton $w.f2.$i -indicatoron 1 -image tb_$i -height 20 -width 22 \
1344  -variable toolbar_temp($i) -relief solid -borderwidth 1
1345  pack $w.f2.$i -side left -ipadx 1 -ipady 1
1346  }
1347  pack [ttk::frame $w.f3] -side top -fill x
1348  foreach i {cut copy paste} {
1349  checkbutton $w.f3.$i -indicatoron 1 -image tb_$i -height 20 -width 22 \
1350  -variable toolbar_temp($i) -relief solid -borderwidth 1
1351  pack $w.f3.$i -side left -ipadx 1 -ipady 1
1352  }
1353  pack [ttk::frame $w.f4] -side top -fill x
1354  foreach i {bsearch hsearch msearch} {
1355  checkbutton $w.f4.$i -indicatoron 1 -image tb_$i -height 20 -width 22 \
1356  -variable toolbar_temp($i) -relief solid -borderwidth 1
1357  pack $w.f4.$i -side left -ipadx 1 -ipady 1
1358  }
1359  pack [ttk::frame $w.f5] -side top -fill x
1360  foreach i {switcher glist pgn tmt maint eco tree crosst engine} {
1361  checkbutton $w.f5.$i -indicatoron 1 -image tb_$i -height 20 -width 22 \
1362  -variable toolbar_temp($i) -relief solid -borderwidth 1
1363  pack $w.f5.$i -side left -ipadx 1 -ipady 1
1364  }
1365 
1367  pack [ttk::frame $w.b] -side bottom -fill x
1368  button $w.on -text "+ [::utils::string::Capital $::tr(all)]" -command {
1369  foreach i [array names toolbar_temp] { set toolbar_temp($i) 1 }
1370  }
1371  button $w.off -text "- [::utils::string::Capital $::tr(all)]" -command {
1372  foreach i [array names toolbar_temp] { set toolbar_temp($i) 0 }
1373  }
1374  ttk::button $w.ok -text "OK" -command {
1375  array set toolbar [array get toolbar_temp]
1376  catch {grab release .tbconfig}
1377  destroy .tbconfig
1378  redrawToolbar
1379  }
1380  ttk::button $w.cancel -text $::tr(Cancel) \
1381  -command "catch {grab release $w}; destroy $w"
1382  pack $w.cancel $w.ok -side right -padx 2
1383  pack $w.on $w.off -side left -padx 2
1384  catch {grab $w}
1385 }
1386 
1387 proc redrawToolbar {} {
1388  global toolbar
1389  foreach i [winfo children .main.tb] { pack forget $i}
1390  set seenAny 0
1391  set seen 0
1392  foreach i {new open save close finder bkm} {
1393  if {$toolbar($i)} {
1394  set seen 1; set seenAny 1
1395  pack .main.tb.$i -side left -pady 1 -padx 0 -ipadx 0 -pady 0 -ipady 0
1396  }
1397  }
1398  if {$seen} { pack .main.tb.space1 -side left}
1399  set seen 0
1400  foreach i {gprev gnext} {
1401  if {$toolbar($i)} {
1402  set seen 1; set seenAny 1
1403  pack .main.tb.$i -side left -pady 1 -padx 0 -ipadx 0 -pady 0 -ipady 0
1404  }
1405  }
1406  if {$seen} { pack .main.tb.space2 -side left}
1407  set seen 0
1408  foreach i {cut copy paste} {
1409  if {$toolbar($i)} {
1410  set seen 1; set seenAny 1
1411  pack .main.tb.$i -side left -pady 1 -padx 0 -ipadx 0 -pady 0 -ipady 0
1412  }
1413  }
1414  if {$seen} { pack .main.tb.space3 -side left}
1415  set seen 0
1416  foreach i {bsearch hsearch msearch} {
1417  if {$toolbar($i)} {
1418  set seen 1; set seenAny 1
1419  pack .main.tb.$i -side left -pady 1 -padx 0 -ipadx 0 -pady 0 -ipady 0
1420  }
1421  }
1422  if {$seen} { pack .main.tb.space4 -side left}
1423  set seen 0
1424  foreach i {switcher glist pgn tmt maint eco tree crosst engine} {
1425  if {$toolbar($i)} {
1426  set seen 1; set seenAny 1
1427  pack .main.tb.$i -side left -pady 1 -padx 0 -ipadx 0 -pady 0 -ipady 0
1428  }
1429  }
1430  if {$seenAny} {
1431  grid .main.tb -row 0 -column 0 -columnspan 3 -sticky we
1432  } else {
1433  grid forget .main.tb
1434  }
1435 }
1436 
1437 ##############################