Scid  4.6.5
calvar.tcl
Go to the documentation of this file.
1 ###
2 ### calvar.tcl: part of Scid.
3 ### Copyright (C) 2007 Pascal Georges
4 ###
5 ################################################################################
6 # The number used for the engine playing a serious game is 4
7 ################################################################################
8 
9 namespace eval calvar {
10  # DEBUG
11  set ::uci::uciInfo(log_stdout4) 0
12 
13  array set engineListBox {}
14  set blunderThreshold 0.2
15  set thinkingTimePerLine 10
16  set thinkingTimePosition 30
17  set currentLine 1
18  set currentListMoves {}
19  # each line begins with a list of moves, a nag code and ends with FEN
20  set lines {}
21  set analysisQueue {}
22 
23  # contains multipv analysis of the position, to see if the user considered all important lines
24  set initPosAnalysis {}
25 
26  set working 0
27  set midmove ""
28 
29  set afterIdPosition 0
30  set afterIdLine 0
31 
32  trace add variable ::calvar::working write { ::calvar::traceWorking }
33  ################################################################################
34  #
35  ################################################################################
36  proc traceWorking {a b c} {
37  set widget .calvarWin.fCommand.bDone
38  if {$::calvar::working} {
39  $widget configure -state disabled
40  } else {
41  $widget configure -state normal
42  }
43  }
44  ################################################################################
45  #
46  ################################################################################
47  proc reset {} {
48  set currentLine 1
49  set currentListMoves {}
50  set lines {}
51  set working 0
52  set analysisQueue {}
53  if {[winfo exists .calvarWin]} {
54  .calvarWin.fText.t delete 1.0 end
55  }
56  }
57  ################################################################################
58  #
59  ################################################################################
60  proc config {} {
61 
62  # check if game window is already opened. If yes abort previous game
63  set w ".calvarWin"
64  if {[winfo exists $w]} {
65  focus .calvarWin
66  return
67  }
68 
69  set w ".configCalvarWin"
70  if {[winfo exists $w]} {
71  focus $w
72  return
73  }
74 
75  toplevel $w
76  wm title $w [::tr "ConfigureCalvar"]
77 
78  bind $w <F1> { helpWindow CalVar }
80 
81  # builds the list of UCI engines
82  ttk::frame $w.fengines -relief raised -borderwidth 1
83  listbox $w.fengines.lbEngines -yscrollcommand "$w.fengines.ybar set" -height 5 -width 50 -exportselection 0
84  ttk::scrollbar $w.fengines.ybar -command "$w.fengines.lbEngines yview"
85  pack $w.fengines.ybar -side left -fill y
86  pack $w.fengines.lbEngines -side left -fill both -expand yes
87  pack $w.fengines -expand yes -fill both -side top
88  set i 0
89  set idx 0
90  foreach e $::engines(list) {
91  if { [lindex $e 7] != 1} { incr idx ; continue}
92  set ::calvar::engineListBox($i) $idx
93  set name [lindex $e 0]
94  $w.fengines.lbEngines insert end $name
95  incr i
96  incr idx
97  }
98  $w.fengines.lbEngines selection set 0
99 
100  # if no engines defined, bail out
101  if {$i == 0} {
102  tk_messageBox -type ok -message "No UCI engine defined" -icon error
103  destroy $w
104  return
105  }
106 
107  # parameters setting
108  set f $w.parameters
109  ttk::frame $w.parameters
110  pack $f -expand yes -fill both
111  # label $f.lThreshold -text "Threshold"
112  # spinbox $f.sbThreshold -background white -width 3 -textvariable ::calvar::blunderThreshold -from 0.1 -to 1.5 -increment 0.1
113  # pack $f.lThreshold $f.sbThreshold -side left
114  ttk::label $f.lTime -text "Move thinking time"
115  spinbox $f.sbTime -background white -width 3 -textvariable ::calvar::thinkingTimePerLine -from 5 -to 120 -increment 5 -validate all -vcmd { regexp {^[0-9]+$} %P }
116  pack $f.lTime $f.sbTime -side left
117  ttk::label $f.lTime2 -text "Position thinking time"
118  spinbox $f.sbTime2 -background white -width 3 -textvariable ::calvar::thinkingTimePosition -from 5 -to 300 -increment 5 -validate all -vcmd { regexp {^[0-9]+$} %P }
119  pack $f.lTime2 $f.sbTime2 -side left
120 
121  ttk::frame $w.fbuttons
122  pack $w.fbuttons -expand yes -fill both
123  ttk::button $w.fbuttons.start -text Start -command {
124  focus .
125  set chosenEngine [.configCalvarWin.fengines.lbEngines curselection]
126  set ::calvar::engineName [.configCalvarWin.fengines.lbEngines get $chosenEngine]
127  destroy .configCalvarWin
128  ::calvar::start $chosenEngine
129  }
130  ttk::button $w.fbuttons.cancel -textvar ::tr(Cancel) -command "focus .; destroy $w"
131 
132  pack $w.fbuttons.start $w.fbuttons.cancel -expand yes -side left -padx 20 -pady 2
133 
134  bind $w <Escape> { .configCalvarWin.fbuttons.cancel invoke }
135  bind $w <Return> { .configCalvarWin.fbuttons.start invoke }
136  bind $w <Destroy> ""
137  bind $w <Configure> "recordWinSize $w"
138  wm minsize $w 45 0
139  }
140  ################################################################################
141  #
142  ################################################################################
143  proc start { engine { n 4 } } {
144 
146 
147  set w ".calvarWin"
148  if {[winfo exists $w]} {
149  focus .calvarWin
150  return
151  }
152  createToplevel $w
153  ::setTitle $w [::tr "Calvar"]
154  bind $w <F1> { helpWindow CalVar }
155  setWinLocation $w
156 
157  set f $w.fNag
158  ttk::frame $f
159  set i 0
160  foreach nag { "=" "+=" "+/-" "+-" "=+" "-/+" "-+" } {
161  ttk::button $f.nag$i -text $nag -command "::calvar::nag $nag" -width 3
162  pack $f.nag$i -side left
163  incr i
164  }
165  pack $f -expand 1 -fill both
166 
167  set f $w.fText
168  ttk::frame $f
169  text $f.t -height 12 -width 50
170  pack $f.t -expand 1 -fill both
171  pack $f -expand 1 -fill both
172 
173  set f $w.fPieces
174  ttk::frame $f
175  ttk::label $f.lPromo -text "Promotion"
176  pack $f.lPromo -side left
177  foreach piece { "q" "r" "b" "n" } {
178  ttk::button $f.p$piece -image w${piece}20 -command "::calvar::promo $piece"
179  pack $f.p$piece -side left
180  }
181  pack $f -expand 1 -fill both
182 
183  set f $w.fCommand
184  ttk::frame $f
185  ttk::button $f.bDone -text [::tr "DoneWithPosition"] -command ::calvar::positionDone
186  pack $f.bDone
187  pack $f -expand 1 -fill both
188 
189  set f $w.fbuttons
190  ttk::frame $f
191  pack $f -expand 1 -fill both
192  ttk::button $w.fbuttons.stop -textvar ::tr(Stop) -command "::calvar::stop"
193  pack $w.fbuttons.stop -expand yes -side left -padx 20 -pady 2
194 
195  bind $w <Escape> { .calvarWin.fbuttons.stop invoke }
196  bind $w <Destroy> ""
197  bind $w <Configure> "recordWinSize $w"
198  wm minsize $w 45 0
199 
200  # start engine and set MultiPV to 10
201  ::uci::startEngine $::calvar::engineListBox($engine) $n
202 
203  set ::analysis(multiPVCount$n) 10
204  ::uci::sendToEngine $n "setoption name MultiPV value $::analysis(multiPVCount$n)"
205  set ::calvar::suggestMoves_old $::suggestMoves
206  set ::calvar::hideNextMove_old $::gameInfo(hideNextMove)
207 
208  set ::suggestMoves 0
209  set ::gameInfo(hideNextMove) 1
211 
212  # fill initPosAnalysis for the current position
213  set ::calvar::working 1
214  ::calvar::startAnalyze "" "" [sc_pos fen]
215 
216  set ::calvar::afterIdPosition [after [expr $::calvar::thinkingTimePosition * 1000] { ::calvar::stopAnalyze "" "" "" ; ::calvar::addLineToCompute "" }]
218  }
219  ################################################################################
220  #
221  ################################################################################
222  proc stop { {n 4 } } {
223  after cancel $::calvar::afterIdPosition
224  after cancel $::calvar::afterIdLine
226  focus .
227  destroy .calvarWin
228  set ::suggestMoves $::calvar::suggestMoves_old
229  set ::gameInfo(hideNextMove) $::calvar::hideNextMove_old
231  }
232 
233  ################################################################################
234  #
235  ################################################################################
236  proc pressSquare { sq } {
237  global ::calvar::midmove
238 
239  set sansq [::board::san $sq]
240  if {$midmove == ""} {
241  set midmove $sansq
242  } else {
243  lappend ::calvar::currentListMoves "$midmove$sansq"
244  set midmove ""
245  }
246  set tmp " "
247  if {$midmove == ""} {
248  set tmp "-"
249  }
250  .calvarWin.fText.t insert "$::calvar::currentLine.end" "$tmp$sansq"
251  }
252  ################################################################################
253  #
254  ################################################################################
255  proc promo { piece } {
256  if { [llength $::calvar::currentListMoves] == 0 } { return}
257 
258  set tmp [lindex $::calvar::currentListMoves end]
259  set tmp "$tmp$piece"
260  lset ::calvar::currentListMoves end $tmp
261  .calvarWin.fText.t insert end "$piece"
262  }
263  ################################################################################
264  # This will end a line, and start engine computation
265  ################################################################################
266  proc nag { n } {
267  .calvarWin.fText.t insert "$::calvar::currentLine.end" " $n\n"
268  set newline [list $::calvar::currentListMoves $n [sc_pos fen]]
269  lappend ::calvar::lines $newline
270  incr ::calvar::currentLine
271  addLineToCompute $newline
272  set ::calvar::currentListMoves {}
273  }
274  ################################################################################
275  #
276  ################################################################################
277  proc addLineToCompute {line {n 4} } {
278  global ::calvar::analysisQueue
279  if {$line != ""} {
280  lappend analysisQueue $line
281  }
282  if { $::calvar::working } { return}
283 
284  while { [llength $analysisQueue] != 0 } {
285  set line [lindex $analysisQueue 0]
286  set analysisQueue [lreplace analysisQueue 0 0]
287  computeLine $line
288  }
289  }
290  ################################################################################
291  #
292  ################################################################################
293  proc computeLine {line {n 4} } {
294  set ::calvar::working 1
295  set moves [ lindex $line 0]
296  set nag [ lindex $line 1]
297  set fen [ lindex $line 2]
298  startAnalyze $moves $nag $fen
299  set ::calvar::afterIdLine [after [expr $::calvar::thinkingTimePerLine * 1000] "::calvar::stopAnalyze [list $moves $nag $fen]"]
300  }
301  ################################################################################
302  # we suppose FEN has not changed !
303  ################################################################################
304  proc handleResult {moves nag fen {n 4} } {
305  set comment ""
306 
307  set usermoves [::uci::formatPv $moves $fen]
308  set firstmove [lindex $usermoves 0]
309 
310  # format engine's output
311  # append first move to the variations
312  set ::analysis(multiPV$n) {}
313  for {set i 0} {$i < [llength $::analysis(multiPVraw$n)]} {incr i} {
314  set elt [lindex $::analysis(multiPVraw$n) $i]
315  set line [::uci::formatPvAfterMoves $firstmove [lindex $elt 2]]
316  set line "$firstmove $line"
317  lappend ::analysis(multiPV$n) [list [lindex $elt 0] [lindex $elt 1] $line [lindex $elt 3]]
318  }
319 
320  if { [llength $moves] != [llength $usermoves]} {
321  set comment " error in user moves [lrange $moves [llength $usermoves] end]"
322  puts $comment
323  }
324 
325  set pv [ lindex $::analysis(multiPV$n) 0]
326  if { [ llength $pv] == 4 } {
327  set engmoves [lindex $pv 2]
328  # score is computed for the opposite side, so invert it
329  set engscore [expr - 1.0 * [lindex $pv 1]]
330  set engdepth [lindex $pv 0]
331  addVar $usermoves $engmoves $nag $comment $engscore
332  } else {
333  puts "Error pv = $pv"
334  }
335  }
336  ################################################################################
337  # will add a variation at current position.
338  # Try to merge the variation with an existing one.
339  ################################################################################
340  proc addVar {usermoves engmoves nag comment engscore} {
341  # Cannot add a variation to an empty variation:
342  if {[sc_pos isAt vstart] && [sc_pos isAt vend]} {
343  # enter the first move as dummy variation
344  sc_move addSan [lindex $engmoves 0]
345  sc_move back
346  }
347 
348  set repeat_move ""
349  # If at the end of the game or a variation, repeat previous move
350  if {[sc_pos isAt vend] && ![sc_pos isAt vstart]} {
351  set repeat_move [sc_game info previousMoveNT]
352  sc_move back
353  }
354 
355  # first enter the user moves
356  sc_var create
357  if {$repeat_move != ""} {sc_move addSan $repeat_move}
358  sc_move addSan $usermoves
359  if {$comment != ""} {
360  sc_pos setComment $comment
361  }
362 
363  sc_pos addNag $nag
364 
365  # now enter the engine moves
366  while {![sc_pos isAt vstart] } {sc_move back}
367  if {$repeat_move != ""} {sc_move forward}
368  sc_var create
369  sc_pos setComment "$::calvar::engineName : $engscore"
370  sc_move addSan $engmoves
371  sc_var exit
372  sc_var exit
373 
374  if {$repeat_move != ""} {sc_move forward}
375 
376  updateBoard -pgn
377  }
378  ################################################################################
379  # will add a variation at current position.
380  # Try to merge the variation with an existing one.
381  ################################################################################
382  proc addMissedLine {moves score depth} {
383  # Cannot add a variation to an empty variation:
384  if {[sc_pos isAt vstart] && [sc_pos isAt vend]} {
385  # enter the first move as dummy variation
386  sc_move addSan [lindex $moves 0]
387  sc_move back
388  }
389 
390  set repeat_move ""
391  # If at the end of the game or a variation, repeat previous move
392  if {[sc_pos isAt vend] && ![sc_pos isAt vstart]} {
393  set repeat_move [sc_game info previousMoveNT]
394  sc_move back
395  }
396 
397  sc_var create
398  if {$repeat_move != ""} {sc_move addSan $repeat_move}
399  sc_pos setComment "Missed line ($depth) $score"
400  sc_move addSan $moves
401  sc_var exit
402  if {$repeat_move != ""} { sc_move forward}
403 
404  updateBoard -pgn
405  }
406  ################################################################################
407  # The user stops entering var, check he founds all important ones.
408  # All the moves that the user did not consider with a score better than the first best
409  # move entered by the user should be pointed out.
410  ################################################################################
411  proc positionDone {} {
412  global ::calvar::initPosAnalysis ::calvar::lines
413 
414  ################################################################################
415  proc isPresent { engmoves } {
416  global ::calvar::lines
417  set res 0
418  set firsteng [lindex $engmoves 0]
419  foreach userLine $::calvar::lines {
420  set usermoves [::uci::formatPv [lindex $userLine 0]]
421  set firstuser [lindex $usermoves 0]
422  if {$firstuser == $firsteng} { return 1}
423  }
424  return 0
425  }
426 
427  ################################################################################
428  foreach pv $::calvar::initPosAnalysis {
429  set engmoves [lindex $pv 2]
430  set engscore [lindex $pv 1]
431  set engdepth [lindex $pv 0]
432  if { ! [isPresent $engmoves] } {
433  addMissedLine $engmoves $engscore $engdepth
434  } else {
435  # the user considered at least one line (skip those that are below)
436  break
437  }
438  }
440  }
441  ################################################################################
442  # startAnalyze:
443  # Put the engine in analyze mode and ponder on the first move entered by the user to see
444  # if the line's evaluation is coherent
445  ################################################################################
446  proc startAnalyze {moves nag fen {n 4}} {
447  global analysis
448 
449  # Check that the engine has not already had analyze mode started:
450  if {$analysis(analyzeMode$n)} { return}
451  set analysis(analyzeMode$n) 1
452  set analysis(waitForReadyOk$n) 1
453  ::uci::sendToEngine $n "isready"
454  vwait analysis(waitForReadyOk$n)
455  set analysis(fen$n) $fen
456  if { [llength $moves] > 0 } {
457  ::uci::sendToEngine $n "position fen $fen moves [lindex $moves 0]"
458  } else {
459  ::uci::sendToEngine $n "position fen $fen"
460  }
461  ::uci::sendToEngine $n "go infinite"
462  }
463  ################################################################################
464  # stopAnalyzeMode
465  ################################################################################
466  proc stopAnalyze { moves nag fen {n 4} } {
467  if {! $::analysis(analyzeMode$n)} { return}
468  set ::analysis(analyzeMode$n) 0
469  ::uci::sendToEngine $n "stop"
470 
471  if { [llength $moves] > 0 } {
472  handleResult $moves $nag $fen
473  } else {
474  set ::calvar::initPosAnalysis $::analysis(multiPV$n)
475  }
476  set ::calvar::working 0
478  }
479 
480 }
481 ###
482 ### End of file: calvar.tcl
483 ###