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
[email protected]
https://lists.sourceforge.net/lists/listinfo/scidvspc-users
