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