Scid  4.7.0
correspondence.tcl
Go to the documentation of this file.
1 ###
2 ### Correspondence.tcl: part of Scid.
3 ### Copyright (C) 2008 Alexander Wagner
4 ###
5 ### $Id: correspondence.tcl,v 4.3 2011/02/13 18:12:02 arwagner Exp $
6 ###
7 ### Last change: <Mon, 2014/10/27 19:29:26 arwagner agamemnon>
8 ###
9 ### Add correspondence chess via eMail or external protocol to scid
10 ###
11 #======================================================================
12 
13 # http and tdom are required for the Xfcc protocol
14 
15 #======================================================================
16 #
17 # Xfcc interface for scid
18 #
19 #======================================================================
20 namespace eval Xfcc {
21 
22  #----------------------------------------------------------------------
23  # Header and footer of the SOAP-messages. Linebreaking is important
24  #
25  set SOAPstart {<?xml version="1.0" encoding="utf-8"?>
26  <soap:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
27  <soap:Body>
28  }
29 
30  set SOAPend {</soap:Body>
31  </soap:Envelope>}
32  #
33  #----------------------------------------------------------------------
34 
35  set xfccrc ""
36  set xfccstate {}
37 
38  # list of server names for config dialog
39  set lsrvname {}
40 
41  # when was the last update was retrieved online?
42  set lastupdate 0
43  set update 0
44 
45  array unset xfccsrv
46  # entry values for config dialog
47  set Oldnum 0
48  set Server ""
49  set Username ""
50  set Password ""
51  set URI ""
52 
53  # To pass on directories on windows with a backslash
54  set xfccrcfile ""
55 
56  # Set up a proper user agent
57  # Something like
58  # Scid/3.7 (x11; Linux i686; rv:Devel 2009) Tcl/Tk 8.5.2
59  set useragent "Scid/$::scidVersion ([tk windowingsystem]; $::tcl_platform(os) $::tcl_platform(machine); rv:$scidVersionDate) Tcl/Tk [info patchlevel]"
60 
61  #----------------------------------------------------------------------
62  # Replace XML entities by their normal characters
63  #----------------------------------------------------------------------
64  proc xmldecrypt {chdata} {
65  foreach from {{\&amp;} {\&lt;} {\&gt;} {\&quot;} {\&apos;}} \
66  to {{\&} < > {"} {'}} { ;# '"
67  regsub -all $from $chdata $to chdata
68  }
69  return $chdata
70  }
71 
72  #----------------------------------------------------------------------
73  # Replace normal characters by their XML entities
74  #----------------------------------------------------------------------
75  proc xmlencrypt {chdata} {
76  foreach from {{\&} < > {"} {'}} \
77  to {{\&amp;} {\&lt;} {\&gt;} {\&quot;} {\&apos;}} { ;# '"
78  regsub -all $from $chdata $to chdata
79  }
80  return $chdata
81  }
82 
83  #----------------------------------------------------------------------
84  # Configure Xfcc by means of rewriting the .xfccrc in xml
85  #----------------------------------------------------------------------
86  proc SaveXfcc {} {
87  global ::Xfcc::xfccrc ::Xfcc::xfccrcfile
88  # file delete $xfccrcfile
89  if {[catch {open $xfccrcfile w} optionF]} {
90  puts stderr "$xfccrcfile can not be created"
91  } else {
92  # devide by 4 as the size function returns all subarray entries
93  set size [expr [ array size ::Xfcc::xfccsrv] / 4]
94 
95  puts $optionF "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
96  puts $optionF "<xfcc>"
97  for {set i 0} {$i < $size } {incr i} {
98  if { [regexp {^# } $::Xfcc::xfccsrv($i,0)] && \
99  [regexp {^# } $::Xfcc::xfccsrv($i,1)] && \
100  [regexp {^# } $::Xfcc::xfccsrv($i,2)] && \
101  [regexp {^# } $::Xfcc::xfccsrv($i,3)] } {
102  if {$size == 1} {
103  puts $optionF "\t<server>"
104  puts $optionF "\t\t<name>Server</name>"
105  puts $optionF "\t\t<uri>http://</uri>"
106  puts $optionF "\t\t<user>User_Name</user>"
107  puts $optionF "\t\t<pass>Password</pass>"
108  puts $optionF "\t\t<rating>Rating</rating>"
109  puts $optionF "\t</server>"
110  }
111  } else {
112  set ::Xfcc::xfccsrv($i,0) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,0)]
113  set ::Xfcc::xfccsrv($i,1) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,1)]
114  set ::Xfcc::xfccsrv($i,2) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,2)]
115  set ::Xfcc::xfccsrv($i,3) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,3)]
116  set ::Xfcc::xfccsrv($i,4) [::Xfcc::xmlencrypt $::Xfcc::xfccsrv($i,4)]
117  puts $optionF "\t<server>"
118  puts $optionF "\t\t<name>$::Xfcc::xfccsrv($i,0)</name>"
119  puts $optionF "\t\t<uri>$::Xfcc::xfccsrv($i,1)</uri>"
120  puts $optionF "\t\t<user>$::Xfcc::xfccsrv($i,2)</user>"
121  puts $optionF "\t\t<pass>$::Xfcc::xfccsrv($i,3)</pass>"
122  puts $optionF "\t\t<rating>$::Xfcc::xfccsrv($i,4)</rating>"
123  puts $optionF "\t</server>"
124  }
125  }
126  puts $optionF "</xfcc>"
127  close $optionF
128  ::Xfcc::ReadConfig $xfccrcfile
129  }
130  }
131 
132  #----------------------------------------------------------------------
133  # Delete the currently selected server entry
134  #----------------------------------------------------------------------
135  proc DeleteServer {} {
136  # mark a deleted server by '#' allows the user to manually
137  # undelete again by removing the '#' before hitting ok.
138  set ::Xfcc::Server "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,0)"
139  set ::Xfcc::Username "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,2)"
140  set ::Xfcc::Password "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,3)"
141  set ::Xfcc::Rating "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,4)"
142  set ::Xfcc::URI "# $::Xfcc::xfccsrv($::Xfcc::Oldnum,1)"
143  set ::Xfcc::xfccsrv($::Xfcc::Oldnum) $::Xfcc::Server
144  }
145 
146  #----------------------------------------------------------------------
147  # Add a new, empty server entry to xfccsrv array
148  #----------------------------------------------------------------------
149  proc AddServer {} {
150  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,0) $::Xfcc::Server
151  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,2) $::Xfcc::Username
152  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,3) $::Xfcc::Password
153  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,1) $::Xfcc::URI
154  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,4) $::Xfcc::Rating
155 
156  set size [expr [ array size ::Xfcc::xfccsrv] / 4]
157 
158  # increement the list box with a new server entry
159  .configXfccSrv.xfccSrvList configure -height [expr $size+2]
160 
161  set ::Xfcc::xfccsrv($size,0) "Unique_ServerName"
162  set ::Xfcc::xfccsrv($size,2) "Your_Login"
163  set ::Xfcc::xfccsrv($size,3) "SeCrEt!"
164  set ::Xfcc::xfccsrv($size,4) "Rating"
165  set ::Xfcc::xfccsrv($size,1) "http://"
166 
167  set ::Xfcc::Server $::Xfcc::xfccsrv($size,0)
168  set ::Xfcc::Username $::Xfcc::xfccsrv($size,2)
169  set ::Xfcc::Password $::Xfcc::xfccsrv($size,3)
170  set ::Xfcc::Rating $::Xfcc::xfccsrv($size,4)
171  set ::Xfcc::URI $::Xfcc::xfccsrv($size,1)
172 
173  lappend ::Xfcc::lsrvname [list $::Xfcc::xfccsrv($size,0)]
174 
175  set ::Xfcc::Oldnum $size
176  }
177 
178  #----------------------------------------------------------------------
179  # Store the current values to the xfccsrv-array
180  #----------------------------------------------------------------------
181  proc xfccsrvstore {} {
182  set number [ .configXfccSrv.xfccSrvList curselection]
183  if {!($number > 0)} {
184  set number 0
185  }
186  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,0) $::Xfcc::Server
187  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,2) $::Xfcc::Username
188  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,3) $::Xfcc::Password
189  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,4) $::Xfcc::Rating
190  set ::Xfcc::xfccsrv($::Xfcc::Oldnum,1) $::Xfcc::URI
191 
192  set ::Xfcc::Server $::Xfcc::xfccsrv($number,0)
193  set ::Xfcc::Username $::Xfcc::xfccsrv($number,2)
194  set ::Xfcc::Password $::Xfcc::xfccsrv($number,3)
195  set ::Xfcc::Rating $::Xfcc::xfccsrv($number,4)
196  set ::Xfcc::URI $::Xfcc::xfccsrv($number,1)
197 
198  set ::Xfcc::Oldnum $number
199  .configXfccSrv.xfccSrvList selection set $number
200  }
201 
202  #----------------------------------------------------------------------
203  # Configure Xfcc by means of rewriting the .xfccrc in xml
204  #----------------------------------------------------------------------
205  proc config {configfile} {
206  global ::Xfcc::xfccrc ::Xfcc::xfccrcfile
207 
208  set xfccrcfile $configfile
209 
210  ::Xfcc::ReadConfig $xfccrcfile
211  set size [expr [array size ::Xfcc::xfccsrv] / 4]
212 
213  set w ".configXfccSrv"
214  if {[winfo exists $w]} {
215  focus $w
216  return
217  }
218 
219  set number 1
220  set ::Xfcc::Oldnum 0
221  set ::Xfcc::Server $::Xfcc::xfccsrv($::Xfcc::Oldnum,0)
222  set ::Xfcc::Username $::Xfcc::xfccsrv($::Xfcc::Oldnum,2)
223  set ::Xfcc::Password $::Xfcc::xfccsrv($::Xfcc::Oldnum,3)
224  set ::Xfcc::Rating $::Xfcc::xfccsrv($::Xfcc::Oldnum,4)
225  set ::Xfcc::URI $::Xfcc::xfccsrv($::Xfcc::Oldnum,1)
226  set ::Xfcc::showPass 0
227 
228  # create the window and buttons
229  win::createDialog $w
230  wm title $w "\[$xfccrcfile\]"
231 
232  ttk::frame $w.buttons
233  ttk::button $w.bOk -text OK -command "::Xfcc::xfccsrvstore; ::Xfcc::SaveXfcc; destroy .configXfccSrv"
234  ttk::button $w.bAdd -text [::tr "GlistAddField"] -command {
235  ::Xfcc::AddServer
236  }
237 
238  ttk::button $w.bDelete -text [::tr "GlistDeleteField"] -command {
239  ::Xfcc::DeleteServer
240  }
241  ttk::button $w.bCancel -text [::tr "Cancel"] -command "destroy $w"
242  grid $w.bAdd -in $w.buttons -row 0 -column 0 -pady "5 0" -sticky nw
243  grid $w.bDelete -in $w.buttons -row 0 -column 1 -padx "10 0" -pady "5 0" -sticky nw
244  grid $w.bOk -in $w.buttons -row 0 -column 3 -padx 5 -pady "15 5"
245  grid $w.bCancel -in $w.buttons -row 0 -column 4 -padx 5 -pady "15 5"
246  grid columnconfigure $w.buttons 2 -weight 1
247 
248  listbox $w.xfccSrvList -height [expr [ array size ::Xfcc::xfccsrv] / 4 + 1] -width 60 -selectmode single -list ::Xfcc::lsrvname
249  # select the first entry
250  $w.xfccSrvList selection set $::Xfcc::Oldnum
251 
252  ttk::label $w.lxfccSrv -text [::tr CCDlgServerName]
253  ttk::label $w.lxfccUid -text [::tr CCDlgLoginName]
254  ttk::label $w.lxfccPas -text [::tr CCDlgPassword]
255  ttk::checkbutton $w.showPass -text [::tr CCDlgShowPassword] -variable ::Xfcc::showPass -command {
256  if {$::Xfcc::showPass} {
257  .configXfccSrv.xfccPas configure -show {}
258  } else {
259  .configXfccSrv.xfccPas configure -show *
260  }
261  }
262  ttk::label $w.lxfccURI -text [::tr CCDlgURL]
263  ttk::label $w.lxfccrtype -text [::tr CCDlgRatingType]
264 
265  ttk::entry .configXfccSrv.xfccSrv -width 60 -textvariable ::Xfcc::Server
266  ttk::entry .configXfccSrv.xfccUid -width 60 -textvariable ::Xfcc::Username
267  ttk::entry .configXfccSrv.xfccPas -width 60 -textvariable ::Xfcc::Password -show *
268  ttk::entry .configXfccSrv.xfccURI -width 60 -textvariable ::Xfcc::URI
269 
270  if {$::tcl_version >= 8.5} {
271  ttk::combobox .configXfccSrv.xfccrtype -values [sc_info ratings] -width 7 -textvariable ::Xfcc::Rating
272  } else {
273  eval tk_optionMenu .configXfccSrv.xfccrtype ::Xfcc::Rating [sc_info ratings]
274  .configXfccSrv.xfccrtype configure -indicatoron 0 -width 7 -takefocus 1
275  }
276 
277  # Bind the change of selection to a proper update of variables
278  # and internal representation
279  bind .configXfccSrv.xfccSrvList <<ListboxSelect>> {
280  ::Xfcc::xfccsrvstore
281  }
282 
283  grid $w.xfccSrvList -sticky e -columnspan 6 -column 0 -row 0 -rowspan $number
284 
285  grid $w.lxfccSrv -sticky e -columnspan 2 -column 0 -row [expr {$number + 1}]
286  grid $w.lxfccUid -sticky e -columnspan 2 -column 0 -row [expr {$number + 2}]
287  grid $w.lxfccPas -sticky e -columnspan 2 -column 0 -row [expr {$number + 3}]
288  grid $w.showPass -sticky w -columnspan 4 -column 2 -row [expr {$number + 4}]
289  grid $w.lxfccURI -sticky e -columnspan 2 -column 0 -row [expr {$number + 5}]
290  grid $w.lxfccrtype -sticky e -columnspan 2 -column 0 -row [expr {$number + 6}]
291 
292  grid $w.xfccSrv -sticky w -columnspan 4 -column 2 -row [expr {$number + 1}]
293  grid $w.xfccUid -sticky w -columnspan 4 -column 2 -row [expr {$number + 2}]
294  grid $w.xfccPas -sticky w -columnspan 4 -column 2 -row [expr {$number + 3}]
295  grid $w.xfccURI -sticky w -columnspan 4 -column 2 -row [expr {$number + 5}]
296  grid $w.xfccrtype -sticky w -columnspan 4 -column 2 -row [expr {$number + 6}]
297 
298  # Add the buttons to the window
299  grid $w.buttons -sticky news -columnspan 6 -column 0 -row [expr {$number + 7}]
300 
301  bind $w <Escape> "$w.bCancel invoke"
302  bind $w <F1> { helpWindow CCXfccSetupDialog}
303  }
304 
305  #----------------------------------------------------------------------
306  # Read xfccrcfile (xml) config file and stores the xml structure as
307  # is to the global $xfccrc
308  #----------------------------------------------------------------------
309  proc ReadConfig {xfccrcfile} {
310  global xfccrc
311 
312  ::CorrespondenceChess::updateConsole "info This is Scid's internal Xfcc-interface"
313  ::CorrespondenceChess::updateConsole "info Using $xfccrcfile..."
314  if {[catch {open $xfccrcfile r} optionF]} {
315  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open config file $xfccrcfile";
316  } else {
317  set xfccrc [read $optionF]
318 
319  set dom [dom parse $xfccrc]
320  set doc [$dom documentElement]
321  set aNodes [$doc selectNodes {/xfcc/server}]
322  set number 0
323 
324  # reset the servernames before reading them in again
325  set ::Xfcc::lsrvname {}
326 
327  foreach srv $aNodes {
328  set name [$srv selectNodes {string(name)}]
329  set uri [$srv selectNodes {string(uri)}]
330  set username [$srv selectNodes {string(user)}]
331  set password [$srv selectNodes {string(pass)}]
332  set rating [$srv selectNodes {string(rating)}]
333 
334  set ::Xfcc::xfccsrv($number,0) $name
335  set ::Xfcc::xfccsrv($number,1) $uri
336  set ::Xfcc::xfccsrv($number,2) $username
337  set ::Xfcc::xfccsrv($number,3) $password
338  set ::Xfcc::xfccsrv($number,4) $rating
339 
340  lappend ::Xfcc::lsrvname [list $name]
341 
342  incr number
343  }
344  close $optionF
345  }
346  }
347 
348  #----------------------------------------------------------------------
349  # SOAPError: parses $xml and searches for error messages from the
350  # server to report them to the user.
351  #----------------------------------------------------------------------
352  proc SOAPError {server xml} {
353  # Remove the SOAP-Envelope and make all server responses to a
354  # common XML format as they use the same error messages anyway.
355  regsub -all {.*<soap:Fault>} $xml {<error>} xml
356  regsub -all {</soap:Fault>.*} $xml {</error>} xml
357 
358  regsub -all {.*<MakeAMoveResponse.*\">} $xml {<error>} xml
359  regsub -all {</MakeAMoveResponse>.*} $xml {</error>} xml
360  regsub -all {<MakeAMoveResult>} $xml {<faultstring>} xml
361  regsub -all {</MakeAMoveResult>} $xml {</faultstring>} xml
362 
363  set dom [dom parse $xml]
364  set doc [$dom documentElement]
365 
366  set aNodes [$doc selectNodes //error]
367  foreach game $aNodes {
368  set fcode [$game selectNodes {string(faultcode)}]
369  set fstring [$game selectNodes {string(faultstring)}]
370  switch -regexp -- $fstring \
371  "Success" {
372  ::CorrespondenceChess::updateConsole "info Processing successfull!"
373  } \
374  "ServerError" {
375  ::CorrespondenceChess::updateConsole "info Server Error!"
376  set Title "Scid Error"
377  set Error "$server reported an unknown error."
378  tk_messageBox -icon warning -type ok -parent . \
379  -title $Title -message $Error
380  } \
381  "FeatureUnavailable" {
382  ::CorrespondenceChess::updateConsole "info Feature unavailable!"
383  } \
384  "AuthenticationFailed" {
385  ::CorrespondenceChess::updateConsole "info Authentication failed!"
386  set Title "Scid Authentication Failure!"
387  set Error "Could not authenticate to the Xfcc-Server.\nPlease check Username and Password for $server."
388  tk_messageBox -icon warning -type ok -parent . \
389  -title $Title -message $Error
390  } \
391  "InvalidGameID" {
392  ::CorrespondenceChess::updateConsole "info Invalid Game-ID!"
393  } \
394  "NotYourGame" {
395  ::CorrespondenceChess::updateConsole "info Not your game!"
396  } \
397  "NotYourTurn" {
398  ::CorrespondenceChess::updateConsole "info Not your turn!"
399  } \
400  "InvalidMove" {
401  ::CorrespondenceChess::updateConsole "info Invalid move!"
402  } \
403  "InvalidMoveNumber" {
404  ::CorrespondenceChess::updateConsole "info Invalid move number!"
405  } \
406  "NoDrawWasOffered" {
407  ::CorrespondenceChess::updateConsole "info No draw was offered!"
408  } \
409  "LostOnTime" {
410  ::CorrespondenceChess::updateConsole "info Lost on time!"
411  } \
412  "YouAreOnLeave" {
413  ::CorrespondenceChess::updateConsole "info You are on leave!"
414  } \
415  "MoveIsAmbigous" {
416  ::CorrespondenceChess::updateConsole "info Move is ambigous!"
417  }
418  }
419  }
420 
421  #----------------------------------------------------------------------
422  # Process all servers found in the global xfccrc and store the
423  # games in path/.
424  #----------------------------------------------------------------------
425  proc ProcessAll {path} {
426  global xfccrc
427 
428  # empty the state array
429  set ::Xfcc::xfccstate {}
430 
431  set dom [dom parse $xfccrc]
432  set doc [$dom documentElement]
433 
434  set aNodes [$doc selectNodes {/xfcc/server}]
435 
436  foreach srv $aNodes {
437  set name [::Xfcc::xmlencrypt [$srv selectNodes {string(name)}]]
438  set uri [::Xfcc::xmlencrypt [$srv selectNodes {string(uri)}]]
439  set username [::Xfcc::xmlencrypt [$srv selectNodes {string(user)}]]
440  set password [::Xfcc::xmlencrypt [$srv selectNodes {string(pass)}]]
441  set rating [$srv selectNodes {string(rating)}]
442 
443  if {$rating == ""} {
444  set rating "ICCF"
445  }
446 
447  ::CorrespondenceChess::updateConsole "info Processing $username\@$name..."
448  set xml [::Xfcc::Receive $uri $username $password]
449  ::Xfcc::SOAPError $name $xml
450  ::Xfcc::WritePGN $path $name $rating $xml
451  ::Xfcc::PrintStatus $path $name $xml
452  }
453  }
454 
455  #----------------------------------------------------------------------
456  # Receive games via XFCC from the web service at uri using username
457  # and password provided
458  #----------------------------------------------------------------------
459  proc Receive {uri username password} {
460  # construct the SOAP-message for Xfcc Webservice
461  set xmlmessage $::Xfcc::SOAPstart
462  # generate the "Get my Games" call
463  append xmlmessage {<GetMyGames xmlns="http://www.bennedik.com/webservices/XfccBasic">}
464  append xmlmessage "<username>$username</username>"
465  append xmlmessage "<password>$password</password>"
466  append xmlmessage "</GetMyGames>"
467  append xmlmessage $::Xfcc::SOAPend
468 
469  # send it to the web service note the space before the charset
470  set token [::http::geturl $uri \
471  -type "text/xml; charset=\"utf-8\"" \
472  -query $xmlmessage]
473 
474  # retrieve result
475  set xmlresult [::http::data $token]
476  ::http::cleanup $token
477 
478  ###---###
479  # if {[catch {open "/tmp/xfcc.xml" w} dbg]} {
480  # ::CorrespondenceChess::updateConsole "info ERROR: Unable to open debug file";
481  # } else {
482  # puts $dbg $xmlresult
483  # }
484  # close $dbg
485  ###---###
486 
487  return $xmlresult
488  }
489 
490  #----------------------------------------------------------------------
491  # Send move via XFCC to the web service at uri using username
492  # and password provided. Gameid is the unique id on the server,
493  # move count the current move number, move the move to send in SAN,
494  # comment the comment sent to the opponent. The other variables are
495  # flags that might be true/false.
496  #----------------------------------------------------------------------
497  proc SendMove {uri username password gameid movecount move comment \
498  resign acceptdraw offerdraw claimdraw} {
499 
500  # Encrypt textual entities to conform to XML
501  set uri [::Xfcc::xmlencrypt $uri]
502  set username [::Xfcc::xmlencrypt $username]
503  set password [::Xfcc::xmlencrypt $password]
504  set comment [::Xfcc::xmlencrypt $comment]
505 
506  set xmlmessage $::Xfcc::SOAPstart
507  append xmlmessage {<MakeAMove xmlns="http://www.bennedik.com/webservices/XfccBasic">}
508  append xmlmessage "<username>$username</username>"
509  append xmlmessage "<password>$password</password>"
510  append xmlmessage "<gameId>$gameid</gameId>"
511  append xmlmessage "<resign>$resign</resign>"
512  append xmlmessage "<acceptDraw>$acceptdraw</acceptDraw>"
513  append xmlmessage "<movecount>$movecount</movecount>"
514  append xmlmessage "<myMove>$move</myMove>"
515  append xmlmessage "<offerDraw>$offerdraw</offerDraw>"
516  append xmlmessage "<claimDraw>$claimdraw</claimDraw>"
517  append xmlmessage "<myMessage>$comment</myMessage>"
518  append xmlmessage "</MakeAMove>"
519  append xmlmessage $::Xfcc::SOAPend
520 
521  # if {[catch {open "/tmp/send.xml" w} debug]} {
522  # ::CorrespondenceChess::updateConsole "info unable to open debug file..."
523  # } else {
524  # puts $debug $xmlmessage
525  # }
526  # close $debug
527 
528  # send it to the web service note the space before the charset
529  set token [::http::geturl $uri \
530  -type "text/xml; charset=\"utf-8\"" \
531  -query $xmlmessage]
532 
533  # retrieve result
534  set xmlresult [::http::data $token]
535  ::http::cleanup $token
536  return $xmlresult
537  }
538 
539  #----------------------------------------------------------------------
540  # Send move to server, extracting login data first from config file
541  #----------------------------------------------------------------------
542  proc Send {name gameid movecount move comment \
543  resign acceptdraw offerdraw claimdraw} {
544  global xfccrc
545 
546  set dom [dom parse $xfccrc]
547  set doc [$dom documentElement]
548 
549  set aNodes [$doc selectNodes {/xfcc/server}]
550 
551  foreach srv $aNodes {
552  set server [$srv selectNodes {string(name)}]
553  set uri [$srv selectNodes {string(uri)}]
554  set username [$srv selectNodes {string(user)}]
555  set password [$srv selectNodes {string(pass)}]
556 
557  if {$name == $server} {
558  ::CorrespondenceChess::updateConsole "info Processing $gameid for $username\@$name..."
559  ::CorrespondenceChess::updateConsole "info Sending $movecount\. $move \{$comment\}"
560 
561  if {$resign == "true"} {
562  ::CorrespondenceChess::updateConsole "info Resigning..."
563  }
564  if {$acceptdraw == "true"} {
565  ::CorrespondenceChess::updateConsole "info Accepting draw..."
566  }
567  if {$claimdraw == "true"} {
568  ::CorrespondenceChess::updateConsole "info Claiming draw..."
569  }
570  if {$offerdraw == "true"} {
571  ::CorrespondenceChess::updateConsole "info Offering draw..."
572  }
573 
574  set xml [::Xfcc::SendMove $uri $username $password \
575  $gameid $movecount $move $comment \
576  $resign $acceptdraw $offerdraw $claimdraw]
577  ::Xfcc::SOAPError $name $xml
578 
579  # if {[catch {open "/tmp/answer.xml" w} debug]} {
580  # ::CorrespondenceChess::updateConsole "info unable to open debug file..."
581  # } else {
582  # puts $debug $xml
583  # }
584  # close $debug
585  }
586  }
587  }
588 
589  #----------------------------------------------------------------------
590  # Given the name of the Xfcc-Server and the XML-result from the web
591  # server a PGN file with a single game is written. name is the name
592  # of the server used for generation of the CmailGameID, xml is the
593  # result from the web service. rating contains the string that
594  # should be used to specify the rating system. It could be
595  # something like Rating, Elo, ICCF, USCF, BCF etc. like usual in
596  # Scid
597  #----------------------------------------------------------------------
598  proc WritePGN {path name rating xml} {
599  # The following removes the SOAP-Envelope. tDOM does not seem to
600  # like it for whatever reason, but it's not needed anyway.
601  regsub -all {.*<GetMyGamesResult>} $xml {<GetMyGamesResult>} xml
602  regsub -all {</GetMyGamesResult>.*} $xml {</GetMyGamesResult>} xml
603 
604  set dom [dom parse $xml]
605  set doc [$dom documentElement]
606 
607  set aNodes [$doc selectNodes //XfccGame]
608  foreach game $aNodes {
609 
610  set id [::Xfcc::xmldecrypt [$game selectNodes {string(id)}]]
611  set Event [::Xfcc::xmldecrypt [$game selectNodes {string(event)}]]
612  set Site [::Xfcc::xmldecrypt [$game selectNodes {string(site)}]]
613  set Date [::Xfcc::xmldecrypt [$game selectNodes {string(eventDate)}]]
614  set White [::Xfcc::xmldecrypt [$game selectNodes {string(white)}]]
615  set Black [::Xfcc::xmldecrypt [$game selectNodes {string(black)}]]
616  set WhiteElo [::Xfcc::xmldecrypt [$game selectNodes {string(whiteElo)}]]
617  set BlackElo [::Xfcc::xmldecrypt [$game selectNodes {string(blackElo)}]]
618  set TimeControl [::Xfcc::xmldecrypt [$game selectNodes {string(timeControl)}]]
619  set GameId [::Xfcc::xmldecrypt [$game selectNodes {string(id)}]]
620  set Source [::Xfcc::xmldecrypt [$game selectNodes {string(gameLink)}]]
621  set Round [::Xfcc::xmldecrypt [$game selectNodes {string(round)}]]
622  set Result [::Xfcc::xmldecrypt [$game selectNodes {string(result)}]]
623  set drawOffered [::Xfcc::xmldecrypt [$game selectNodes {string(drawOffered)}]]
624  set setup [::Xfcc::xmldecrypt [$game selectNodes {string(setup)}]]
625  set fen [::Xfcc::xmldecrypt [$game selectNodes {string(fen)}]]
626  set myTurn [$game selectNodes {string(myTurn)}]
627  set moves [::Xfcc::xmldecrypt [$game selectNodes {string(moves)}]]
628  set mess [::Xfcc::xmldecrypt [$game selectNodes {string(message)}]]
629 
630  # These values may not be set, they were first introduced by
631  # SchemingMind as extension to Xfcc. If uppercase settings
632  # (usual default) exist: use them and they should take
633  # precedence. Note that the PNG header should use upper case
634  # by convention
635  set whiteCountry [::Xfcc::xmldecrypt [$game selectNodes {string(WhiteCountry)}]]
636  set blackCountry [::Xfcc::xmldecrypt [$game selectNodes {string(BlackCountry)}]]
637  set whiteIccfID [::Xfcc::xmldecrypt [$game selectNodes {string(WhiteIccfID)}]]
638  set blackIccfID [::Xfcc::xmldecrypt [$game selectNodes {string(BlackIccfID)}]]
639  set whiteFideID [::Xfcc::xmldecrypt [$game selectNodes {string(WhiteFideID)}]]
640  set blackFideID [::Xfcc::xmldecrypt [$game selectNodes {string(BlackFideID)}]]
641  set WhiteNA [::Xfcc::xmldecrypt [$game selectNodes {string(WhiteNA)}]]
642  set BlackNA [::Xfcc::xmldecrypt [$game selectNodes {string(BlackNA)}]]
643 
644  if {$whiteCountry == ""} {
645  set whiteCountry [::Xfcc::xmldecrypt [$game selectNodes {string(whiteCountry)}]]
646  }
647  if {$whiteIccfID == ""} {
648  set whiteIccfID [::Xfcc::xmldecrypt [$game selectNodes {string(whiteIccfID)}]]
649  }
650  if {$whiteFideID == ""} {
651  set whiteFideID [::Xfcc::xmldecrypt [$game selectNodes {string(whiteFideID)}]]
652  }
653  if {$blackCountry == ""} {
654  set blackCountry [::Xfcc::xmldecrypt [$game selectNodes {string(blackCountry)}]]
655  }
656  if {$blackIccfID == ""} {
657  set blackIccfID [::Xfcc::xmldecrypt [$game selectNodes {string(blackIccfID)}]]
658  }
659  if {$blackFideID == ""} {
660  set blackFideID [::Xfcc::xmldecrypt [$game selectNodes {string(blackFideID)}]]
661  }
662  # White/BlackNA are normally left blank but if the user
663  # allwos contain the mail addresses of the player
664  if {$WhiteNA == ""} {
665  set WhiteNA [::Xfcc::xmldecrypt [$game selectNodes {string(whiteNA)}]]
666  }
667  if {$BlackNA == ""} {
668  set BlackNA [::Xfcc::xmldecrypt [$game selectNodes {string(blackNA)}]]
669  }
670  if {$WhiteNA == ""} {
671  set WhiteNA "white@unknown.org"
672  }
673  if {$BlackNA == ""} {
674  set BlackNA "black@unknown.org"
675  }
676 
677 
678  # get the variant as scid can not handle many of them.
679  # a list of all possible tags can be found here:
680  # http://wiki.schemingmind.com/PGNVariantValues
681  # http://wiki.schemingmind.com/Variants
682  set variant [$game selectNodes {string(variant)}]
683 
684  set filename [file nativename [file join $path "$name-$id.pgn"]]
685  file delete $filename
686 
687  # Drop games that are not "normal" chess as scid can not
688  # handle variants. Note that the ICCF does not set the
689  # variant flag. Additionally, it is enough to drop variant
690  # games from the inbox to get proper playlists.
691  if { ($Result == "Cancelled") } {
692  ::CorrespondenceChess::updateConsole "info $name-$id was cancelled...";
693  } elseif {($variant == "chess") || ($variant == "") || ($variant == "randompieces") || ($variant == "upsidedown") || ($variant == "loosers") || ($variant == "nocastle")} {
694  ### --- Istvan --- ###
695  ### Racing Kings is not possible due to unambiguous moves
696  ### that are ambiguous if check is allowed
697  ### ($variant == "racingkings") ||
698  ### --- Istvan --- ###
699 
700  if {[catch {open $filename w} pgnF]} {
701  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open config file $filename";
702  } else {
703  ::CorrespondenceChess::updateConsole "info $name-$id..."
704  puts $pgnF "\[Event \"$Event\"\]";
705  puts $pgnF "\[Site \"$Site\"\]";
706  puts $pgnF "\[Date \"$Date\"\]";
707  puts $pgnF "\[Round \"$Round\"\]";
708  puts $pgnF "\[White \"$White\"\]";
709  puts $pgnF "\[Black \"$Black\"\]";
710  puts $pgnF "\[White$rating \"$WhiteElo\"\]";
711  puts $pgnF "\[Black$rating \"$BlackElo\"\]";
712  puts $pgnF "\[TimeControl \"$TimeControl\"\]";
713  puts $pgnF "\[GameId \"$GameId\"\]";
714  puts $pgnF "\[Source \"$Source\"\]";
715  puts $pgnF "\[WhiteNA \"$WhiteNA\"]";
716  puts $pgnF "\[BlackNA \"$BlackNA\"]";
717  puts $pgnF "\[Mode \"XFCC\"\]";
718  puts $pgnF "\[CmailGameName \"$name-$id\"\]";
719 
720  if {$whiteCountry != ""} {
721  puts $pgnF "\[WhiteCountry \"$whiteCountry\"\]";
722  }
723  if {$blackCountry != ""} {
724  puts $pgnF "\[BlackCountry \"$blackCountry\"\]";
725  }
726  if {$whiteIccfID > 0} {
727  puts $pgnF "\[WhiteIccfID \"$whiteIccfID\"\]";
728  }
729  if {$blackIccfID > 0} {
730  puts $pgnF "\[BlackIccfID \"$blackIccfID\"\]";
731  }
732  if {$whiteFideID > 0} {
733  puts $pgnF "\[WhiteFideID \"$whiteFideID\"\]";
734  }
735  if {$blackFideID > 0} {
736  puts $pgnF "\[BlackFideID \"$blackFideID\"\]";
737  }
738  if {$setup == "true"} {
739  puts $pgnF "\[FEN \"$fen\"\]";
740  }
741 
742  # add result to the header
743  # Adjudication is handled like normal game results, that
744  # is WhiteWins == WhiteWinAdjudicated etc.
745  switch -regexp -- $Result \
746  "Ongoing" {
747  puts $pgnF "\[Result \"*\"\]\n";
748  } \
749  "AdjudicationPending" {
750  puts $pgnF "\[Result \"*\"\]\n";
751  } \
752  "WhiteWin*" {
753  puts $pgnF "\[Result \"1-0\"\]\n";
754  } \
755  "BlackWin*" {
756  puts $pgnF "\[Result \"0-1\"\]\n";
757  } \
758  "Draw*" {
759  puts $pgnF "\[Result \"1/2-1/2\"\]\n";
760  } \
761  "WhiteDefaulted" {
762  puts $pgnF "\[Result \"0-1\"\]\n";
763  } \
764  "BlackDefaulted" {
765  puts $pgnF "\[Result \"1-0\"\]\n";
766  } \
767  "BothDefaulted" {
768  puts $pgnF "\[Result \"1/2-1/2\"\]\n";
769  } \
770  default {
771  puts $pgnF "\[Result \"$Result\"\]\n";
772  }
773 
774  # Add the game-id as comment before starting the game.
775  # This might be helpful on certain mobile devices, that
776  # can not deal with extensive header information, e.g.
777  # OpenChess on PalmOS.
778  puts $pgnF "{$name-$id}"
779  puts $pgnF $moves
780 
781  # If the PGN already ends with a comment, do not place
782  # the message string afterwards as scid will then
783  # discard the comment in the movelist.
784  if {[string range $moves end end] != "\}"} {
785  if {($myTurn == "true") && ($mess != "")} {
786  puts -nonewline $pgnF "\{"
787  puts -nonewline $pgnF $mess
788  puts $pgnF "\}"
789  }
790  }
791  # If a game has finished and a message is sent always
792  # add it here.
793  if {($Result != "Ongoing") && ($mess != "")} {
794  puts -nonewline $pgnF "\{"
795  puts -nonewline $pgnF $mess
796  puts $pgnF "\}"
797  }
798 
799  # add result at the end
800  switch -regexp -- $Result \
801  "Ongoing" {
802  puts $pgnF "*";
803  } \
804  "AdjudicationPending" {
805  puts $pgnF "*";
806  } \
807  "WhiteWin*" {
808  puts $pgnF "1-0\n";
809  }\
810  "BlackWin*" {
811  puts $pgnF "0-1\n";
812  }\
813  "Draw*" {
814  puts $pgnF "1/2-1/2\n";
815  } \
816  "WhiteDefaulted" {
817  puts $pgnF "\{White Defaulted\} 0-1\n";
818  }\
819  "BlackDefaulted" {
820  puts $pgnF "\{Black Defaulted\} 1-0\n";
821  }\
822  "BothDefaulted" {
823  puts $pgnF "\{Both Defaulted\} 1/2-1/2\n";
824  }
825  close $pgnF
826  }
827  }
828  }
829  }
830 
831  #----------------------------------------------------------------------
832  # Prints all status flags of the games in xml for server name.
833  #----------------------------------------------------------------------
834  proc PrintStatus {path name xml} {
835  regsub -all {.*<GetMyGamesResult>} $xml {<GetMyGamesResult>} xml
836  regsub -all {</GetMyGamesResult>.*} $xml {</GetMyGamesResult>} xml
837 
838  set dom [dom parse $xml]
839  set doc [$dom documentElement]
840 
841  set aNodes [$doc selectNodes //XfccGame]
842  foreach game $aNodes {
843  set id [$game selectNodes {string(id)}]
844  set myTurn [$game selectNodes {string(myTurn)}]
845  set daysPlayer [$game selectNodes {string(daysPlayer)}]
846  set hoursPlayer [$game selectNodes {string(hoursPlayer)}]
847  set minutesPlayer [$game selectNodes {string(minutesPlayer)}]
848  set daysOpponent [$game selectNodes {string(daysOpponent)}]
849  set hoursOpponent [$game selectNodes {string(hoursOpponent)}]
850  set minutesOpponent [$game selectNodes {string(minutesOpponent)}]
851  set drawOffered [$game selectNodes {string(drawOffered)}]
852  set setup [$game selectNodes {string(setup)}]
853  set fen [$game selectNodes {string(fen)}]
854  set variant [$game selectNodes {string(variant)}]
855  set noOpeningBooks [$game selectNodes {string(noOpeningBooks)}]
856  set noDatabases [$game selectNodes {string(noDatabases)}]
857  set noTablebases [$game selectNodes {string(noTablebases)}]
858  set noEngines [$game selectNodes {string(noEngines)}]
859  set Result [$game selectNodes {string(result)}]
860  set TimeControl [$game selectNodes {string(timeControl)}]
861  set mess [::Xfcc::xmldecrypt [$game selectNodes {string(message)}]]
862  set serverinfo [::Xfcc::xmldecrypt [$game selectNodes {string(serverInfo)}]]
863 
864  # Set to official ICCF timing by default
865  # as ICCF does not send TimeControl
866  set TC "10/50d (?)"
867  if { [regexp {\+} $TimeControl] } {
868  set TC [split $TimeControl "+"]
869  set gametime [ expr {[lindex $TC 0] / 86400}]
870  set increment [ expr {[lindex $TC 1] / 86400}]
871 
872  set TC $gametime
873  append TC "d + "
874  append TC $increment
875  append TC "d (Fischer)"
876  } elseif { [regexp {\/} $TimeControl] } {
877  set TC [split $TimeControl "/"]
878  set moves [ expr {[lindex $TC 0]}]
879  set days [ expr {[lindex $TC 1] / 86400 }]
880  set TC $moves
881  append TC " / "
882  append TC $days
883  append TC "d"
884  # 10/50 is the official timing for ICCF
885  if { ($moves == 10) && ($days == 50) } {
886  set TC "$TC (ICCF)"
887  }
888  }
889 
890  set mytime [expr $daysPlayer*24*60+$hoursPlayer*60+$minutesPlayer]
891  set opptime [expr $daysOpponent*24*60+$hoursOpponent*60+$minutesOpponent]
892 
893  if {[$game selectNodes {string(hasWhite)}] == "true"} {
894  set clockW [format "%2ud %2u:%2u" $daysPlayer $hoursPlayer $minutesPlayer]
895  set clockB [format "%2ud %2u:%2u" $daysOpponent $hoursOpponent $minutesOpponent]
896  } else {
897  set clockB [format "%2ud %2u:%2u" $daysPlayer $hoursPlayer $minutesPlayer]
898  set clockW [format "%2ud %2u:%2u" $daysOpponent $hoursOpponent $minutesOpponent]
899  }
900  lappend ::Xfcc::xfccstate [list \
901  "$name-$id" \
902  [list "myTurn" $myTurn] \
903  [list "clockW" $clockW] \
904  [list "clockB" $clockB] \
905  [list "drawOffered" $drawOffered]\
906  [list "setup" $setup] \
907  [list "fen" $fen] \
908  [list "variant" $variant] \
909  [list "noOpeningBooks" $noOpeningBooks] \
910  [list "noTablebases" $noTablebases] \
911  [list "noDatabases" $noDatabases] \
912  [list "noEngines" $noEngines] \
913  [list "result" $Result] \
914  [list "TimeControl" $TC] \
915  [list "message" $mess] \
916  [list "mytime" $mytime] \
917  [list "opptime" $opptime] \
918  [list "serverInfo" $serverinfo]]
919  }
920 
921  set filename [scidConfigFile xfccstate]
922  file delete $filename
923 
924  if {[catch {open $filename w} stateF]} {
925  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open state file $filename";
926  } else {
927  puts $stateF "# Scid options file"
928  puts $stateF "# State file for correspondence chess"
929  puts $stateF "# Version: $::scidVersion, $::scidVersionDate"
930  puts $stateF "# This file is generated automatically. Do NOT edit."
931 
932  set ::Xfcc::update 1
933  set ::Xfcc::lastupdate [clock seconds]
934  set curtime [clock format $::Xfcc::lastupdate]
935  puts $stateF "#"
936  puts $stateF "# Last Update: $curtime"
937  puts $stateF "#"
938  foreach i { ::Xfcc::lastupdate \
939  ::Xfcc::xfccstate } {
940  puts $stateF "set $i [list [set $i]]"
941  }
942  }
943  close $stateF
944  }
945 
946  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
947  # source the options file to overwrite the above setup
948  if {[catch {source [scidConfigFile xfccstate]}]} {
949  } else {
950  ::splash::add "Xfcc state found and restored."
951  }
952 
953 }
954 
955 #======================================================================
956 #
957 # Correspondence chess menus, dialogs and functions
958 #
959 #======================================================================
960 
961 #----------------------------------------------------------------------
962 # Correspnodence Chess functions
963 namespace eval CorrespondenceChess {
964 
965  # whether the console is already open or not
966  set isOpen 0
967 
968  # default Database
969  set CorrBase [file nativename [file join $scidDataDir "Correspondence.si4"]]
970 
971  # incoming PGN files
972  set Inbox [file nativename [file join $scidDataDir "Inbox"]]
973  # outgoing PGN files
974  set Outbox [file nativename [file join $scidDataDir "Outbox"]]
975 
976  # Connector config for game relay
977  set Connector [file nativename [file join $scidDataDir "connector.xml"]]
978 
979  # use internal xfcc-support
980  set XfccInternal 1
981  set xfccrcfile [file nativename [file join $scidConfigDir "xfccrc"]]
982 
983  # Path for additional functions that should be available in the CC
984  # window only. All files from here are sourced once the CC window
985  # starts up.
986  set PluginPath [file nativename [file join $scidDataDir "Plugins/Correspondence"]]
987 
988  # external fetch tool (eg. Xfcc)
989  set XfccFetchcmd "./Xfcc-Receive.pl"
990  # external send tool (eg. Xfcc)
991  set XfccSendcmd "./Xfcc-Send.pl"
992 
993  # confirm before sending moves?
994  set XfccConfirm 1
995 
996  # Relay games from ICCF: this list contains all MakeAMove-URLs for
997  # the games to be relayed
998  set RelayGames {}
999 
1000  # Show only games where the player has the move?
1001  set ListOnlyOwnMove 0
1002  # set sortoptlist [list "Site, Event, Round, Result, White, Black" "My Time" "Time per Move" "Opponent Time"]
1003 
1004  # Sort criteria to use
1005  set CCOrderClassic 0
1006  set CCOrderMyTime 1
1007  set CCOrderTimePerMove 2
1008  set CCOrderStartDate 3
1009  set CCOrderOppTime 4
1010 
1011  # Which to use
1012  set ListOrder $CCOrderClassic
1013 
1014  # email-programm capable of SMTP auth and attachments
1015  set mailer "/usr/bin/nail"
1016  # mail a bcc of the outgoing mails to this address
1017  set bccaddr ""
1018  # mailermode might be: mailx, mozilla, claws or mailurl
1019  set mailermode "mailx"
1020  # parameter for attaching a file
1021  set attache "-a"
1022  # parameter for the subject line
1023  set subject "-s"
1024 
1025  set CorrSlot -1
1026 
1027  # current number in game list
1028  set num 0
1029 
1030  # Content of CC windows games list
1031  set clipboardText ""
1032 
1033  set glccstart 1
1034  set glgames 0
1035 
1036  #----------------------------------------------------------------------
1037  # Fetch a file via http
1038  #----------------------------------------------------------------------
1039  proc getPage { url } {
1040  set token [::http::geturl $url]
1041  set data [::http::data $token]
1042  ::http::cleanup $token
1043  return $data
1044  }
1045 
1046  #----------------------------------------------------------------------
1047  # Open a File select dialog and returns the file selected
1048  # $i: title text after "Scid Correspondence Chess: Select "
1049  # $filespecs: the specs of the file (currently ignored)
1050  #----------------------------------------------------------------------
1051  proc chooseFile {i filespecs} {
1052  set idir [pwd]
1053  set fullname [tk_getOpenFile -initialdir $idir -title "Scid Correspondence Chess: Select $i"]
1054  if {$fullname == ""} { return}
1055  return $fullname
1056  }
1057 
1058  #----------------------------------------------------------------------
1059  # Set the default correspondence base to the file selected.
1060  # Open Database works on that file, but in principle every other
1061  # DB of the type "Correspondence" can be used by just loading by
1062  # hand before using the CC features.
1063  #----------------------------------------------------------------------
1064  proc chooseCorrBase {} {
1065  global ::CorrespondenceChess::CorrBase
1066 
1067  set filetype { "Scid databases" {".si4" ".si"} }
1068  set CorrBase [chooseFile "default correspondence chess DB..." $filetype]
1069  }
1070 
1071  #----------------------------------------------------------------------
1072  # Choose the path where to fetch Xfcc-games to. All pgn-files in
1073  # this path are used as input so this offers a way to incorporate
1074  # cmail games as well.
1075  #----------------------------------------------------------------------
1076  proc chooseInbox {} {
1077  global ::CorrespondenceChess::Inbox
1078 
1079  set filetype { "All files" {".*"} }
1080  set Inbox [file dirname [chooseFile "default correspondence chess Inbox..." $filetype]]
1081  }
1082 
1083  #----------------------------------------------------------------------
1084  # In Outbox a pgn-version of the game after the users move is
1085  # stored. This includes all variations and comments! For
1086  # incorporation of cmail they need to be stripped.
1087  #----------------------------------------------------------------------
1088  proc chooseOutbox {} {
1089  global ::CorrespondenceChess::Outbox \
1090 
1091  set filetype { "All files" {".*"} }
1092  set Outbox [file dirname [chooseFile "default correspondence chess Outbox..." $filetype]]
1093  }
1094 
1095  #----------------------------------------------------------------------
1096  # Xfcc fetching is done by an external utility, currently perl as
1097  # this eases up XML parsing a lot. Having it natively would be
1098  # desireable though. On the other hand an external utility could
1099  # also fetch cmail games or whatever other source as it will be
1100  # transparent to scid. It just has to write the CmailGameName extra
1101  # tag within the header to a unique ID.
1102  #----------------------------------------------------------------------
1103  proc chooseFetch {} {
1104  global ::CorrespondenceChess::XfccFetchcmd
1105 
1106  set filetype { "All files" {".*"} }
1107  set XfccFetchcmd [chooseFile "default correspondence chess Fetch Tool..." $filetype]
1108  }
1109 
1110  #----------------------------------------------------------------------
1111  # Xfcc send utility. Similar to fetch but just the other way round
1112  # ;)
1113  #----------------------------------------------------------------------
1114  proc chooseSend {} {
1115  global ::CorrespondenceChess::XfccSendcmd
1116 
1117  set filetype { "All files" {".*"} }
1118  set XfccSendcmd [chooseFile "default correspondence chess Send Tool..." $filetype]
1119  }
1120 
1121  #----------------------------------------------------------------------
1122  # Check for xfccrc
1123  #----------------------------------------------------------------------
1124  proc checkXfccrc {} {
1125  global ::CorrespondenceChess::xfccrcfile
1126 
1127  if {![file exists $xfccrcfile]} {
1128  if {[catch {open $xfccrcfile w} optionF]} {
1129  tk_messageBox -title "Scid: Unable to write file" -type ok -icon warning \
1130  -message "Unable to write options file: $xfccrcfile\n$optionF"
1131  } else {
1132  puts $optionF "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
1133  puts $optionF "<xfcc>"
1134  puts $optionF "<server>"
1135  puts $optionF " <name>ServerName</name>"
1136  puts $optionF " <uri>http://</uri>"
1137  puts $optionF " <user>UserName</user>"
1138  puts $optionF " <pass>PassWord</pass>"
1139  puts $optionF "</server>"
1140  puts $optionF "</xfcc>"
1141  close $optionF
1142  }
1143  }
1144  }
1145 
1146  #----------------------------------------------------------------------
1147  # Check for the default DB, create it if it does not exist.
1148  #----------------------------------------------------------------------
1149  proc checkCorrBase {} {
1150  global ::CorrespondenceChess::CorrBase
1151 
1152  if {![file exists $CorrBase]} {
1153  set currbase [sc_base current]
1154  set fName [file rootname $CorrBase]
1155  if {[catch {sc_base create $fName} newbase]} {
1156  ERROR::MessageBox "$fName\n"
1157  }
1158  # Type 6 == Correspondence chess
1159  sc_base extra $newbase type 6
1160  sc_base close $newbase
1161  sc_base switch $currbase
1162  }
1163  }
1164 
1165  #----------------------------------------------------------------------
1166  # Check for In-/Outbox directories and create them if not available
1167  #----------------------------------------------------------------------
1168  proc checkInOutbox {} {
1169  global scidDataDir ::CorrespondenceChess::Inbox ::CorrespondenceChess::Outbox
1170 
1171  if {[file exists $Inbox]} {
1172  if {[file isfile $Inbox]} {
1173  file rename -force $Inbox "$Inbox.bak"
1174  file mkdir $Inbox
1175  }
1176  } else {
1177  if {[catch { file mkdir "$Inbox"} result]} {
1178  set ::CorrespondenceChess::Inbox [file nativename [file join $scidDataDir "Inbox"]]
1179  file mkdir $Inbox
1180  }
1181  }
1182 
1183  if {[file exists $Outbox]} {
1184  if {[file isfile $Outbox]} {
1185  file rename -force $Outbox "$Outbox.bak"
1186  file mkdir $Outbox
1187  }
1188  } else {
1189  if {[catch { file mkdir "$Outbox"} result]} {
1190  set ::CorrespondenceChess::Inbox [file nativename [file join $scidDataDir "Outbox"]]
1191  file mkdir $Outbox
1192  }
1193  }
1194  }
1195 
1196  #----------------------------------------------------------------------
1197  # Save the Correspondence Chess options
1198  #----------------------------------------------------------------------
1199  proc saveCCoptions {} {
1200  set optionF ""
1201  if {[catch {open [scidConfigFile correspondence] w} optionF]} {
1202  tk_messageBox -title "Scid: Unable to write file" -type ok -icon warning \
1203  -message "Unable to write options file: [scidConfigFile correspondence]\n$optionF"
1204  } else {
1205  # Check all paths etc. exist and contain valid data
1206  ::CorrespondenceChess::checkInOutbox
1207  ::CorrespondenceChess::checkXfccrc
1208  ::CorrespondenceChess::checkCorrBase
1209 
1210  puts $optionF "# Scid options file"
1211  puts $optionF "# Version: $::scidVersion, $::scidVersionDate"
1212  puts $optionF "# This file contains commands in the Tcl language format."
1213  puts $optionF "# If you edit this file, you must preserve valid Tcl"
1214  puts $optionF "# format or it will not set your Scid options properly."
1215  puts $optionF ""
1216 
1217  foreach i { ::CorrespondenceChess::CorrBase \
1218  ::CorrespondenceChess::Inbox \
1219  ::CorrespondenceChess::Outbox \
1220  ::CorrespondenceChess::XfccFetchcmd \
1221  ::CorrespondenceChess::XfccSendcmd \
1222  ::CorrespondenceChess::mailer \
1223  ::CorrespondenceChess::bccaddr \
1224  ::CorrespondenceChess::mailermode \
1225  ::CorrespondenceChess::attache \
1226  ::CorrespondenceChess::subject \
1227  ::CorrespondenceChess::PluginPath \
1228  ::CorrespondenceChess::Connector \
1229  ::CorrespondenceChess::RelayGames \
1230  ::CorrespondenceChess::ListOrder } {
1231  set path [set $i]
1232 
1233  puts $optionF "set $i [list [set $i]]"
1234 
1235  # If possible replace absolute path by a relative one to
1236  # $scidDataDir
1237 
1238  # first get rid of windows path separators as they get
1239  # interpreted by TCL
1240  # regsub -all {\\} $::scidDataDir "/" sdd
1241  # regsub -all {\\} $path "/" pd
1242 
1243  # if { [regexp $sdd $pd] } {
1244  # regsub -all $sdd $pd "scidDataDir" path
1245  # # now convert back to nativename
1246  # set path [file nativename $path]
1247  # puts $optionF "set $i \$$path"
1248  #} else {
1249  # puts $optionF "set $i [list [set $i]]"
1250  #}
1251 
1252  }
1253  foreach i { ::CorrespondenceChess::xfccrcfile \
1254  } {
1255  puts $optionF "set $i [list [set $i]]"
1256 
1257  # set path [set $i]
1258  # regsub -all {\\} $::scidConfigDir "/" sdd
1259  # regsub -all {\\} $path "/" pd
1260  # if { [regexp $sdd $pd] } {
1261  # regsub -all $sdd $pd "scidDataDir" path
1262  # set path [file nativename $path]
1263  # puts $optionF "set $i \$$path"
1264  #} else {
1265  # puts $optionF "set $i [list [set $i]]"
1266  #}
1267 
1268  }
1269  if {$::CorrespondenceChess::XfccInternal < 0} {
1270  puts $optionF {set ::CorrespondenceChess::XfccInternal 0}
1271  } else {
1272  puts $optionF "set ::CorrespondenceChess::XfccInternal $::CorrespondenceChess::XfccInternal"
1273  }
1274  if {$::CorrespondenceChess::XfccConfirm < 0} {
1275  puts $optionF {set ::CorrespondenceChess::XfccConfirm 0}
1276  } else {
1277  puts $optionF "set ::CorrespondenceChess::XfccConfirm $::CorrespondenceChess::XfccConfirm"
1278  }
1279  if {$::CorrespondenceChess::ListOnlyOwnMove < 0} {
1280  puts $optionF {set ::CorrespondenceChess::ListOnlyOwnMove 0}
1281  } else {
1282  puts $optionF "set ::CorrespondenceChess::ListOnlyOwnMove $::CorrespondenceChess::ListOnlyOwnMove"
1283  }
1284 
1285  }
1286  close $optionF
1287  set ::statusBar "Correspondence chess options were saved to: [scidConfigFile correspondence]"
1288  }
1289 
1290  #----------------------------------------------------------------------
1291  # yset / yview: enable synchronous scrolling of the CC game list, ie.
1292  # all text widgets involved scroll simultaneously by the same amount
1293  # in the vertical direction.
1294  #----------------------------------------------------------------------
1295  proc yset {args} {
1296  set w .ccWindow
1297  eval [linsert $args 0 $w.bottom.ysc set]
1298  yview moveto [lindex [$w.bottom.ysc get] 0]
1299  }
1300 
1301  proc yview {args} {
1302  set w .ccWindow
1303  eval [linsert $args 0 $w.bottom.id yview]
1304  eval [linsert $args 0 $w.bottom.toMove yview]
1305  eval [linsert $args 0 $w.bottom.event yview]
1306  eval [linsert $args 0 $w.bottom.site yview]
1307  eval [linsert $args 0 $w.bottom.white yview]
1308  eval [linsert $args 0 $w.bottom.black yview]
1309  eval [linsert $args 0 $w.bottom.clockW yview]
1310  eval [linsert $args 0 $w.bottom.clockB yview]
1311  eval [linsert $args 0 $w.bottom.var yview]
1312  eval [linsert $args 0 $w.bottom.feature yview]
1313  }
1314 
1315  #----------------------------------------------------------------------
1316  # Translate the local menu
1317  #----------------------------------------------------------------------
1318  proc doConfigMenus { } {
1319  set lang $::language
1320 
1321  if {! [winfo exists .ccWindow]} {
1322  raiseWin .ccWindow
1323  return
1324  }
1325 
1326  set m .ccWindow.menu
1327 
1328  foreach idx {0 1} tag {CorrespondenceChess Edit} {
1329  configMenuText $m $idx $tag $lang
1330  }
1331  foreach idx {0 1 3 4 6 7 8 9 10 11 13 14} tag {CCConfigure CCConfigRelay CCRetrieve CCInbox CCSend CCResign CCClaimDraw CCOfferDraw CCAcceptDraw CCGamePage CCNewMailGame CCMailMove } {
1332  configMenuText $m.correspondence $idx $tag $lang
1333  }
1334  foreach idx {0 } tag { CCEditCopy } {
1335  configMenuText $m.edit $idx $tag $lang
1336  }
1337  }
1338 
1339  #----------------------------------------------------------------------
1340  # Call the web page of the game. The URL is extracted from the
1341  # Source tag that is stored with each game.
1342  #----------------------------------------------------------------------
1343  proc CallWWWGame {} {
1344  ::CorrespondenceChess::updateConsole "Calling web page..."
1345  set Extra [sc_game tags get Extra]
1346  set extraTagsList [split $Extra "\n"]
1347  set source ""
1348  foreach i $extraTagsList {
1349  if { [string equal -nocase [lindex $i 0] "Source"] } {
1350  set source [string range $i 8 end-1]
1351  openURL $source
1352  }
1353  }
1354  }
1355 
1356  #----------------------------------------------------------------------
1357  # Store the relays list, but only those URLs that match
1358  # iccf-webchess' games page.
1359  #----------------------------------------------------------------------
1360  proc RelaysOK { } {
1361  global ::CorrespondenceChess::RelayGames
1362 
1363  set w .editCCRelays
1364 
1365  if {[catch {open $::CorrespondenceChess::Connector r} connectF]} {
1366  set Title "Error"
1367  append Error "$::CorrespondenceChess::Connector\n"
1368  append Error [::tr CCErrDirNotUsable]
1369  tk_messageBox -icon warning -type ok -parent . \
1370  -title $Title -message $Error
1371  return
1372  } else {
1373  set connectxml [read $connectF]
1374 
1375  set dom [dom parse $connectxml]
1376  set doc [$dom documentElement]
1377  set aNodes [$doc selectNodes {/connector/server}]
1378  set number 0
1379  foreach srv $aNodes {
1380  set stripforid [$srv selectNodes {string(stripforid)}]
1381 
1382  set text [string trim [$w.f.text get 1.0 end]]
1383  set ::CorrespondenceChess::RelayGames {}
1384  foreach game [split $text "\n"] {
1385  set game [string trim $game]
1386  if {[string match "*$stripforid*" $game]} {
1387  lappend ::CorrespondenceChess::RelayGames $game
1388  }
1389  }
1390  }
1391  close $connectF
1392  }
1393 
1394  ::CorrespondenceChess::saveCCoptions
1395  destroy .editCCRelays
1396  }
1397 
1398  #----------------------------------------------------------------------
1399  # Configure the games to be relayed from ICCF Webchess
1400  #----------------------------------------------------------------------
1401  proc ConfigureRelay { } {
1402  global ::CorrespondenceChess::RelayGames
1403 
1404  puts stderr $::CorrespondenceChess::Connector
1405  if {![file exists $::CorrespondenceChess::Connector]} {
1406  if {[catch {open $::CorrespondenceChess::Connector w} connectF]} {
1407 
1408  } else {
1409  puts $connectF "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
1410  puts $connectF "<connector>";
1411  puts $connectF "\t<server>";
1412  puts $connectF "\t\t<name>ICCF</name>";
1413  puts $connectF "\t\t<stripforid>http://www.iccf-webchess.com/MakeAMove.aspx\?id=</stripforid>";
1414  puts $connectF "\t\t<pgnbaseurl>http://www.iccf-webchess.com/GetPGN.aspx?id=</pgnbaseurl>";
1415  puts $connectF "\t\t<cmailprefix>game</cmailprefix>";
1416  puts $connectF "\t</server>";
1417  puts $connectF "</connector>";
1418  close $connectF
1419  }
1420  }
1421 
1422  if {[catch {open $::CorrespondenceChess::Connector r} connectF]} {
1423  set Title "Error"
1424  append Error "$::CorrespondenceChess::Connector\n"
1425  append Error [::tr CCErrDirNotUsable]
1426  tk_messageBox -icon warning -type ok -parent . \
1427  -title $Title -message $Error
1428  return
1429  } else {
1430  close $connectF
1431  set w .editCCRelays
1432  set oldRelays $::CorrespondenceChess::RelayGames
1433 
1434  if {[winfo exists $w]} { return}
1435  toplevel $w
1436  ::setTitle $w [::tr "CCDlgConfigRelay"]
1437 
1438  autoscrollframe $w.desc text $w.desc.text \
1439  -background gray90 -foreground black \
1440  -width 60 -height 7 -wrap word -cursor top_left_arrow
1441  $w.desc.text insert end [::tr "CCDlgConfigRelayHelp"]
1442  $w.desc.text configure -state disabled
1443  pack $w.desc -side top -fill x
1444 
1445  pack [ttk::frame $w.b] -side bottom -fill x
1446  autoscrollframe $w.f text $w.f.text -width 60 -height 10 -wrap none
1447 
1448  foreach g $::CorrespondenceChess::RelayGames {
1449  $w.f.text insert end "$g\n"
1450  }
1451  pack $w.f -side top -fill both -expand yes
1452 
1453  ttk::button $w.b.ok -text OK -command {
1454  ::CorrespondenceChess::RelaysOK
1455  }
1456  ttk::button $w.b.cancel -text $::tr(Cancel) -command "grab release $w; destroy $w"
1457  pack $w.b.cancel $w.b.ok -side right -padx 5 -pady 5
1458  }
1459  }
1460 
1461  #----------------------------------------------------------------------
1462  # Fetch PGN file of games to be relayed and put them with the
1463  # proper header tags into Scid's inbox for display
1464  # As parameter use the MakeAMove-URL from ICCF.
1465  # Currently only relaying from ICCF is supported.
1466  #----------------------------------------------------------------------
1467  proc RelayGames { gameurl } {
1468  global ::CorrespondenceChess::Inbox
1469 
1470  if {[catch {open $::CorrespondenceChess::Connector r} connectF]} {
1471  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open connector $::CorrespondenceChess::Connector";
1472  } else {
1473 
1474  set connectxml [read $connectF]
1475 
1476  set dom [dom parse $connectxml]
1477  set doc [$dom documentElement]
1478  set aNodes [$doc selectNodes {/connector/server}]
1479  set number 0
1480  foreach srv $aNodes {
1481  set name [$srv selectNodes {string(name)}]
1482  set stripforid [$srv selectNodes {string(stripforid)}]
1483  set pgnbaseurl [$srv selectNodes {string(pgnbaseurl)}]
1484  set cmailprefix [$srv selectNodes {string(cmailprefix)}]
1485 
1486  if {[regexp "$stripforid" $gameurl]} {
1487 
1488  regsub -all "$stripforid" $gameurl {} gameid
1489 
1490  ::CorrespondenceChess::updateConsole "info Fetching $gameid from $name";
1491  set cmailgamename "$cmailprefix$gameid"
1492  set pgnurl "$pgnbaseurl$gameid"
1493 
1494  # convert from latin-1 to utf-8
1495  set pgn [encoding convertfrom iso8859-1 [::CorrespondenceChess::getPage $pgnurl]]
1496 
1497  # split by line endings for insertion of necessary header tags
1498  set gamelist [split $pgn "\n"]
1499 
1500  set filename [file nativename [file join $::CorrespondenceChess::Inbox "$cmailgamename.pgn"]]
1501 
1502  if {[catch {open $filename w} pgnF]} {
1503  ::CorrespondenceChess::updateConsole "info ERROR: Unable to open $filename";
1504  } else {
1505  foreach line $gamelist {
1506  if {[string match "*Result *" $line]} {
1507  puts $pgnF $line
1508  puts $pgnF "\[CmailGameName \"$cmailgamename\"\]"
1509  puts $pgnF "\[Source \"$gameurl\"\]"
1510  puts $pgnF "\[Mode \"Relay\"\]"
1511  } else {
1512  puts $pgnF $line
1513  }
1514  }
1515  close $pgnF
1516  }
1517  }
1518 
1519  }
1520  }
1521  close $connectF
1522  }
1523 
1524  #----------------------------------------------------------------------
1525  # Resize the console window
1526  #----------------------------------------------------------------------
1527  proc ConsoleResize {} {
1528  set w .ccWindow
1529 
1530  # unbind configure event
1531  bind $w <Configure> {}
1532 
1533  # get old window width and height
1534  set oldheight $::winHeight($w)
1535  set oldwidth $::winWidth($w)
1536 
1537  # get the new window width and height
1538  set temp [wm geometry $w]
1539  set n [scan $temp "%dx%d+%d+%d" width height x y]
1540 
1541  if {$height > 0 && $width > 0} {
1542  if {$height != $oldheight} {
1543  # resize the table of games
1544  foreach col {id toMove event site white black clockW clockB var feature} {
1545  $w.bottom.$col configure -height $height
1546  }
1547  # record the new size
1548  recordWinSize $w
1549  # set the windows size to this new size explicitly to
1550  # avoid flicker
1551  setWinSize $w
1552  }
1553  }
1554  recordWinSize $w
1555  # rebind the configure event
1556  bind $w <Configure> { ::CorrespondenceChess::ConsoleResize }
1557  }
1558 
1559  #----------------------------------------------------------------------
1560  # Allow to disable engine analysis in case engines are not allowed
1561  # for the ongoing game.
1562  #----------------------------------------------------------------------
1563  proc EnableEngineAnalysis {on} {
1564  # Broken: depends on the old menu structure
1565  # TODO: use the new callback mechanism ::setPlayMode()
1566  return
1567 
1568  if {$on == 0} {
1569  set m .menu.tools
1570  $m entryconfigure 0 -state disabled
1571  $m entryconfigure 1 -state disabled
1572  $m entryconfigure 2 -state disabled
1573  $m entryconfigure 3 -state disabled
1574 
1575  # disable hotkeys, needs to be done for each window
1576  foreach w { .maintWin .sortWin .playerInfoWin .repWin \
1577  .fics .metadataWindow .crosstableWin .ecograph \
1578  .glistWin .plist .statsWin .baseWin .tourney \
1579  .pgnWin .main .nedit .ccWindow } {
1580 
1581  if {[winfo exists $w]} {
1582  bind $w <Control-A> {}
1583  bind $w <Control-Shift-2> {}
1584  bind $w <F2> {}
1585  bind $w <F3> {}
1586  }
1587  }
1588  } else {
1589  set m .menu.tools
1590  $m entryconfigure 0 -state normal
1591  $m entryconfigure 1 -state normal
1592  $m entryconfigure 2 -state normal
1593  $m entryconfigure 3 -state normal
1594 
1595  # disable hotkeys, needs to be done for each window
1596  foreach w { .maintWin .sortWin .playerInfoWin .repWin \
1597  .fics .metadataWindow .crosstableWin .ecograph \
1598  .glistWin .plist .statsWin .baseWin .tourney \
1599  .pgnWin .main .nedit .ccWindow } {
1600 
1601  if {[winfo exists $w]} {
1602  bind $w <Control-A> makeAnalysisWin
1603  bind $w <Control-Shift-2> "makeAnalysisWin 2"
1604  bind $w <F2> "::makeAnalysisWin 1 0"
1605  bind $w <F3> "::makeAnalysisWin 2 0"
1606  }
1607  }
1608  }
1609  }
1610 
1611  #----------------------------------------------------------------------
1612  # Copy the games list as CSV (tab separated) to the clipboard
1613  #----------------------------------------------------------------------
1614  proc List2Clipboard {} {
1615  clipboard clear
1616  clipboard append $::CorrespondenceChess::clipboardText
1617  }
1618 
1619  #----------------------------------------------------------------------
1620  # Generate the Correspondence Chess Window. This Window offers a
1621  # console displaying whats going on and which game is displayed
1622  # plus a gmae list containing current games synced in and their
1623  # status. Xfcc offers quite some information here whereas eMail
1624  # relies mostly on the user.
1625  # Additionally this window contains the buttons for easy navigation
1626  # and in case of Xfcc the special moves available (resign etc.)
1627  #----------------------------------------------------------------------
1628  proc CCWindow {} {
1629  global scidDataDir helpMessage
1630 
1631  set w .ccWindow
1632  if {[winfo exists .ccWindow]} {
1633  focus .
1634  destroy .ccWindow
1635  set ::CorrespondenceChess::isOpen 0
1636  return
1637  }
1638  set ::CorrespondenceChess::isOpen 1
1639 
1640  ::createToplevel $w
1641  ::setTitle $w [::tr "CorrespondenceChess"]
1642 
1643  # hook up with scid's geometry manager
1644  setWinLocation $w
1645  setWinSize $w
1646 
1647  ::CorrespondenceChess::EnableEngineAnalysis 0
1648 
1649  # create the menu and add default CC menu items here as well
1650  menu $w.menu
1651  ::setMenu $w $w.menu
1652  set m $w.menu
1653  $w.menu add cascade -label CorrespondenceChess -menu $w.menu.correspondence
1654  $w.menu add cascade -label Edit -menu $w.menu.edit
1655  foreach i {correspondence edit} {
1656  menu $w.menu.$i -tearoff 0
1657  }
1658 
1659  $m.correspondence add command -label CCConfigure -command {::CorrespondenceChess::config}
1660  set helpMessage($m.correspondence,0) CCConfigure
1661  $m.correspondence add command -label CCConfigRelay -command {::CorrespondenceChess::ConfigureRelay}
1662  set helpMessage($m.correspondence,1) CCConfigRelay
1663 
1664  $m.correspondence add separator
1665  $m.correspondence add command -label CCRetrieve -command { ::CorrespondenceChess::FetchGames }
1666  set helpMessage($m.correspondence,3) CCRetrieve
1667 
1668  $m.correspondence add command -label CCInbox -command { ::CorrespondenceChess::ReadInbox }
1669  set helpMessage($m.correspondence,4) CCInbox
1670 
1671  $m.correspondence add separator
1672  $m.correspondence add command -label CCSend -command {::CorrespondenceChess::SendMove 0 0 0 0}
1673  set helpMessage($m.correspondence,6) CCSend
1674  $m.correspondence add command -label CCResign -command {::CorrespondenceChess::SendMove 1 0 0 0}
1675  set helpMessage($m.correspondence,7) CCResign
1676  $m.correspondence add command -label CCClaimDraw -command {::CorrespondenceChess::SendMove 0 1 0 0}
1677  set helpMessage($m.correspondence,8) CCClaimDraw
1678  $m.correspondence add command -label CCOfferDraw -command {::CorrespondenceChess::SendMove 0 0 1 0}
1679  set helpMessage($m.correspondence,9) CCOfferDraw
1680  $m.correspondence add command -label CCAcceptDraw -command {::CorrespondenceChess::SendMove 0 0 0 1}
1681  set helpMessage($m.correspondence,10) CCAcceptDraw
1682  $m.correspondence add command -label CCGamePage -command {::CorrespondenceChess::CallWWWGame}
1683  set helpMessage($m.correspondence,11) CCGamePage
1684  $m.correspondence add separator
1685  $m.correspondence add command -label CCNewMailGame -command {::CorrespondenceChess::newEMailGame}
1686  set helpMessage($m.correspondence,13) CCNewMailGame
1687  $m.correspondence add command -label CCMailMove -command {::CorrespondenceChess::eMailMove}
1688  set helpMessage($m.correspondence,14) CCMailMove
1689 
1690  $m.edit add command -label CCEditCopy -accelerator "Ctrl+C" -command { ::CorrespondenceChess::List2Clipboard }
1691 
1692  # Translate the menu
1693  ::CorrespondenceChess::doConfigMenus
1694 
1695  ttk::frame $w.top
1696  ttk::frame $w.bottom
1697 
1698  pack $w.top -anchor w -expand no
1699  pack $w.bottom -fill both -expand yes
1700 
1701  ttk::scrollbar $w.top.ysc -command { .ccWindow.top.console yview }
1702  text $w.top.console -height 3 -width 80 -wrap word -yscrollcommand "$w.top.ysc set"
1703  ttk::button $w.top.retrieveCC -image tb_CC_Retrieve -command {::CorrespondenceChess::FetchGames}
1704  ttk::button $w.top.sendCC -image tb_CC_Send -command {::CorrespondenceChess::SendMove 0 0 0 0}
1705  ttk::button $w.top.delinbox -image tb_CC_delete -command {::CorrespondenceChess::EmptyInOutbox}
1706 
1707  ttk::button $w.top.openDB -text [::tr "CCOpenDB"] -command {::CorrespondenceChess::OpenCorrespondenceDB}
1708  ttk::button $w.top.inbox -text [::tr "CCInbox"] -command {::CorrespondenceChess::ReadInbox}
1709 
1710  ttk::button $w.top.resign -text [::tr "CCResign"] -state disabled -command {::CorrespondenceChess::SendMove 1 0 0 0}
1711  ttk::button $w.top.claimDraw -text [::tr "CCClaimDraw"] -state disabled -command {::CorrespondenceChess::SendMove 0 1 0 0}
1712  ttk::button $w.top.offerDraw -text [::tr "CCOfferDraw"] -state disabled -command {::CorrespondenceChess::SendMove 0 0 1 0}
1713  ttk::button $w.top.acceptDraw -text [::tr "CCAcceptDraw"] -state disabled -command {::CorrespondenceChess::SendMove 0 0 0 1}
1714 
1715  ttk::button $w.top.help -image tb_help -width 24 -command { helpWindow CCIcons }
1716 
1717  ttk::label $w.top.plugins -image tb_CC_spacer -takefocus 0
1718  ttk::label $w.top.onoffline -image tb_CC_offline -takefocus 0
1719 
1720 
1721  ::utils::tooltip::Set $w.top.retrieveCC [::tr "CCFetchBtn"]
1722  ::utils::tooltip::Set $w.top.sendCC [::tr "CCSendBtn"]
1723  ::utils::tooltip::Set $w.top.delinbox [::tr "CCEmptyBtn"]
1724  ::utils::tooltip::Set $w.top.help [::tr "CCHelpBtn"]
1725  ::utils::tooltip::Set $w.top.onoffline [clock format $::Xfcc::lastupdate]
1726 
1727  grid $w.top.retrieveCC -stick ewns -column 0 -row 0
1728  grid $w.top.openDB -stick ew -column 0 -row 1 -columnspan 2
1729  grid $w.top.inbox -stick ew -column 0 -row 2 -columnspan 2
1730 
1731  grid $w.top.sendCC -stick ewns -column 1 -row 0
1732 
1733  grid $w.top.console -column 4 -row 0 -columnspan 8
1734  grid $w.top.ysc -stick ns -column 13 -row 0
1735  grid $w.top.help -stick nsew -column 14 -row 0 -columnspan 2
1736 
1737  grid $w.top.delinbox -stick ewns -column 5 -row 1 -rowspan 2
1738  grid $w.top.onoffline -column 6 -row 1
1739  grid $w.top.plugins -column 6 -row 2
1740 
1741  grid $w.top.resign -stick ew -column 7 -row 1
1742 
1743  grid $w.top.claimDraw -stick ew -column 7 -row 2
1744  grid $w.top.offerDraw -stick ew -column 8 -row 2
1745  grid $w.top.acceptDraw -stick ew -column 9 -row 2
1746 
1747  # build the table in the bottom frame. This table of text widgets has to
1748  # scroll synchronously!
1749  ttk::scrollbar $w.bottom.ysc -command ::CorrespondenceChess::yview
1750 
1751  set height $::winHeight($w)
1752  set width $::winWidth($w)
1753 
1754  text $w.bottom.id -cursor top_left_arrow -font font_Small -height $height -width 15 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1755  text $w.bottom.toMove -cursor top_left_arrow -font font_Small -height $height -width 4 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1756  text $w.bottom.event -cursor top_left_arrow -font font_Small -height $height -width 10 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1757  text $w.bottom.site -cursor top_left_arrow -font font_Small -height $height -width 10 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1758  text $w.bottom.white -cursor top_left_arrow -font font_Small -height $height -width 15 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1759  text $w.bottom.black -cursor top_left_arrow -font font_Small -height $height -width 15 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1760  text $w.bottom.clockW -cursor top_left_arrow -font font_Small -height $height -width 10 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1761  text $w.bottom.clockB -cursor top_left_arrow -font font_Small -height $height -width 10 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1762  text $w.bottom.var -cursor top_left_arrow -font font_Small -height $height -width 3 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1763  text $w.bottom.feature -cursor top_left_arrow -font font_Small -height $height -width 16 -setgrid 1 -relief flat -wrap none -yscrollcommand ::CorrespondenceChess::yset
1764 
1765  grid $w.bottom.id -column 0 -row 1
1766  grid $w.bottom.toMove -column 1 -row 1
1767  grid $w.bottom.event -column 2 -row 1
1768  grid $w.bottom.site -column 3 -row 1
1769  grid $w.bottom.white -column 4 -row 1
1770  grid $w.bottom.black -column 5 -row 1
1771  grid $w.bottom.clockW -column 15 -row 1
1772  grid $w.bottom.clockB -column 16 -row 1
1773  grid $w.bottom.var -column 17 -row 1
1774  grid $w.bottom.feature -column 18 -row 1
1775  grid $w.bottom.ysc -column 19 -row 1 -stick ns
1776 
1777  # Copy games list to clipboard
1778  bind $w <Control-Insert> { ::CorrespondenceChess::List2Clipboard }
1779  bind $w <Control-c> { ::CorrespondenceChess::List2Clipboard }
1780 
1781  # Handle scrolling in the games list by keyboard
1782  bind $w <Control-Up> { ::CorrespondenceChess::PrevGame}
1783  bind $w <Control-Down> { ::CorrespondenceChess::NextGame}
1784  bind $w <Up> { ::CorrespondenceChess::yview scroll -1 units}
1785  bind $w <Down> { ::CorrespondenceChess::yview scroll 1 units}
1786  bind $w <Prior> { ::CorrespondenceChess::yview scroll -1 pages}
1787  bind $w <Next> { ::CorrespondenceChess::yview scroll 1 pages}
1788  bindMouseWheel $w "::CorrespondenceChess::yview scroll"
1789 
1790  # Help
1791  bind $w <F1> { helpWindow Correspondence}
1792  bind $w "?" { helpWindow CCIcons}
1793 
1794  bind $w <Configure> { ::CorrespondenceChess::ConsoleResize }
1795  bind $w <Destroy> { ::CorrespondenceChess::EnableEngineAnalysis 1
1796  set ::CorrespondenceChess::isOpen 0 }
1797 
1798  foreach f [glob -nocomplain [file join "$CorrespondenceChess::PluginPath" *]] {
1799  $w.top.plugins configure -image tb_CC_pluginactive
1800  source $f
1801  }
1802 
1803  ::createToplevelFinalize $w
1804  }
1805 
1806  #--------------------------------------------------------------------------
1807  # Updates the game list with another event and all data available.
1808  # This just adds another line at the end of the current list, hence
1809  # the list has to be emptied if all games are resynced in.
1810  #--------------------------------------------------------------------------
1811  proc updateGamelist {id toMove event site date white black clockW \
1812  clockB var db books tb engines wc bc mess TC \
1813  lastmove drawoffer } {
1814  global ::CorrespondenceChess::num
1815  global ::CorrespondenceChess::clipboardText
1816 
1817  set w .ccWindow
1818 
1819  #----------------------------------------------------------------------
1820  # Layout for the gamelist: Xfcc offers more information about
1821  # the ongoing game then eMail, hence more is presented to the
1822  # user. ToMove and features use icons for easy reading.
1823  # Xfcc:
1824  # ID | ToMove? | White | Black | Event | Site | ClockW | ClockB # | Var | features
1825  # eMail:
1826  # ID | | White | Black | Event | Site | | | |
1827 
1828  foreach tag {id toMove event site white black clockW clockB var feature} {
1829  # enable additions
1830  $w.bottom.$tag configure -state normal
1831  # make each line high enough for the icons to be placed
1832  $w.bottom.$tag image create end -align center -image tb_CC_spacer
1833  }
1834 
1835  # Calculate the TimeDiff between the event date and the current
1836  # date. This diff is used to mark event that have not yet
1837  # started.
1838  set TimeDiff [expr [clock seconds] - [clock scan $date -format "%Y.%m.%d"]]
1839 
1840  if { $::Xfcc::update > 0 } {
1841  $w.top.onoffline configure -image tb_CC_online
1842  ::utils::tooltip::Set $w.top.onoffline [clock format $::Xfcc::lastupdate]
1843  }
1844 
1845  if {$mess != ""} {
1846  set curpos [$w.bottom.id index insert]
1847  $w.bottom.id image create end -align center -image tb_CC_message
1848  set endpos [$w.bottom.id index insert]
1849 
1850  $w.bottom.id tag add idmsg$id $curpos $endpos
1851  ::utils::tooltip::SetTag $w.bottom.id "$mess" idmsg$id
1852  }
1853  # add the game id. Note the \n at the end is necessary!
1854  set curpos [$w.bottom.id index insert]
1855  $w.bottom.id insert end "$id\n"
1856  set endpos [$w.bottom.id index insert]
1857  $w.bottom.id tag add id$id $curpos $endpos
1858  ::utils::tooltip::SetTag $w.bottom.id "$id" id$id
1859 
1860  # ToMove may contain a mixture of text for game results plus
1861  # several icons displaying the current game status.
1862  if { (($clockW == " 0d 0: 0") || ($clockB == " 0d 0: 0")) && (($toMove == "yes") || ($toMove == "no")) } {
1863  $w.bottom.toMove image create end -align center -image tb_CC_outoftime
1864  }
1865 
1866  set text ""
1867  switch -regexp -- $toMove \
1868  "1-0" {
1869  set curpos [$w.bottom.toMove index insert]
1870  $w.bottom.toMove image create end -align center -image $::board::letterToPiece(K)25
1871  $w.bottom.toMove insert end " $toMove"
1872  set endpos [$w.bottom.toMove index insert]
1873  set text "$lastmove ($toMove)"
1874  } \
1875  "0-1" {
1876  set curpos [$w.bottom.toMove index insert]
1877  $w.bottom.toMove image create end -align center -image $::board::letterToPiece(k)25
1878  $w.bottom.toMove insert end " $toMove"
1879  set endpos [$w.bottom.toMove index insert]
1880  set text "$lastmove ($toMove)"
1881  } \
1882  " = " {
1883  set curpos [$w.bottom.toMove index insert]
1884  $w.bottom.toMove image create end -align center -image tb_CC_draw
1885  $w.bottom.toMove insert end "$toMove"
1886  set endpos [$w.bottom.toMove index insert]
1887  set text "$lastmove ($toMove)"
1888  } \
1889  "yes" {
1890  set curpos [$w.bottom.toMove index insert]
1891  $w.bottom.toMove image create end -align center -image tb_CC_yourmove
1892  set endpos [$w.bottom.toMove index insert]
1893  set text "$lastmove"
1894  } \
1895  "no" {
1896  set curpos [$w.bottom.toMove index insert]
1897  $w.bottom.toMove image create end -align center -image tb_CC_oppmove
1898  set endpos [$w.bottom.toMove index insert]
1899  set text "$lastmove"
1900  } \
1901  " ? " {
1902  set curpos [$w.bottom.toMove index insert]
1903  $w.bottom.toMove insert end "$toMove"
1904  set endpos [$w.bottom.toMove index insert]
1905  set text "$lastmove"
1906  } \
1907  "POS" {
1908  set curpos [$w.bottom.toMove index insert]
1909  $w.bottom.toMove image create end -align center -image tb_CC_postal
1910  set endpos [$w.bottom.toMove index insert]
1911  set text "$lastmove"
1912  } \
1913  "EML" {
1914  set curpos [$w.bottom.toMove index insert]
1915  $w.bottom.toMove image create end -align center -image tb_CC_envelope
1916  set endpos [$w.bottom.toMove index insert]
1917  set text "$lastmove"
1918  } \
1919  "REL" {
1920  set curpos [$w.bottom.toMove index insert]
1921  $w.bottom.toMove image create end -align center -image tb_CC_relay
1922  set endpos [$w.bottom.toMove index insert]
1923  set text "$lastmove"
1924  }
1925  $w.bottom.toMove tag add toMove$id $curpos $endpos
1926  ::utils::tooltip::SetTag $w.bottom.toMove "$text" toMove$id
1927  $w.bottom.toMove insert end "\n"
1928 
1929 
1930  # Add textual information to the edit fields
1931  set curpos [$w.bottom.event index insert]
1932  $w.bottom.event insert end "$event\n"
1933  set endpos [$w.bottom.event index insert]
1934  $w.bottom.event tag add event$id $curpos $endpos
1935 
1936 
1937  set curpos [$w.bottom.site index insert]
1938  $w.bottom.site insert end "$site\n"
1939  set endpos [$w.bottom.site index insert]
1940  $w.bottom.site tag add site$id $curpos $endpos
1941  ::utils::tooltip::SetTag $w.bottom.site "$site" site$id
1942 
1943  if {$wc != ""} {
1944  if {[lsearch [image names] $wc] > -1} {
1945  $w.bottom.white image create end -align center -image $wc
1946  $w.bottom.white insert end " "
1947  } else {
1948  puts stderr "$wc does not exist"
1949  }
1950  }
1951  $w.bottom.white insert end "$white\n"
1952 
1953  if {$bc != ""} {
1954  if {[lsearch [image names] $bc] > -1} {
1955  $w.bottom.black image create end -align center -image $bc
1956  $w.bottom.black insert end " "
1957  } else {
1958  puts stderr "$bc does not exist"
1959  }
1960  }
1961  $w.bottom.black insert end "$black\n"
1962 
1963  $w.bottom.clockW insert end "$clockW\n"
1964  $w.bottom.clockB insert end "$clockB\n"
1965  $w.bottom.var insert end "$var\n"
1966 
1967  # Xfcc defines noDB, noTablebase no etc.pp. Hence check for
1968  # false to display the icons for allowed features.
1969  if {$db == "false"} {
1970  $w.bottom.feature image create end -align center -image tb_CC_database
1971  }
1972  if {$books == "false"} {
1973  $w.bottom.feature image create end -align center -image tb_CC_book
1974  }
1975  if {$tb == "false"} {
1976  $w.bottom.feature image create end -align center -image tb_CC_tablebase
1977  }
1978  if {!($engines == "true")} {
1979  $w.bottom.feature image create end -align center -image tb_CC_engine
1980  }
1981 
1982  $w.bottom.feature insert end "\n"
1983 
1984  # Link the click on each field to jump to this specific game
1985  # easily, then lock the entry field from changes by the user.
1986  # SetSelection just sets the global $num to the actual row the
1987  # user clicked. This has to be a global variable and it has to
1988  # be passed to the ProcessServerResult masqueraded to prevent
1989  # from interpretation. See also Scid's gamelist.
1990  foreach tag {id toMove event site white black clockW clockB var feature} {
1991  bind $w.bottom.$tag <Button-1> {
1992  ::CorrespondenceChess::SetSelection %x %y
1993  ::CorrespondenceChess::ProcessServerResult $::CorrespondenceChess::num
1994  break }
1995  # lock the area from changes
1996  $w.bottom.$tag configure -state disable
1997  }
1998 
1999  if {$TimeDiff < -1} {
2000  foreach col {id toMove event site} {
2001  $w.bottom.$col tag configure $col$id -foreground DarkGray -font font_Bold
2002  }
2003  ::utils::tooltip::SetTag $w.bottom.event "$event\nTime: $TC\n\nStart: $date" event$id
2004  } else {
2005  ::utils::tooltip::SetTag $w.bottom.event "$event\nTime: $TC" event$id
2006  }
2007 
2008  regsub -all "flag_" $wc "" wc1
2009  regsub -all "flag_" $bc "" bc1
2010 
2011  set wc1 [string toupper $wc1]
2012  set bc1 [string toupper $bc1]
2013 
2014  set ::CorrespondenceChess::clipboardText "$::CorrespondenceChess::clipboardText\n$id\t $event\t$site\t$date\t$white\t$black\t$wc1\t$bc1\t$clockW\t$clockB\t$toMove\t$mess\t$lastmove\t$var\t$db\t$books\t$tb\t$engines\t$TC"
2015  }
2016 
2017  #----------------------------------------------------------------------
2018  # Visually highlight line $::CorrespondenceChess::num
2019  #----------------------------------------------------------------------
2020  proc SetHighlightedLine {} {
2021  global ::CorrespondenceChess::num
2022  set gamecount $::CorrespondenceChess::glgames
2023 
2024  # remove old highlighting
2025  foreach col {id toMove event site white black clockW clockB var feature} {
2026  .ccWindow.bottom.$col tag remove highlight 1.0 end
2027  }
2028 
2029  # highlight current games line
2030  foreach col {id toMove event site white black clockW clockB var feature} {
2031  .ccWindow.bottom.$col tag add highlight $num.0 [expr {$num+1}].0
2032  .ccWindow.bottom.$col tag configure highlight -background lightYellow2 -font font_Bold
2033  }
2034  updateConsole "info: switched to game $num/$gamecount"
2035  }
2036 
2037  #----------------------------------------------------------------------
2038  # Set the global $num to the row the user clicked upon
2039  #----------------------------------------------------------------------
2040  proc SetSelection {xcoord ycoord} {
2041  global ::CorrespondenceChess::num
2042  set gamecount $::CorrespondenceChess::glgames
2043 
2044  set num [expr {int([.ccWindow.bottom.id index @$xcoord,$ycoord]) + $::CorrespondenceChess::glccstart - 1 }]
2045 
2046  # Prevent clicking beyond the last game
2047  if { $num > $gamecount } {
2048  set num $gamecount
2049  }
2050 
2051  SetHighlightedLine
2052  }
2053 
2054  #----------------------------------------------------------------------
2055  # Empties the gamelist and reset global $num. This should be done
2056  # once the games are (re)synchronised.
2057  #----------------------------------------------------------------------
2058  proc emptyGamelist {} {
2059  set w .ccWindow
2060  foreach tag {id toMove event site white black clockW clockB var feature} {
2061  # unlock the list
2062  $w.bottom.$tag configure -state normal
2063  # delete it
2064  $w.bottom.$tag delete 1.0 end
2065  }
2066  # reset the number of processed games
2067  set ::CorrespondenceChess::num 0
2068  set ::CorrespondenceChess::clipboardText ""
2069 
2070  }
2071 
2072  #----------------------------------------------------------------------
2073  # Add a line to the status console
2074  #----------------------------------------------------------------------
2075  proc updateConsole {line} {
2076  set t .ccWindow.top.console
2077  if { [winfo exists $t] } {
2078  $t insert end "$line\n"
2079  $t yview moveto 1
2080  }
2081  }
2082 
2083  #----------------------------------------------------------------------
2084  # Opens a config dialog to set the default parameters. Currently
2085  # they are not stored to scid's setup though.
2086  #----------------------------------------------------------------------
2087  proc config {} {
2088  set w .correspondenceChessConfig
2089  if { [winfo exists $w]} {
2090  raiseWin $w
2091  return
2092  }
2093  win::createDialog $w
2094  wm title $w [::tr "CCDlgConfigureWindowTitle"]
2095 
2096  set ::CorrespondenceChess::sortoptlist [list \
2097  [::tr "CCOrderClassicTxt"] \
2098  [::tr "CCOrderMyTimeTxt"] \
2099  [::tr "CCOrderTimePerMoveTxt"] \
2100  [::tr "CCOrderStartDate"] \
2101  [::tr "CCOrderOppTimeTxt"]]
2102 
2103 
2104  ttk::frame $w.buttons
2105  ttk::button $w.bOk -text OK -command {
2106  ::CorrespondenceChess::saveCCoptions
2107  destroy .correspondenceChessConfig
2108  }
2109  ttk::button $w.bCancel -text [::tr "Cancel"] -command "destroy $w"
2110 
2111  ttk::labelframe $w.lgeneral -text [::tr "CCDlgCGeneraloptions"]
2112  ttk::label $w.ldb -text [::tr "CCDlgDefaultDB"]
2113  ttk::label $w.linbox -text [::tr "CCDlgInbox"]
2114  ttk::label $w.loutbox -text [::tr "CCDlgOutbox"]
2115 
2116  ttk::labelframe $w.lxfccrc -text [::tr "CCDlgXfcc"]
2117  ttk::label $w.lxfcc -text [::tr "CCDlgExternalProtocol"]
2118  ttk::label $w.lfetch -text [::tr "CCDlgFetchTool"]
2119  ttk::label $w.lsend -text [::tr "CCDlgSendTool"]
2120  ttk::label $w.lsortopt -text [::tr "CCDlgSortOption"]
2121 
2122  ttk::labelframe $w.lemail -text [::tr "CCDlgEmailCommunication"]
2123  ttk::label $w.lmailx -text [::tr "CCDlgMailPrg"]
2124  ttk::label $w.lbccaddr -text [::tr "CCDlgBCCAddr"]
2125  ttk::label $w.lmoderb -text [::tr "CCDlgMailerMode"]
2126  ttk::label $w.lattache -text [::tr "CCDlgAttachementPar"]
2127  ttk::label $w.lsubject -text [::tr "CCDlgSubjectPar"]
2128 
2129  ttk::checkbutton $w.internalXfcc -text [::tr "CCDlgInternalXfcc"] \
2130  -variable ::CorrespondenceChess::XfccInternal
2131  ttk::checkbutton $w.confirmXfcc -text [::tr "CCDlgConfirmXfcc"] \
2132  -variable ::CorrespondenceChess::XfccConfirm
2133  ttk::checkbutton $w.onlyOwnMove -text [::tr "CCDlgListOnlyOwnMove"] \
2134  -variable ::CorrespondenceChess::ListOnlyOwnMove
2135 
2136  ttk::scrollbar $w.ysc -command { .correspondenceChessConfig.sortopt yview }
2137  listbox $w.sortopt -height 3 -width 60 -exportselection 0 -selectmode single -list ::CorrespondenceChess::sortoptlist -yscrollcommand "$w.ysc set"
2138  $w.sortopt selection set $::CorrespondenceChess::ListOrder
2139  bind .correspondenceChessConfig.sortopt <<ListboxSelect>> {
2140  set ::CorrespondenceChess::ListOrder [ .correspondenceChessConfig.sortopt curselection ]
2141  }
2142 
2143  ttk::button $w.xfconf -text [::tr CCConfigure] -command { ::CorrespondenceChess::checkXfccrc
2144  ::Xfcc::config $::CorrespondenceChess::xfccrcfile}
2145 
2146  if {$::CorrespondenceChess::XfccInternal < 0} {
2147  $w.internalXfcc configure -state disabled
2148  $w.xfconf configure -state disabled
2149  }
2150 
2151  ttk::entry $w.db -width 60 -textvariable ::CorrespondenceChess::CorrBase
2152  ttk::entry $w.inbox -width 60 -textvariable ::CorrespondenceChess::Inbox
2153  ttk::entry $w.outbox -width 60 -textvariable ::CorrespondenceChess::Outbox
2154 
2155  ttk::entry $w.xfccrc -width 60 -textvariable ::CorrespondenceChess::xfccrcfile
2156  ttk::entry $w.fetch -width 60 -textvariable ::CorrespondenceChess::XfccFetchcmd
2157  ttk::entry $w.send -width 60 -textvariable ::CorrespondenceChess::XfccSendcmd
2158 
2159  ttk::entry $w.mailx -width 60 -textvariable ::CorrespondenceChess::mailer
2160  ttk::entry $w.bccaddr -width 60 -textvariable ::CorrespondenceChess::bccaddr
2161  ttk::entry $w.attache -width 30 -textvariable ::CorrespondenceChess::attache
2162  ttk::entry $w.subject -width 30 -textvariable ::CorrespondenceChess::subject
2163 
2164  ttk::radiobutton $w.moderb1 -text "Mozilla \($::tr(CCDlgThunderbirdEg)\)" -value "mozilla" -variable ::CorrespondenceChess::mailermode
2165  ttk::radiobutton $w.moderb2 -text "Mail-URL \($::tr(CCDlgMailUrlEg)\)" -value "mailurl" -variable ::CorrespondenceChess::mailermode
2166  ttk::radiobutton $w.moderb3 -text "Claws \($::tr(CCDlgClawsEg)\)" -value "claws" -variable ::CorrespondenceChess::mailermode
2167  ttk::radiobutton $w.moderb4 -text "mailx \($::tr(CCDlgmailxEg)\)" -value "mailx" -variable ::CorrespondenceChess::mailermode
2168 
2169  ttk::button $w.bdb -text "..." -command {::CorrespondenceChess::chooseCorrBase }
2170  ttk::button $w.binbox -text "..." -command {::CorrespondenceChess::chooseInbox }
2171  ttk::button $w.boutbox -text "..." -command {::CorrespondenceChess::chooseOutbox }
2172  ttk::button $w.bfetch -text "..." -command {::CorrespondenceChess::chooseFetch }
2173  ttk::button $w.bsend -text "..." -command {::CorrespondenceChess::chooseSend }
2174 
2175  grid $w.lgeneral -column 0 -row 0 -pady "10 0" -sticky we
2176  grid $w.ldb -in $w.lgeneral -sticky e -column 0 -row 1
2177  grid $w.db -in $w.lgeneral -sticky we -column 1 -row 1 -columnspan 2 -padx 5
2178  grid $w.bdb -in $w.lgeneral -sticky w -column 3 -row 1
2179  grid $w.linbox -in $w.lgeneral -sticky e -column 0 -row 2
2180  grid $w.inbox -in $w.lgeneral -sticky we -column 1 -row 2 -columnspan 2 -padx 5
2181  grid $w.binbox -in $w.lgeneral -sticky w -column 3 -row 2
2182  grid $w.loutbox -in $w.lgeneral -sticky e -column 0 -row 3
2183  grid $w.outbox -in $w.lgeneral -sticky we -column 1 -row 3 -columnspan 2 -padx 5
2184  grid $w.boutbox -in $w.lgeneral -sticky w -column 3 -row 3
2185 
2186  grid $w.lxfccrc -column 0 -row 1 -pady 10 -sticky we
2187  grid $w.internalXfcc -in $w.lxfccrc -sticky w -column 0 -row 0 -columnspan 2
2188  grid $w.xfconf -in $w.lxfccrc -sticky w -column 2 -row 0
2189  grid $w.confirmXfcc -in $w.lxfccrc -sticky w -column 0 -row 1
2190  grid $w.onlyOwnMove -in $w.lxfccrc -sticky w -column 1 -row 1 -padx 5
2191  grid $w.lxfcc -in $w.lxfccrc -column 0 -row 2
2192  grid $w.xfccrc -in $w.lxfccrc -sticky we -column 1 -row 2 -columnspan 2 -padx 5
2193 
2194  grid $w.lfetch -in $w.lxfccrc -sticky e -column 0 -row 3
2195  grid $w.fetch -in $w.lxfccrc -sticky we -column 1 -row 3 -columnspan 2 -padx 5
2196  grid $w.bfetch -in $w.lxfccrc -sticky w -column 3 -row 3
2197  grid $w.lsend -in $w.lxfccrc -sticky e -column 0 -row 4
2198  grid $w.send -in $w.lxfccrc -sticky we -column 1 -row 4 -columnspan 2 -padx 5
2199  grid $w.bsend -in $w.lxfccrc -sticky w -column 3 -row 4
2200 
2201  grid $w.lsortopt -in $w.lxfccrc -sticky e -column 0 -row 5
2202  grid $w.sortopt -in $w.lxfccrc -sticky we -column 1 -row 5 -columnspan 2 -padx "5 0"
2203  grid $w.ysc -in $w.lxfccrc -sticky wns -column 3 -row 5
2204 
2205  grid $w.lemail -column 0 -row 2 -sticky we
2206  grid $w.lmailx -in $w.lemail -sticky e -column 0 -row 0
2207  grid $w.mailx -in $w.lemail -sticky we -column 1 -row 0 -padx 5
2208  grid $w.lbccaddr -in $w.lemail -sticky e -column 0 -row 1
2209  grid $w.bccaddr -in $w.lemail -sticky we -column 1 -row 1 -padx 5
2210 
2211  grid $w.lmoderb -in $w.lemail -sticky e -column 0 -row 2
2212  grid $w.moderb1 -in $w.lemail -sticky w -column 1 -row 2 -padx 5
2213  grid $w.moderb2 -in $w.lemail -sticky w -column 1 -row 3 -padx 5
2214  grid $w.moderb3 -in $w.lemail -sticky w -column 1 -row 4 -padx 5
2215  grid $w.moderb4 -in $w.lemail -sticky w -column 1 -row 5 -padx 5
2216 
2217  grid $w.lattache -in $w.lemail -sticky e -column 0 -row 6
2218  grid $w.attache -in $w.lemail -sticky we -column 1 -row 6 -padx 5
2219 
2220  grid $w.lsubject -in $w.lemail -sticky e -column 0 -row 7
2221  grid $w.subject -in $w.lemail -sticky we -column 1 -row 7 -padx 5
2222 
2223  grid columnconfigure $w.lgeneral 1 -weight 1
2224  grid columnconfigure $w.lxfccrc 1 -weight 1
2225  grid columnconfigure $w.lemail 1 -weight 1
2226  grid columnconfigure $w 0 -weight 1
2227 
2228  # Buttons and ESC-key
2229  packdlgbuttons $w.bCancel $w.bOk -in $w.buttons
2230  grid $w.buttons -column 0 -row 3 -sticky news
2231  bind $w <Escape> "$w.bCancel invoke"
2232 
2233  bind $w <F1> { helpWindow CCSetupDialog}
2234  }
2235 
2236  #----------------------------------------------------------------------
2237  # startEmailGame: create an empty new game and set the header for
2238  # to a cmail compatible format with the parameters entered by the
2239  # user (own and opponent names and mail addresses and unique id)
2240  #----------------------------------------------------------------------
2241  proc startEmailGame {ownname ownmail oppname oppmail gameid} {
2242  global ::CorrespondenceChess::Inbox
2243 
2244  # the following header tags have to be in this form for cmail to
2245  # recognise the mail as an eMail correspondence game.
2246  # Additionally scid searched for some of them to retrieve mail
2247  # addresses automagically and also to recognise this game as
2248  # eMail and not Xfcc.
2249  set Event "Email correspondence game"
2250  set Site "NET"
2251  set Round "-"
2252  set CmailGameName "CmailGameName \"$gameid\""
2253  set WhiteNA "WhiteNA \"$ownmail\""
2254  set BlackNA "BlackNA \"$oppmail\""
2255  set whiteCountry "WhiteCountry \"EUR\""
2256  set blackCountry "BlackCountry \"EUR\""
2257 
2258  set Mode "Mode \"EM\""
2259 
2260  set year [::utils::date::today year]
2261  set month [::utils::date::today month]
2262  set day [::utils::date::today day]
2263  set today "$year.$month.$day"
2264 
2265  # add a new game
2266  ::game::Clear
2267 
2268  # set the header tags
2269  sc_game tags set -event $Event
2270  sc_game tags set -site $Site
2271  sc_game tags set -round $Round
2272  sc_game tags set -white $ownname
2273  sc_game tags set -black $oppname
2274  sc_game tags set -date $today
2275  sc_game tags set -eventdate $today
2276 
2277  # add cmails extra header tags
2278  sc_game tags set -extra [list $CmailGameName $WhiteNA $BlackNA $whiteCountry $blackCountry $Mode]
2279 
2280  updateBoard -pgn
2281  updateTitle
2282 
2283  # Call gameSave with argument 0 to append to the current
2284  # database. This also gives the Save-dialog for additional user
2285  # values.
2286  gameSave 0
2287 
2288  # construct a PGN in Inbox for CC gamelist to work
2289  set pgnfile "[file join $Inbox $gameid].pgn"
2290  sc_base export "current" "PGN" $pgnfile -append 0 -comments 0 -variations 0 \
2291  -space 1 -symbols 0 -indentC 0 -indentV 0 -column 0 -noMarkCodes 0 -convertNullMoves 1
2292 
2293  ::CorrespondenceChess::ReadInbox
2294  }
2295 
2296  #----------------------------------------------------------------------
2297  # Generate a new email correspondence game in the style of cmail,
2298  # but with a friendly dialog presented to the user instead of
2299  # somewhat cryptic command line parameters.
2300  # This procedure adds a new game to the Correspondence DB and fills
2301  # in the header appropriately.
2302  #----------------------------------------------------------------------
2303  proc newEMailGame {} {
2304  global ::CorrespondenceChess::CorrSlot
2305 
2306  # Regardless how the user opened this DB, find it! ;)
2307  ::CorrespondenceChess::CheckForCorrDB
2308  # Only proceed if a correspondence DB is already loaded
2309  if {$CorrSlot > -1} {
2310  set w .wnewEMailGame
2311  if { [winfo exists $w]} { return}
2312  toplevel $w
2313  wm title $w [::tr "CCDlgStartEmail"]
2314 
2315  set ownemail ::CorrespondenceChess::bccaddr
2316  set ownname ""
2317  set oppemail ""
2318  set oppname ""
2319  set gameid ""
2320 
2321  ttk::label $w.lownname -text [::tr CCDlgYourName]
2322  ttk::label $w.lownmail -text [::tr CCDlgYourMail]
2323  ttk::label $w.loppname -text [::tr CCDlgOpponentName]
2324  ttk::label $w.loppmail -text [::tr CCDlgOpponentMail]
2325  ttk::label $w.lgameid -text [::tr CCDlgGameID]
2326 
2327  ttk::entry $w.ownname -width 40 -textvariable ownname
2328  ttk::entry $w.ownmail -width 40 -textvariable $ownemail
2329  ttk::entry $w.oppname -width 40 -textvariable oppname
2330  ttk::entry $w.oppmail -width 40 -textvariable oppemail
2331  ttk::entry $w.gameid -width 40 -textvariable gameid
2332 
2333  ttk::button $w.bOk -text OK -command {
2334  ::CorrespondenceChess::startEmailGame \
2335  [.wnewEMailGame.ownname get] \
2336  [.wnewEMailGame.ownmail get] \
2337  [.wnewEMailGame.oppname get] \
2338  [.wnewEMailGame.oppmail get] \
2339  [.wnewEMailGame.gameid get]
2340  destroy .wnewEMailGame
2341  }
2342  ttk::button $w.bCancel -text [::tr "Cancel"] -command "destroy $w"
2343 
2344  grid $w.lownname -sticky e -column 0 -row 0
2345  grid $w.lownmail -sticky e -column 0 -row 1
2346  grid $w.loppname -sticky e -column 0 -row 2
2347  grid $w.loppmail -sticky e -column 0 -row 3
2348  grid $w.lgameid -sticky e -column 0 -row 4
2349 
2350  grid $w.ownname -sticky w -column 1 -row 0 -columnspan 2
2351  grid $w.ownmail -sticky w -column 1 -row 1 -columnspan 2
2352  grid $w.oppname -sticky w -column 1 -row 2 -columnspan 2
2353  grid $w.oppmail -sticky w -column 1 -row 3 -columnspan 2
2354  grid $w.gameid -sticky w -column 1 -row 4 -columnspan 2
2355 
2356  # Buttons and ESC-key
2357  grid $w.bOk -column 1 -row 5 -pady 10
2358  grid $w.bCancel -column 2 -row 5 -pady 10
2359  bind $w <Escape> "$w.bCancel invoke"
2360  bind $w <F1> { helpWindow CCeMailChess}
2361  }
2362  }
2363 
2364  #----------------------------------------------------------------------
2365  # Call an external program via a proper shell
2366  # open and exec call the external without a shell environment
2367  # For Windows make sure that the executable uses its short name
2368  # catch {set mailer [file attributes $mailer -shortname]}
2369  # or it resides in a path without spaces
2370  # For Windows quoting is not possible as usual, < and > are not allowed
2371  # as textual arguments even if quoted properly.
2372  #----------------------------------------------------------------------
2373  proc CallExternal {callstring {param ""}} {
2374  global windowsOS
2375 
2376  if {$windowsOS} {
2377  # On Windows, use the "start" command:
2378  if {[string match $::tcl_platform(os) "Windows NT"]} {
2379  catch {exec $::env(COMSPEC) /c "$callstring $param" &}
2380  } else {
2381  catch {exec start "$callstring $param" &}
2382  }
2383  } else {
2384  # On Unix just call the shell with the converter tool
2385  catch {exec /bin/sh -c "$callstring $param" &}
2386  }
2387  }
2388 
2389  #----------------------------------------------------------------------
2390  # Check whether a Correspondence Database is loaded. Note that the
2391  # first one found is used as reference DB for game processing.
2392  #----------------------------------------------------------------------
2393  proc CheckForCorrDB {} {
2394  global ::windows::switcher::base_types
2395  global ::CorrespondenceChess::Inbox ::CorrespondenceChess::Outbox
2396  global ::CorrespondenceChess::CorrSlot
2397 
2398  set CorrSlot -1
2399  if {$CorrSlot < 0} {
2400  # check for the status window to exist, if not open it
2401  if {![winfo exists .ccWindow]} {
2402  ::CorrespondenceChess::CCWindow
2403  }
2404 
2405  # check for In/Outbox to exist and be accessible
2406  if { [file exists $Inbox] == 0 && ([file isdirectory $Inbox] == 0) } {
2407  set Title [::tr CCDlgTitNoInbox]
2408  set Error [::tr CCErrInboxDir]
2409  append Error "\n $Inbox\n"
2410  append Error [::tr CCErrDirNotUsable]
2411  tk_messageBox -icon warning -type ok -parent . \
2412  -title $Title -message $Error
2413  return
2414  }
2415  if { ([file exists $Outbox] == 0) && ([file isdirectory $Outbox] == 0) } {
2416  set Title [::tr CCDlgTitNoOutbox]
2417  set Error [::tr CCErrOutboxDir]
2418  append Error "\n $Outbox\n"
2419  append Error [::tr CCErrDirNotUsable]
2420  tk_messageBox -icon warning -type ok -parent . \
2421  -title $Title -message $Error
2422  return
2423  }
2424 
2425  set typeCorr [lsearch $base_types {Correspondence chess}]
2426  foreach x [sc_base list] {
2427  set type [getBaseType $x]
2428  if {$type == $typeCorr} {
2429  .ccWindow.top.openDB configure -state disabled
2430  set CorrSlot $x
2431  break
2432  }
2433  }
2434  if {$CorrSlot < 0} {
2435  set Title [::tr CCDlgTitNoCCDB]
2436  set Error [::tr CCErrNoCCDB]
2437  tk_messageBox -icon warning -type ok -parent . \
2438  -title $Title -message $Error
2439  }
2440  }
2441  }
2442 
2443  #----------------------------------------------------------------------
2444  # Opens the DB holding the correspondence games
2445  #----------------------------------------------------------------------
2446  proc OpenCorrespondenceDB {} {
2447  global ::CorrespondenceChess::CorrBase
2448 
2449  ## set fName [file rootname $CorrBase]
2450  set fName $CorrBase
2451 
2452  if {[catch {::file::Open_ $fName} result]} {
2453  set err 1
2454  tk_messageBox -icon warning -type ok -parent . \
2455  -title "Scid: Error opening file" -message $result
2456  } else {
2457  if {[file extension $fName] == ".si3"} {
2458  # file has been converted to si4
2459  set CorrBase "[file rootname $CorrBase].si4"
2460  ::CorrespondenceChess::saveCCoptions
2461  }
2462  set ::initialDir(base) [file dirname $fName]
2463  }
2464  updateBoard -pgn
2465  ::notify::DatabaseChanged
2466 
2467  ::CorrespondenceChess::CheckForCorrDB
2468  }
2469 
2470  #----------------------------------------------------------------------
2471  # Search for a game by Event, Site, White, Black and CmailGameName
2472  # This has to result in only one game matching the criteria.
2473  # No problem with cmail and Xfcc as GameIDs are unique.
2474  #----------------------------------------------------------------------
2475  proc SearchGame {Event Site White Black CmailGameName result refresh} {
2476  global ::CorrespondenceChess::CorrSlot
2477 
2478  # switch to the Correspondence Games DB
2479  sc_base switch $CorrSlot
2480  set move ""
2481 
2482  set sPgnlist {}
2483  lappend sPgnlist [string trim $CmailGameName]
2484 
2485  # Search the header for the game retrieved. Use as much info as
2486  # possible to get a unique result. In principle $sPgnList should
2487  # be enough. However searching indexed fields speeds up things
2488  # a lot in case of large DBs. Also: disregard deleted games,
2489  # this avoids the necessity to compact a db in case of
2490  # accidential duplication of a game.
2491  # -filter 2: Ignore previous searches
2492  set str [sc_search header \
2493  -event $Event \
2494  -site $Site \
2495  -white $White \
2496  -black $Black \
2497  -pgn $sPgnlist \
2498  -flag! D \
2499  -filter 2 \
2500  -gnum [list 1 -1]]
2501 
2502  CorrespondenceChess::updateConsole "info: search [sc_filter count]"
2503 
2504  # There should be only one result. If so, load it and place the
2505  # game pointer to the end of the game ::game::Load also handles
2506  # board rotation if Player Names are set up correctly.
2507  if {[sc_filter count] == 1} {
2508  set filternum [sc_filter first]
2509 
2510  # Refresh windows only if necessary
2511  if {$refresh == 1} {
2512  # ::game::Load also checks the dirty flag and asks to
2513  # save the game in case necessary.
2514  ::game::Load $filternum
2515  } else {
2516  sc_game load $filternum
2517  }
2518 
2519  set Mode [::CorrespondenceChess::CheckMode]
2520 
2521  sc_move end
2522  # Number of moves in the current DB game
2523  set mnCorr [expr {[sc_pos moveNumber]-1}]
2524  set side [sc_pos side]
2525 
2526  # Number of moves in the new game in Clipbase
2527  sc_base switch $::clipbase_db
2528  sc_move end
2529  set mnClip [sc_pos moveNumber]
2530 
2531  if {$side == "white"} {
2532  set plyStart [expr {$mnCorr*2-1}]
2533  } else {
2534  set plyStart [expr {$mnCorr*2}]
2535  }
2536 
2537  set side [sc_pos side]
2538  if {$side == "white"} {
2539  set plyEnd [expr {$mnClip*2-1}]
2540  } else {
2541  set plyEnd [expr {$mnClip*2}]
2542  }
2543 
2544  # Check if the games mainline in DB contains more ply than
2545  # the game in the clipbase. If so inform the user.
2546  if {($plyEnd-$plyStart < 2) && ($Mode == "XFCC") && ($result == "*")} {
2547  set Title [::tr CCDlgDBGameToLong]
2548  set Error [::tr CCDlgDBGameToLongError]
2549  tk_messageBox -icon warning -type ok -parent . \
2550  -title $Title -message "$Error $mnClip (= ply $plyEnd)"
2551  }
2552 
2553  # Add moves from the relayed games if the mode is not Postal.
2554  # On mixed ICCF Events also the ICCF server deliveres an
2555  # empty game via Xfcc, therefore this check is required
2556  if {$Mode != "Postal"} {
2557 
2558  # Add moves from clipbase to the DB game. This keeps
2559  # comments, but requires that tries are inserted as variants
2560  # as it is always appended to the end of the game
2561  for {set x $plyStart} {$x < $plyEnd} {incr x} {
2562  set basecomment ""
2563  set comment ""
2564 
2565  sc_base switch $::clipbase_db
2566 
2567  # move to the beginning of the new part
2568  sc_move start
2569  sc_move forward [expr {$x+1}]
2570 
2571  # Get the move in _untranslated_ form...
2572  set move [sc_game info nextMoveNT]
2573  # ... move on one ply ...
2574  sc_move forward
2575  # ... and get the comment
2576  set comment [sc_pos getComment]
2577 
2578  # switch to Correspondence DB and add the move and comment
2579  sc_base switch $CorrSlot
2580  sc_move addSan $move
2581 
2582  # Get the comment stored in the base for comparison
2583  set basecomment [sc_pos getComment]
2584 
2585  # Some servers keep old comments within the game
2586  # (SchemingMind) some don't (ICCF). Try to preserve
2587  # comments inserted by the user as well as add new
2588  # responses properly.
2589  set sbasecomment ""
2590  set scomment ""
2591 
2592  # Strip of [%ccsnt...] like comments (SchemingMind time stamps)
2593  regsub -all {\[.*\]} $basecomment "" sbasecomment
2594  regsub -all {^\s*} $sbasecomment "" sbasecomment
2595  # Strip of "Name: " to compare original text entered by
2596  # the user only.
2597  regsub -all "$White:" $sbasecomment "" sbasecomment
2598  regsub -all "$Black:" $sbasecomment "" sbasecomment
2599 
2600  # Same for the game delivered by Xfcc
2601  regsub -all {\[.*\]} $comment "" scomment
2602  regsub -all {^\s*} $scomment "" scomment
2603  regsub -all "$White:" $scomment "" scomment
2604  regsub -all "$Black:" $scomment "" scomment
2605 
2606  # Check what to preserve and which comment to set.
2607  if { [string length $sbasecomment] == 0} {
2608  sc_pos setComment "$comment"
2609  } elseif { [string length $scomment] < [string length $sbasecomment]} {
2610  # base contains more text than the one retrieved
2611  if { [string first $scomment $sbasecomment] < 0 } {
2612  sc_pos setComment "$basecomment $comment"
2613  }
2614  } else {
2615  # retrieved game contains more text than the stored
2616  if { [string first $sbasecomment $scomment] < 0 } {
2617  sc_pos setComment "$basecomment $comment"
2618  } else {
2619  sc_pos setComment "$comment"
2620  }
2621  }
2622  }
2623  sc_game tags set -result $result
2624  sc_base switch $CorrSlot
2625  sc_game save $filternum
2626 
2627  # Only refresh when SearchGame was triggered by the user,
2628  # otherwise just reload the game but leave the window in
2629  # state to save considerable amount of time
2630  if {$refresh == 1} {
2631  ::game::Load $filternum
2632  } else {
2633  sc_game load $filternum
2634  }
2635  } else {
2636  # only switch to base for postal games
2637  sc_base switch $CorrSlot
2638  }
2639  } elseif {[sc_filter count] == 0} {
2640  # No matching game found, add it as a new one
2641  # Clear the current game first, then just paste the clipboard
2642  # game as it is. No need to do something as complex as for
2643  # already existing games above.
2644  game::Clear
2645  sc_clipbase paste
2646  # append the current game without asking and the header
2647  # supplied
2648  # gameAdd gets confused here with with an altered game opeing
2649  # another dialogue besides the save game
2650  sc_game save 0
2651 
2652  CorrespondenceChess::updateConsole "info: new game added"
2653  } else {
2654  if {[winfo exists .glistWin]} {
2655  raise .glistWin
2656  } else {
2657  ::windows::gamelist::Open
2658  }
2659  set Title [::tr CCDlgDuplicateGame]
2660  set Error [::tr CCDlgDuplicateGameError]
2661  tk_messageBox -icon warning -type ok -parent . \
2662  -title $Title -message $Error
2663  }
2664  ::notify::DatabaseChanged
2665  }
2666 
2667  #----------------------------------------------------------------------
2668  # If a Correspondence DB is loaded, switch to the clipbase and
2669  # use the game with the given id to find headers.
2670  # PGN file and jump to the game number given. Then extract the
2671  # header tags and call "SearchGame" to display the game in question
2672  # to the user.
2673  #----------------------------------------------------------------------
2674  proc ProcessServerResult {game} {
2675  global ::CorrespondenceChess::CorrSlot
2676  global emailData
2677 
2678  # Regardless how the user opened this DB, find it! ;)
2679  ::CorrespondenceChess::CheckForCorrDB
2680  # Only proceed if a correspondence DB is already loaded
2681  if {$CorrSlot > -1} {
2682  sc_base switch $::clipbase_db
2683  sc_game load $game
2684 
2685  # get the header
2686  set Event [sc_game tags get Event]
2687  set Site [sc_game tags get Site]
2688  set White [sc_game tags get White]
2689  set Black [sc_game tags get Black]
2690  set Extra [sc_game tags get Extra]
2691  set result [sc_game tags get Result]
2692  # CmailGameName is an extra header :(
2693  set extraTagsList [split $Extra "\n"]
2694 
2695  # ... extract it as it contains the unique ID
2696  foreach i $extraTagsList {
2697  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
2698  set CmailGameName [string range $i 15 end-1]
2699  }
2700  }
2701 
2702  # set these variables for email games where they get no
2703  # values otherwise
2704  set noENG "false"
2705  set drawoffer "false"
2706  # Search the game in the correspondence DB and display it
2707  foreach xfccextra $::Xfcc::xfccstate {
2708  if { [string equal -nocase [lindex $xfccextra 0] "$CmailGameName"] } {
2709  foreach i $xfccextra {
2710  if { [string equal -nocase [lindex $i 0] "noEngines"] } {
2711  set noENG [string range $i 10 end]
2712  }
2713  if { [string equal -nocase [lindex $i 0] "drawOffered"] } {
2714  set drawoffer [string range $i 12 end]
2715  }
2716  }
2717  }
2718  }
2719  if {$noENG == "true"} {
2720  ::CorrespondenceChess::EnableEngineAnalysis 0
2721  } else {
2722  ::CorrespondenceChess::EnableEngineAnalysis 1
2723  }
2724 
2725  # After this search the windows need to be refreshed to show
2726  # the current state
2727  SearchGame $Event $Site $White $Black $CmailGameName $result 1
2728 
2729  set Mode [::CorrespondenceChess::CheckMode]
2730 
2731  # hook up with the old email manager: this implements the
2732  # manual timestamping required
2733  if {($Mode == "EM") || ($Mode == "Relay") || ($Mode == "Postal")} {
2734  set emailData [::tools::email::readOpponentFile]
2735  set done 0
2736  set idx 0
2737  # search through the whole list and check if the current
2738  # game was already defined to be an email game.
2739  foreach dataset $emailData {
2740  if { [lindex $dataset 0] == $CmailGameName} {
2741  set done 1
2742  # add the received flag and date
2743  ::tools::email::addSentReceived $idx r
2744  }
2745  incr idx
2746  }
2747  if {$done < 1} {
2748  set idx [llength $emailData]
2749  lappend emailData [list "" "" "" "" ""]
2750  set emailData [lreplace $emailData $idx $idx \
2751  [list "$CmailGameName" "somewhere@somehost.org" "scid game" [sc_filter first] "-- "]]
2752  ::tools::email::writeOpponentFile $emailData
2753  ::tools::email::refresh
2754  # add the received flag and date
2755  ::tools::email::addSentReceived $idx r
2756  }
2757  }
2758  # Jump to the end of the game and update the display
2759  ::move::End
2760  if {$drawoffer == "true"} {
2761  .ccWindow.top.acceptDraw configure -state normal
2762  set comment [sc_pos getComment]
2763  set drwstr "- [::tr Draw] -"
2764  if { [regexp "$drwstr" $comment] } {
2765  } else {
2766  sc_pos setComment "$comment $drwstr"
2767  updateBoard -pgn
2768  }
2769  } else {
2770  .ccWindow.top.acceptDraw configure -state disabled
2771  }
2772 
2773 
2774  # Set some basic info also to the button tooltips
2775  ::utils::tooltip::Set .ccWindow.top.resign "$CmailGameName: $Event\n$Site\n\n$White - $Black"
2776  ::utils::tooltip::Set .ccWindow.top.claimDraw "$CmailGameName: $Event\n$Site\n\n$White - $Black"
2777  ::utils::tooltip::Set .ccWindow.top.acceptDraw "$CmailGameName: $Event\n$Site\n\n$White - $Black"
2778  ::utils::tooltip::Set .ccWindow.top.offerDraw "$CmailGameName: $Event\n$Site\n\n$White - $Black"
2779  }
2780  }
2781 
2782  #----------------------------------------------------------------------
2783  # Checks the mode of the current game and return it (EM or XFCC).
2784  # Additionally update the button status in the Console window
2785  # accordingly and update the console itself with $Event, Mode and
2786  # $Site.
2787  #----------------------------------------------------------------------
2788  proc CheckMode {} {
2789  set Event [sc_game tags get Event]
2790  set Site [sc_game tags get Site]
2791  set Extra [sc_game tags get Extra]
2792  # CmailGameName is an extra header :(
2793  set extraTagsList [split $Extra "\n"]
2794 
2795  # ... extract it as it contains the unique ID
2796  foreach i $extraTagsList {
2797  if { [string equal -nocase [lindex $i 0] "Mode"] } {
2798  set Mode [string range $i 6 end-1]
2799  }
2800  }
2801 
2802  set m .menu.play.correspondence
2803 
2804  # do not set state of top.acceptDraw as this is set dynamically
2805  if {($Mode == "EM") || ($Mode == "Relay") || ($Mode == "Postal")} {
2806  if {$Mode == "EM"} {
2807  ::CorrespondenceChess::updateConsole "info Event: $Event (eMail-based)"
2808  } elseif {$Mode == "Relay"} {
2809  ::CorrespondenceChess::updateConsole "info Event: $Event (observed)"
2810  } elseif {$Mode == "Postal"} {
2811  ::CorrespondenceChess::updateConsole "info Event: $Event (postal)"
2812  }
2813 
2814  # eMail/postal games: manual handling for resign and draw is
2815  # needed, no standard way/protocol exists => disable the
2816  # buttons and menu entries accordingly
2817  .ccWindow.top.resign configure -state disabled
2818  .ccWindow.top.claimDraw configure -state disabled
2819  .ccWindow.top.offerDraw configure -state disabled
2820  # .ccWindow.top.acceptDraw configure -state disabled
2821 
2822  $m entryconfigure 8 -state disabled
2823  $m entryconfigure 9 -state disabled
2824  $m entryconfigure 10 -state disabled
2825  $m entryconfigure 11 -state disabled
2826  } else {
2827  .ccWindow.top.resign configure -state normal
2828  .ccWindow.top.claimDraw configure -state normal
2829  .ccWindow.top.offerDraw configure -state normal
2830  # .ccWindow.top.acceptDraw configure -state normal
2831  ::CorrespondenceChess::updateConsole "info Event: $Event (Xfcc-based)"
2832 
2833  $m entryconfigure 8 -state normal
2834  $m entryconfigure 9 -state normal
2835  $m entryconfigure 10 -state normal
2836  $m entryconfigure 11 -state normal
2837  }
2838  ::CorrespondenceChess::updateConsole "info Site: $Site"
2839 
2840  return $Mode
2841  }
2842 
2843  #----------------------------------------------------------------------
2844  # Search the previous game from the input file in the correspondence DB
2845  # If at last game already nothing happens
2846  #----------------------------------------------------------------------
2847  proc PrevGame {} {
2848  global ::CorrespondenceChess::CorrSlot ::CorrespondenceChess::num
2849  set gamecount $::CorrespondenceChess::glgames
2850 
2851  busyCursor .
2852  # Regardless how the user opened this DB, find it! ;)
2853  ::CorrespondenceChess::CheckForCorrDB
2854  if {$CorrSlot > -1} {
2855  if {$num > 1} {
2856  set num [expr {$num - 1}]
2857  SetHighlightedLine
2858  ::CorrespondenceChess::ProcessServerResult $::CorrespondenceChess::num
2859  }
2860  }
2861  unbusyCursor .
2862  }
2863 
2864  #----------------------------------------------------------------------
2865  # Search the next game from the input file in the correspondence DB
2866  # If at last game already nothing happens
2867  #----------------------------------------------------------------------
2868  proc NextGame {} {
2869  global ::CorrespondenceChess::CorrSlot ::CorrespondenceChess::num
2870  set gamecount $::CorrespondenceChess::glgames
2871 
2872  busyCursor .
2873  # Regardless how the user opened this DB, find it! ;)
2874  ::CorrespondenceChess::CheckForCorrDB
2875  if {$CorrSlot > -1} {
2876  if {$num < $gamecount} {
2877  set num [expr {$num + 1}]
2878  SetHighlightedLine
2879  ::CorrespondenceChess::ProcessServerResult $::CorrespondenceChess::num
2880  }
2881  }
2882  unbusyCursor .
2883  }
2884 
2885  #----------------------------------------------------------------------
2886  # FetchGames: retrieve games via Xfcc
2887  #----------------------------------------------------------------------
2888  proc FetchGames {} {
2889  global ::CorrespondenceChess::Inbox ::CorrespondenceChess::XfccFetchcmd ::CorrespondenceChess::CorrSlot
2890  busyCursor .
2891 
2892  # Regardless how the user opened this DB, find it! ;)
2893  ::CorrespondenceChess::CheckForCorrDB
2894  # Only proceed if a correspondence DB is already loaded
2895  if {$CorrSlot > -1} {
2896  if {$::CorrespondenceChess::XfccInternal == 1} {
2897  # use internal Xfcc-handling
2898  ::Xfcc::ReadConfig $::CorrespondenceChess::xfccrcfile
2899  ::Xfcc::ProcessAll $::CorrespondenceChess::Inbox
2900  } else {
2901  # call external protocol handler
2902  if {[file executable "$XfccFetchcmd"]} {
2903  ::CorrespondenceChess::updateConsole "info Calling external fetch tool $XfccFetchcmd..."
2904  CallExternal "$XfccFetchcmd $Inbox"
2905  }
2906  }
2907  # Fetch games that should be relayed from the ICCF Server
2908  ::CorrespondenceChess::updateConsole "info Fetching relayed games from ICCF..."
2909  foreach g $::CorrespondenceChess::RelayGames {
2910  ::CorrespondenceChess::RelayGames $g
2911  }
2912  # process what was just retrieved
2913  ::CorrespondenceChess::ReadInbox
2914  }
2915  unbusyCursor .
2916  }
2917 
2918  #----------------------------------------------------------------------
2919  # EmptyInOutbox: remove all pgn files currently stored in in- and
2920  # outbox directories to get a fresh fetch
2921  #----------------------------------------------------------------------
2922  proc EmptyInOutbox {} {
2923  global ::CorrespondenceChess::Inbox ::CorrespondenceChess::Outbox
2924  global windowsOS
2925 
2926  if {$windowsOS} {
2927  set inpath "$Inbox\\"
2928  set outpath "$Outbox\\"
2929  } else {
2930  set inpath "$Inbox/"
2931  set outpath "$Outbox/"
2932  }
2933  set result [tk_dialog .roDialog "Scid: [tr CCDlgDeleteBoxes]" \
2934  $::tr(CCDlgDeleteBoxesText) "" 1 $::tr(Yes) $::tr(No)]
2935  if {$result == 0} {
2936  foreach f [glob -nocomplain [file join $inpath *]] {
2937  file delete $f
2938  }
2939  foreach f [glob -nocomplain [file join $outpath *]] {
2940  file delete $f
2941  }
2942  set filename [scidConfigFile xfccstate]
2943  file delete $filename
2944 
2945  # clean also status information as they're now invalid!
2946  set ::Xfcc::xfccstate {}
2947 
2948  ::CorrespondenceChess::emptyGamelist
2949  }
2950 
2951  }
2952 
2953  #----------------------------------------------------------------------
2954  # ReadInbox: process the inbox game per game by adding them one by
2955  # one to the clipboard.
2956  #----------------------------------------------------------------------
2957  proc ReadInbox {} {
2958  global ::CorrespondenceChess::Inbox ::CorrespondenceChess::CorrSlot
2959  global ::CorrespondenceChess::glccstart ::CorrespondenceChess::glgames windowsOS
2960  global ::Xfcc::lastupdate ::Xfcc::xfccstate
2961 
2962  set pgnopen 0
2963 
2964  busyCursor .
2965 
2966  if {$windowsOS} {
2967  set inpath "$Inbox\\"
2968  } else {
2969  set inpath "$Inbox/"
2970  }
2971 
2972  # Regardless how the user opened this DB, find it! ;)
2973  ::CorrespondenceChess::CheckForCorrDB
2974 
2975  set games 0
2976  if {$CorrSlot > -1} {
2977 
2978  # extract the number of the last move using Scid's internal
2979  # PGN parser as comments etc. might appear, and this number
2980  # is not given via Xfcc. Similar for the event date.
2981  sc_clipbase clear
2982  sc_base switch $::clipbase_db"
2983  set game 0
2984  set gamemoves {}
2985  foreach f [glob -nocomplain [file join $inpath *]] {
2986  catch {sc_base import [sc_base current] $f}
2987  set game [expr {$game + 1}]
2988  sc_game load $game
2989  sc_move end
2990  set number [sc_pos moveNumber]
2991  set Date [sc_game tags get Date]
2992  set Extra [sc_game tags get Extra]
2993  set extraTagsList [split $Extra "\n"]
2994  foreach i $extraTagsList {
2995  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
2996  set CmailGameName [string range $i 15 end-1]
2997  }
2998  }
2999  lappend gamemoves [list $CmailGameName $number $Date]
3000  }
3001 
3002  # generate a list of games retrieved by Xfcc. Add game-ID and
3003  # timing to two lists: one holds all games and one holds
3004  # those the user does not have the move (they may be skipped
3005  # in display)
3006  set xfcclist {}
3007  set filelist {}
3008  set skiplist {}
3009  set sortmode "-ascii"
3010 
3011  foreach xfccextra $::Xfcc::xfccstate {
3012  set CmailGameName [lindex $xfccextra 0]
3013  set criterion 0
3014  set timepermove 0
3015  set mytime 0
3016  set opptime 0
3017  set movestoTC 1
3018  set tincrement 0
3019  set moves 0
3020  set myTurn "false"
3021  set TimeControl "10/50"
3022  set idx [lsearch -exact -index 0 $gamemoves $CmailGameName]
3023  set number [lindex [lindex $gamemoves $idx] 1]
3024  set Date [lindex [lindex $gamemoves $idx] 2]
3025  regsub -all {\.} $Date "" Date
3026 
3027  foreach i $xfccextra {
3028  if { [string equal -nocase [lindex $i 0] "myTurn"] } {
3029  set myTurn [string range $i 7 end]
3030  }
3031  if { [string equal -nocase [lindex $i 0] "mytime"] } {
3032  set mytime [string range $i 7 end]
3033  }
3034  if { [string equal -nocase [lindex $i 0] "opptime"] } {
3035  set opptime [string range $i 8 end]
3036  }
3037  if { [string equal -nocase [lindex $i 0] "TimeControl"] } {
3038  set TCstr [string range $i 13 end]
3039  # Calculate the moves to the next time control.
3040  # Makes sense only if no Fischer Clock is used.
3041  if { [regexp {/} $TCstr]} {
3042  set TC [split $TCstr "/"]
3043  set moves [ lindex $TC 0]
3044  set tincrement [ lindex $TC 1]
3045  regsub -all "d.*" $tincrement "" tincrement
3046  set movestoTC [ expr {$moves - ($number % $moves)}]
3047  } else {
3048  # Fischer Clock
3049  set moves 1
3050  }
3051  }
3052  }
3053  set mytime [expr {int($mytime / 60.0 / 24.0)}]
3054 
3055  # Calculate the time per move till next TC: include also
3056  # the next time control periode in this calculation
3057  set timepermove1 [expr {($mytime+$tincrement) / ($movestoTC+$moves)}]
3058  set timepermove2 [expr {$mytime / $movestoTC}]
3059 
3060  # Time per move is the minimum of the two above
3061  set timepermove [expr min($timepermove1, $timepermove2)]
3062 
3063  # Define criteria to be added to the list to sort. Classic
3064  # mode is handled below by resorting the clipbase
3065  switch -regexp -- $::CorrespondenceChess::ListOrder \
3066  "$::CorrespondenceChess::CCOrderMyTime" {
3067  set criterion $mytime
3068  set sortmode "-integer"
3069  } \
3070  "$::CorrespondenceChess::CCOrderOppTime" {
3071  set criterion $opptime
3072  set sortmode "-integer"
3073  } \
3074  "$::CorrespondenceChess::CCOrderTimePerMove" {
3075  set criterion $timepermove
3076  set sortmode "-real"
3077  } \
3078  "$::CorrespondenceChess::CCOrderStartDate" {
3079  set criterion $Date
3080  set sortmode "-integer"
3081  }
3082 
3083  if {($myTurn == "false") && ($::CorrespondenceChess::ListOnlyOwnMove == 1) } {
3084  lappend skiplist [list $CmailGameName $criterion]
3085  } else {
3086  lappend filelist [list $CmailGameName $criterion]
3087  }
3088  lappend xfcclist [list $CmailGameName]
3089  }
3090 
3091  # sort file list by mytime, ascending
3092  set filelist [lsort -index 1 "$sortmode" $filelist]
3093  set skiplist [lsort -index 1 "$sortmode" $skiplist]
3094 
3095  ::CorrespondenceChess::emptyGamelist
3096  sc_clipbase clear
3097  sc_base switch $::clipbase_db
3098 
3099  # Loop over all files and add all game files that are not
3100  # Xfcc (ie. eMail chess)
3101  foreach f [glob -nocomplain [file join $inpath *]] {
3102  set id [file tail $f]
3103  regsub -all ".pgn" $id "" id
3104  if { [lsearch $xfcclist "$id"] < 0 } {
3105  set filelist [concat $id $filelist]
3106  }
3107  }
3108 
3109  # import the games on basis of the sorted list created above
3110  foreach f $filelist {
3111  set filename "[file join $inpath [lindex $f 0]].pgn"
3112  if {[catch {sc_base import [sc_base current] $filename} result]} {
3113  ::CorrespondenceChess::updateConsole "info Error retrieving server response from $filename"
3114  } else {
3115  # count the games processed successfully
3116  set games [expr {$games+1}]
3117  }
3118  }
3119 
3120  set glgames $games
3121 
3122  # For Classic sorting: sort the clipbase, this is easier
3123  # to implement than individual sorting upon import.
3124  if {$::CorrespondenceChess::ListOrder == $::CorrespondenceChess::CCOrderClassic} {
3125  tk_messageBox -message "oops, 300+ lines functions are not maintainable"
3126  }
3127 
3128 
3129  if {$glgames > 0} {
3130  # work through all games processed and fill in the gamelist
3131  # in the console window
3132 
3133  for {set game $glccstart} {$game < [expr {$games+1}]} {incr game} {
3134 
3135  set clockW "no update"; set clockB "no update";
3136  set var ""; set noDB "";
3137  set noBK ""; set noTB "";
3138  set noENG ""; set mess ""
3139  set TC ""; set drawoffer "false";
3140  set wc ""; set bc "";
3141  set YM " ? ";
3142 
3143  sc_base switch $::clipbase_db
3144  sc_game load $game
3145  # get the header
3146  set Event [sc_game tags get Event]
3147  set Site [sc_game tags get Site]
3148  set Date [sc_game tags get Date]
3149  set White [sc_game tags get White]
3150  set Black [sc_game tags get Black]
3151  set Result [sc_game tags get Result]
3152  set Extra [sc_game tags get Extra]
3153  # CmailGameName is an extra header :(
3154  set extraTagsList [split $Extra "\n"]
3155  foreach i $extraTagsList {
3156  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3157  set CmailGameName [string range $i 15 end-1]
3158  }
3159  }
3160  #
3161  # Switch to the real database to retrieve locally
3162  # stored additions like addresses, countries etc.
3163  # Disable refresh for SearchGame to speed up the list
3164  # building considerably
3165  SearchGame $Event $Site $White $Black $CmailGameName $result 0
3166  sc_base switch $CorrSlot
3167  set Extra [sc_game tags get Extra]
3168  set extraTagsList [split $Extra "\n"]
3169 
3170  # ... extract it as it contains the unique ID
3171  foreach i $extraTagsList {
3172  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3173  set CmailGameName [string range $i 15 end-1]
3174  }
3175  if { [string equal -nocase [lindex $i 0] "Mode"] } {
3176  set Mode [string range $i 6 end-1]
3177  }
3178  if { [string equal -nocase [lindex $i 0] "whiteCountry"] } {
3179  set wc [string range $i 14 end-1]
3180  set wc [string tolower $wc]
3181  set wc "flag_$wc"
3182  }
3183  if { [string equal -nocase [lindex $i 0] "blackCountry"] } {
3184  set bc [string range $i 14 end-1]
3185  set bc [string tolower $bc]
3186  set bc "flag_$bc"
3187  }
3188  if { [string equal -nocase [lindex $i 0] "WhiteCountry"] } {
3189  set wc [string range $i 14 end-1]
3190  set wc [string tolower $wc]
3191  set wc "flag_$wc"
3192  }
3193  if { [string equal -nocase [lindex $i 0] "BlackCountry"] } {
3194  set bc [string range $i 14 end-1]
3195  set bc [string tolower $bc]
3196  set bc "flag_$bc"
3197  }
3198  if { [string equal -nocase [lindex $i 0] "TimeControl"] } {
3199  set TC [string range $i 13 end-1]
3200  }
3201  }
3202  sc_move end
3203  set number [sc_pos moveNumber]
3204  set move [sc_game info previousMoveNT]
3205  set side [sc_pos side]
3206 
3207  if {$side == "white"} {
3208  set number [expr {$number-1}]
3209  set lastmove "$number...$move"
3210  } else {
3211  set lastmove "$number. $move"
3212  }
3213  ::CorrespondenceChess::updateConsole "info TC (base): $TC..."
3214 
3215  if {$Mode == "EM"} {
3216  ::CorrespondenceChess::updateGamelist $CmailGameName "EML" \
3217  $Event $Site $Date $White $Black "" "" "" "" $TC "" "" \
3218  $wc $bc "" "" $lastmove "false"
3219  } elseif {$Mode == "Relay"} {
3220  ::CorrespondenceChess::updateGamelist $CmailGameName "REL" \
3221  $Event $Site $Date $White $Black "" "" "" "" $TC "" "" \
3222  $wc $bc "" "" $lastmove "false"
3223  } elseif {$Mode == "Postal"} {
3224  ::CorrespondenceChess::updateGamelist $CmailGameName "POS" \
3225  $Event $Site $Date $White $Black "" "" "" "" $TC "" "" \
3226  $wc $bc "" "" $lastmove "false"
3227  } else {
3228  # actually check the $xfccstate list for the current
3229  # values. If it is not set (e.g. only inbox processed
3230  # buy no current retrieval) set some default values.
3231  foreach xfccextra $::Xfcc::xfccstate {
3232  if { [string equal -nocase [lindex $xfccextra 0] "$CmailGameName"] } {
3233  foreach i $xfccextra {
3234  if { [string equal -nocase [lindex $i 0] "myTurn"] } {
3235  if {[string range $i 7 end] == "true"} {
3236  set YM "yes"
3237  } else {
3238  set YM "no"
3239  }
3240  }
3241  if { [string equal -nocase [lindex $i 0] "clockW"] } {
3242  set clockW [string range $i 7 end]
3243  regsub -all "\{" $clockW "" clockW
3244  regsub -all "\}" $clockW "" clockW
3245  }
3246  if { [string equal -nocase [lindex $i 0] "clockB"] } {
3247  set clockB [string range $i 7 end]
3248  regsub -all "\{" $clockB "" clockB
3249  regsub -all "\}" $clockB "" clockB
3250  }
3251  if { [string equal -nocase [lindex $i 0] "drawOffered"] } {
3252  set drawoffer [string range $i 12 end]
3253  }
3254  if { [string equal -nocase [lindex $i 0] "variant"] } {
3255  set var [string range $i 8 end]
3256  }
3257  if { [string equal -nocase [lindex $i 0] "noDatabases"] } {
3258  set noDB [string range $i 12 end]
3259  }
3260  if { [string equal -nocase [lindex $i 0] "noOpeningBooks"] } {
3261  set noBK [string range $i 15 end]
3262  }
3263  if { [string equal -nocase [lindex $i 0] "noTablebases"] } {
3264  set noTB [string range $i 13 end]
3265  }
3266  if { [string equal -nocase [lindex $i 0] "noEngines"] } {
3267  set noENG [string range $i 10 end]
3268  }
3269  if { [string equal -nocase [lindex $i 0] "TimeControl"] } {
3270  set TC [string range $i 13 end-1]
3271  }
3272  if { [string equal -nocase [lindex $i 0] "message"] } {
3273  set mess [string range $i 9 end-1]
3274  }
3275  }
3276  }
3277  }
3278  if {$Result == "1"} {
3279  set YM "1-0"
3280  } elseif {$Result == "0"} {
3281  set YM "0-1"
3282  } elseif {$Result == "="} {
3283  set YM " = "
3284  }
3285  ::CorrespondenceChess::updateConsole "info TC (xfcc): $TC..."
3286  ::CorrespondenceChess::updateGamelist $CmailGameName $YM \
3287  $Event $Site $Date $White $Black $clockW $clockB $var \
3288  $noDB $noBK $noTB $noENG $wc $bc $mess $TC $lastmove $drawoffer
3289  }
3290  }
3291  # ::CorrespondenceChess::num is the game currently shown
3292  set ::CorrespondenceChess::num 0
3293  # current game is game 0 -> go to game 1 in the list
3294  ::CorrespondenceChess::NextGame
3295  } else {
3296  set Title [::tr CCDlgTitNoGames]
3297  set Error [::tr CCErrInboxDir]
3298  append Error "\n $Inbox\n"
3299  append Error [::tr CCErrNoGames]
3300  tk_messageBox -icon warning -type ok -parent . \
3301  -title $Title -message $Error
3302  }
3303  }
3304  unbusyCursor .
3305  }
3306 
3307  #----------------------------------------------------------------------
3308  # Send the move to the opponent via eMail
3309  # This requires an external MTA that is capable of sending a pgn file
3310  # as attachment (content-type: application/x-chess-pgn). This can be
3311  # accomplished by nail with proper /etc/mime.types (default on debian).
3312  # Additionally the program has to handle SMTP-Auth in all its flavours
3313  # to be of any use in present days.
3314  # A stripped version of the game is placed in outbox and sent to the
3315  # opponent. As nail does not handle empty bodies it is sent as text
3316  # within the body and once attached for easy extraction with mail
3317  # programs that do not know a thing about piping.
3318  # After the mail is sent a full featured version of the pgn is placed
3319  #----------------------------------------------------------------------
3320  proc eMailMove { } {
3321  global ::CorrespondenceChess::Outbox \
3322  ::CorrespondenceChess::mailer ::CorrespondenceChess::mailermode \
3323  ::CorrespondenceChess::attache ::CorrespondenceChess::subject \
3324  ::CorrespondenceChess::bccaddr ::CorrespondenceChess::CorrSlot
3325  global emailData
3326  global windowsOS
3327 
3328  busyCursor .
3329 
3330  # Regardless how the user opened this DB, find it! ;)
3331  ::CorrespondenceChess::CheckForCorrDB
3332 
3333  if {$CorrSlot > -1} {
3334  # move to end to show the location to send AND to get the right
3335  # side to move, ie. for the extraction of the correct To: address
3336  ::move::End
3337  set Event [sc_game tags get Event]
3338  set Site [sc_game tags get Site]
3339  set Date [sc_game tags get Date]
3340  set Round [sc_game tags get Round]
3341  set Result [sc_game tags get Result]
3342  set White [sc_game tags get White]
3343  set Black [sc_game tags get Black]
3344  set Extra [sc_game tags get Extra]
3345  set Extra [sc_game tags get Extra]
3346  set extraTagsList [split $Extra "\n"]
3347 
3348  foreach i $extraTagsList {
3349  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3350  set CmailGameName [string range $i 15 end-1]
3351  }
3352  if { [string equal -nocase [lindex $i 0] "WhiteNA"] } {
3353  set WhiteNA [string range $i 9 end-1]
3354  }
3355  if { [string equal -nocase [lindex $i 0] "BlackNA"] } {
3356  set BlackNA [string range $i 9 end-1]
3357  }
3358  }
3359 
3360  # construct a PGN in Outbox, stripped bare of comments and variations
3361  set pgnfile "[file join $Outbox $CmailGameName].pgn"
3362 
3363  sc_base export "current" "PGN" $pgnfile -append 0 -comments 0 -variations 0 \
3364  -space 1 -symbols 0 -indentC 0 -indentV 0 -column 0 -noMarkCodes 0 -convertNullMoves 1
3365 
3366  # sc_game pgn -gameNumber $i -width 70 -tags 0 -variations 0 -comments 0]
3367 
3368  # try to handle some obscure problem that the file is not
3369  # existent yet when calling the mailer
3370  while {! [file exists $pgnfile]} {
3371  after 1500 puts "waiting..."
3372  }
3373  # send the game to the side to move
3374  set toMove [sc_pos side]
3375 
3376  if {$toMove == "white"} {
3377  set to $WhiteNA
3378  set from $BlackNA
3379  } else {
3380  set from $WhiteNA
3381  set to $BlackNA
3382  }
3383 
3384  # get rid of spaces in names by using Windows internal real names
3385  if {$windowsOS} {
3386  catch {set mailer [file attributes $mailer -shortname]}
3387  }
3388 
3389  set title "scid mail 1 game ($CmailGameName)"
3390  set body "Final FEN: "
3391  append body [sc_pos fen]
3392  append body "\n\n"
3393  append body "Move List: "
3394  append body [sc_game moves]
3395  append body "\n\n"
3396 
3397  # Check what calling convention to use:
3398  # - mailx : something like mailx, mutt, nail or whatever via
3399  # commandline. This sends the mail without further
3400  # intervention by the user
3401  # - mozilla: call a mozilla or descendent like icedove or
3402  # thunderbird. This syntax is found somewhere in the
3403  # developers docs and almost entirely undocumented
3404  # - mailurl: the same syntax as for mailto:-links in webpages
3405  # (rfc 2368). This calling convention is supported by
3406  # evolution
3407  # -claws : Claws mailer, seems to be almost mailurl, but needs
3408  # a parameter for attachments
3409  switch -regexp -- $::CorrespondenceChess::mailermode \
3410  "mailx" {
3411  set callstring "$mailer $subject \"$title\" -b $bccaddr $attache \"$pgnfile\" $to <\"$pgnfile\""
3412  } \
3413  "mozilla" {
3414  if {$windowsOS} {
3415  set callstring "$mailer -compose subject='$title',bcc=$bccaddr,attachment='file:///$pgnfile',to=$to,body=$body"
3416  } else {
3417  set callstring "$mailer -compose subject='$title',bcc=$bccaddr,attachment='file://$pgnfile',to='$to',body='$body'"
3418  }
3419  } \
3420  "mailurl" {
3421  set callstring "$mailer \'mailto:<$to>?bcc=$bccaddr\&subject=$title\&attach=$pgnfile\&body=$body\'"
3422  } \
3423  "claws" {
3424  set callstring "$mailer --compose \'mailto:$to?subject=$title&cc=$bccaddr&body=$body\' --attach \"$pgnfile\""
3425  }
3426  ::CorrespondenceChess::updateConsole "info Calling eMail program: $mailer..."
3427  CallExternal $callstring
3428 
3429  # Save the game once the move is sent
3430  set num [sc_game number]
3431  sc_game save $num
3432 
3433  # Hook up with email manager: search the game in its internal
3434  # list and add the send flag automatically.
3435  set done 0
3436  set idx 0
3437  foreach dataset $emailData {
3438  if { [lindex $dataset 0] == $CmailGameName} {
3439  set done 1
3440  # add the sent flag and date
3441  ::tools::email::addSentReceived $idx s
3442  }
3443  incr idx
3444  }
3445  }
3446 
3447  unbusyCursor .
3448  }
3449 
3450  #----------------------------------------------------------------------
3451  # Send the move to the opponent via XFCC or eMail
3452  #----------------------------------------------------------------------
3453  proc SendMove {resign claimDraw offerDraw acceptDraw } {
3454  global ::CorrespondenceChess::Outbox
3455  global ::CorrespondenceChess::XfccSendcmd
3456  global ::CorrespondenceChess::CorrSlot
3457  global ::CorrespondenceChess::XfccConfirm
3458  global ::CorrespondenceChess::num
3459 
3460  busyCursor .
3461 
3462  ::CorrespondenceChess::CheckForCorrDB
3463  if {$CorrSlot > -1} {
3464  sc_move end
3465 
3466  set Extra [sc_game tags get Extra]
3467  set extraTagsList [split $Extra "\n"]
3468 
3469  # ... extract it as it contains the unique ID
3470  foreach i $extraTagsList {
3471  if { [string equal -nocase [lindex $i 0] "CmailGameName"] } {
3472  set CmailGameName [string range $i 15 end-1]
3473  }
3474  if { [string equal -nocase [lindex $i 0] "WhiteAddress"] } {
3475  set WhiteAdr [split [string range $i 14 end-1] ";"]
3476  set WhiteAdr [split [string range $i 14 end-1] ";"]
3477  }
3478  if { [string equal -nocase [lindex $i 0] "BlackAddress"] } {
3479  set BlackAdr [string range $i 14 end-1]
3480  set BlackAdr [split [string range $i 14 end-1] ";"]
3481  }
3482  }
3483 
3484  set pgnfile "[file join $Outbox $CmailGameName].pgn"
3485 
3486  set IdList [split $CmailGameName "-"]
3487  set name [lindex $IdList 0]
3488  set gameid [lindex $IdList 1]
3489  set movecount [sc_pos moveNumber]
3490  set ply [sc_pos location]
3491  set move [sc_game info previousMoveNT]
3492  set comment [sc_pos getComment]
3493  set Event [sc_game tags get Event]
3494 
3495  # Throw away everything in [] as often as it exists
3496  # This matches [%ccsnt] as well as scid marker codes
3497  regsub -all {\[[^\]]*\]} $comment {} comment
3498 
3499  # moveNumber gives the number of the next full move. This is
3500  # one to high in case of playing black. Note that for this
3501  # ply it is _white_ to move!
3502  if {[sc_pos side] == "white"} {
3503  set movecount [expr {$movecount-1}]
3504  }
3505 
3506  # Mark the ID background:
3507  # yellow while sending in progress,
3508  # green if the move was sent in the
3509  # current session (ie. without update)
3510  .ccWindow.bottom.id tag add hlsent$CmailGameName $num.0 [expr {$num+1}].0
3511  .ccWindow.bottom.id tag configure hlsent$CmailGameName -background yellow -font font_Bold
3512 
3513  set DlgBoxText "[::tr CCDlgConfirmMoveText]\n\n$name-$gameid:\n\t$movecount. $move\n\t{$comment}"
3514  if {$resign == 1} {
3515  set DlgBoxText "$DlgBoxText\n\n[::tr CCResign]"
3516  # When resigning usually no move is made before.
3517  # Therefore, we have to increase the ply by one (faking a
3518  # move) and recalculate the resulting move number if White
3519  # is to move.
3520  # This gives:
3521  # 1. e4 <resign> => ply 2 => no ply increment => move
3522  # number = 1, move number to send = 1
3523  # 1. e4 e5 <resign> => increment ply => ply = 3 => move
3524  # number = 1, move number to send = 2
3525  if {[sc_pos side] == "white"} {
3526  set movecount [expr {$ply / 2 + 1}]
3527  ::CorrespondenceChess::updateConsole "info Increment ply $movecount"
3528  }
3529  } elseif {$acceptDraw == 1} {
3530  set DlgBoxText "$DlgBoxText\n\n[::tr CCAcceptDraw]"
3531  } elseif {$offerDraw == 1} {
3532  set DlgBoxText "$DlgBoxText\n\n[::tr CCofferDraw]"
3533  } elseif {$claimDraw == 1} {
3534  set DlgBoxText "$DlgBoxText\n\n[::tr CCClaimDraw]"
3535  }
3536 
3537  set result 0
3538  if {$::CorrespondenceChess::XfccConfirm == 1} {
3539  set result [tk_dialog .roDialog "Scid: [tr CCDlgConfirmMove]" \
3540  $DlgBoxText "" 1 $::tr(Yes) $::tr(No)]
3541  }
3542  if {$result == 0} {
3543  # Go to the last move is important to send the comment for
3544  # the last move only not the comment for the current game
3545  # position!
3546 
3547  # If Event = "Email correspondence game"
3548  # treat it as cmail game that is send by mail, otherwise it is
3549  # Xfcc and sent accordingly
3550  set Mode [::CorrespondenceChess::CheckMode]
3551  if {$Mode == "EM"} {
3552  eMailMove
3553  } elseif {$Mode == "XFCC"} {
3554 
3555  if {$::CorrespondenceChess::XfccInternal == 1} {
3556  # use internal Xfcc-handling
3557  ::Xfcc::ReadConfig $::CorrespondenceChess::xfccrcfile
3558  ::Xfcc::Send $name $gameid $movecount $move $comment \
3559  $resign $acceptDraw $offerDraw $claimDraw
3560  } else {
3561  if {[file executable "$XfccSendcmd"]} {
3562  set callstring "$XfccSendcmd $Outbox $name $gameid $movecount $move \"$comment\" $resign $claimDraw $offerDraw $acceptDraw &"
3563 
3564  ::CorrespondenceChess::updateConsole "info Spawning external send tool $XfccSendcmd..."
3565  CallExternal $callstring
3566  }
3567  }
3568  } elseif {$Mode == "Postal"} {
3569  # produce a postcard
3570  }
3571 
3572  # Save the game once the move is sent
3573  sc_game save [sc_game number]
3574 
3575  # setting "noMarkCodes" to 1 would drop the timing comments
3576  # inserted e.g. by SchemingMind. Do not overwrite eMail based
3577  # games as the mailer might not have sent them and most
3578  # mailers load the file right before transmission.
3579  if {!(($Mode == "EM") || ($Mode == "Relay"))} {
3580  sc_base export "current" "PGN" $pgnfile -append 0 -comments 1 -variations 1 \
3581  -space 1 -symbols 1 -indentC 0 -indentV 0 -column 0 -noMarkCodes 0 -convertNullMoves 1
3582  }
3583 
3584  # Everything done, set background to green
3585  .ccWindow.bottom.id tag configure hlsent$CmailGameName -background green -font font_Bold
3586  } else {
3587  # mark games with unconfirmed moves in gray:
3588  .ccWindow.bottom.id tag configure hlsent$CmailGameName -background gray -font font_Small
3589  }
3590  }
3591  unbusyCursor .
3592  }
3593 
3594  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3595  # source the options file to overwrite the above setup
3596  if {[catch {source [scidConfigFile correspondence]}]} {
3597  #::splash::add "Unable to find the options file: [file tail $optionsFile]"
3598  } else {
3599  ::splash::add "Correspondence Chess configuration was found and loaded."
3600  }
3601 
3602  if {[catch { package require http}]} {
3603  ::splash::add "http package not found, disabling internal Xfcc support"
3604  set XfccInternal -1
3605  } else {
3606  ::http::config -useragent $::Xfcc::useragent
3607  if {![catch { package require tls}]} {
3608  ::tls::init -ssl3 false -ssl2 false -tls1 true
3609  http::register https 443 ::tls::socket
3610  }
3611  }
3612 
3613  if {[catch {package require tdom}]} {
3614  ::splash::add "tDOM package not found, disabling internal Xfcc support"
3615  set XfccInternal -1
3616  }
3617 
3618  ::CorrespondenceChess::checkInOutbox
3619  ::CorrespondenceChess::checkXfccrc
3620  ::CorrespondenceChess::checkCorrBase
3621  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3622 }
3623 
3624 
3625 ###
3626 ### End of file: Correspondence.tcl
3627 ###
Generated by   doxygen 1.8.13