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