Hi Everyone, Uwe Klimmek has been messing with the tournament feature, and has made some interesting changes. He sums them up:
> - Improved layout > - Saving and loading tournaments > - A slipping system (Rutschsystem, carousel) for a better round system. > Perhaps you know that from Arena. > - Automated adaptation of engine selection fields. > - Selection of the games to be played. This way you can also play a > tournament in parallel by starting 2x scidvspc. > - Saving the used time > - Interrupt and resume a tournament after a game. > I also note he has added a handy status bar, made losing on time a lot harder, and removed my ugly "12 engine" limit. I'm not sure how much of the changes i will adopt (A couple of them at least, and maybe all) but users can try out his version by replacing comp.tcl in scid.gui with the attached version, or by recompiling with it. In the tournament, if you select "Save Move Time", you'll also have to make this 1 line change in tcl/tools/graphs.tcl (though this has been fixed in subversion). if {$type == "Score Combo" && [llength $scoreValues] < 5} { > # Scale to emt yaxis , as no Scores > # ... or we *could* use a "total time" scale if we recalculate > yticks, hlines > set scale [expr $maxEmt / $maxLines] > } else { > set scale [expr $max / $maxLines] > } > + *if { $maxLines <= 0 } { set scale 0 }* > set scaledWhiteValues {} > set scaledBlackValues {} > Uwe has also been making some ttk (Themed Tk) changes to mainline Scid, and also updated Scid's Spelling (with Player data and ratings) , Rating and Photo files. A new (derived) spelling.ssp is now in our subversion, or you can download his files from https://sourceforge.net/projects/scid/files/Player%20Data/ Cheers, Steve
### Computer Tournament ### ### comp.tcl: part of Scid. ### Copyright (C) 2010- Steven Atkinson ### Copyright (C) 2018 Uwe Klimmek # Credit to Fulvio for a few lines of UCI code that enabled me # to make this run nicely (without constantly reseting analysis), # and gave me impetus for a decent control structure using # semaphores/vwait instead of the often abused dig-deeper procedural flow # sometimes evident in tcl programs. ################################## set comp(showscores) 1 set comp(showtimes) 1 set comp(showemt) 1 set comp(base) 4 set comp(playing) 0 set comp(endaftergame) 0 set comp(current) 1 set comp(lastgame) 2 set comp(games) {} set comp(count) 2 ; # number of computer players set comp(start) 0 ; # "Start at position" radiobutton set comp(delta) 10000; # 10 seconds is the time set comp(permoveleeway) 1.75 ;# 175% is the max allowed set comp(name) "Scid Engine Tournament" set comp(carousel) 1 set comp(site) "SCID" set comp(seconds) 180 set comp(timecontrol) pergame set comp(minutes) 1 set comp(incr) 0 set comp(timeout) 0 ;# disabled by default set comp(rounds) 2 set comp(showclock) 1 set comp(debug) 0 ; # print info to console set comp(animate) 0 set comp(firstonly) 0 set comp(ponder) 0 set comp(usebook) 0 set comp(book) {} set comp(players) {} set comp(playernames) {} set comp(statustext) "" proc storeTimeComment { color } { set sec [::gameclock::getSec $color] set h [format "%d" [expr abs($sec) / 60 / 60] ] set m [format "%02d" [expr (abs($sec) / 60) % 60] ] set s [format "%02d" [expr abs($sec) % 60] ] set time "$h:$m:$s" #Replace %clk if present, otherwise prepend it if {[regsub {\[%clk\s*.*?\]} [sc_pos getComment] "\[%clk $time\]" comment]} { sc_pos setComment "$comment" } else { sc_pos setComment "\[%clk $time\]$comment" } } proc storeEmtComment { h m s } { set time "[format "%d" $h]:[format "%02d" $m]:[format "%02d" $s]" #Replace %emt if present, otherwise prepend it if {[regsub {\[%emt\s*.*?\]} [sc_pos getComment] "\[%emt $time\]" comment]} { sc_pos setComment "$comment" } else { sc_pos setComment "\[%emt $time\]$comment" } } ### Non-transient options are set in start.tcl proc calcGames {} { global comp if { $comp(firstonly)} { set comp(lastgame) [expr {($comp(count)-1) * $comp(rounds)}] } else { set comp(lastgame) [expr {$comp(count) * ($comp(count)-1) * $comp(rounds) / 2}] } } proc compInit { } { global analysis comp engines set w .comp if {[winfo exists $w]} { raiseWin $w return } toplevel $w wm state $w withdrawn wm title $w "Configure Tournament" setWinLocation $w grid [ttk::labelframe $w.engines -text Engines] -row 0 -column 0 -rowspan 3 -sticky nswe -padx "0 10" grid [ttk::labelframe $w.tournament -text Tournament] -row 0 -column 1 -sticky nswe grid [ttk::labelframe $w.time -text {Time Control}] -row 1 -column 1 -sticky nswe -pady 5 grid [ttk::labelframe $w.config -text Setup] -row 2 -column 1 -sticky nswe grid [ttk::frame $w.buttons] -row 4 -column 0 -columnspan 2 -sticky we -pady "5 0" grid [ttk::frame $w.games] -row 3 -column 0 -sticky nswe ### Engines grid [ttk::frame $w.engines.top] -sticky nw -pady "0 5" ttk::button $w.engines.top.engAdd -text " + " -width 0 -command { if { $comp(count) < [llength $engines(list)] } { incr comp(count) drawCombos calcGames set comp(current) 1 .comp.engines.top.engSub configure -state enable if { $comp(count) == [llength $engines(list)] } { .comp.engines.top.engAdd configure -state disabled } } } ttk::button $w.engines.top.engSub -text " - " -width 0 -command { if { $comp(count) > 2 } { incr comp(count) -1 drawCombos calcGames set comp(current) 1 .comp.engines.top.engAdd configure -state enable if { $comp(count) == 2 } { .comp.engines.top.engSub configure -state disabled } } } ttk::button $w.engines.top.eng2 -text " 2 " -width 0 -command { set comp(count) 2 drawCombos calcGames set comp(current) 1 .comp.engines.top.engSub configure -state disabled .comp.engines.top.engAdd configure -state enabled } ttk::button $w.engines.top.engAll -text "All" -width 0 -command { set comp(count) [llength $engines(list)] drawCombos calcGames set comp(current) 1 .comp.engines.top.engSub configure -state enable .comp.engines.top.engAdd configure -state disabled } pack $w.engines.top.eng2 $w.engines.top.engSub $w.engines.top.engAdd $w.engines.top.engAll -side left -padx 5 set comp(endaftergame) 0 set comp(countcombos) $comp(count) drawCombos ### Config widgets set row 0 ttk::label $w.tournament.eventlabel -text "Event:" ttk::entry $w.tournament.evententry -width 26 -textvariable comp(name) grid $w.tournament.eventlabel -row $row -column 0 -sticky w -pady 2 grid $w.tournament.evententry -row $row -column 1 -sticky we -pady 2 -columnspan 3 incr row ttk::label $w.tournament.sitelabel -text "Site:" ttk::entry $w.tournament.siteentry -width 26 -textvariable comp(site) grid $w.tournament.sitelabel -row $row -column 0 -sticky w -pady 2 grid $w.tournament.siteentry -row $row -column 1 -sticky we -pady 2 -columnspan 3 incr row ttk::frame $w.tournament.firstonlyvalue ttk::label $w.tournament.firstonlyvalue.0 -text "Type:" ttk::radiobutton $w.tournament.firstonlyvalue.1 -text {Round-Robin} -variable comp(firstonly) -value 0 -command "calcGames" ttk::radiobutton $w.tournament.firstonlyvalue.2 -text {Gauntlet} -variable comp(firstonly) -value 1 -command "calcGames" pack $w.tournament.firstonlyvalue.0 $w.tournament.firstonlyvalue.1 $w.tournament.firstonlyvalue.2 -side left -padx "0 5" grid $w.tournament.firstonlyvalue -row $row -column 0 -pady 2 -sticky w -columnspan 4 incr row ttk::label $w.tournament.roundslabel -text "Rounds:" ttk::label $w.tournament.aktlabel -text "Next game:" ttk::label $w.tournament.roundsakt -textvar comp(current) ttk::spinbox $w.tournament.roundsvalue -textvariable comp(rounds) -from 1 -to 10 -width 3 -command "calcGames" grid $w.tournament.roundslabel -row $row -column 0 -sticky w -pady 2 grid $w.tournament.roundsvalue -row $row -column 1 -pady 2 -sticky w grid $w.tournament.aktlabel -row $row -column 2 -sticky w -pady 2 grid $w.tournament.roundsakt -row $row -column 3 -sticky w -pady 2 incr row ttk::frame $w.time.control ttk::label $w.time.control.0 -text {per} ttk::radiobutton $w.time.control.1 -variable comp(timecontrol) -value pergame -text Game -command checkTimeControl ttk::radiobutton $w.time.control.2 -variable comp(timecontrol) -value permove -text Move -command checkTimeControl pack $w.time.control.0 $w.time.control.1 $w.time.control.2 -side left -padx "0 5" grid $w.time.control -row $row -column 0 -columnspan 3 -sticky w -pady 2 incr row ttk::frame $w.time.timegame ttk::label $w.time.timegame.label -text "Time per\ngame" ttk::spinbox $w.time.timegame.base -textvariable comp(base) -from 0 -to 7200 -incr 5 -width 4 ttk::label $w.time.timegame.label2 -text "Basic\nSec." ttk::spinbox $w.time.timegame.incr -textvariable comp(incr) -from 0 -to 60 -width 4 ttk::label $w.time.timegame.label3 -text "Increment\nSec." pack $w.time.timegame.label -side left -padx "0 5" pack $w.time.timegame.base -side left pack $w.time.timegame.label2 -side left -padx "0 5" pack $w.time.timegame.label3 $w.time.timegame.incr -side right grid $w.time.timegame -row $row -column 0 -columnspan 2 -sticky ew -pady 2 incr row ttk::frame $w.time.timesecs ttk::label $w.time.timesecs.label -text "Time per\nmove" set tmp $comp(seconds) ttk::spinbox $w.time.timesecs.value -textvariable comp(seconds) -from 1 -to 3600 -width 4 set comp(seconds) $tmp ttk::label $w.time.timesecs.label2 -text "Sek." pack $w.time.timesecs.label -side left -padx "0 5" pack $w.time.timesecs.value $w.time.timesecs.label2 -side left grid $w.time.timesecs -row $row -column 0 -columnspan 2 -sticky we -pady 2 incr row ttk::frame $w.time.show ttk::label $w.time.show.l -text "Store time: " ttk::radiobutton $w.time.show.time0 -text "no" -variable comp(showtimes) -value 0 ttk::radiobutton $w.time.show.time1 -text "Clock" -variable comp(showtimes) -value 1 ttk::radiobutton $w.time.show.time2 -text "Move" -variable comp(showtimes) -value 2 pack $w.time.show.l -side left pack $w.time.show.time0 $w.time.show.time1 $w.time.show.time2 -side left -padx "5 0" grid $w.time.show -row $row -column 0 -sticky w -columnspan 3 incr row ttk::checkbutton $w.config.showclockvalue -text {Show Clocks} -variable comp(showclock) grid $w.config.showclockvalue -row $row -column 0 -sticky w checkTimeControl ttk::checkbutton $w.config.carousel -text "Carousel" -variable comp(carousel) grid $w.config.carousel -row $row -column 1 -sticky w ttk::checkbutton $w.config.pondervalue -text {Permanent Thinking} -variable comp(ponder) grid $w.config.pondervalue -row $row -column 2 -sticky w incr row ttk::checkbutton $w.config.animatevalue -text {Animate Moves} -variable comp(animate) grid $w.config.animatevalue -row $row -column 0 -sticky w ttk::checkbutton $w.config.scorevalue -text {Engine Scores as Comments} -variable comp(showscores) grid $w.config.scorevalue -row $row -column 1 -columnspan 2 -sticky w ### Opening Book incr row ttk::frame $w.config.book ttk::checkbutton $w.config.book.value -variable comp(usebook) -textvar ::tr(UseBook) set bookPath $::scidBooksDir set bookList [ lsort -dictionary [ glob -nocomplain -directory $bookPath *.bin ] ] set tmp {} ttk::combobox $w.config.book.combo -width 12 if { [llength $bookList] == 0 } { $w.config.book.value configure -state disabled set comp(usebook) 0 } else { set i 0 set idx 0 foreach file $bookList { lappend tmp [file tail $file] if { $comp(book) == [file tail $file]} { set idx $i } incr i } $w.config.book.combo configure -values $tmp $w.config.book.combo current $idx } grid $w.config.book -row $row -column 0 -columnspan 3 -sticky w pack $w.config.book.combo $w.config.book.value -side right -padx "0 5" label $w.games.aktstart -text "Games " label $w.games.aktend -text " - " ttk::spinbox $w.games.roundakt -textvariable comp(current) -from 1 -to 999 -width 3 ttk::spinbox $w.games.roundend -textvariable comp(lastgame) -from 1 -to 999 -width 3 pack $w.games.aktstart $w.games.roundakt $w.games.aktend $w.games.roundend -side left ### OK, Cancel Buttons ttk::button $w.buttons.cancel -text $::tr(Cancel) -command compClose set starttext "Start" ttk::button $w.buttons.ok -text $starttext -command "startComp; compOk" ttk::button $w.buttons.save -text Save -command "startComp; compSave" ttk::button $w.buttons.load -text Load -command "loadComp" focus $w.buttons.ok packbuttons right $w.buttons.cancel $w.buttons.ok $w.buttons.save $w.buttons.load -anchor e bind $w <Configure> "recordWinSize $w" wm protocol $w WM_DELETE_WINDOW compClose wm resizable $w 0 0 bind $w <Escape> compClose bind $w <F1> {helpWindow Tourney} update wm state $w normal } proc checkTimeControl {} { set w .comp if {$::comp(timecontrol) == "permove" } { foreach i [winfo children $w.time.timesecs] { $i configure -state normal } foreach i "[winfo children $w.time.timegame] $w.config.showclockvalue" { $i configure -state disabled } } else { foreach i [winfo children $w.time.timesecs] { $i configure -state disabled } foreach i "[winfo children $w.time.timegame] $w.config.showclockvalue" { $i configure -state normal } } update } proc loadComp {} { global comp engines scidConfigDir set filename "" set types { {{Scid Tournament Files} {.sto}} } set filename [tk_getOpenFile -initialdir $scidConfigDir -initialfile $comp(name) -filetypes $types -defaultextension ".sto"] if {$filename != ""} { source $filename } set comp(players) {} for {set i 0} {$i < $comp(count)} {incr i} { set j 0 set found 0 foreach e $engines(list) { if { [lindex $comp(playernames) $i] == [lindex $e 0] } { lappend comp(players) $j set found 1 break } incr j } if { ! $found } { tk_messageBox -type ok -title {Scid: Fehler} -message "Engine [lindex $comp(playernames) $i] nicht gefunden." return } } .comp.config.book.combo set $comp(book) compInit createGames $comp(carousel) destroy .comp.engines.list drawCombos } proc createGames { carousel } { global comp ### Place games in cue set comp(games) {} set gamesPerRound [expr int($comp(count)/2)] set even [expr ($comp(count)+1) % 2] set rounds [expr $comp(count) -1 ] set last [expr $comp(count) -1 ] set plist {} set hlist {} if { !$even } { set last [expr $comp(count) -2 ] set rounds $comp(count) } if { $carousel && ! $comp(firstonly) } { for {set k 1} {$k <= $comp(rounds)} {incr k} { for {set i 0} {$i < $comp(count)} {incr i} { lappend plist $i } ## Carousel or Rutschsystem for {set l 1} {$l <= $rounds} {incr l} { for {set i 0; set j $last } {$i < $gamesPerRound} {incr i; incr j -1 } { if { $even && [expr ($l-1) % 2] } { lappend comp(games) [list [lindex $comp(players) [lindex $plist $j]] [lindex $comp(players) [lindex $plist $i]] \ [lindex $comp(playernames) [lindex $plist $j]] [lindex $comp(playernames) [lindex $plist $i]] "$k.$l"] lappend hlist [list [lindex $comp(players) [lindex $plist $i]] [lindex $comp(players) [lindex $plist $j]] \ [lindex $comp(playernames) [lindex $plist $i]] [lindex $comp(playernames) [lindex $plist $j]] "[expr $k+1].$l"] } else { lappend comp(games) [list [lindex $comp(players) [lindex $plist $i]] [lindex $comp(players) [lindex $plist $j]] \ [lindex $comp(playernames) [lindex $plist $i]] [lindex $comp(playernames) [lindex $plist $j]] "$k.$l"] lappend hlist [list [lindex $comp(players) [lindex $plist $j]] [lindex $comp(players) [lindex $plist $i]] \ [lindex $comp(playernames) [lindex $plist $j]] [lindex $comp(playernames) [lindex $plist $i]] "[expr $k+1].$l"] } } set help [lindex $plist end]; set xlist [linsert $plist $even $help] set plist [lreplace $xlist end end] } incr k if { $k <= $comp(rounds) } { append comp(games) " $hlist" set hlist {} } } } else { for {set k 1} {$k <= $comp(rounds)} {incr k} { for {set i 0} {$i < $comp(count)} {incr i} { for {set j [expr $i + 1]} { $j < $comp(count) } {incr j} { lappend comp(games) [list [lindex $comp(players) $i] [lindex $comp(players) $j] [lindex $comp(playernames) $i] [lindex $comp(playernames) $j] $k] lappend hlist [list [lindex $comp(players) $j] [lindex $comp(players) $i] [lindex $comp(playernames) $j] [lindex $comp(playernames) $i] [expr $k+1]] } if {$comp(firstonly)} {break} } incr k if { $k <= $comp(rounds) } { append comp(games) " $hlist" set hlist {} } } } } proc startComp { } { global analysis comp engines set comp(startfen) [sc_pos fen] # make sure decimals have a leading 0 catch { set comp(incr) [expr $comp(incr)] set comp(base) [expr $comp(base)] set comp(seconds) [expr $comp(seconds)] } if {$comp(count) != $comp(countcombos)} { drawCombos return } set comp(players) {} ;# to remember which engines are selected between widget restarts set comp(playernames) {} set names {} set comp(book) [.comp.config.book.combo get] if {$comp(timecontrol) == "permove"} { set comp(time) [expr {int($comp(seconds) * 1000)}] puts "Move delay is $comp(time) milliseconds" } for {set i 0} {$i < $comp(count)} {incr i} { set j [.comp.engines.list.$i.combo current] lappend comp(players) $j lappend comp(playernames) [lindex [lindex $engines(list) $j] 0] } if {$comp(firstonly)} { set comp(firstN) [lindex $comp(players) 0] } ### Check players are unique if {[llength [lsort -unique $comp(players)]] != $comp(count)} { tk_messageBox -type ok -parent .comp -title {Scid: error} \ -message {Duplicate engines not supported} return } createGames $comp(carousel) } proc toggleEndAfterGame {} { global comp if { $comp(endaftergame) } { set comp(endaftergame) 0 .comp.buttons.save state !pressed } else { set comp(endaftergame) 1 .comp.buttons.save state pressed } } proc compOk {} { global analysis comp engines if {[winfo exists .analysisWin1]} "destroy .analysisWin1" if {[winfo exists .analysisWin2]} "destroy .analysisWin2" ## wait short for cleanup the engine analysis windows set ::wfwd 0 after 800 set ::wfwd 1 vwait ::wfwd set w .comp if {[sc_base isReadOnly]} { set answer [tk_messageBox -title Tournanment -icon question -type okcancel \ -message {Database is read only. Continue ?} -parent $w] if {$answer != "ok"} {return} } if {![sc_pos isAt end] && $comp(start) > 0} { set answer [tk_messageBox -title Tournanment -icon question -type okcancel \ -message {Current game is not at end of game. Continue ?} -parent $w] if {$answer != "ok"} {return} } ### Reconfigure init widget for pausing for {set i 0} {$i < $comp(count)} {incr i} { $w.engines.list.$i.combo configure -state disabled ; # disable widgets too $w.engines.list.$i.configure configure -state disabled } foreach j {.comp.config .comp.engines .comp.engines.top .comp.time.control .comp.time.timesecs .comp.time.timegame .comp.config.book .comp.tournament} { foreach i [winfo children $j] { catch {$i configure -state disabled} } } $w.buttons.ok configure -text Pause -command compPause -state normal $w.buttons.save configure -text "Stop after\nthis game" -command "toggleEndAfterGame" -state normal pack forget $w.buttons.load $w.buttons.cancel configure -text {Cancel} -command compAbort -state normal wm title $w "$::scidName Tournament" focus $w.buttons.ok ### Clocks set row 4 if {$comp(showclock) && $comp(timecontrol) == "pergame"} { ttk::frame $w.clocks grid $w.clocks -column 0 -row $row -rowspan 2 -sticky nswe ::gameclock::new $w.clocks 1 120 1 horizontal digital ::gameclock::new $w.clocks 2 120 1 horizontal digital ::gameclock::setColor 1 white ::gameclock::setColor 2 black pack forget $w.clocks.clock1 $w.clocks.clock2 pack $w.clocks.clock1 $w.clocks.clock2 -side left -fill x -padx "0 10" } ### Extra decision buttons ttk::frame $w.say grid $w.say -column 1 -row 3 -sticky e ttk::button $w.say.white -text "$::tr(White) wins" -command {compGameEnd 1} ttk::button $w.say.draw -text "$::tr(Draw)" -command {compGameEnd =} ttk::button $w.say.black -text "$::tr(Black) wins" -command {compGameEnd 0} pack $w.say.white $w.say.draw $w.say.black -side left -padx 5 -pady "5 0" # This is no longer reliable because of comp(firstonly) option # set num_games [expr {$comp(count) * ($comp(count)-1) * $comp(rounds) / 2}] set num_games [llength $comp(games)] puts "$num_games GAMES total: $comp(games)" ttk::progressbar $w.progress -mode determinate \ -maximum $num_games -variable comp(current) grid $w.progress -column 0 -row 6 -columnspan 2 -sticky we ttk::label $w.status -textvariable comp(statustext) grid $w.status -column 0 -row 7 -columnspan 2 -sticky we ### Play games set comp(statustext) "" set thisgame [lindex $comp(games) [expr $comp(current) - 1]] while {$thisgame != {} } { set n [lindex $thisgame 0] set m [lindex $thisgame 1] set name1 [lindex $thisgame 2] set name2 [lindex $thisgame 3] set k [lindex $thisgame 4] if {$n != {} && $m != {}} { append comp(statustext) "\nGame $comp(current): $name1 - $name2" compNM $n $m $k set res [sc_game tags get Result] switch -- $res { 0 { set res "Black wins" } 1 { set res "White wins" } = { set res "Draw" } * { set res "Canceled" } } set res1 [sc_pos getComment] set wbt [string first "wtime" $res1] if { $wbt >= 0 } { set res1 [string range $res1 0 [expr $wbt-1]] } set comp(statustext) "Result $name1 - $name2: $res $res1" incr comp(current) ## wait short for cleanup the engine analysis windows set ::wfwd 0 after 800 set ::wfwd 1 vwait ::wfwd } if { $comp(endaftergame) } { toggleEndAfterGame; compSave; break } set thisgame [lindex $comp(games) [expr $comp(current) - 1]] if { $thisgame != {} && $comp(current) > $comp(lastgame)} { compSave; break } } ### Comp over if { $comp(current) > $comp(lastgame)} { append comp(statustext) "\nComp finished" set comp(current) $comp(lastgame) pack forget $w.buttons.save } else { append comp(statustext) "\nComp paused" $w.buttons.save configure -text [tr Continue] -state normal -command { compDestroy update compInit startComp compOk } } if {[winfo exists .comp]} { # voodoo that you do wm geometry .comp [wm geometry .comp] # Hmm - if we leave this window open , and run F2 (say) the engines can sometimes stop working # So better make sure this window gets closed .comp.buttons.ok configure -text [tr Restart] -command { compDestroy update compInit set comp(current) 1 } .comp.buttons.cancel configure -text [tr Close] -command { if { $comp(current) >= $comp(lastgame) } { set comp(current) 1 } compDestroy } foreach i [winfo children $w.say] { catch {$i configure -state disabled} } raiseWin .comp } } proc compNM {n m k} { global analysis comp ::uci::uciInfo set comp(result) {} if {$comp(timecontrol) == "pergame"} { set comp(wtime) [expr int($comp(base)*1000)] set comp(btime) [expr int($comp(base)*1000)] set total [expr int($comp(base))] set mins [expr $total/60] set secs [expr $total%60] if {$secs == 0} { set timecontrol $mins } else { if {$secs < 10} { set secs "0$secs" } set timecontrol $mins:$secs } if {$comp(showclock) && $comp(timecontrol) == "pergame"} { ::gameclock::setSec 1 [ expr -int($comp(base)) ] ::gameclock::setSec 2 [ expr -int($comp(base)) ] } } sc_game new if {($comp(start) == 1 && $comp(current) == 1) || $comp(start) == 2} { sc_game startBoard $comp(startfen) set comp(startpos) "fen $comp(startfen)" } else { set comp(startpos) startpos } set comp(playing) 1 set comp(paused) 0 set comp(white) $n set comp(fen) {} ## add 50ms to avoid lose on time set incr [expr int($comp(incr) * 1000) + 50] set comp(inbook) $comp(usebook) if {[winfo exists .analysisWin$n]} "destroy .analysisWin$n" if {[winfo exists .analysisWin$m]} "destroy .analysisWin$m" ### makeAnalysisWin creates a toplevel widget to run an engine but we don't really need a toplevel %< # The problem is that only UCI has a procedure for running an engine without a toplevel (uci::startSilentEngine). # There is currently no equivalent for xboard engines makeAnalysisWin $n if {![winfo exists .analysisWin$n]} { set comp(games) {} return } ## ToDo ## remove button bar of analysis window to avoid misuse pack forget .analysisWin$n.b1 toggleMovesDisplay $n makeAnalysisWin $m if {![winfo exists .analysisWin$m]} { set comp(games) {} return } pack forget .analysisWin$m.b1 toggleMovesDisplay $m # Stop all engines # (Is this necessary ? We are sending a "stop" straight away. &&&) if {$analysis(analyzeMode$n)} { toggleEngineAnalysis $n } if {$analysis(analyzeMode$m)} { toggleEngineAnalysis $m } sc_game tags set -white $analysis(name$n) sc_game tags set -black $analysis(name$m) sc_game tags set -event $comp(name) sc_game tags set -site $comp(site) set lextra [list "Time \"[clock format [clock seconds] -format %T]\"\n"] if {$comp(timecontrol) == "permove"} { lappend lextra "Movetime \"$comp(seconds)\"" sc_game tags set -date [::utils::date::today] -round $k -extra $lextra } else { lappend lextra "TimeControl \"$timecontrol/$comp(incr)\"" sc_game tags set -date [::utils::date::today] -round $k -extra $lextra } if {$comp(firstonly)} { # Show games from first players view if {( $n == $comp(firstN) && [::board::isFlipped .main.board] ) || \ ( $m == $comp(firstN) && ![::board::isFlipped .main.board] ) } { ::board::flip .main.board } } update idletasks updateBoard -pgn updateTitle update ### Thanks to HGM and Talkchess for help with UCI/Xboard protocols ### Initialisation foreach current_engine "$n $m" { ### don't display engine output set analysis(movesDisplay$current_engine) 2 toggleMovesDisplay $current_engine if { $analysis(uci$current_engine)} { ### UCI initialisation # fulvio issues isready every move ?? set analysis(waitForReadyOk$current_engine) 1 sendToEngine $current_engine ucinewgame if {$comp(ponder)} { sendToEngine $current_engine "setoption name Ponder value true" } else { sendToEngine $current_engine "setoption name Ponder value false" } sendToEngine $current_engine "isready" vwait analysis(waitForReadyOk$current_engine) # if {!$comp(playing)} {break} # sendToEngine $current_engine {debug off} } else { ### xboard initialisation sendToEngine $current_engine xboard if {!$analysis(seen$current_engine)} { vwait analysis(seen$current_engine) } sendToEngine $current_engine "protover 2" if {$comp(ponder)} { sendToEngine $current_engine "hard" } else { sendToEngine $current_engine "easy" } sendToEngine $current_engine "bk off" # done later # sendToEngine $current_engine "st $comp(seconds)" ### Hacks if {0} { # Sjeng or Chen run too fast unless "hard" is issued if {[regexp -nocase arasan $analysis(name$current_engine)]} { sendToEngine $current_engine hard } if {[regexp -nocase sjeng $analysis(name$current_engine)]} { sendToEngine $current_engine hard } if {[regexp -nocase xchen $analysis(name$current_engine)] || \ [regexp -nocase chenard $analysis(name$current_engine)] } { sendToEngine $current_engine hard } } ### Setup initial position if {$comp(startpos) == "startpos"} { if {$current_engine == $m} { # "new" command means "play black" sendToEngine $current_engine "new" } } else { ## Don't test for setboard as Phalanx doest report this working feature # if {$analysis(has_setboard$current_engine)} sendToEngine $current_engine "setboard $comp(startfen)" # Without force, some engines try to play both side !? sendToEngine $current_engine "force" } ### Send initial time control if {$comp(timecontrol) == "permove"} { sendToEngine $current_engine "st $comp(seconds)" } else { set secs [expr $comp(wtime)/1000] set seconds [expr $secs%60] if {$seconds < 10} { set seconds 0$seconds } set mins [expr $secs/60]:$seconds ##Winboard supports sec only set wincr [expr int($comp(incr) / 1)] sendToEngine $current_engine "level 0 $mins $wincr" ### set search depth. # "sd" is meant to be orthogonal to the "time" command, but the first engine i tested (zct) never came back # While spike needs it set to something reasonable, otherwise it never plays a move # but spike is uci too... hmmm # sendToEngine $current_engine "sd 12" } } } if {[sc_pos side] == "white"} { set current_engine $n set other_engine $m } else { set current_engine $m set other_engine $n } # Automatically set a timeout value &&& if {$comp(timecontrol) == "permove"} { # Automatically time-out comp in $movetime + 10 secs after [expr {$comp(time) + $comp(delta)}] compTimeout } else { after [expr {$comp(wtime) + $comp(delta)}] compTimeout } ### Main control loop # Thanks to Fulvio for inspiration to rewrite this properly :> while {$comp(playing)} { # hmm... promo pieces are shown in uppercase, but this crashes some engines # todo: make command "sc_game move uci" set movehistory1 [sc_game moves coord] set movehistory [string tolower $movehistory1] if {$comp(showclock) && $comp(timecontrol) == "pergame"} { if {$current_engine == $n} { ::gameclock::start 1 } else { ::gameclock::start 2 } } set comp(move) $current_engine set comp(nextmove) $other_engine set lastmove [lindex $movehistory end] set comp(bookmove) {} set comp(lasttime) [clock clicks -milli] if {$analysis(uci$current_engine)} { ### UCI main loop if {$comp(inbook) && $comp(book) != ""} { catch { # KomodoVariety.bin has bugs set comp(bookmove) [::book::getMove $comp(book) [sc_pos fen] $::sergame::bookSlot] } if {$comp(bookmove) == ""} { set comp(inbook) 0 } } if {$comp(bookmove) == ""} { ### position set hit 0 if {$movehistory == {}} { sendToEngine $current_engine "position $comp(startpos)" } elseif {!$comp(ponder)} { sendToEngine $current_engine "position $comp(startpos) moves $movehistory" } else { if {$uciInfo(ponder$current_engine) == $lastmove && $lastmove != {}} { sendToEngine $current_engine "ponderhit" set hit 1 } else { if {[llength $movehistory] > 1 && $uciInfo(ponder$current_engine) != {}} { sendToEngine $current_engine "stop" set uciInfo(bestmove$current_engine) stop } sendToEngine $current_engine "position $comp(startpos) moves $movehistory" } } ### go set comp(lasttime) [clock clicks -milli] if {$comp(timecontrol) == "permove"} { if {!$hit} { sendToEngine $current_engine "go movetime $comp(time)" } } else { if {!$hit} { sendToEngine $current_engine "go wtime $comp(wtime) btime $comp(btime) winc $incr binc $incr" } } # set analysis(fen$current_engine) [sc_pos fen] set analysis(maxmovenumber$current_engine) 0 set analysis(waitForBestMove$current_engine) 1 vwait analysis(waitForBestMove$current_engine) } if {!$comp(playing)} {break} } else { ### Xboard main loop # Setup times if {$comp(timecontrol) != "permove"} { # Should we only send time, otim if has "time" as a feature &&& if {$comp(white) == $current_engine} { sendToEngine $current_engine "time [expr $comp(wtime)/10]" sendToEngine $current_engine "otim [expr $comp(btime)/10]" } else { sendToEngine $current_engine "time [expr $comp(btime)/10]" sendToEngine $current_engine "otim [expr $comp(wtime)/10]" } } else { ### permove time control doesn't need reissuing ? # sendToEngine $current_engine "st $comp(seconds)" } # Setup move set comp(lasttime) [clock clicks -milli] set nummoves [llength $comp(fen)] if {$nummoves == 0 } { sendToEngine $current_engine "go" } elseif {$nummoves == 1 && $comp(startpos) != "startpos"} { sendToEngine $current_engine "setboard [sc_pos fen]" sendToEngine $current_engine "go" } else { ### Send the previous move to engine # (protocol 2 can also use "usermove MOVE") if {$lastmove != {}} { sendToEngine $current_engine $lastmove } ; # else "go" ? } vwait analysis(waitForBestMove$current_engine) if {!$comp(playing)} {break} } set expired [expr [clock clicks -milli] - $comp(lasttime)] if {$analysis(uci$other_engine) && $comp(ponder) && ($uciInfo(ponder$other_engine) != "")} { ### UCI other engine # position if {$movehistory != {}} { ### todo - verfiy this works all scenarios (ponder with non-standard start) sendToEngine $other_engine "position $comp(startpos) moves $movehistory $uciInfo(ponder$other_engine)" } # go if {$comp(timecontrol) == "permove"} { sendToEngine $other_engine "go ponder movetime $comp(time)" } else { sendToEngine $other_engine "go ponder wtime $comp(wtime) btime $comp(btime) winc $incr binc $incr" } } # Updating the board (via makeAnalysisMove) takes order of # 1/40th second (23000microseconds) on my core2quad if {[makeCompMove $current_engine]} { ### Store evaluation (and time) if {$comp(showscores)} { if {1} { set comment $analysis(score$current_engine) if {$comment != 0} { if {$comment > 0} { set comment +$comment } sc_pos setComment $comment } } else { sc_pos setComment "\[%ms $expired\]\[%eval $analysis(score$current_engine)\]" } } ### Move success after cancel compTimeout if {$comp(showclock) && $comp(timecontrol) == "pergame"} { if {$current_engine == $n} { ::gameclock::stop 1 } else { ::gameclock::stop 2 } } # Note - No time slice enforcement for permove time control while {$comp(paused)} { vwait comp(paused) } ### Check if game is over ## Check for unsufficent material set ps [lrange [split [sc_pos fen]] 0 0] set pieces [string map { / "" 1 "" 2 "" 3 "" 4 "" 5 "" 6 "" 7 "" 8 "" } $ps ] set anzPieces [string length $pieces] if { $anzPieces < 5 } { set lp [split $pieces ""] set wbn [llength [lsearch -all -inline -regexp $lp "\[bn\]"]] set bbn [llength [lsearch -all -inline -regexp $lp "\[BN\]"]] if { $anzPieces < 3 || \ ($anzPieces == 3 && ( $wbn == 1 || $bbn == 1)) || ($anzPieces == 4 && $wbn == 1 && $bbn == 1) } { sc_game tags set -result = sc_pos setComment {Scid: Insufficient Material} break } } if {[sc_pos moves] == {}} { if {![sc_pos isCheck]} { ### stalemate sc_game tags set -result = sc_pos setComment [tr stalemate] } else { ### checkmate if {[sc_pos side] == {black}} { sc_game tags set -result 1 } else { sc_game tags set -result 0 } } break } else { set elt [lrange [split [sc_pos fen]] 0 2] # append the position only if different from the last element if { $elt != [ lindex $comp(fen) end ] } { lappend comp(fen) $elt } else { ##ToDo # sc_pos setComment "Double Fen: $::analysis(name$current_engine): $elt" } set fen [sc_pos fen] if {[lindex $fen 4] > 99} { sc_pos setComment "50 move rule" sc_game tags set -result = ### draw break } elseif {[llength [lsearch -all $comp(fen) $elt]] >= 3 } { # Could we use "sc_pos analyse" for 3 fold detection ? sc_pos setComment "3 fold repetition" sc_game tags set -result = ### draw break } } if {$comp(showtimes) == 2} { set min 0 set sec [expr int($expired / 1000) ] if { $sec > 59 } { set min [expr int($sec / 60) ]; set [expr $sec % 60 ] } storeEmtComment 0 $min $sec } set ::analysis(moves$current_engine) "" set ::analysis(moves$other_engine) "" ### Swap players if {$current_engine != $n} { if {$comp(timecontrol) == "pergame"} { set comp(btime) [expr $comp(btime) - $expired] if {$comp(btime) < 0} { sc_game tags set -result 1 sc_pos setComment {Black loses on time} break } # add time increment if {$comp(bookmove) == ""} { incr comp(btime) $incr } if {$comp(showclock) && $comp(timecontrol) == "pergame"} { ::gameclock::setSec 2 [ expr -int($comp(btime)/1000) ] if {$comp(showtimes) == 1} { storeTimeComment 2 } } # In case white hangs, automatically time-out comp in $wtime + 2 secs after [expr {$comp(wtime) + $comp(delta)}] compTimeout } else { if {$expired > $comp(permoveleeway)*$comp(time)} { sc_game tags set -result 1 sc_pos setComment "Blacks move takes $expired secs" break } # Automatically time-out comp in $movetime + 2 secs after [expr {$comp(time) + $comp(delta)}] compTimeout } # Now its whites turn set current_engine $n set other_engine $m } else { if {$comp(timecontrol) == "pergame"} { set comp(wtime) [expr $comp(wtime) - $expired] if {$comp(wtime) < 0} { sc_game tags set -result 0 sc_pos setComment {White loses on time} break } # add time increment if {$comp(bookmove) == ""} { incr comp(wtime) $incr } if {$comp(showclock) && $comp(timecontrol) == "pergame"} { ::gameclock::setSec 1 [ expr -int($comp(wtime)/1000) ] if {$comp(showtimes) == 1} { storeTimeComment 1 } } # In case black hangs, automatically time-out comp in $wtime + 2 secs after [expr {$comp(btime) + $comp(delta)}] compTimeout } else { if {$expired > $comp(permoveleeway)*$comp(time)} { sc_game tags set -result 0 sc_pos setComment "Whites move takes $expired secs" break } # Automatically time-out comp in $movetime + 2 secs after [expr {$comp(time) + $comp(delta)}] compTimeout } # Now its blacks turn set current_engine $m set other_engine $n } } else { ### Move failed... don't swap players ### Unlikely, but could happen while {$comp(paused)} { after cancel compTimeout ##ToDo sc_pos setComment "Move failed:" vwait comp(paused) # todo - handle wtime/btime if {$comp(timecontrol) == "pergame"} { after [expr {$comp(time) + $comp(delta)}] compTimeout } } } } ; # end main control loop ### This game is over after cancel compTimeout if {$comp(showclock) && $comp(timecontrol) == "pergame"} { ::gameclock::stop 1 ::gameclock::stop 2 } ### Save game # Perhaps game has been adjudicated by user ? if {$comp(result) != {}} { sc_game tags set -result $comp(result) } puts "Game $n - $m is over. Result [sc_game tags get Result]" if {$comp(timecontrol) == "pergame"} { set comment [sc_pos getComment] if {$comment == {}} { sc_pos setComment "wtime $comp(wtime), btime $comp(btime)" } else { sc_pos setComment "$comment. wtime $comp(wtime), btime $comp(btime)" } } if {![sc_base isReadOnly]} { sc_game save [sc_game number] ::windows::gamelist::Refresh ::crosstab::Refresh } # ::pgn::Refresh 1 updateBoard -pgn catch {destroy .analysisWin$n} catch {destroy .analysisWin$m} set comp(playing) 0 } proc makeCompMove {current_engine} { if {$::comp(bookmove) != {}} { sc_move addSan $::comp(bookmove) if {$::comp(animate)} { updateBoard -pgn -animate } else { updateBoard -pgn } return 1 } else { ::tools::graphs::score::Refresh2 return [makeAnalysisMove $current_engine] } } proc compPause {} { global analysis comp engines set w .comp after cancel compTimeout $w.buttons.ok configure -text Resume -command compResume set comp(paused) 1 } proc compResume {} { global analysis comp engines set w .comp $w.buttons.ok configure -text Pause -command compPause set comp(paused) 0 } proc drawCombos {} { global analysis comp engines # Check number of engines is sane if {![string is integer -strict $comp(count)] || $comp(count) < 2} { set comp(count) 2 update } if {$comp(count) > [llength $engines(list)]} { set comp(count) [llength $engines(list)] update } set w .comp set l $w.engines.list if {[winfo exists $l]} { # Remember current players # ... before destroying widget (which is easiest) set comp(players) {} for {set i 0} {$i < $comp(count)} {incr i} { catch { lappend comp(players) [$l.$i.combo current] } } destroy $l } grid [ttk::frame $l] -sticky n set values {} foreach e $engines(list) { lappend values [lindex $e 0] } set col 0 set row 0 set maxr 11 set startpad 0 for {set i 0} {$i < $comp(count)} {incr i} { ttk::frame $l.$i # Only pack so many grid $l.$i -column $col -row $row ttk::combobox $l.$i.combo -width 12 -state readonly -values $values ttk::button $l.$i.configure -image uci -text "uci" -command "::uci::uciConfigN \[ $l.$i.combo current \] .comp" button $l.$i.log -image tb_annotate -command " engineShowLog \[ $l.$i.combo current \] " pack $l.$i.log $l.$i.combo -side left -padx "$startpad 0" pack $l.$i.configure -side left -padx "5 0" incr row if { $row > $maxr } { set row 0; incr col; set startpad 10} if {[info exists comp(players)]} { # Set the combo boxes to the previous players if we can set prev_player [lindex $comp(players) $i] if {[catch {$l.$i.combo current $prev_player}]} { $l.$i.combo current $i } } else { $l.$i.combo current $i } } set comp(countcombos) $comp(count) update return 1 } proc compTimeout {} { global analysis comp puts "Timed out" set expired [expr [clock clicks -milli] - $comp(lasttime)] if {[sc_pos side] == "white"} { if {$comp(timecontrol) == "pergame"} { set comp(wtime) [expr $comp(wtime) - $expired] set comment {Timed out} } else { set comment "White movetime [expr $expired / 1000.0] secs" } set result 0 } else { if {$comp(timecontrol) == "pergame"} { set comp(btime) [expr $comp(btime) - $expired] set comment {Timed out} } else { set comment "Black movetime [expr $expired / 1000.0] secs" } set result 1 } compGameEnd $result $comment } proc compGameEnd {result {comment {Manual adjudication}}} { global analysis comp if {$comp(paused)} { compResume } set comp(playing) 0 set comp(result) $result sc_pos setComment $comment set analysis(waitForReadyOk$comp(move)) 1 set analysis(waitForBestMove$comp(move)) 1 } proc compAbort {} { # Close all games, called when game is active global analysis comp if {$comp(paused)} { compResume } set comp(playing) 0 set comp(games) {} catch { set analysis(waitForReadyOk$comp(move)) 1 set analysis(waitForBestMove$comp(move)) 1 } } proc compClose {} { global analysis comp if {[.comp.buttons.cancel cget -text] == {End Comp}} { # comp is running. Double check before exitting set msg {A Computer Tournament is running.} set answer [tk_dialog .unsaved "Scid: Confirm Quit" $msg question {} " [tr FileExit] " [tr Cancel]] if {$answer != 0} { return } } compDestroy } proc compDestroy {} { global comp ### there's some ttk bug when destroying widget, but havent found it yet # ttk::combobox seems to need destroying # for {set i 0} {$i < $comp(countcombos)} {incr i} { # must unbind .comp Destroy # destroy .comp.engines.list.$i # } set comp(games) {} set comp(playing) 0 update idletasks destroy .comp } proc compSave {} { global comp global scidConfigDir set comp(fen) {} set filename "" set types { {{Scid Tournament Files} {.sto}} } set filename [tk_getSaveFile -initialdir $scidConfigDir -initialfile $comp(name) -filetypes $types -defaultextension ".sto"] if {$filename != ""} { if { [catch {open $filename w} stofile]} { tk_messageBox -title "Scid: Save Tournament" -type ok -icon warning -message "Unable to write options file:\n$filename" } else { puts $stofile "# Scid comptournament file" puts $stofile "" foreach i [array names comp] { puts $stofile "set comp($i) [list $comp($i)]" } close $stofile } } } ### ### End of file: comp.tcl ### ### from scidvspc analysis.tcl
_______________________________________________ Scidvspc-users mailing list Scidvspc-users@lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/scidvspc-users