Scid  4.7.0
•All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros
tree.tcl
Go to the documentation of this file.
1 
2 ############################################################
3 ### TREE window
4 ### (C) 2007 Pascal Georges : multiple Tree windows support
5 
6 namespace eval ::tree {
7  set trainingBase 0
8  array set cachesize {}
9  set scoreHighlight_MinGames 15
10  set scoreHighlight_WhiteExpectedScoreBonus 3.8 ; # on average white achieves a score of 53.8
11  set scoreHighlight_Margin 3.0 ; # if +/- this value, something special happened
12 }
13 # ################################################################################
14 proc ::tree::doConfigMenus { baseNumber { lang "" } } {
15  if {! [winfo exists .treeWin$baseNumber]} { return}
16  if {$lang == ""} { set lang $::language}
17  set m .treeWin$baseNumber.menu
18  foreach idx {0 1 2 3 4} tag {File Mask Sort Opt Help} {
19  configMenuText $m $idx Tree$tag $lang
20  }
21  foreach idx {0 1 2 3 5 7 9} tag {FillWithBase FillWithGame SetCacheSize CacheInfo Graph Copy Close} {
22  configMenuText $m.file $idx TreeFile$tag $lang
23  }
24  foreach idx {0 1 2 3 4 5 6 7 8 9} tag {New Open OpenRecent Save Close FillWithGame FillWithBase Search Info Display} {
25  configMenuText $m.mask $idx TreeMask$tag $lang
26  }
27  foreach idx {0 1 2 3} tag {Alpha ECO Freq Score } {
28  configMenuText $m.sort $idx TreeSort$tag $lang
29  }
30  foreach idx {0 1} tag {Lock Training } {
31  configMenuText $m.opt $idx TreeOpt$tag $lang
32  }
33  foreach idx {0 1} tag {Tree Index} {
34  configMenuText $m.helpmenu $idx TreeHelp$tag $lang
35  }
36 }
37 
38 # ################################################################################
39 proc ::tree::ConfigMenus { { lang "" } } {
40  for {set i [sc_info limit bases]} {$i > 0} {incr i -1} {
41  ::tree::doConfigMenus $i $lang
42  }
43 }
44 ################################################################################
45 proc ::tree::menuCopyToSelection { baseNumber } {
46  clipboard clear
47  clipboard append [ .treeWin$baseNumber.f.tl get 1.0 end]
48 }
49 ################################################################################
50 proc ::tree::make { { baseNumber -1 } {locked 0} } {
51  global tree highcolor geometry helpMessage
52 
53  if {$baseNumber == -1} {set baseNumber [sc_base current]}
54 
55  if {[winfo exists .treeWin$baseNumber]} {
56  ::tree::closeTree $baseNumber
57  return
58  }
59 
60  if {$baseNumber == [sc_base current]} { set ::treeWin 1}
61  set w .treeWin$baseNumber
62 
63  ::createToplevel .treeWin$baseNumber
64 
65  # Set the tree window title now:
66  ::setTitle $w "Scid: [tr WindowsTree] $baseNumber"
67  set ::treeWin$baseNumber 1
68  set tree(training$baseNumber) 0
69  set tree(autorefresh$baseNumber) 1
70  set tree(locked$baseNumber) $locked
71  set tree(base$baseNumber) $baseNumber
72  set tree(status$baseNumber) ""
73  set tree(order$baseNumber) "frequency"
74  set tree(allgames$baseNumber) 1
75 
76  bind $w <Destroy> "::tree::closeTree $baseNumber"
77  bind $w <Escape> "::tree::hideCtxtMenu $baseNumber ; .treeWin$baseNumber.buttons.stop invoke "
78 
79  # Bind left button to close ctxt menu:
80  bind $w <ButtonPress-1> "::tree::hideCtxtMenu $baseNumber"
81 
82  menu $w.menu
83  ::setMenu $w $w.menu
84  $w.menu add cascade -label TreeFile -menu $w.menu.file
85  $w.menu add cascade -label TreeMask -menu $w.menu.mask
86  $w.menu add cascade -label TreeSort -menu $w.menu.sort
87  $w.menu add cascade -label TreeOpt -menu $w.menu.opt
88  $w.menu add cascade -label TreeHelp -menu $w.menu.helpmenu
89  foreach i {file mask sort opt helpmenu} {
90  menu $w.menu.$i -tearoff 0
91  }
92 
93  #TODO: remove this
94  $w.menu.file add command -label TreeFileFillWithBase
95  set helpMessage($w.menu.file,0) TreeFileFillWithBase
96  $w.menu.file add command -label TreeFileFillWithGame
97  set helpMessage($w.menu.file,1) TreeFileFillWithGame
98 
99  menu $w.menu.file.size
100  foreach i { 250 500 1000 2000 5000 10000 } {
101  $w.menu.file.size add radiobutton -label "$i" -value $i -variable ::tree::cachesize($baseNumber) -command "::tree::setCacheSize $baseNumber $i"
102  }
103 
104  $w.menu.file add cascade -menu $w.menu.file.size -label TreeFileSetCacheSize
105  set helpMessage($w.menu.file,2) TreeFileSetCacheSize
106 
107  $w.menu.file add command -label TreeFileCacheInfo -command "::tree::getCacheInfo $baseNumber"
108  set helpMessage($w.menu.file,3) TreeFileCacheInfo
109 
110  $w.menu.file add separator
111  $w.menu.file add command -label TreeFileGraph -command "::tree::graph $baseNumber 1"
112  set helpMessage($w.menu.file,5) TreeFileGraph
113  $w.menu.file add separator
114  $w.menu.file add command -label TreeFileCopy -command "::tree::menuCopyToSelection $baseNumber"
115  set helpMessage($w.menu.file,7) TreeFileCopy
116  $w.menu.file add separator
117  $w.menu.file add command -label TreeFileClose -command ".treeWin$baseNumber.buttons.close invoke"
118  set helpMessage($w.menu.file,9) TreeFileClose
119 
120  $w.menu.mask add command -label TreeMaskNew -command "::tree::mask::new"
121  set helpMessage($w.menu.mask,0) TreeMaskNew
122  $w.menu.mask add command -label TreeMaskOpen -command "::tree::mask::open"
123  set helpMessage($w.menu.mask,1) TreeMaskOpen
124 
125  menu $w.menu.mask.recent
126  foreach f $::tree::mask::recentMask {
127  $w.menu.mask.recent add command -label $f -command "::tree::mask::open $f"
128  }
129  $w.menu.mask add cascade -label TreeMaskOpenRecent -menu $w.menu.mask.recent
130  set helpMessage($w.menu.mask,2) TreeMaskOpenRecent
131 
132  $w.menu.mask add command -label TreeMaskSave -command "::tree::mask::save"
133  set helpMessage($w.menu.mask,3) TreeMaskSave
134  $w.menu.mask add command -label TreeMaskClose -command "::tree::mask::close"
135  set helpMessage($w.menu.mask,4) TreeMaskClose
136  $w.menu.mask add command -label TreeMaskFillWithGame -command "::tree::mask::fillWithGame"
137  set helpMessage($w.menu.mask,5) TreeMaskFillWithGame
138  $w.menu.mask add command -label TreeMaskFillWithBase -command "::tree::mask::fillWithBase"
139  set helpMessage($w.menu.mask,6) TreeMaskFillWithBase
140 
141  $w.menu.mask add command -label TreeMaskSearch -command "::tree::mask::searchMask $baseNumber"
142  set helpMessage($w.menu.mask,7) TreeMaskSearch
143  $w.menu.mask add command -label TreeMaskInfo -command "::tree::mask::infoMask"
144  set helpMessage($w.menu.mask,8) TreeMaskInfo
145  $w.menu.mask add command -label TreeMaskDisplay -command "::tree::mask::displayMask"
146  set helpMessage($w.menu.mask,9) TreeMaskDisplay
147 
148  foreach label {Alpha ECO Freq Score} value {alpha eco frequency score} {
149  $w.menu.sort add radiobutton -label TreeSort$label \
150  -variable tree(order$baseNumber) -value $value -command " ::tree::refresh $baseNumber "
151  }
152 
153  $w.menu.opt add checkbutton -label TreeOptLock -variable tree(locked$baseNumber) -command "::tree::toggleLock $baseNumber"
154  set helpMessage($w.menu.opt,0) TreeOptLock
155 
156  $w.menu.opt add checkbutton -label TreeOptTraining -variable tree(training$baseNumber) -command "::tree::toggleTraining $baseNumber"
157  set helpMessage($w.menu.opt,1) TreeOptTraining
158 
159  $w.menu.opt add separator
160 
161  $w.menu.helpmenu add command -label TreeHelpTree -accelerator F1 -command {helpWindow Tree}
162  $w.menu.helpmenu add command -label TreeHelpIndex -command {helpWindow Index}
163 
164  ::tree::doConfigMenus $baseNumber
165 
166  autoscrollframe $w.f text $w.f.tl \
167  -wrap none -selectbackground lightgrey -selectforeground black \
168  -font font_Fixed -foreground black -background white -setgrid 1 -exportselection 1
169  #define default tags
170  $w.f.tl tag configure greybg -background gray95
171  $w.f.tl tag configure whitebg -background white
172  $w.f.tl tag configure bluefg -foreground blue
173  $w.f.tl tag configure greenfg -foreground SeaGreen
174  $w.f.tl tag configure redfg -foreground red
175 
176  selection handle $w.f.tl "::tree::copyToSelection $baseNumber"
177 
178  ttk::frame $w.statusframe
179  pack $w.statusframe -side bottom -fill x
180  grid rowconfigure $w.statusframe 0 -weight 1
181  grid columnconfigure $w.statusframe 0 -weight 1
182  ttk::label $w.status -anchor w -font font_Small -relief sunken
183  grid $w.status -in $w.statusframe -column 0 -row 0 -sticky nsew
184  canvas $w.progress -height 0 -bg white -relief solid -border 1
185  $w.progress create rectangle 0 0 0 0 -fill blue -outline blue -tags bar
186 
187  pack [ttk::frame $w.buttons -relief sunken] -side bottom -fill x
188  pack $w.f -side top -expand 1 -fill both
189 
190  ttk::button $w.buttons.best -image tb_list -style Pad0.Small.TButton -command "::tree::best $baseNumber"
191  ttk::button $w.buttons.graph -image tb_bargraph -style Pad0.Small.TButton -command "::tree::graph $baseNumber 1"
192  # add a button to start/stop tree refresh
193  ttk::button $w.buttons.bStartStop -image tb_search_on -style Pad0.Small.TButton -command "::tree::toggleRefresh $baseNumber" ;# -relief flat
194 
195  ttk::checkbutton $w.buttons.allgames -textvar ::tr(allGames) -variable tree(allgames$baseNumber) -command "::tree::refresh $baseNumber"
196  ttk::checkbutton $w.buttons.training -textvar ::tr(Training) -variable tree(training$baseNumber) -command "::tree::toggleTraining $baseNumber"
197 
198  foreach {b t} { best TreeFileBest graph TreeFileGraph allgames TreeOptLock training TreeOptTraining bStartStop TreeOptStartStop } {
199  set helpMessage($w.buttons.$b) $t
200  }
201 
202  dialogbutton $w.buttons.stop -textvar ::tr(Stop) -command { progressBarCancel }
203  dialogbutton $w.buttons.close -textvar ::tr(Close) -command "::tree::closeTree $baseNumber"
204 
205  pack $w.buttons.best $w.buttons.graph $w.buttons.bStartStop $w.buttons.allgames $w.buttons.training \
206  -side left -padx 3 -pady 2
207  packbuttons right $w.buttons.close $w.buttons.stop
208  $w.buttons.stop configure -state disabled
209 
210  wm minsize $w 40 5
211  ::createToplevelFinalize $w
212 
213  wm protocol $w WM_DELETE_WINDOW " .treeWin$baseNumber.buttons.close invoke "
214  ::tree::refresh $baseNumber
215  set ::tree::cachesize($baseNumber) [lindex [sc_tree cacheinfo $baseNumber] 1]
216 }
217 ################################################################################
218 proc ::tree::hideCtxtMenu { baseNumber } {
219  set w .treeWin$baseNumber.f.tl.ctxtMenu
220  if {[winfo exists $w]} {
221  destroy $w
222  focus .treeWin$baseNumber
223  }
224 }
225 ################################################################################
226 proc ::tree::selectCallback { baseNumber move } {
227 
228  if { $::tree(refresh) } {
229  return
230  }
231 
232  if {$::tree(autorefresh$baseNumber)} {
233  tree::select $move $baseNumber
234  }
235 }
236 
237 ################################################################################
238 # close the corresponding base if it is flagged as locked
239 proc ::tree::closeTree {baseNumber} {
240  global tree
241  ::tree::mask::close
242 
243  ::tree::hideCtxtMenu $baseNumber
244  # .treeWin$baseNumber.buttons.stop invoke
245 
246  set ::geometry(treeWin$baseNumber) [wm geometry .treeWin$baseNumber]
247  focus .
248 
249  if {[winfo exists .treeGraph$baseNumber]} { destroy .treeGraph$baseNumber}
250  destroy .treeBest$baseNumber
251  destroy .treeWin$baseNumber
252  if {$::tree(locked$baseNumber)} { ::file::Close $baseNumber}
253  set curr_base [sc_base current]
254  set ::treeWin [winfo exists .treeWin$curr_base]
255 }
256 ################################################################################
257 proc ::tree::toggleTraining { baseNumber } {
258  global tree
259 
260  for {set i 1} {$i <= [sc_info limit bases]} {incr i} {
261  if {! [winfo exists .treeWin$baseNumber] || $i == $baseNumber } { continue}
262  set tree(training$i) 0
263  }
264 
265  set ::tree::trainingBase 0
266  if {$tree(training$baseNumber)} {
267  set ::tree::trainingBase $baseNumber
268  set ::tree::trainingColor [sc_pos side]
269  }
270  ::tree::refresh $baseNumber
271 }
272 
273 ################################################################################
274 proc ::tree::doTraining { { n 0 } } {
275  global tree
276  if {$n != 1 && [winfo exists .analysisWin1] && $::analysis(automove1)} {
277  automove 1
278  return
279  }
280  if {$n != 2 && [winfo exists .analysisWin2] && $::analysis(automove2)} {
281  automove 2
282  return
283  }
284  if {[::tb::isopen] && $::tbTraining} {
285  ::tb::move
286  return
287  }
288  if {! [winfo exists .treeWin$::tree::trainingBase]} { return}
289  if { $::tree::trainingBase == 0 } { return}
290 
291  # Before issuing a training move, annotate player's move
292  if { $::tree::mask::maskFile != "" } {
293  set move_done [sc_game info previousMoveNT]
294  if {$move_done != ""} {
295  sc_move back
296  set fen [ ::tree::mask::toShortFen [sc_pos fen]]
297  sc_move forward
298  if { [info exists ::tree::mask::mask($fen)] } {
299  set moves [ lindex $::tree::mask::mask($fen) 0]
300 
301  # if move out of Mask, and there exists moves in Mask, set a warning
302  if { ! [ ::tree::mask::moveExists $move_done $fen] } {
303  if {[llength $moves] != 0} {
304  set txt ""
305  foreach elt $moves {
306  append txt "[::trans [lindex $elt 0]][lindex $elt 1] "
307  }
308  sc_pos setComment "[sc_pos getComment] Mask : $txt"
309  }
310  }
311 
312  # if move was bad, set a warning
313  set nag_played [::tree::mask::getNag $move_done $fen]
314  set nag_order { "??" " ?" "?!" $::tree::mask::emptyNag "!?" " !" "!!"}
315  set txt ""
316  foreach elt $moves {
317  set n [lindex $elt 1]
318  if { [lsearch $nag_order $nag_played] < [lsearch $nag_order $n]} {
319  append txt "[::trans [lindex $elt 0]][lindex $elt 1] "
320  }
321  }
322  if {$txt != ""} {
323  sc_pos addNag [string trim $nag_played]
324  sc_pos setComment "[sc_pos getComment] Mask : $txt"
325  }
326 
327  # if move was on an exclude line, set a warning (img = tb_cross)
328  if { [::tree::mask::getImage $move_done 0] == "tb_cross" || \
329  [::tree::mask::getImage $move_done 1] == "tb_cross"} {
330  sc_pos setComment "[sc_pos getComment] Mask : excluded line"
331  }
332  }
333  }
334  }
335 
336  set move [sc_tree move $::tree::trainingBase random]
337  addSanMove $move
338 }
339 
340 ################################################################################
341 proc ::tree::toggleLock { baseNumber } {
342  ::tree::refresh $baseNumber
343 }
344 
345 ################################################################################
346 proc ::tree::select { move baseNumber } {
347  global tree
348 
349  if {! [winfo exists .treeWin$baseNumber]} { return}
350 
351  catch { addSanMove $move}
352 }
353 
354 set tree(refresh) 0
355 
356 ################################################################################
357 proc ::tree::refresh { { baseNumber "" }} {
358  set tree(refresh) 1
359  if {$baseNumber == "" } {
360  sc_tree search -cancel all
361  foreach i [sc_base list] {
362  if { [::tree::dorefresh $i] == "canceled" } { break}
363  }
364  } else {
365  ::tree::dorefresh $baseNumber
366  }
367  set tree(refresh) 0
368 }
369 
370 ################################################################################
371 proc ::tree::dorefresh { baseNumber } {
372  global tree treeWin
373  set w .treeWin$baseNumber
374 
375  if {![winfo exists $w]} { return}
376  if { ! $tree(autorefresh$baseNumber) } { return}
377 
378  grid $w.progress -in $w.statusframe -column 0 -row 0 -sticky nsew
379 
380  progressBarSet $w.progress [$w.progress cget -width] 100
381  foreach button {best graph training allgames close} {
382  $w.buttons.$button configure -state disabled
383  }
384  $w.buttons.stop configure -state normal
385 
386  set filtered 0
387  if { $tree(allgames$baseNumber) == 0 } {
388  set filtered 1
389  }
390 
391  set err [ catch { sc_tree search -hide $tree(training$baseNumber) \
392  -sort $tree(order$baseNumber) \
393  -base $baseNumber \
394  -filtered $filtered} moves]
395  if { $err } {
396  set tree(status$baseNumber) ""
397  set moves [ERROR::getErrorMsg]
398  }
399  catch {$w.f.tl itemconfigure 0 -foreground darkBlue}
400 
401  foreach button {best graph training allgames close} {
402  $w.buttons.$button configure -state normal
403  }
404  $w.buttons.stop configure -state disabled
405 
406  ::tree::status "" $baseNumber
407  if {[winfo exists .treeGraph$baseNumber]} { ::tree::graph $baseNumber}
408 
409  if { $moves == "canceled" } { return "canceled"}
410  displayLines $baseNumber $moves
411 
412  grid forget $w.progress
413  if {$::tree::trainingBase != 0 && $::tree::trainingColor == [sc_pos side]} {
414  ::tree::doTraining
415  }
416 }
417 
418 ################################################################################
419 #
420 ################################################################################
421 proc ::tree::displayLines { baseNumber moves } {
422  global ::tree::mask::maskFile
423 
424  ::tree::mask::setCacheFenIndex
425 
426  set lMoves {}
427  set w .treeWin$baseNumber
428 
429  $w.f.tl configure -state normal
430 
431  set moves [split $moves "\n"]
432 
433  # for the graph display
434  set ::tree::treeData$baseNumber $moves
435 
436  set len [llength $moves]
437  $w.f.tl delete 1.0 end
438 
439  foreach t [$w.f.tl tag names] {
440  if { [ string match "tagclick*" $t] || [ string match "tagtooltip*" $t] } {
441  $w.f.tl tag delete $t
442  }
443  }
444 
445  # Position comment
446  set hasPositionComment 0
447  if { $maskFile != "" } {
448  set posComment [::tree::mask::getPositionComment]
449  if {$posComment != ""} {
450  set hasPositionComment 1
451  set firstLine [ lindex [split $posComment "\n"] 0]
452  $w.f.tl insert end "$firstLine\n" [ list bluefg tagtooltip_poscomment]
453  ::utils::tooltip::SetTag $w.f.tl $posComment tagtooltip_poscomment
454  $w.f.tl tag bind tagtooltip_poscomment <Double-Button-1> "::tree::mask::addComment"
455  }
456  }
457 
458  # Display the first line
459  if { $maskFile != "" } {
460  $w.f.tl image create end -image tb_empty -align center
461  $w.f.tl image create end -image tb_empty -align center
462  $w.f.tl insert end " "
463  $w.f.tl tag bind tagclick0 <ButtonPress-$::MB3> "::tree::mask::contextMenu $w.f.tl dummy %x %y %X %Y ; break"
464  }
465  $w.f.tl insert end "[lindex $moves 0]\n" tagclick0
466 
467  for { set i 1} { $i < [expr $len - 3] } { incr i} {
468  set line [lindex $moves $i]
469  if {$line == ""} { continue}
470  set move [lindex $line 1]
471  set move [::untrans $move]
472  lappend lMoves $move
473  set colorScore [::tree::getColorScore $line]
474  if { $move == "\[end\]" } { set colorScore ""}
475 
476  set tagfg ""
477 
478  if { $maskFile != "" && $i > 0 && $i < [expr $len - 3] } {
479  if { [::tree::mask::moveExists $move] } {
480  set tagfg "bluefg"
481  }
482  }
483  if { $maskFile != "" } {
484  if { $i > 0 && $i < [expr $len - 3] && $move != "\[end\]" } {
485  # images
486  foreach j { 0 1 } {
487  set img [::tree::mask::getImage $move $j]
488  $w.f.tl image create end -image $img -align center
489  }
490  # color tag
491  $w.f.tl tag configure color$i -background [::tree::mask::getColor $move]
492  $w.f.tl insert end " " color$i
493  # NAG tag
494  $w.f.tl insert end [::tree::mask::getNag $move]
495  } else {
496  $w.f.tl image create end -image tb_empty -align center
497  $w.f.tl image create end -image tb_empty -align center
498  $w.f.tl insert end " "
499  }
500  }
501 
502  # Move and stats
503  if {[expr $i % 2] && $i < [expr $len -3] } {
504  $w.f.tl insert end "$line" [list greybg $tagfg tagtooltip$i]
505  } else {
506  $w.f.tl insert end "$line" [list whitebg $tagfg tagtooltip$i]
507  }
508  if {$colorScore != ""} {
509  $w.f.tl tag add $colorScore end-31c end-26c
510  }
511  if {$move != "" && $move != "---" && $move != "\[end\]" && $i != [expr $len -2] && $i != 0} {
512  $w.f.tl tag bind tagclick$i <Button-1> "[list ::tree::selectCallback $baseNumber $move] ; break"
513  }
514 
515  if { $maskFile != "" } {
516  # Move comment
517  set comment [::tree::mask::getComment $move]
518  if {$comment != ""} {
519  set firstLine [ lindex [split $comment "\n"] 0]
520  $w.f.tl insert end " $firstLine" tagtooltip$i
521  ::utils::tooltip::SetTag $w.f.tl $comment tagtooltip$i
522  $w.f.tl tag bind tagtooltip$i <Double-Button-1> "::tree::mask::addComment $move"
523  }
524  }
525 
526  if { $maskFile != "" } {
527  # Bind right button to popup a contextual menu:
528  $w.f.tl tag bind tagclick$i <ButtonPress-$::MB3> "::tree::mask::contextMenu $w.f.tl $move %x %y %X %Y ; break"
529  }
530  $w.f.tl tag add tagclick$i [expr $i +1 + $hasPositionComment].0 [expr $i + 1 + $hasPositionComment].end
531 
532  $w.f.tl insert end "\n"
533 
534  } ;# end for loop
535 
536  # Display the last lines (total)
537  for { set i [expr $len - 3]} { $i < [expr $len - 1] } { incr i} {
538  if { $maskFile != "" } {
539  $w.f.tl image create end -image tb_empty -align center
540  $w.f.tl image create end -image tb_empty -align center
541  $w.f.tl insert end " "
542  }
543  $w.f.tl insert end "[lindex $moves $i]\n"
544  }
545 
546  # Add moves present in Mask and not in Tree
547  set idx $len
548  if { $maskFile != "" } {
549  set movesMask [::tree::mask::getAllMoves]
550  foreach m $movesMask {
551  if { [ scan [$w.f.tl index end] "%d.%d" currentLine dummy] != 2 } {
552  puts "ERROR scan index end [$w.f.tl index end]"
553  }
554  # move nag color move_anno
555  if {[lsearch $lMoves [lindex $m 0]] != -1 || [lindex $m 0] == "null"} {
556  continue
557  }
558 
559  $w.f.tl tag bind tagclick$idx <Button-1> "[list ::tree::selectCallback $baseNumber [lindex $m 0]] ; break"
560  # images
561  foreach j {4 5} {
562  if {[lindex $m $j] == ""} {
563  $w.f.tl image create end -image tb_empty -align center
564  } else {
565  $w.f.tl image create end -image [lindex $m $j] -align center
566  }
567  }
568 
569  # color tag
570  $w.f.tl tag configure color$idx -background [lindex $m 2]
571  $w.f.tl insert end " " color$idx
572  # NAG tag
573  $w.f.tl insert end [::tree::mask::getNag [lindex $m 0]]
574  # move
575  $w.f.tl insert end "[::trans [lindex $m 0]]" bluefg
576  # comment
577  set comment [lindex $m 3]
578  set firstLine [ lindex [split $comment "\n"] 0]
579  $w.f.tl insert end " $firstLine\n" tagtooltip$idx
580  ::utils::tooltip::SetTag $w.f.tl $comment tagtooltip$idx
581 
582  # Bind right button to popup a contextual menu:
583  $w.f.tl tag bind tagclick$idx <ButtonPress-$::MB3> "::tree::mask::contextMenu $w.f.tl [lindex $m 0] %x %y %X %Y ; break"
584  $w.f.tl tag add tagclick$idx [ expr $currentLine -1].0 [ expr $currentLine -1].end
585  incr idx
586  }
587  }
588 
589  $w.f.tl configure -state disabled
590 }
591 ################################################################################
592 # returns a list with (ngames freq success eloavg perf) or
593 # {} if there was a problem during parsing
594 # 1: e4 B00 37752: 47.1% 54.7% 2474 2513 2002 37%
595 ################################################################################
596 proc ::tree::getLineValues { l } {
597  set ret {}
598  if {[scan [string range $l 14 24] "%d:" ngames] != 1} {
599  return {}
600  } else {
601  lappend ret $ngames
602  }
603 
604  if {[scan [string range $l 25 29] "%f%%" freq] != 1} {
605  return {}
606  } else {
607  lappend ret $freq
608  }
609 
610  if {[scan [string range $l 33 37] "%f%%" success] != 1} {
611  return {}
612  } else {
613  lappend ret $success
614  }
615 
616  if {[scan [string range $l 40 44] "%d" eloavg] != 1} {
617  return {}
618  } else {
619  lappend ret $eloavg
620  }
621 
622  if {[scan [string range $l 46 50] "%d" perf] != 1} {
623  return {}
624  } else {
625  lappend ret $perf
626  }
627 
628  return $ret
629 }
630 ################################################################################
631 # returns the color to use for score (red, green) or ""
632 ################################################################################
633 proc ::tree::getColorScore { line } {
634  set data [::tree::getLineValues $line]
635  if { $data == {} } { return ""}
636  set ngames [lindex $data 0]
637  set freq [lindex $data 1]
638  set success [lindex $data 2]
639  set eloavg [lindex $data 3]
640  set perf [lindex $data 4]
641  if { $ngames < $::tree::scoreHighlight_MinGames } {
642  return ""
643  }
644  set wavg [ expr 50 + $::tree::scoreHighlight_WhiteExpectedScoreBonus]
645  set bavg [ expr 50 - $::tree::scoreHighlight_WhiteExpectedScoreBonus]
646  if { [sc_pos side] == "white" && $success > [ expr $wavg + $::tree::scoreHighlight_Margin] || \
647  [sc_pos side] == "black" && $success < [ expr $wavg - $::tree::scoreHighlight_Margin] } {
648  return greenfg
649  }
650  if { [sc_pos side] == "white" && $success < [ expr $wavg - $::tree::scoreHighlight_Margin] || \
651  [sc_pos side] == "black" && $success > [ expr $wavg + $::tree::scoreHighlight_Margin] } {
652  return redfg
653  }
654  return ""
655 }
656 ################################################################################
657 proc ::tree::status { msg baseNumber } {
658  global tree
659 
660  set w .treeWin$baseNumber
661  if { $tree(status$baseNumber) == "" } {
662  catch {sc_base filename $baseNumber} tree(status$baseNumber)
663  set tree(status$baseNumber) [file tail $tree(status$baseNumber)]
664  ::setTitle $w "Scid: [tr WindowsTree] $baseNumber: $tree(status$baseNumber)"
665  }
666 
667  if {$msg != ""} {
668  set status $msg
669  } else {
670  set status " $::tr(Database) $baseNumber: $tree(status$baseNumber)"
671  if {$tree(locked$baseNumber)} { append status " ($::tr(TreeLocked))"}
672  if {! $tree(allgames$baseNumber)} {
673  append status " $::tr(Filter)"
674  append status ": [::windows::gamelist::filterText "" $baseNumber]"
675  }
676  }
677  $w.status configure -text $status
678 }
679 
680 ################################################################################
681 set tree(standardLines) {
682  {}
683  {1.c4}
684  {1.c4 c5}
685  {1.c4 c5 2.Nf3}
686  {1.c4 e5}
687  {1.c4 Nf6}
688  {1.c4 Nf6 2.Nc3}
689  {1.d4}
690  {1.d4 d5}
691  {1.d4 d5 2.c4}
692  {1.d4 d5 2.c4 c6}
693  {1.d4 d5 2.c4 c6 3.Nf3}
694  {1.d4 d5 2.c4 c6 3.Nf3 Nf6}
695  {1.d4 d5 2.c4 c6 3.Nf3 Nf6 4.Nc3}
696  {1.d4 d5 2.c4 c6 3.Nf3 Nf6 4.Nc3 dxc4}
697  {1.d4 d5 2.c4 c6 3.Nf3 Nf6 4.Nc3 e6}
698  {1.d4 d5 2.c4 c6 3.Nf3 Nf6 4.Nc3 e6 5.e3}
699  {1.d4 d5 2.c4 e6}
700  {1.d4 d5 2.c4 e6 3.Nc3}
701  {1.d4 d5 2.c4 e6 3.Nc3 Nf6}
702  {1.d4 d5 2.c4 e6 3.Nf3}
703  {1.d4 d5 2.c4 dxc4}
704  {1.d4 d5 2.c4 dxc4 3.Nf3}
705  {1.d4 d5 2.c4 dxc4 3.Nf3 Nf6}
706  {1.d4 d5 2.Nf3}
707  {1.d4 d5 2.Nf3 Nf6}
708  {1.d4 d5 2.Nf3 Nf6 3.c4}
709  {1.d4 d6}
710  {1.d4 d6 2.c4}
711  {1.d4 Nf6}
712  {1.d4 Nf6 2.c4}
713  {1.d4 Nf6 2.c4 c5}
714  {1.d4 Nf6 2.c4 d6}
715  {1.d4 Nf6 2.c4 e6}
716  {1.d4 Nf6 2.c4 e6 3.Nc3}
717  {1.d4 Nf6 2.c4 e6 3.Nc3 Bb4}
718  {1.d4 Nf6 2.c4 e6 3.Nf3}
719  {1.d4 Nf6 2.c4 g6}
720  {1.d4 Nf6 2.c4 g6 3.Nc3}
721  {1.d4 Nf6 2.c4 g6 3.Nc3 Bg7}
722  {1.d4 Nf6 2.c4 g6 3.Nc3 Bg7 4.e4}
723  {1.d4 Nf6 2.c4 g6 3.Nc3 Bg7 4.e4 d6}
724  {1.d4 Nf6 2.c4 g6 3.Nc3 Bg7 4.e4 d6 5.Nf3}
725  {1.d4 Nf6 2.c4 g6 3.Nc3 Bg7 4.e4 d6 5.Nf3 O-O}
726  {1.d4 Nf6 2.c4 g6 3.Nc3 Bg7 4.e4 d6 5.Nf3 O-O 6.Be2}
727  {1.d4 Nf6 2.c4 g6 3.Nf3}
728  {1.d4 Nf6 2.Bg5}
729  {1.d4 Nf6 2.Bg5 Ne4}
730  {1.d4 Nf6 2.Nf3}
731  {1.d4 Nf6 2.Nf3 e6}
732  {1.d4 Nf6 2.Nf3 g6}
733  {1.e4}
734  {1.e4 c5}
735  {1.e4 c5 2.c3}
736  {1.e4 c5 2.c3 d5}
737  {1.e4 c5 2.c3 Nf6}
738  {1.e4 c5 2.Nc3}
739  {1.e4 c5 2.Nc3 Nc6}
740  {1.e4 c5 2.Nf3}
741  {1.e4 c5 2.Nf3 d6}
742  {1.e4 c5 2.Nf3 d6 3.d4}
743  {1.e4 c5 2.Nf3 d6 3.d4 cxd4}
744  {1.e4 c5 2.Nf3 d6 3.d4 cxd4 4.Nxd4}
745  {1.e4 c5 2.Nf3 d6 3.d4 cxd4 4.Nxd4 Nf6}
746  {1.e4 c5 2.Nf3 d6 3.d4 cxd4 4.Nxd4 Nf6 5.Nc3}
747  {1.e4 c5 2.Nf3 d6 3.d4 cxd4 4.Nxd4 Nf6 5.Nc3 a6}
748  {1.e4 c5 2.Nf3 d6 3.d4 cxd4 4.Nxd4 Nf6 5.Nc3 e6}
749  {1.e4 c5 2.Nf3 d6 3.d4 cxd4 4.Nxd4 Nf6 5.Nc3 g6}
750  {1.e4 c5 2.Nf3 d6 3.d4 cxd4 4.Nxd4 Nf6 5.Nc3 Nc6}
751  {1.e4 c5 2.Nf3 d6 3.Bb5+}
752  {1.e4 c5 2.Nf3 e6}
753  {1.e4 c5 2.Nf3 Nc6}
754  {1.e4 c5 2.Nf3 Nc6 3.d4}
755  {1.e4 c5 2.Nf3 Nc6 3.Bb5}
756  {1.e4 c6}
757  {1.e4 c6 2.d4}
758  {1.e4 c6 2.d4 d5}
759  {1.e4 c6 2.d4 d5 3.e5}
760  {1.e4 c6 2.d4 d5 3.Nc3}
761  {1.e4 c6 2.d4 d5 3.Nd2}
762  {1.e4 d5}
763  {1.e4 d6}
764  {1.e4 d6 2.d4}
765  {1.e4 d6 2.d4 Nf6}
766  {1.e4 d6 2.d4 Nf6 3.Nc3}
767  {1.e4 e5}
768  {1.e4 e5 2.Nf3}
769  {1.e4 e5 2.Nf3 Nc6}
770  {1.e4 e5 2.Nf3 Nc6 3.d4}
771  {1.e4 e5 2.Nf3 Nc6 3.Bb5}
772  {1.e4 e5 2.Nf3 Nc6 3.Bb5 a6}
773  {1.e4 e5 2.Nf3 Nc6 3.Bb5 a6 4.Ba4}
774  {1.e4 e5 2.Nf3 Nc6 3.Bb5 a6 4.Ba4 Nf6}
775  {1.e4 e5 2.Nf3 Nc6 3.Bb5 a6 4.Ba4 Nf6 5.O-O}
776  {1.e4 e5 2.Nf3 Nc6 3.Bc4}
777  {1.e4 e5 2.Nf3 Nf6}
778  {1.e4 e6}
779  {1.e4 e6 2.d4}
780  {1.e4 e6 2.d4 d5}
781  {1.e4 e6 2.d4 d5 3.Nc3}
782  {1.e4 e6 2.d4 d5 3.Nc3 Bb4}
783  {1.e4 e6 2.d4 d5 3.Nc3 Nf6}
784  {1.e4 e6 2.d4 d5 3.Nd2}
785  {1.e4 e6 2.d4 d5 3.Nd2 c5}
786  {1.e4 e6 2.d4 d5 3.Nd2 Nf6}
787  {1.e4 Nf6}
788  {1.e4 Nf6 2.e5}
789  {1.e4 Nf6 2.e5 Nd5}
790  {1.Nf3}
791  {1.Nf3 Nf6}
792 }
793 # if there is a treecache file source it, otherwise use hard coded
794 # values above
795 catch {source [scidConfigFile treecache]}
796 
797 
798 ################################################################################
799 # ::tree::best
800 # Open/Close the window of best (highest-rated) tree games.
801 #
802 proc ::tree::best { baseNumber } {
803  set w .treeBest$baseNumber
804  if {[winfo exists $w]} {
805  destroy $w
806  } else {
807  .treeWin$baseNumber.buttons.best state pressed
808  ::windows::gamelist::OpenTreeBest $::tree(base$baseNumber) $w
809  bind $w <Destroy> "+.treeWin$baseNumber.buttons.best state !pressed"
810  }
811 }
812 
813 ################################################################################
814 # ::tree::graphRedraw
815 # Redraws the tree graph window.
816 #
817 proc ::tree::graphRedraw { baseNumber } {
818  .treeGraph$baseNumber.c itemconfigure text -width [expr {[winfo width .treeGraph$baseNumber.c] - 50}]
819  .treeGraph$baseNumber.c coords text [expr {[winfo width .treeGraph$baseNumber.c] / 2}] 10
820  ::utils::graph::configure tree$baseNumber -height [expr {[winfo height .treeGraph$baseNumber.c] - 100}]
821  ::utils::graph::configure tree$baseNumber -width [expr {[winfo width .treeGraph$baseNumber.c] - 50}]
822  ::utils::graph::redraw tree$baseNumber
823 }
824 
825 ################################################################################
826 # ::tree::graph
827 # Updates the tree graph window, creating it if necessary.
828 # bpress: the button/menu was selected => bring window to front
829 #
830 proc ::tree::graph { baseNumber {bpress 0}} {
831  set w .treeGraph$baseNumber
832  if {! [winfo exists .treeWin$baseNumber]} { return}
833  if {! [winfo exists $w]} {
834  toplevel $w
835  setWinLocation $w
836  bind $w <Escape> "destroy $w"
837  bind $w <F1> {helpWindow Tree Graph}
838 
839  menu $w.menu
840  ::setMenu $w $w.menu
841  $w.menu add cascade -label GraphFile -menu $w.menu.file
842  menu $w.menu.file
843  $w.menu.file add command -label GraphFileColor -command "::tools::graphs::Save color $w.c"
844  $w.menu.file add command -label GraphFileGrey -command "::tools::graphs::Save gray $w.c"
845  $w.menu.file add separator
846  $w.menu.file add command -label GraphFileClose -command "destroy $w"
847 
848  canvas $w.c -width 500 -height 300 -selectforeground [ttk::style lookup . -foreground] -background [ttk::style lookup . -background]
849  pack $w.c -side top -fill both -expand yes
850  $w.c create text 25 10 -tag text -justify center -width 1 -font font_Regular -anchor n
851  update
852  bind $w <Configure> "::tree::graphRedraw $baseNumber"
853  bind $w.c <Button-1> "::tree::graph $baseNumber"
854  ::setTitle $w "Scid: Tree Graph $baseNumber: [file tail [sc_base filename $baseNumber]]"
855  # wm minsize $w 300 200
856  keyboardShortcuts $w
857  ::tree::configGraphMenus "" $baseNumber
858  } elseif {$bpress == 1} {
859  focus $w
860  raise $w
861  }
862 
863  $w.c itemconfigure text -width [expr {[winfo width $w.c] - 50}]
864  $w.c coords text [expr {[winfo width $w.c] / 2}] 10
865  set height [expr {[winfo height $w.c] - 100}]
866  set width [expr {[winfo width $w.c] - 50}]
867  ::utils::graph::create tree$baseNumber -width $width -height $height -xtop 25 -ytop 60 \
868  -xmin 0.5 -xtick 1 -ytick 5 -font font_Small -canvas $w.c
869 
870  set data {}
871  set xlabels {}
872  set othersCount 0
873  set numOthers 0
874  set othersName "..."
875  set count 0
876  set othersScore 0.0
877  set mean 50.0
878  set totalGames 0
879  set treeData [subst $[subst {::tree::treeData$baseNumber}]]
880  # [.treeWin$baseNumber.f.tl get 0 end]
881 
882  set numTreeLines [llength $treeData]
883  set totalLineIndex [expr $numTreeLines - 2]
884 
885  for {set i 0} {$i < [llength $treeData]} {incr i} {
886  # Extract info from each line of the tree window:
887  # Note we convert "," decimal char back to "." where necessary.
888  set line [lindex $treeData $i]
889  set mNum [string trim [string range $line 0 1]]
890  set freq [string trim [string range $line 17 23]]
891  set fpct [string trim [string range $line 25 29]]
892  regsub -all {,} $fpct . fpct
893  set move [string trim [string range $line 4 9]]
894  set score [string trim [string range $line 33 37]]
895  regsub -all {,} $score . score
896  if {$score > 99.9} { set score 99.9}
897  # Check if this line is "TOTAL:" line:
898  if {$i == $totalLineIndex} {
899  set mean $score
900  set totalGames $freq
901  }
902  # Add info for this move to the graph if necessary:
903  if {[string index $line 2] == ":" && [string compare "<end>" $move]} {
904  if {$fpct < 1.0 || $freq < 5 || $i > 5} {
905  incr othersCount $freq
906  incr numOthers
907  set othersScore [expr {$othersScore + (double($freq) * $score)}]
908  set m $move
909  if {$numOthers > 1} { set m "..."}
910  } else {
911  incr count
912  lappend data $count
913  lappend data $score
914  lappend xlabels [list $count "$move ([expr round($score)]%)\n$freq: [expr round($fpct)]%"]
915  }
916  }
917  }
918 
919  # Add extra bar for other moves if necessary:
920  if {$numOthers > 0 && $totalGames > 0} {
921  incr count
922  set fpct [expr {double($othersCount) * 100.0 / double($totalGames)}]
923  set sc [expr {round($othersScore / double($othersCount))}]
924  set othersName "$m ($sc%)\n$othersCount: [expr round($fpct)]%"
925  lappend data $count
926  lappend data [expr {$othersScore / double($othersCount)}]
927  lappend xlabels [list $count $othersName]
928  }
929 
930  # Plot fake bounds data so graph at least shows range 40-65:
931  ::utils::graph::data tree$baseNumber bounds -points 0 -lines 0 -bars 0 -coords {1 41 1 64}
932 
933  # Replot the graph:
934  ::utils::graph::data tree$baseNumber data -color red -points 0 -lines 0 -bars 1 \
935  -barwidth 0.75 -outline black -coords $data
936  ::utils::graph::configure tree$baseNumber -xlabels $xlabels -xmax [expr {$count + 0.5}] \
937  -hline [list {gray80 1 each 5} {gray50 1 each 10} {black 2 at 50} \
938  {black 1 at 55} [list red 2 at $mean]] \
939  -brect [list [list 0.5 55 [expr {$count + 0.5}] 50 LightSkyBlue1]]
940 
941  ::utils::graph::redraw tree$baseNumber
942  set moves ""
943  catch {set moves [sc_game firstMoves -1]}
944  if {[string length $moves] == 0} { set moves $::tr(StartPos)}
945  set title "$moves ([::utils::thousands $totalGames] $::tr(games))"
946  $w.c itemconfigure text -text $title
947 }
948 
949 ################################################################################
950 proc ::tree::configGraphMenus { lang baseNumber } {
951  if {! [winfo exists .treeGraph$baseNumber]} { return}
952  if {$lang == ""} { set lang $::language}
953  set m .treeGraph$baseNumber.menu
954  foreach idx {0} tag {File} {
955  configMenuText $m $idx Graph$tag $lang
956  }
957  foreach idx {0 1 3} tag {Color Grey Close} {
958  configMenuText $m.file $idx GraphFile$tag $lang
959  }
960 }
961 
962 # ################################################################################
963 proc ::tree::toggleRefresh { baseNumber } {
964  global tree
965  set b .treeWin$baseNumber.buttons.bStartStop
966 
967  if {$tree(autorefresh$baseNumber)} {
968  $b configure -image tb_search_off
969  set tree(autorefresh$baseNumber) 0
970  } else {
971  $b configure -image tb_search_on
972  set tree(autorefresh$baseNumber) 1
973  ::tree::refresh $baseNumber
974  }
975 }
976 ################################################################################
977 #
978 ################################################################################
979 proc ::tree::setCacheSize { base size } {
980  sc_tree cachesize $base $size
981 }
982 ################################################################################
983 #
984 ################################################################################
985 proc ::tree::getCacheInfo { base } {
986  set ci [sc_tree cacheinfo $base]
987  tk_messageBox -title "Scid" -type ok -icon info \
988  -message "Cache used : [lindex $ci 0] / [lindex $ci 1]"
989 
990 }
991 
992 
993 ################################################################################
994 #
995 # Mask namespace
996 #
997 # All function calls with move in english
998 # Images are 17x17
999 ################################################################################
1000 namespace eval ::tree::mask {
1001 
1002  # mask(fen) contains data for a position <fen> : ( moves, comment )
1003  # where moves is ( move nag color move_anno img1 img2 )
1004  array set mask {}
1005  set maskSerialized {}
1006  set maskFile ""
1007  set defaultColor white
1008  set emptyNag " "
1009  set textComment ""
1010  set cacheFenIndex -1
1011  set dirty 0 ; # if Mask data has changed
1012  # Mask Search
1013  set searchMask_usenag 0
1014  set searchMask_usemarker0 0
1015  set searchMask_usemarker1 0
1016  set searchMask_usecolor 0
1017  set searchMask_usemovecomment 0
1018  set searchMask_useposcomment 0
1019  set displayMask_showNag 1
1020  set displayMask_showComment 1
1021 
1022  array set marker2image { Include tb_tick Exclude tb_cross MainLine tb_mainline Bookmark tb_bkm \
1023  White tb_white Black tb_black \
1024  NewLine tb_new ToBeVerified tb_rfilter ToTrain tb_msearch Dubious tb_help_small ToRemove tb_cut }
1025  set maxRecent 10
1026 }
1027 ################################################################################
1028 #
1029 ################################################################################
1030 proc ::tree::mask::open { {filename ""} } {
1031  global ::tree::mask::maskSerialized ::tree::mask::mask ::tree::mask::recentMask
1032 
1033  if {$filename == ""} {
1034  set types {
1035  {{Tree Mask Files} {.stm} }
1036  }
1037  set filename [tk_getOpenFile -initialdir $::initialDir(stm) -filetypes $types -defaultextension ".stm"]
1038  set ::initialDir(stm) [file dirname $filename]
1039  }
1040 
1041  if {$filename != ""} {
1042  ::tree::mask::askForSave
1043  array unset ::tree::mask::mask
1044  array set ::tree::mask::mask {}
1045  source $filename
1046  array set mask $maskSerialized
1047  set maskSerialized {}
1048  set ::tree::mask::maskFile $filename
1049  set ::tree::mask::dirty 0
1050  ::tree::refresh
1051 
1052  if { [lsearch $recentMask $filename] == -1 } {
1053  set recentMask [ linsert $recentMask 0 $filename]
1054  if {[llength $recentMask] > $::tree::mask::maxRecent } {
1055  set recentMask [ lreplace $recentMask [ expr $::tree::mask::maxRecent -1] end]
1056  }
1057 
1058  # update recent masks menu entry
1059  foreach i [sc_base list] {
1060  set w .treeWin$i
1061  if { [winfo exists $w] } {
1062  $w.menu.mask.recent delete 0 end
1063  foreach f $::tree::mask::recentMask {
1064  $w.menu.mask.recent add command -label $f -command "::tree::mask::open $f"
1065  }
1066  }
1067  }
1068 
1069  }
1070  }
1071 
1072 }
1073 ################################################################################
1074 #
1075 ################################################################################
1076 proc ::tree::mask::askForSave {} {
1077  if {$::tree::mask::dirty} {
1078  set answer [tk_messageBox -title Scid -icon warning -type yesno \
1079  -message "[ tr DoYouWantToSaveFirst]\n$::tree::mask::maskFile ?"]
1080  if {$answer == "yes"} {
1081  ::tree::mask::save
1082  }
1083  }
1084 }
1085 ################################################################################
1086 #
1087 ################################################################################
1088 proc ::tree::mask::new {} {
1089 
1090  set types {
1091  {{Tree Mask Files} {.stm} }
1092  }
1093  set filename [tk_getSaveFile -filetypes $types -defaultextension ".stm"]
1094 
1095  if {$filename != ""} {
1096  if {[file extension $filename] != ".stm" } {
1097  append filename ".stm"
1098  }
1099  ::tree::mask::askForSave
1100  set ::tree::mask::dirty 0
1101  set ::tree::mask::maskFile $filename
1102  array unset ::tree::mask::mask
1103  array set ::tree::mask::mask {}
1104  ::tree::refresh
1105  }
1106 }
1107 ################################################################################
1108 #
1109 ################################################################################
1110 proc ::tree::mask::close {} {
1111  if { $::tree::mask::maskFile == "" } {
1112  return
1113  }
1114  ::tree::mask::askForSave
1115  set ::tree::mask::dirty 0
1116  array unset ::tree::mask::mask
1117  array set ::tree::mask::mask {}
1118  set ::tree::mask::maskFile ""
1119  ::tree::refresh
1120 }
1121 ################################################################################
1122 #
1123 ################################################################################
1124 proc ::tree::mask::save {} {
1125  set f [ ::open $::tree::mask::maskFile w]
1126  puts $f "set ::tree::mask::maskSerialized [list [array get ::tree::mask::mask]]"
1127  ::close $f
1128  set ::tree::mask::dirty 0
1129 }
1130 ################################################################################
1131 #
1132 ################################################################################
1133 proc ::tree::mask::contextMenu {win move x y xc yc} {
1134  update idletasks
1135 
1136  set mctxt $win.ctxtMenu
1137  if { [winfo exists $mctxt] } {
1138  destroy $mctxt
1139  }
1140 
1141  if {$move == "dummy"} {
1142  set state "disabled"
1143  } else {
1144  set state "normal"
1145  }
1146  menu $mctxt
1147  $mctxt add command -label [tr AddToMask] -command "::tree::mask::addToMask $move" -state $state
1148  $mctxt add command -label [tr RemoveFromMask] -command "::tree::mask::removeFromMask $move" -state $state
1149  $mctxt add separator
1150 
1151  menu $mctxt.nag
1152  $mctxt add cascade -label [tr Nag] -menu $mctxt.nag -state $state
1153 
1154  foreach nag [ list "!!" " !" "!?" "?!" " ?" "??" " ~" [::tr "None"]] {
1155  $mctxt.nag add command -label $nag -command "::tree::mask::setNag [list $move $nag]" -state $state
1156  }
1157 
1158  foreach j { 0 1 } {
1159  menu $mctxt.image$j
1160  $mctxt add cascade -label "[tr Marker] [expr $j +1]" -menu $mctxt.image$j -state $state
1161  foreach e { Include Exclude MainLine Bookmark White Black NewLine ToBeVerified ToTrain Dubious ToRemove } {
1162  set i $::tree::mask::marker2image($e)
1163  $mctxt.image$j add command -label [ tr $e] -image $i -compound left -command "::tree::mask::setImage $move $i $j"
1164  }
1165  $mctxt.image$j add command -label [tr NoMarker] -command "::tree::mask::setImage $move {} $j"
1166  }
1167  menu $mctxt.color
1168  $mctxt add cascade -label [tr ColorMarker] -menu $mctxt.color -state $state
1169  foreach c { "White" "Green" "Yellow" "Blue" "Red"} {
1170  $mctxt.color add command -label [ tr "${c}Mark"] -background $c -command "::tree::mask::setColor $move $c"
1171  }
1172 
1173  $mctxt add separator
1174  $mctxt add command -label [ tr CommentMove] -command "::tree::mask::addComment $move" -state $state
1175  $mctxt add command -label [ tr CommentPosition] -command "::tree::mask::addComment"
1176 
1177  $mctxt add separator
1178  set lMatchMoves [sc_pos matchMoves ""]
1179  if {[llength $lMatchMoves] > 16} {
1180  # split the moves in several menus
1181  for {set idxMenu 0} { $idxMenu <= [expr int([llength $lMatchMoves] / 16)]} {incr idxMenu} {
1182  menu $mctxt.matchmoves$idxMenu
1183  $mctxt add cascade -label "[ tr AddThisMoveToMask] ([expr $idxMenu + 1])" -menu $mctxt.matchmoves$idxMenu
1184  for {set i 0} {$i < 16} {incr i} {
1185  if {[expr $i + $idxMenu * 16 +1] > [llength $lMatchMoves] } {
1186  break
1187  }
1188  set m [lindex $lMatchMoves [expr $i + $idxMenu * 16]]
1189  if {$m == "OK"} { set m "O-O"}
1190  if {$m == "OQ"} { set m "O-O-O"}
1191  $mctxt.matchmoves$idxMenu add command -label [::trans $m] -command "::tree::mask::addToMask $m"
1192  }
1193  }
1194  } else {
1195  menu $mctxt.matchmoves
1196  $mctxt add cascade -label [ tr AddThisMoveToMask] -menu $mctxt.matchmoves
1197  foreach m [sc_pos matchMoves ""] {
1198  if {$m == "OK"} { set m "O-O"}
1199  if {$m == "OQ"} { set m "O-O-O"}
1200  $mctxt.matchmoves add command -label [::trans $m] -command "::tree::mask::addToMask $m"
1201  }
1202  }
1203 
1204  $mctxt post [winfo pointerx .] [winfo pointery .]
1205 }
1206 ################################################################################
1207 #
1208 ################################################################################
1209 proc ::tree::mask::addToMask { move {fen ""} } {
1210  global ::tree::mask::mask
1211 
1212  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1213 
1214  if {![info exists mask($fen)]} {
1215  set mask($fen) { {} {} }
1216  }
1217  set ::tree::mask::dirty 1
1218  set moves [ lindex $mask($fen) 0]
1219  if {[lsearch $moves $move] == -1} {
1220  lappend moves [list $move {} $::tree::mask::defaultColor {} {} {}]
1221  set newpos [lreplace $mask($fen) 0 0 $moves]
1222  set mask($fen) $newpos
1223  ::tree::refresh
1224  }
1225 }
1226 ################################################################################
1227 #
1228 ################################################################################
1229 proc ::tree::mask::removeFromMask { move {fen ""} } {
1230  global ::tree::mask::mask
1231 
1232  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1233 
1234  if {![info exists mask($fen)]} {
1235  return
1236  }
1237  set ::tree::mask::dirty 1
1238 
1239  set moves [ lindex $mask($fen) 0]
1240  set idxm [lsearch -regexp $moves "^$move *"]
1241  if { $idxm != -1} {
1242  set moves [lreplace $moves $idxm $idxm]
1243  lset mask($fen) 0 $moves
1244  ::tree::refresh
1245  }
1246 
1247  # if the position has no move left and no comment, unset it
1248  if { [llength [lindex $mask($fen) 0]] == 0 && [lindex $mask($fen) 1] == "" } {
1249  array unset mask $fen
1250  }
1251 }
1252 ################################################################################
1253 # returns 1 if the move is already in mask
1254 ################################################################################
1255 proc ::tree::mask::moveExists { move {fen ""} } {
1256  global ::tree::mask::mask
1257 
1258  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1259 
1260  if {![info exists mask($fen)] || $move == "\[end\]" } {
1261  return 0
1262  }
1263  set moves [ lindex $mask($fen) 0]
1264  if {[lsearch -regexp $moves "^$move *"] == -1} {
1265  return 0
1266  }
1267  return 1
1268 }
1269 ################################################################################
1270 # return the list of moves with their data
1271 ################################################################################
1272 proc ::tree::mask::getAllMoves {} {
1273  global ::tree::mask::mask
1274  if {![info exists mask($::tree::mask::cacheFenIndex)]} {
1275  return ""
1276  }
1277  set moves [ lindex $mask($::tree::mask::cacheFenIndex) 0]
1278  return $moves
1279 }
1280 ################################################################################
1281 #
1282 ################################################################################
1283 proc ::tree::mask::getColor { move {fen ""}} {
1284  global ::tree::mask::mask
1285 
1286  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1287 
1288  if {![info exists mask($fen)]} {
1289  return $::tree::mask::defaultColor
1290  }
1291 
1292  set moves [ lindex $mask($fen) 0]
1293  set idxm [lsearch -regexp $moves "^$move *"]
1294  if { $idxm == -1} {
1295  return $::tree::mask::defaultColor
1296  }
1297  set col [ lindex $moves $idxm 2]
1298 
1299  return $col
1300 }
1301 ################################################################################
1302 #
1303 ################################################################################
1304 proc ::tree::mask::setColor { move color {fen ""}} {
1305  global ::tree::mask::mask
1306 
1307  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1308 
1309  if {![info exists mask($fen)]} {
1310  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1311  return
1312  }
1313  set ::tree::mask::dirty 1
1314  set moves [ lindex $mask($fen) 0]
1315  set idxm [lsearch -regexp $moves "^$move *"]
1316  if { $idxm == -1} {
1317  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1318  return
1319  }
1320  set newmove [lreplace [lindex $moves $idxm] 2 2 $color]
1321  set moves [lreplace $moves $idxm $idxm $newmove]
1322  set mask($fen) [ lreplace $mask($fen) 0 0 $moves]
1323  ::tree::refresh
1324 }
1325 ################################################################################
1326 # defaults to " " (2 spaces)
1327 ################################################################################
1328 proc ::tree::mask::getNag { move { fen "" }} {
1329  global ::tree::mask::mask ::tree::mask::emptyNag
1330 
1331  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1332 
1333  if {![info exists mask($fen)]} {
1334  return $emptyNag
1335  }
1336  set moves [ lindex $mask($fen) 0]
1337  set idxm [lsearch -regexp $moves "^$move *"]
1338  if { $idxm == -1} {
1339  return $emptyNag
1340  }
1341  set nag [ lindex $moves $idxm 1]
1342  if {$nag == ""} {
1343  set nag $emptyNag
1344  }
1345  if { [string length $nag] == 1} { set nag " $nag"}
1346  return $nag
1347 }
1348 ################################################################################
1349 #
1350 ################################################################################
1351 proc ::tree::mask::setNag { move nag {fen ""} {refresh 1} } {
1352  global ::tree::mask::mask
1353 
1354  if { $nag == [::tr "None"] } {
1355  set nag ""
1356  }
1357 
1358  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1359 
1360  if {![info exists mask($fen)]} {
1361  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1362  return
1363  }
1364  set ::tree::mask::dirty 1
1365  set moves [ lindex $mask($fen) 0]
1366  set idxm [lsearch -regexp $moves "^$move *"]
1367  if { $idxm == -1} {
1368  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1369  return
1370  }
1371  set newmove [lreplace [lindex $moves $idxm] 1 1 $nag]
1372  set moves [lreplace $moves $idxm $idxm $newmove]
1373  set mask($fen) [ lreplace $mask($fen) 0 0 $moves]
1374  if {$refresh} { ::tree::refresh}
1375 }
1376 ################################################################################
1377 #
1378 ################################################################################
1379 proc ::tree::mask::getComment { move { fen "" } } {
1380  global ::tree::mask::mask
1381 
1382  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1383 
1384  if {![info exists mask($fen)] || $move == "" || $move == "\[end\]" } {
1385  return ""
1386  }
1387 
1388  set moves [ lindex $mask($fen) 0]
1389  set idxm [lsearch -regexp $moves "^$move *"]
1390  if { $idxm == -1} {
1391  return ""
1392  }
1393  set comment [ lindex $moves $idxm 3]
1394  if {$comment == ""} {
1395  set comment " "
1396  }
1397  return $comment
1398 }
1399 ################################################################################
1400 #
1401 ################################################################################
1402 proc ::tree::mask::setComment { move comment { fen "" } } {
1403  global ::tree::mask::mask
1404 
1405  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1406 
1407  set comment [string trim $comment]
1408 
1409  if {![info exists mask($fen)]} {
1410  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1411  return
1412  }
1413  set ::tree::mask::dirty 1
1414  set moves [ lindex $mask($fen) 0]
1415  set idxm [lsearch -regexp $moves "^$move *"]
1416  if { $idxm == -1} {
1417  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1418  return
1419  }
1420  set newmove [lreplace [lindex $moves $idxm] 3 3 $comment]
1421  set moves [lreplace $moves $idxm $idxm $newmove]
1422  set mask($fen) [ lreplace $mask($fen) 0 0 $moves]
1423 }
1424 ################################################################################
1425 #
1426 ################################################################################
1427 proc ::tree::mask::getPositionComment {{fen ""}} {
1428  global ::tree::mask::mask
1429 
1430  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1431 
1432  if { ! [ info exists mask($fen)] } {
1433  return ""
1434  }
1435 
1436  set comment [ lindex $mask($fen) 1]
1437  set comment [ string trim $comment]
1438 
1439  return $comment
1440 }
1441 ################################################################################
1442 #
1443 ################################################################################
1444 proc ::tree::mask::setPositionComment { comment {fen ""} } {
1445  global ::tree::mask::mask
1446 
1447  if {$fen == ""} { set fen $::tree::mask::cacheFenIndex}
1448  set comment [ string trim $comment]
1449  set ::tree::mask::dirty 1
1450  # add position automatically
1451  if {![info exists mask($fen)]} {
1452  set mask($fen) { {} {} }
1453  }
1454 
1455  set newpos [ lreplace $mask($fen) 1 1 $comment]
1456  set mask($fen) $newpos
1457 }
1458 ################################################################################
1459 #
1460 ################################################################################
1461 proc ::tree::mask::setImage { move img nmr } {
1462  global ::tree::mask::mask
1463  set fen $::tree::mask::cacheFenIndex
1464  if {![info exists mask($fen)]} {
1465  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1466  return
1467  }
1468  set ::tree::mask::dirty 1
1469  set moves [ lindex $mask($fen) 0]
1470  set idxm [lsearch -regexp $moves "^$move *"]
1471  if { $idxm == -1} {
1472  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1473  return
1474  }
1475  set loc [expr 4 + $nmr]
1476  set newmove [lreplace [lindex $moves $idxm] $loc $loc $img]
1477  set moves [lreplace $moves $idxm $idxm $newmove]
1478  set mask($fen) [ lreplace $mask($fen) 0 0 $moves]
1479 
1480  ::tree::refresh
1481 }
1482 ################################################################################
1483 # nmr = 0 or 1 (two images per line)
1484 ################################################################################
1485 proc ::tree::mask::getImage { move nmr } {
1486  global ::tree::mask::mask
1487 
1488  set fen $::tree::mask::cacheFenIndex
1489  if {![info exists mask($fen)]} {
1490  return tb_empty
1491  }
1492  set moves [ lindex $mask($fen) 0]
1493  set idxm [lsearch -regexp $moves "^$move *"]
1494  if { $idxm == -1} {
1495  return tb_empty
1496  }
1497  set loc [expr 4 + $nmr]
1498  set img [lindex $moves $idxm $loc]
1499  if {$img == ""} { set img tb_empty}
1500  return $img
1501 }
1502 
1503 ################################################################################
1504 # if move is null, this is a position comment
1505 ################################################################################
1506 proc ::tree::mask::addComment { { move "" } } {
1507 
1508  # first check the move is present in Mask
1509  if { $move != "" } {
1510  if { ![::tree::mask::moveExists $move] } {
1511  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr AddMoveToMaskFirst]
1512  return
1513  }
1514  }
1515  set w .treeMaskAddComment
1516  toplevel .treeMaskAddComment
1517  if {$move == ""} {
1518  set oldComment [::tree::mask::getPositionComment]
1519  ::setTitle $w [::tr CommentPosition]
1520  } else {
1521  set oldComment [::tree::mask::getComment $move]
1522  ::setTitle $w [::tr CommentMove]
1523  }
1524  set oldComment [ string trim $oldComment]
1525  autoscrollframe $w.f text $w.f.e -width 40 -height 5 -wrap word -setgrid 1
1526  $w.f.e insert end $oldComment
1527  ttk::button $w.ok -text OK -command "::tree::mask::updateComment $move ; destroy $w ; ::tree::refresh"
1528  pack $w.f -side top -expand 1 -fill both
1529  pack $w.ok -side bottom
1530  focus $w.f.e
1531 }
1532 ################################################################################
1533 #
1534 ################################################################################
1535 proc ::tree::mask::updateComment { { move "" } } {
1536  set e .treeMaskAddComment.f.e
1537  set newComment [$e get 1.0 end]
1538  set newComment [ string trim $newComment]
1539  set ::tree::mask::dirty 1
1540  if {$move == ""} {
1541  ::tree::mask::setPositionComment $newComment
1542  } else {
1543  ::tree::mask::setComment $move $newComment
1544  }
1545  ::tree::refresh
1546 }
1547 ################################################################################
1548 #
1549 ################################################################################
1550 proc ::tree::mask::fillWithBase {} {
1551  if {$::tree::mask::maskFile == ""} {
1552  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr OpenAMaskFileFirst]
1553  return
1554  }
1555 
1556  set n [sc_base numGames $::curr_db]
1557  progressWindow "Scid" "[tr TreeMaskFillWithBase]" $::tr(Stop)
1558  for {set gnum 1} { $gnum <= $n} {incr gnum} {
1559  if {[catch { updateProgressWindow $gnum $n}]} { break}
1560  ::tree::mask::fillWithGame $::curr_db $gnum 0
1561  }
1562  closeProgressWindow
1563  ::notify::PosChanged
1564 }
1565 ################################################################################
1566 #
1567 ################################################################################
1568 proc ::tree::mask::fillWithGame { {base ""} {gnum ""} {refresh 1} } {
1569  if {$::tree::mask::maskFile == ""} {
1570  tk_messageBox -title "Scid" -type ok -icon warning -message [ tr OpenAMaskFileFirst]
1571  return
1572  }
1573 
1574  if {$base == ""} {
1575  set base [sc_base current]
1576  set gnum [sc_game number]
1577  }
1578 
1579  set lastRAVd 0
1580  set lastRAVn 0
1581  set iFEN(0) 0
1582  set iFENvar(0) 0
1583  set game [sc_base getGame $base $gnum]
1584  set n [llength $game]
1585  for {set i 0} { $i < $n} {incr i} {
1586  # Quick assign
1587  foreach {RAVd RAVn FEN NAGs comment lastMoveSAN} [lindex $game $i] {}
1588 
1589  if { $RAVd > $lastRAVd || ($RAVd == $lastRAVd && $RAVn != $lastRAVn) } {
1590  # New variation
1591  set parent [expr { $RAVd - 1 }]
1592  set iFEN($RAVd) $iFENrav($parent)
1593  }
1594 
1595  set fromFEN [lindex [lindex $game $iFEN($RAVd)] 2]
1596  ::tree::mask::feedMask "$fromFEN" "$lastMoveSAN" "$NAGs" "$comment"
1597 
1598  set lastRAVd $RAVd
1599  set lastRAVn $RAVn
1600  set iFENrav($RAVd) $iFEN($RAVd)
1601  set iFEN($RAVd) $i
1602  }
1603 
1604  set ::tree::mask::dirty 1
1605  if {$refresh} { ::notify::PosChanged}
1606 }
1607 ################################################################################
1608 # Take current position information and fill the mask (move, nag, comments, etc)
1609 ################################################################################
1610 proc ::tree::mask::feedMask { fen move nag comment } {
1611  global ::tree::mask::mask
1612 
1613  set stdNags { "!!" "!" "!?" "?!" "??" "~"}
1614  set fen [toShortFen $fen]
1615 
1616  if {$move == ""} {
1617  set move "null"
1618  }
1619 
1620  # add move if not in mask
1621  if { ![moveExists $move $fen]} {
1622  if {![info exists mask($fen)]} {
1623  set mask($fen) { {} {} }
1624  }
1625  set moves [ lindex $mask($fen) 0]
1626  if {[lsearch $moves $move] == -1} {
1627  lappend moves [list $move {} $::tree::mask::defaultColor {} {} {}]
1628  set newpos [lreplace $mask($fen) 0 0 $moves]
1629  set mask($fen) $newpos
1630  }
1631  }
1632 
1633  if {$move == "null"} {
1634  set comment "$comment [getPositionComment]"
1635  setPositionComment $comment $fen
1636  return
1637  }
1638 
1639  # NAG
1640  if {$nag == 0} { set nag ""}
1641  if {$nag != ""} {
1642  # append the NAGs to comment if not standard
1643  if {[lsearch $stdNags $nag] == -1 } {
1644  set comment "$nag $comment"
1645  set nag ""
1646  } else {
1647  set oldNag [getNag $move]
1648  if {$oldNag != $::tree::mask::emptyNag && $oldNag != $nag} {
1649  set comment "<$oldNag>(?!?) $comment"
1650  }
1651  setNag $move $nag $fen 0
1652  }
1653  }
1654 
1655  # append comment
1656  set oldComment [getComment $move $fen]
1657  if { $oldComment != "" && $oldComment != $comment } {
1658  set comment "$oldComment\n$comment"
1659  }
1660  setComment $move $comment $fen
1661 }
1662 ################################################################################
1663 # trim the fen to keep position data only
1664 ################################################################################
1665 proc ::tree::mask::toShortFen {fen} {
1666  set ret [lreplace $fen end-1 end]
1667  return $ret
1668 }
1669 ################################################################################
1670 #
1671 ################################################################################
1672 proc ::tree::mask::setCacheFenIndex {} {
1673  set ::tree::mask::cacheFenIndex [ toShortFen [sc_pos fen]]
1674 }
1675 ################################################################################
1676 #
1677 ################################################################################
1678 proc ::tree::mask::infoMask {} {
1679  global ::tree::mask::mask
1680 
1681  set npos [array size mask]
1682  # set nmoves 0
1683  set nmoves [lindex [ split [array statistics mask] "\n"] end]
1684  # foreach pos $mask {
1685  # incr nmoves [llength [lindex $pos 1]]
1686  # }
1687  tk_messageBox -title "Mask info" -type ok -icon info -message "Mask : $::tree::mask::maskFile\n[tr Positions] : $npos\n[tr Moves] : $nmoves"
1688 }
1689 ################################################################################
1690 # Dumps mask content in a tree view widget
1691 # The current position is the reference base
1692 ################################################################################
1693 proc ::tree::mask::displayMask {} {
1694  global ::tree::mask::mask
1695 
1696  set w .displaymask
1697  if { [winfo exists $w] } {
1698  focus $w
1699  return
1700  }
1701  toplevel $w
1702  wm title $w [::tr DisplayMask]
1703  setWinLocation $w
1704  setWinSize $w
1705 
1706  ttk::frame $w.f
1707  pack $w.f -fill both -expand 1
1708 
1709  ttk::frame $w.fcb
1710  pack $w.fcb -fill x
1711  ttk::button $w.fcb.bupdate -text [::tr "Update"] -command ::tree::mask::updateDisplayMask
1712  ttk::checkbutton $w.fcb.nag -text [::tr "Nag"] -variable ::tree::mask::displayMask_showNag -command ::tree::mask::updateDisplayMask
1713  ttk::checkbutton $w.fcb.comment -text [::tr "Comments"] -variable ::tree::mask::displayMask_showComment -command ::tree::mask::updateDisplayMask
1714  pack $w.fcb.bupdate $w.fcb.nag $w.fcb.comment -side right -padx 5 -pady "2 5"
1715 
1716  ttk::treeview $w.f.tree -yscrollcommand "$w.f.ybar set" -xscrollcommand "$w.f.xbar set" -show tree -selectmode browse
1717  # workaround for a bug in treeview (xscrollbar does not get view size)
1718  $w.f.tree column #0 -minwidth 1200
1719  ttk::scrollbar $w.f.xbar -command "$w.f.tree xview" -orient horizontal
1720  ttk::scrollbar $w.f.ybar -command "$w.f.tree yview"
1721 
1722  pack $w.f.xbar -side bottom -fill x
1723  pack $w.f.ybar -side right -fill y
1724  pack $w.f.tree -side left -expand 1 -fill both
1725 
1726  updateDisplayMask
1727 
1728  bind $w <Escape> { destroy .displaymask }
1729  bind $w <Configure> {
1730  recordWinSize .displaymask
1731  }
1732 
1733  $w.f.tree tag bind dblClickTree <Double-Button-1> {::tree::mask::maskTreeUnfold }
1734 }
1735 ################################################################################
1736 #
1737 ################################################################################
1738 proc ::tree::mask::updateDisplayMask {} {
1739  global ::tree::mask::mask
1740 
1741  set tree .displaymask.f.tree
1742  $tree delete [ $tree children {}]
1743  set fen [toShortFen [sc_pos fen]]
1744  # use clipbase to enter a dummy game
1745  set currentbase [sc_base current]
1746  sc_base switch $::clipbase_db
1747  sc_game push copyfast
1748 
1749  if {[catch {sc_game startBoard $fen} err]} {
1750  puts "sc_game startBoard $fen => $err"
1751  }
1752  if { [info exists mask($fen)] } {
1753  set moves [lindex $mask($fen) 0]
1754  ::tree::mask::populateDisplayMask $moves {} $fen {} [lindex $mask($fen) 1]
1755  }
1756  sc_game pop
1757  sc_base switch $currentbase
1758 }
1759 ################################################################################
1760 # creates a new image whose name is name1_name2, and concatenates two images.
1761 # parameters are the markers, not the images names
1762 ################################################################################
1763 proc ::tree::mask::createImage {marker1 marker2} {
1764 
1765  if {[lsearch [image names] "$marker1$marker2"] != -1} {
1766  return
1767  }
1768  set img1 $::tree::mask::marker2image($marker1)
1769  set img2 $::tree::mask::marker2image($marker2)
1770  set w1 [image width $img1]
1771  set w2 [image width $img2]
1772  set h1 [image height $img1]
1773  set h2 [image height $img2]
1774  set margin 2
1775  image create photo $marker1$marker2 -height $h1 -width [expr $w1 + $w2 + $margin]
1776  $marker1$marker2 copy $img1 -from 0 0 -to 0 0
1777  $marker1$marker2 copy $img2 -from 0 0 -to [expr $w1 +$margin] 0
1778 }
1779 ################################################################################
1780 #
1781 ################################################################################
1782 proc ::tree::mask::maskTreeUnfold {} {
1783  set t .displaymask.f.tree
1784 
1785  proc unfold {id} {
1786  set t .displaymask.f.tree
1787  foreach c [$t children $id] {
1788  $t item $c -open true
1789  unfold $c
1790  }
1791  }
1792 
1793  set id [$t selection]
1794  unfold $id
1795 }
1796 ################################################################################
1797 # returns the first line of multi-line string (separated with \n)
1798 ################################################################################
1799 proc ::tree::mask::trimToFirstLine {s} {
1800  set s [ lindex [ split $s "\n"] 0]
1801  return $s
1802 }
1803 ################################################################################
1804 #
1805 ################################################################################
1806 proc ::tree::mask::populateDisplayMask { moves parent fen fenSeen posComment} {
1807  global ::tree::mask::mask
1808 
1809  set posComment [ trimToFirstLine $posComment]
1810 
1811  if { $posComment != ""} {
1812  set posComment "\[$posComment\] "
1813  }
1814 
1815  set tree .displaymask.f.tree
1816 
1817  foreach m $moves {
1818  set move [lindex $m 0]
1819  if {$move == "null"} { continue}
1820  set img ""
1821  if {[lindex $m 4] != "" && [lindex $m 5] == ""} {
1822  set img [lindex $m 4]
1823  }
1824  if {[lindex $m 4] == "" && [lindex $m 5] != ""} {
1825  set img [lindex $m 5]
1826  }
1827  if {[lindex $m 4] != "" && [lindex $m 5] != ""} {
1828  set l [array get ::tree::mask::marker2image]
1829  set idx [ lsearch $l [lindex $m 4]]
1830  set mark1 [lindex $l [expr $idx -1]]
1831  set idx [ lsearch $l [lindex $m 5]]
1832  set mark2 [lindex $l [expr $idx -1]]
1833  createImage $mark1 $mark2
1834  set img $mark1$mark2
1835  }
1836 
1837  set nag ""
1838  if { $::tree::mask::displayMask_showNag } {
1839  set nag [lindex $m 1]
1840  }
1841 
1842  if {[lindex $m 3] != "" && $::tree::mask::displayMask_showComment} {
1843  set move_comment " [lindex $m 3]"
1844  set move_comment [ trimToFirstLine $move_comment]
1845  } else {
1846  set move_comment ""
1847  }
1848  if { ! $::tree::mask::displayMask_showComment} {
1849  set posComment ""
1850  }
1851  set id [ $tree insert $parent end -text "$posComment[::trans $move][set nag]$move_comment" -image $img -tags dblClickTree]
1852  if {[catch {sc_game startBoard $fen} err]} {
1853  puts "ERROR sc_game startBoard $fen => $err"
1854  }
1855  sc_move addSan $move
1856 
1857  set newfen [toShortFen [sc_pos fen]]
1858  if {[lsearch $fenSeen $newfen] != -1} { return}
1859  if { [info exists mask($newfen)] } {
1860  set newmoves [lindex $mask($newfen) 0]
1861 
1862  while { [llength $newmoves] == 1 } {
1863  lappend fenSeen $newfen
1864  sc_move addSan [ lindex $newmoves { 0 0 }]
1865  set newfen [toShortFen [sc_pos fen]]
1866  if {[lsearch $fenSeen $newfen] != -1} { return}
1867  lappend fenSeen $newfen
1868  if {[lindex $newmoves 0 3] != "" && $::tree::mask::displayMask_showComment } {
1869  set move_comment " [lindex $newmoves 0 3]"
1870  set move_comment [ trimToFirstLine $move_comment]
1871  } else {
1872  set move_comment ""
1873  }
1874 
1875  if {[lindex $newmoves 1] != "" && $::tree::mask::displayMask_showComment } {
1876  set pos_comment " \[[lindex $newmoves 1]\]"
1877  set pos_comment [ trimToFirstLine $pos_comment]
1878  } else {
1879  set pos_comment ""
1880  }
1881  set nag ""
1882  if { $::tree::mask::displayMask_showNag } {
1883  set nag [ lindex $newmoves { 0 1 }]
1884  }
1885  $tree item $id -text "[ $tree item $id -text] $pos_comment[::trans [ lindex $newmoves { 0 0 }]][ set nag]$move_comment"
1886  if { ! [info exists mask($newfen)] } {
1887  break
1888  }
1889  set newmoves [lindex $mask($newfen) 0]
1890  }
1891 
1892  if { [info exists mask($newfen)] } {
1893  set newmoves [lindex $mask($newfen) 0]
1894  ::tree::mask::populateDisplayMask $newmoves $id $newfen $fenSeen [lindex $mask($newfen) 1]
1895  }
1896  }
1897  }
1898 
1899 }
1900 ################################################################################
1901 #
1902 ################################################################################
1903 proc ::tree::mask::searchMask { baseNumber } {
1904 
1905  set w .searchmask
1906  if { [winfo exists $w] } {
1907  focus $w
1908  return
1909  }
1910  toplevel $w
1911  wm title $w [::tr SearchMask]
1912  ttk::frame $w.f1
1913  ttk::frame $w.f2
1914  pack $w.f1 -side top -fill both -expand 1 -anchor e
1915  pack $w.f2 -side top -fill both -expand 1 -anchor e
1916 
1917  # NAG selection
1918  ttk::checkbutton $w.f1.nagl -text [tr Nag] -variable ::tree::mask::searchMask_usenag
1919  menu $w.f1.nagmenu
1920  ttk::menubutton $w.f1.nag -textvariable ::tree::mask::searchMask_nag -menu $w.f1.nagmenu -style pad0.TMenubutton
1921  set ::tree::mask::searchMask_nag [::tr "None"]
1922  foreach nag [ list "!!" " !" "!?" "?!" " ?" "??" " ~" [::tr "None"]] {
1923  $w.f1.nagmenu add command -label $nag -command "set ::tree::mask::searchMask_nag $nag"
1924  }
1925  grid $w.f1.nagl -column 0 -row 0 -sticky w -padx 10
1926  grid $w.f1.nag -column 0 -row 1 -sticky w -padx 10
1927 
1928  # Markers 1 & 2
1929  foreach j { 0 1 } {
1930  ttk::checkbutton $w.f1.ml$j -text "[tr Marker] [expr $j +1]" -variable ::tree::mask::searchMask_usemarker$j
1931  menu $w.f1.menum$j
1932  ttk::menubutton $w.f1.m$j -textvariable ::tree::mask::searchMask_trm$j -menu $w.f1.menum$j -style pad0.TMenubutton
1933  set ::tree::mask::searchMask_trm$j [tr "Include"]
1934  set ::tree::mask::searchMask_m$j $::tree::mask::marker2image(Include)
1935  foreach e { Include Exclude MainLine Bookmark White Black NewLine ToBeVerified ToTrain Dubious ToRemove } {
1936  set i $::tree::mask::marker2image($e)
1937  $w.f1.menum$j add command -label [ tr $e] -image $i -compound left \
1938  -command "set ::tree::mask::searchMask_trm$j \"[tr $e]\" ; set ::tree::mask::searchMask_m$j $i"
1939  }
1940  grid $w.f1.ml$j -column [expr 1 + $j] -row 0 -sticky w -padx [expr $j*10]
1941  grid $w.f1.m$j -column [expr 1 + $j] -row 1 -sticky w -padx [expr $j*10]
1942  }
1943 
1944  # Color
1945  ttk::checkbutton $w.f1.colorl -text [tr ColorMarker] -variable ::tree::mask::searchMask_usecolor
1946  menu $w.f1.colormenu
1947  ttk::menubutton $w.f1.color -textvariable ::tree::mask::searchMask_trcolor -menu $w.f1.colormenu -style pad0.TMenubutton
1948  set ::tree::mask::searchMask_trcolor [::tr "White"]
1949  set ::tree::mask::searchMask_color "White"
1950  foreach c { "White" "Green" "Yellow" "Blue" "Red"} {
1951  $w.f1.colormenu add command -label [ tr "${c}Mark"] \
1952  -command "set ::tree::mask::searchMask_trcolor [ tr ${c}Mark] ; set ::tree::mask::searchMask_color $c"
1953  }
1954  grid $w.f1.colorl -column 3 -row 0 -sticky w
1955  grid $w.f1.color -column 3 -row 1 -sticky w
1956 
1957  # Move annotation
1958  ttk::checkbutton $w.f1.movecommentl -text "Move comment" -variable ::tree::mask::searchMask_usemovecomment
1959  ttk::entry $w.f1.movecomment -textvariable ::tree::mask::searchMask_movecomment -width 12
1960  grid $w.f1.movecommentl -column 4 -row 0 -sticky w -padx 10
1961  grid $w.f1.movecomment -column 4 -row 1 -sticky w -padx 10
1962 
1963  # Position annotation
1964  ttk::checkbutton $w.f1.poscommentl -text "Position comment" -variable ::tree::mask::searchMask_useposcomment
1965  ttk::entry $w.f1.poscomment -textvariable ::tree::mask::searchMask_poscomment -width 12
1966  grid $w.f1.poscommentl -column 5 -row 0 -sticky w
1967  grid $w.f1.poscomment -column 5 -row 1 -sticky w
1968 
1969  ttk::button $w.f1.search -text [tr "Search"] -command " ::tree::mask::performSearch $baseNumber "
1970  grid $w.f1.search -column 5 -row 2 -sticky e -pady "2 5" -padx "0 5"
1971 
1972  # display search result
1973  text $w.f2.text -yscrollcommand "$w.f2.ybar set" -height 40
1974  ttk::scrollbar $w.f2.ybar -command "$w.f2.text yview"
1975  pack $w.f2.text -side left -fill both -expand yes
1976  pack $w.f2.ybar -side left -fill y
1977 
1978  setWinLocation $w
1979  setWinSize $w
1980 
1981  bind $w.f2.text <ButtonPress-1> " ::tree::mask::searchClick %x %y %W $baseNumber "
1982  bind $w <Escape> { destroy .searchmask }
1983  bind $w <Configure> "recordWinSize $w"
1984 
1985 }
1986 ################################################################################
1987 #
1988 ################################################################################
1989 proc ::tree::mask::performSearch { baseNumber } {
1990  global ::tree::mask::mask
1991  set t .searchmask.f2.text
1992  # contains the search result (FEN)
1993  set res {}
1994 
1995  set pos_count 0
1996  set move_count 0
1997  set pos_total 0
1998  set move_total 0
1999 
2000  $t delete 1.0 end
2001 
2002  # Display FEN + moves and comments. Clicking on a line starts filtering current base
2003  foreach fen [array names mask] {
2004  incr pos_total
2005 
2006  # Position comment
2007  set poscomment [ lindex $mask($fen) 1]
2008  if { $::tree::mask::searchMask_useposcomment } {
2009  if { [string match -nocase "*$::tree::mask::searchMask_poscomment*" $poscomment] } {
2010  lappend res "$fen $poscomment"
2011  incr pos_count
2012  } else {
2013  continue
2014  }
2015  }
2016 
2017  set moves [ lindex $mask($fen) 0]
2018  foreach m $moves {
2019  incr move_total
2020 
2021  # NAG
2022  if { $::tree::mask::searchMask_usenag } {
2023  set nag $::tree::mask::searchMask_nag
2024  if { $nag == [::tr "None"] } { set nag ""}
2025  if { [ string trim [lindex $m 1]] != $nag } {
2026  continue
2027  }
2028  }
2029 
2030  # Markers 1 & 2
2031  if { $::tree::mask::searchMask_usemarker0 } {
2032  if { $::tree::mask::searchMask_m0 != [lindex $m 4] } {
2033  continue
2034  }
2035  }
2036  if { $::tree::mask::searchMask_usemarker1 } {
2037  if { $::tree::mask::searchMask_m1 != [lindex $m 5] } {
2038  continue
2039  }
2040  }
2041 
2042  # Color
2043  if { $::tree::mask::searchMask_usecolor } {
2044  if { [ string compare -nocase $::tree::mask::searchMask_color [lindex $m 2]] != 0 } {
2045  continue
2046  }
2047  }
2048 
2049  # Move annotation
2050  set movecomment [lindex $m 3]
2051  if { $::tree::mask::searchMask_usemovecomment } {
2052  if { ! [string match -nocase "*$::tree::mask::searchMask_movecomment*" $movecomment] } {
2053  continue
2054  }
2055  }
2056 
2057  lappend res "$fen [::trans [lindex $m 0]] $movecomment"
2058  incr move_count
2059  }
2060  }
2061 
2062  # output the result
2063  foreach l $res {
2064  $t insert end "$l\n"
2065  }
2066  wm title .searchmask "[::tr SearchMask] [::tr Positions] $pos_count / $pos_total - [::tr moves] $move_count / $move_total"
2067 }
2068 ################################################################################
2069 #
2070 ################################################################################
2071 proc ::tree::mask::searchClick {x y win baseNumber} {
2072  set idx [ $win index @$x,$y]
2073  if { [ scan $idx "%d.%d" l c] != 2 } {
2074  # should never happen
2075  return
2076  }
2077  set elt [$win get $l.0 $l.end]
2078 
2079  if {[llength $elt] < 4} {
2080  return
2081  }
2082 
2083  set fen [ lrange $elt 0 3]
2084 
2085  # load the position in a temporary game (in clipbase), update the Trees then switch to Tree's base
2086  sc_base switch $::clipbase_db
2087  sc_game push copyfast
2088 
2089  if {[catch {sc_game startBoard $fen} err]} {
2090  puts "sc_game startBoard $fen => $err"
2091  } else {
2092  # TODO : call sc_search board maybe wiser ?
2093  ::tree::refresh
2094  # updateBoard -pgn
2095  }
2096 
2097  sc_game pop
2098 
2099  sc_base switch $baseNumber
2100  # ::file::SwitchToBase $baseNumber
2101  if {[sc_filter first != 0]} {
2102  ::game::Load [sc_filter first]
2103  } else {
2104  updateBoard -pgn
2105  }
2106 
2107  # updateBoard -pgn
2108 
2109 }
2110 ################################################################################
2111 #
2112 ################################################################################
Generated by   doxygen 1.8.13