Scid  4.7.0
All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros
fics.tcl
Go to the documentation of this file.
1 
2 ###
3 ### fics.tcl: part of Scid.
4 ### Copyright (C) 2007 Pascal Georges
5 ###
6 
7 namespace eval fics {
8  set server "freechess.org"
9  set sockchan 0
10  set seeklist {}
11  set observedGame -1
12  set playing 0
13  set rated 0
14  set waitForRating ""
15  set waitForMoves ""
16  set silence 1
17  set sought 0
18  set soughtlist {}
19  set width 300
20  set height 300
21  set off 20
22  set graphon 0
23  set timeseal_pid 0
24  font create font_offers -family courier -size 12 -weight bold
25  set history {}
26  set history_pos 0
27  set offers_minelo 1000
28  set offers_maxelo 2500
29  set offers_mintime 0
30  set offers_maxtime 60
31  variable logged 0
32  variable isGuestLogin 0
33  array set profileVars {}
34  array set findopponent {}
35 
36  set showabortreq 1
37  set showadjournreq 1
38  set showdrawreq 1
39  set showtakebackreq 1
40 
41  set premoveSq1 -1
42  set premoveSq2 -1
43 
44  ################################################################################
45  #
46  ################################################################################
47  proc config {} {
48  variable logged
49  global ::fics::sockChan
50  set w ".ficsConfig"
51 
52  if {[winfo exists $w]} {
53  focus $w
54  return
55  }
56 
57  if {[winfo exists .fics]} {
58  focus .fics
59  return
60  }
61 
62  set logged 0
63  set ::fics::showPass 0
64 
66  ::setTitle $w [::tr "ConfigureFics"]
67  ttk::labelframe $w.f -text "Login"
68  ttk::labelframe $w.conf -text $::tr(CCDlgCGeneraloptions)
69  ttk::frame $w.fbuttons
70 
71  ttk::label $w.f.lLogin -text [::tr "CCDlgLoginName"]
72  ttk::entry $w.f.login -width 20 -textvariable ::fics::login
73  ttk::label $w.f.lPwd -text [::tr "CCDlgPassword"]
74  ttk::entry $w.f.passwd -width 20 -textvariable ::fics::password -show *
75  ttk::checkbutton $w.f.showPass -text [::tr "CCDlgShowPassword"] -variable ::fics::showPass -command {
76  if {$::fics::showPass} {
77  .ficsConfig.f.passwd configure -show {}
78  } else {
79  .ficsConfig.f.passwd configure -show *
80  }
81  }
82 
83  ttk::button $w.fbuttons.connect -text [::tr "FICSConnect"] -state disabled -command {
84  ::fics::connect [.ficsConfig.f.login get] [.ficsConfig.f.passwd get]
85  destroy .ficsConfig
86  }
87  ttk::button $w.fbuttons.guest -text [::tr FICSGuest] -state disabled -command {
88  ::fics::connect "guest" ""
89  destroy .ficsConfig
90  }
91  ttk::button $w.fbuttons.cancel -text [::tr "Cancel"] -command { destroy .ficsConfig }
92 
93  set row 0
94  grid $w.f.lLogin -column 0 -row $row -sticky w -padx "0 5"
95  grid $w.f.login -column 1 -row $row -sticky w
96  incr row
97  grid $w.f.lPwd -column 0 -row $row -sticky w -padx "0 5"
98  grid $w.f.passwd -column 1 -row $row -sticky w
99  incr row
100  grid $w.f.showPass -column 1 -row $row -sticky w
101  incr row
102  pack $w.f -side top -anchor w -fill x
103  pack $w.conf -side top -anchor w -pady "10 0"
104 
105  # use default user variables
106  ttk::checkbutton $w.conf.cbvars -text [::tr "FICSdefaultuservars"] -variable ::fics::usedefaultvars
107  grid $w.conf.cbvars -column 0 -row $row -sticky w -columnspan 2
108  incr row
109 
110  # enable premove
111  ttk::checkbutton $w.conf.premove -text [::tr "FICSpremove"] -variable ::fics::premoveEnabled
112  grid $w.conf.premove -column 0 -row $row -sticky w -columnspan 2
113  incr row
114 
115  # Time seal configuration
116  ttk::checkbutton $w.conf.cbts -text "Time seal" -variable ::fics::use_timeseal -onvalue 1 -offvalue 0
117  grid $w.conf.cbts -column 0 -row $row -sticky w
118  incr row
119  ttk::entry $w.conf.eExec -textvariable ::fics::timeseal_exec
120  ttk::button $w.conf.bExec -text "..." -command { set ::fics::timeseal_exec [tk_getOpenFile] }
121  grid $w.conf.eExec -column 0 -row $row -columnspan 2 -sticky we -padx "20 10"
122  grid $w.conf.bExec -column 2 -row $row -sticky w
123  incr row
124  ttk::label $w.conf.lFICS_ip -text [::tr "FICSServerAddress"]
125  ttk::entry $w.conf.ipserver -width 16 -textvariable ::fics::server_ip -state readonly
126  ttk::button $w.conf.bRefresh -text [::tr "FICSRefresh"] -command ::fics::getIP
127  ttk::label $w.conf.lFICS_port -text [::tr "FICSServerPort"]
128  ttk::entry $w.conf.portserver -width 6 -textvariable ::fics::port_fics
129  ttk::label $w.conf.ltsport -text [::tr "FICSTimesealPort"]
130  ttk::entry $w.conf.portts -width 6 -textvariable ::fics::port_timeseal
131 
132  grid $w.conf.lFICS_ip -column 0 -row $row -sticky w -padx "0 5"
133  grid $w.conf.ipserver -column 1 -row $row -sticky w -padx "0 10"
134  grid $w.conf.bRefresh -column 2 -row $row -sticky w
135  incr row
136  grid $w.conf.lFICS_port -column 0 -row $row -sticky w -padx "0 5"
137  grid $w.conf.portserver -column 1 -row $row -sticky w
138  incr row
139  grid $w.conf.ltsport -column 0 -row $row -sticky w -padx "0 5"
140  grid $w.conf.portts -column 1 -row $row -sticky w
141  incr row
142 
143  pack $w.fbuttons -side top -anchor e
144  packdlgbuttons $w.fbuttons.cancel $w.fbuttons.connect $w.fbuttons.guest
145 
146  bind $w <Escape> "$w.fbuttons.cancel invoke"
147  bind $w <F1> { helpWindow FICSLogin}
148 
149  # Get IP address of server (as Timeseal needs IP address)
150  if { $::fics::server_ip == "0.0.0.0" } {
151  getIP
152  }
153 
154  $w.fbuttons.connect configure -state normal
155  $w.fbuttons.guest configure -state normal
156 
157  }
158  ################################################################################
159  #
160  ################################################################################
161  proc getIP {} {
162  set b .ficsConfig.conf.bRefresh
163  $b configure -state disabled
164  update
165  # First handle the case of a network down
166  if { [catch {set sockChan [socket -async $::fics::server $::fics::port_fics]} err]} {
167  tk_messageBox -icon error -type ok -title "Unable to contact $::fics::server" -message $err -parent .ficsConfig.f
168  return
169  }
170 
171  # Then the case of a proxy
172  set timeOut 5
173  set i 0
174  while { $i <= $timeOut } {
175  after 1000
176 
177  if { [catch {set peer [ fconfigure $sockChan -peername]} err]} {
178  if {$i == $timeOut} {
179  tk_messageBox -icon error -type ok -title "Unable to contact $::fics::server" -message $err -parent .ficsConfig.f
180  return
181  }
182  } else {
183  break
184  }
185  incr i
186  }
187 
188  set ::fics::server_ip [lindex $peer 0]
189  ::close $sockChan
190  $b configure -state normal
191  }
192  ################################################################################
193  #
194  ################################################################################
195  proc setProfileVars { login } {
196  global ::fics::profileVars
197  if { ! [info exists profileVars(initTime_$login)] } {
198  return
199  }
200  set ::fics::findopponent(initTime) $profileVars(initTime_$login)
201  set ::fics::findopponent(incTime) $profileVars(incTime_$login)
202  set ::fics::findopponent(rated) $profileVars(rated_$login)
203  set ::fics::findopponent(color) $profileVars(color_$login)
204  set ::fics::findopponent(limitrating) $profileVars(limitrating_$login)
205  set ::fics::findopponent(rating1) $profileVars(rating1_$login)
206  set ::fics::findopponent(rating2) $profileVars(rating2_$login)
207  set ::fics::findopponent(manual) $profileVars(manual_$login)
208  set ::fics::findopponent(formula) $profileVars(formula_$login)
209  }
210  ################################################################################
211  #
212  ################################################################################
213  proc syncProfileVars { login } {
214  global ::fics::profileVars
215  variable isGuestLogin
216 
217  if {$isGuestLogin} {
218  set login "guest"
219  }
220  set profileVars(initTime_$login) $::fics::findopponent(initTime)
221  set profileVars(incTime_$login) $::fics::findopponent(incTime)
222  set profileVars(rated_$login) $::fics::findopponent(rated)
223  set profileVars(color_$login) $::fics::findopponent(color)
224  set profileVars(limitrating_$login) $::fics::findopponent(limitrating)
225  set profileVars(rating1_$login) $::fics::findopponent(rating1)
226  set profileVars(rating2_$login) $::fics::findopponent(rating2)
227  set profileVars(manual_$login) $::fics::findopponent(manual)
228  set profileVars(formula_$login) $::fics::findopponent(formula)
229  }
230  ################################################################################
231  #
232  ################################################################################
233  proc storeTime { } {
234  set side 1
235  if { [sc_pos side] == "white" } {set side 2}
237  }
238  ################################################################################
239  #
240  ################################################################################
241  proc connect { login passwd } {
242  global ::fics::sockchan ::fics::seeklist ::fics::width ::fics::height ::fics::off
243  variable isGuestLogin
244 
245  if {$login != ""} {
246  set ::fics::reallogin $login
247  # do not reset the password if we log in as guest.
248  # This allows to reset it if we have another UID.
249  if {$login != "guest"} {
250  set ::fics::password $passwd
251  }
252  } else {
253  return
254  }
255 
256  set isGuestLogin [string match -nocase "guest" $login]
257 
258  setProfileVars $login
259 
260  # check timeseal configuration
261  if {$::fics::use_timeseal} {
262  if {![ file executable $::fics::timeseal_exec]} {
263  tk_messageBox -title "Error" -icon error -type ok -message "Timeseal exec error : $::fics::timeseal_exec"
264  return
265  }
266  }
267 
268  set w .fics
270  ::setTitle $w "Free Internet Chess Server $::fics::reallogin"
271  grid [ttk::panedwindow $w.f -orient vertical] -sticky news
272  grid rowconfigure $w 0 -weight 1
273  grid columnconfigure $w 0 -weight 1
274 
275  ttk::notebook $w.f.top
276  ttk::frame $w.f.top.fconsole
277  ttk::frame $w.f.top.fconsole.f1
278  ttk::frame $w.f.top.fconsole.f2
279 
280  ttk::frame $w.f.top.foffers
281  $w.f.top add $w.f.top.fconsole -sticky nsew -text [::tr "FICSConsole"]
282  $w.f.top add $w.f.top.foffers -sticky nsew -text [::tr "FICSOffers"]
283 
284  grid $w.f.top.fconsole.f1 -sticky news
285  grid $w.f.top.fconsole.f2 -sticky news
286  grid rowconfigure $w.f.top.fconsole 0 -weight 1
287  grid columnconfigure $w.f.top.fconsole 0 -weight 1
288  ttk::frame $w.f.bottom
289 
290  $w.f add $w.f.top -weight 1
291  $w.f add $w.f.bottom -weight 0
292 
293  ttk::frame $w.f.bottom.left
294  ttk::frame $w.f.bottom.right
295  grid $w.f.bottom.left $w.f.bottom.right -sticky news
296 
297  # graph
298  canvas $w.f.top.foffers.c -background white -width $width -height $height -relief solid
299  grid $w.f.top.foffers.c
300  bind $w.f.top.foffers <Configure> { ::fics::configureCanvas}
301 
302  ttk::scrollbar $w.f.top.fconsole.f1.ysc -command { .fics.f.top.fconsole.f1.console yview }
303  text $w.f.top.fconsole.f1.console -bg $::fics::consolebg -fg $::fics::consolefg -height $::fics::consoleheight -width $::fics::consolewidth \
304  -font font_Fixed -wrap word -yscrollcommand "$w.f.top.fconsole.f1.ysc set"
305  grid $w.f.top.fconsole.f1.console $w.f.top.fconsole.f1.ysc -sticky news
306  grid rowconfigure $w.f.top.fconsole.f1 0 -weight 1
307  grid columnconfigure $w.f.top.fconsole.f1 0 -weight 1
308 
309  #define colors for console
310  $w.f.top.fconsole.f1.console tag configure seeking -foreground $::fics::colseeking
311  $w.f.top.fconsole.f1.console tag configure game -foreground $::fics::colgame
312  $w.f.top.fconsole.f1.console tag configure gameresult -foreground $::fics::colgameresult
313  $w.f.top.fconsole.f1.console tag configure ficspercent -foreground $::fics::colficspercent
314  $w.f.top.fconsole.f1.console tag configure ficshelpnext -foreground $::fics::colficshelpnext -underline 1
315 
316  ttk::entry $w.f.top.fconsole.f2.cmd -width 32
317  ttk::button $w.f.top.fconsole.f2.send -text [::tr "FICSSend"] -command ::fics::cmd
318  bind $w.f.top.fconsole.f2.cmd <Return> { ::fics::cmd }
319  bind $w.f.top.fconsole.f2.cmd <Up> { ::fics::cmdHistory up ; break }
320  bind $w.f.top.fconsole.f2.cmd <Down> { ::fics::cmdHistory down ; break }
321  bind $w.f.top.fconsole.f2.cmd <Left> " [bind TEntry <Left>] ; break "
322  bind $w.f.top.fconsole.f2.cmd <Right> " [bind TEntry <Right>] ; break "
323  grid $w.f.top.fconsole.f2.cmd $w.f.top.fconsole.f2.send -sticky news
324  grid columnconfigure $w.f.top.fconsole.f2 0 -weight 1
325 
326  # clock 1 is white
327  ::gameclock::new $w.f.bottom.left 1 100 0
328  ::gameclock::new $w.f.bottom.left 2 100 0
329 
330  set row 0
331  ttk::checkbutton $w.f.bottom.right.silence -image FICSsilence -variable ::fics::silence -onvalue 0 -offvalue 1 -command {
332  ::fics::writechan "set gin $::fics::silence" "echo"
333  ::fics::writechan "set seek $::fics::silence" "echo"
334  ::fics::writechan "set silence $::fics::silence" "echo"
335  ::fics::writechan "set chanoff [expr ! $::fics::silence ]" "echo"
336  }
337  ::utils::tooltip::Set $w.f.bottom.right.silence "[::tr FICSSilence]\n(set gin 0\nset seek 0\nset silence 0\nset chanoff 1)"
338  set ::fics::silence 1
339 
340  set ::fics::graphon 0
341 
342  ttk::button $w.f.bottom.right.findopp -image FICSsearch -command { ::fics::findOpponent }
343  ::utils::tooltip::Set $w.f.bottom.right.findopp [::tr "FICSFindOpponent"]
344  grid $w.f.bottom.right.findopp -column 0 -row $row -sticky ew -pady 2
345  ttk::button $w.f.bottom.right.relay -image FICSrelayedgames -compound image -command { ::fics::writechan "tell relay listgames"}
346  ::utils::tooltip::Set $w.f.bottom.right.relay "[::tr FICSRelayedGames]\n(tell relay listgames)"
347  grid $w.f.bottom.right.relay -column 1 -row $row -sticky ew -pady 2
348  ttk::button $w.f.bottom.right.games -image FICSusers -compound image -command { ::fics::writechan "games /bsu"}
349  ::utils::tooltip::Set $w.f.bottom.right.games "[::tr FICSGames]\n(games /bsu)"
350  grid $w.f.bottom.right.games -column 2 -row $row -sticky ew -pady 2
351  ttk::button $w.f.bottom.right.uno -image FICSunobserve -compound image -command { ::fics::writechan "unobserve"}
352  ::utils::tooltip::Set $w.f.bottom.right.uno "[::tr FICSUnobserve]\n(unobserve)"
353  grid $w.f.bottom.right.uno -column 3 -row $row -sticky ew -pady 2
354  ttk::button $w.f.bottom.right.profile -image FICSprofile -compound image -command { ::fics::writechan "finger" ; ::fics::writechan "history" }
355  ::utils::tooltip::Set $w.f.bottom.right.profile "[::tr FICSProfile]\n(finger, history)"
356  grid $w.f.bottom.right.profile -column 4 -row $row -sticky ew -pady 2
357 
358  incr row
359 
360  ttk::button $w.f.bottom.right.draw -image FICSdraw -command { ::fics::writechan "draw"}
361  ::utils::tooltip::Set $w.f.bottom.right.draw "[::tr CCClaimDraw]\n(draw)"
362  ttk::button $w.f.bottom.right.resign -image FICSresign -command { ::fics::writechan "resign"}
363  ::utils::tooltip::Set $w.f.bottom.right.resign "[::tr CCResign]\n(resign)"
364  grid $w.f.bottom.right.draw -column 0 -row $row -sticky ew -pady 2
365  grid $w.f.bottom.right.resign -column 1 -row $row -sticky ew -pady 2
366  ttk::button $w.f.bottom.right.abort -image FICSabort -command { ::fics::writechan "abort" }
367  ::utils::tooltip::Set $w.f.bottom.right.abort "[::tr Abort]\n(abort)"
368  grid $w.f.bottom.right.abort -column 2 -row $row -sticky ew -pady 2
369  grid $w.f.bottom.right.silence -column 4 -row $row -sticky w
370  incr row
371 
372  ttk::button $w.f.bottom.right.takeback -image FICStakeback1 -command { ::fics::writechan "takeback"}
373  ::utils::tooltip::Set $w.f.bottom.right.takeback "[::tr FICSTakeback]\n(takeback)"
374  ttk::button $w.f.bottom.right.takeback2 -image FICStakeback2 -command { ::fics::writechan "takeback 2"}
375  ::utils::tooltip::Set $w.f.bottom.right.takeback2 "[::tr FICSTakeback2]\n(takeback 2)"
376 
377  grid $w.f.bottom.right.takeback -column 0 -row $row -sticky ew -pady 2
378  grid $w.f.bottom.right.takeback2 -column 1 -row $row -sticky ew -pady 2
379  incr row
380 
381  ttk::button $w.f.bottom.right.cancel -image FICSexit -command { ::fics::close }
382  ::utils::tooltip::Set $w.f.bottom.right.cancel [::tr "Close"]
383  grid $w.f.bottom.right.cancel -column 0 -columnspan 3 -row $row -sticky ew -pady 2
384 
385  bind $w.f.top <<NotebookTabChanged>> { ::fics::tabchanged ; break }
386  bind $w <Destroy> { catch ::fics::close }
387 
388  bind $w <F1> { helpWindow FICS}
389  bind $w.f.top.fconsole.f1.console <FocusIn> "focus $w.f.top.fconsole.f2.cmd"
390  bind $w.f.top.fconsole.f1.console <Configure> { .fics.f.top.fconsole.f1.console yview moveto 1 }
391  bind $w.f.top.fconsole.f1.console <ButtonPress-1> { ::fics::consoleClick %x %y %W }
393 
394 
395  # all widgets must be visible
396  update
397  set x [winfo reqwidth $w]
398  set y [winfo reqheight $w]
399  wm minsize $w $x $y
400 
401  ::gameclock::setColor 1 white
402  ::gameclock::setColor 2 black
403 
404  updateConsole "Connecting $login"
405 
406  # start timeseal proxy
407  if {$::fics::use_timeseal} {
408  updateConsole "Starting TimeSeal"
409  if { [catch { set timeseal_pid [exec $::fics::timeseal_exec $::fics::server_ip $::fics::port_fics -p $::fics::port_timeseal &]}] } {
410  set ::fics::use_timeseal 0
411  set port $::fics::port_fics
412  } else {
413  #wait for proxy to be ready !?
414  after 500
415  set server "localhost"
416  set port $::fics::port_timeseal
417  }
418  } else {
419  set server $::fics::server
420  set port $::fics::port_fics
421  }
422 
423  updateConsole "Socket opening"
424 
425  if { [catch { set sockchan [socket $server $port]}] } {
426  tk_messageBox -title "Error" -icon error -type ok -message "Network error\nCan't connect to $server $port" -parent .fics
427  return
428  }
429 
430  updateConsole "Channel configuration"
431 
432  fconfigure $sockchan -blocking 0 -buffering line -translation auto ;#-encoding iso8859-1 -translation crlf
433  fileevent $sockchan readable ::fics::readchan
434  setState disabled
435  }
436  ################################################################################
437  #
438  ################################################################################
439  proc cmd {} {
440  set l [.fics.f.top.fconsole.f2.cmd get]
441  .fics.f.top.fconsole.f2.cmd delete 0 end
442  if {$l == "quit"} {
444  return
445  }
446  # do nothing if the command is void
447  if {[string trim $l] == ""} { return}
448  writechan $l "echo"
449  lappend ::fics::history $l
450  set ::fics::history_pos [llength $::fics::history]
451  }
452  ################################################################################
453  #
454  ################################################################################
455  proc cmdHistory { action } {
456  set t .fics.f.top.fconsole.f2.cmd
457 
458  if {$action == "up" && $::fics::history_pos > 0} {
459  incr ::fics::history_pos -1
460  $t delete 0 end
461  $t insert end [lindex $::fics::history $::fics::history_pos]
462  }
463  if {$action == "down" && $::fics::history_pos < [expr [llength $::fics::history] -1] } {
464  incr ::fics::history_pos
465  $t delete 0 end
466  $t insert end [lindex $::fics::history $::fics::history_pos]
467  }
468  }
469  ################################################################################
470  #
471  ################################################################################
472  proc findOpponent {} {
473  set w .ficsfindopp
474  if {[winfo exists $w]} {
475  focus $w
476  return
477  }
479  wm title $w [::tr "FICSFindOpponent"]
480 
481  ttk::frame $w.f
482  pack $w.f -side top -anchor w -fill x
483  ttk::label $w.f.linit -text [::tr "FICSInitialTime"]
484  ttk::spinbox $w.f.sbTime1 -background white -width 3 -textvariable ::fics::findopponent(initTime) -from 0 -to 120 -increment 1 -validate all -validatecommand { regexp {^[0-9]+$} %P }
485  ttk::label $w.f.linc -text [::tr "FICSIncrement"]
486  ttk::spinbox $w.f.sbTime2 -background white -width 3 -textvariable ::fics::findopponent(incTime) -from 0 -to 120 -increment 1 -validate all -validatecommand { regexp {^[0-9]+$} %P }
487  grid $w.f.linit -column 0 -row 0 -sticky w
488  grid $w.f.sbTime1 -column 1 -row 0 -sticky w -pady "0 2"
489  grid $w.f.linc -column 0 -row 1 -sticky w
490  grid $w.f.sbTime2 -column 1 -row 1 -sticky w
491 
492  ttk::checkbutton $w.f.cbrated -text [::tr "FICSRatedGame"] -onvalue "rated" -offvalue "unrated" -variable ::fics::findopponent(rated)
493  grid $w.f.cbrated -column 0 -row 2 -columnspan 2 -sticky ew
494 
495  ttk::labelframe $w.f.color -text [::tr "FICSColour"]
496  grid $w.f.color -column 0 -row 3 -columnspan 2 -sticky ew
497  ttk::radiobutton $w.f.rb1 -text [::tr "FICSAutoColour"] -value "" -variable ::fics::findopponent(color)
498  ttk::radiobutton $w.f.rb2 -text [::tr "White"] -value "white" -variable ::fics::findopponent(color)
499  ttk::radiobutton $w.f.rb3 -text [::tr "Black"] -value "black" -variable ::fics::findopponent(color)
500  pack $w.f.rb1 $w.f.rb2 $w.f.rb3 -side top -anchor w -in $w.f.color
501 
502  ttk::checkbutton $w.f.cblimitrating -text [::tr "RatingRange"] -variable ::fics::findopponent(limitrating)
503  ttk::spinbox $w.f.sbrating1 -background white -width 4 -textvariable ::fics::findopponent(rating1) -from 1000 -to 3000 -increment 50 -validate all -validatecommand { regexp {^[0-9]+$} %P }
504  ttk::spinbox $w.f.sbrating2 -background white -width 4 -textvariable ::fics::findopponent(rating2) -from 1000 -to 3000 -increment 50 -validate all -validatecommand { regexp {^[0-9]+$} %P }
505  grid $w.f.cblimitrating -column 0 -row 5 -columnspan 2 -sticky ew
506  grid $w.f.sbrating1 -column 0 -row 6 -sticky w
507  grid $w.f.sbrating2 -column 1 -row 6 -sticky w
508 
509  ttk::checkbutton $w.f.cbmanual -text [::tr "FICSManualConfirm"] -onvalue "manual" -offvalue "auto" -variable ::fics::findopponent(manual)
510  grid $w.f.cbmanual -column 0 -row 7 -columnspan 2 -sticky ew
511  ttk::checkbutton $w.f.cbformula -text [::tr "FICSFilterFormula"] -onvalue "formula" -offvalue "" -variable ::fics::findopponent(formula)
512  grid $w.f.cbformula -column 0 -row 8 -columnspan 2 -sticky ew
513 
514  ttk::button $w.seek -text [::tr "FICSIssueSeek"] -command {
515  ::fics::syncProfileVars $::fics::login
516 
517  set range ""
518  if {$::fics::findopponent(limitrating) } {
519  set range "$::fics::findopponent(rating1)-$::fics::findopponent(rating2)"
520  }
521  set cmd "seek $::fics::findopponent(initTime) $::fics::findopponent(incTime) $::fics::findopponent(rated) \
522  $::fics::findopponent(color) $::fics::findopponent(manual) $::fics::findopponent(formula) $range"
523  ::fics::writechan $cmd
524  destroy .ficsfindopp
525  }
526  ttk::button $w.cancel -text [::tr "Cancel"] -command "destroy $w"
527  bind $w <F1> { helpWindow FICSfindOpp}
528 
529  packdlgbuttons $w.cancel $w.seek
530  }
531  ################################################################################
532  #
533  ################################################################################
534  proc readchan {} {
535  variable logged
536 
537  if {[eof $::fics::sockchan]} {
538  fileevent $::fics::sockchan readable {}
539  tk_messageBox -title "FICS" -icon error -type ok -message "Network error reading channel"
540  ::fics::close "error"
541  return
542  }
543 
544  # switch from read to gets in case a read is done at the middle of a line
545  if {! $logged} {
546  set line [read $::fics::sockchan]
547  foreach l [split $line "\n"] {
548  readparse $l
549  }
550  } else {
551  set line [gets $::fics::sockchan]
552  set line [string map {"\a" ""} $line]
553  readparse $line
554  }
555 
557  }
558 
559  ################################################################################
560  # Appends an array to soughtlist if the parameter is correct
561  # returns 0 if the line is not parsed and so it is still pending for use
562  ################################################################################
563  proc parseSoughtLine { l } {
564  global ::fics::offers_minelo ::fics::offers_maxelo ::fics::offers_mintime ::fics::offers_maxtime
565 
566  # it seems that the first offer starts with a prompt
567  if {[string match "fics% *" $l]} {
568  set l [string range $l 6 end]
569  }
570 
571  if { [ catch { if {[llength $l] < 8} { return 0}}] } { return 0}
572  array set ga {}
573 
574  set offset 0
575  set ga(game) [lindex $l 0]
576  if { ! [string is integer $ga(game)] } { return 0}
577  set tmp [lindex $l 1]
578  if { [scan $tmp "%d" ga(elo)] != 1} { set ga(elo) $offers_minelo}
579  if { $ga(elo) < $offers_minelo } { set ga(elo) $offers_minelo}
580  set ga(name) [lindex $l 2]
581 
582  set tmp [lindex $l 3]
583  if { [scan $tmp "%d" ga(time_init)] != 1} { set ga(time_init) $offers_maxtime}
584  set tmp [lindex $l 4]
585  if { [scan $tmp "%d" ga(time_inc)] != 1} { set ga(time_inc) 0}
586 
587  set ga(rated) [lindex $l 5]
588  if {$ga(rated) != "rated" && $ga(rated) != "unrated"} { return 0}
589 
590  set ga(type) [lindex $l 6]
591  if { $ga(type) != "untimed" && $ga(type) != "blitz" && $ga(type) != "standard" && $ga(type) != "lightning" } {
592  return 0
593  }
594  set ga(color) ""
595  if { [lindex $l 7] == "\[white\]" || [lindex $l 7] == "\[black\]" } {
596  set ga(color) [lindex $l 7]
597  set offset 1
598  }
599  set ga(rating_range) [lindex $l [expr 7 + $offset]]
600  if { [ catch { set ga(start) [lindex $l [expr 8 + $offset]]}] } {
601  set ga(start) ""
602  }
603 
604  lappend ::fics::soughtlist [array get ga]
605  return 1
606  }
607  ################################################################################
608  #
609  ################################################################################
610  proc readparse {line} {
611  variable logged
612  variable isGuestLogin
613 
614  if {$line == "" || $line == "fics% "} {return}
615 
616  if { $::fics::sought } {
617  if {[string match "* ad* displayed." $line]} {
618  set ::fics::sought 0
619  catch { displayOffers}
620  return
621  }
622  # lappend ::fics::soughtlist $line
623  if { [ parseSoughtLine $line] } {
624  return
625  }
626  }
627 
628  if {[string match "login: " $line]} {
629  writechan $::fics::reallogin
630  if { $isGuestLogin} {
631  set logged 1
632  }
633  return
634  }
635  if {[string match "password: " $line]} {
636  writechan $::fics::password
637  set logged 1
638  return
639  }
640  if {[string match "<sc>*" $line]} {
641  set ::fics::seeklist {}
642  return
643  }
644  if {[string match "<s>*" $line]} {
645  parseSeek $line
646  return
647  }
648  if {[string match "<sr>*" $line]} {
649  removeSeek $line
650  return
651  }
652 
653  if {[string match "<12>*" $line]} {
654  parseStyle12 $line
655  return
656  }
657 
658  # puts "readparse->$line"
659  updateConsole $line
660  if {[string match "Creating: *" $line]} {
661  # hide offers graph
662  .fics.f.top select 0
663  ::utils::sound::PlaySound sound_move
664  # Create a game in an opened base
665  if {![sc_base inUse]} {
666  sc_base switch $::clipbase_db
667  }
668  sc_game new
669  set idx1 [string first "(" $line]
670  set white [string trim [string range $line 10 [expr $idx1 -1]]]
671  set idx2 [string first ")" $line]
672  set whiteElo [string trim [string range $line [expr $idx1 +1] [expr $idx2 -1]]]
673 
674  set idx1 [expr $idx2 +1]
675  set idx2 [string first "(" $line $idx1]
676  set black [string trim [string range $line $idx1 [expr $idx2 -1]]]
677 
678  set idx1 [expr $idx2 +1]
679  set idx2 [string first ")" $line $idx1]
680  set blackElo [string trim [string range $line $idx1 [expr $idx2 -1]]]
681 
682  if { $whiteElo == "++++"} { set whiteElo 0}
683  if { $blackElo == "++++"} { set blackElo 0}
684 
685  sc_game tags set -white $white
686  sc_game tags set -whiteElo $whiteElo
687  sc_game tags set -black $black
688  sc_game tags set -blackElo $blackElo
689  sc_game tags set -date "[::utils::date::today year].[::utils::date::today month].[::utils::date::today day]"
690  sc_game tags set -site "FICS freechess.org"
691  sc_game tags set -event "FICS played [lrange $line 5 6] game"
692  sc_game tags set -extra [list "Timecontrol \"[lindex $line 7]+[lindex $line 8]\""]
693 
694  if { [::board::isFlipped .main.board] } {
695  if { [ string match -nocase $white $::fics::reallogin] } { ::board::flip .main.board}
696  } else {
697  if { [ string match -nocase $black $::fics::reallogin] } { ::board::flip .main.board}
698  }
700  set ::fics::rated [string equal [lindex $line 5] "rated"]
701  # display the win / draw / loss score
702  if { $::fics::rated } { ::fics::writechan "assess" "noecho"}
703  # it's a new game so show again abort, draw, etc requests
704  set ::fics::showabortreq 1
705  set ::fics::showadjournreq 1
706  set ::fics::showdrawreq 1
707  set ::fics::showtakebackreq 1
708  return
709  }
710 
711  if {[string match "\{Game *" $line]} {
712  set num [lindex [lindex $line 0] 1]
713  set res [lindex $line end]
714  set comment [lrange [lindex $line 0] 2 end]
715  set n [string first {)} $comment]
716  if {$n > -1} {
717  set comment [string range $comment $n+2 end]
718  }
719  sc_pos setComment "[sc_pos getComment]$comment"
720  if {$num == $::fics::observedGame} {
721  if {[string match "1/2*" $res]} {
722  tk_messageBox -title [::tr "Result"] -icon info -type ok -message "Draw\n$comment"
723  } else {
724  tk_messageBox -title [::tr "Result"] -icon info -type ok -message "$res\n$comment"
725  }
726  sc_game tags set -result $res
727  set ::fics::playing 0
728  set ::fics::observedGame -1
731  updateBoard -pgn
732  }
733  return
734  }
735 
736  if { [string match "You are now observing game*" $line] } {
737  scan $line "You are now observing game %d." ::fics::observedGame
738  }
739 
740  # Start session
741  if {[string match "*Starting FICS session*" $line]} {
742 
743  # mandatory init commands
744  writechan "set interface Scid/$::scidVersion ([tk windowingsystem]; $::tcl_platform(os) $::tcl_platform(machine); rv:$::scidVersionDate) Tcl/Tk [info patchlevel]"
745  writechan "iset seekremove 1"
746  writechan "iset seekinfo 1"
747  writechan "style 12"
748  writechan "iset nowrap 1"
749  writechan "iset nohighlight 1"
750 
751  # user init commands
752  if { $::fics::usedefaultvars } {
753  writechan "set seek 1" ; # be informed of "seek" ads when they are made
754  writechan "set silence 1" ; # turn off shouts, cshouts and channel tells while you play
755  writechan "set chanoff 0" ; # stop hearing tells to channels
756  writechan "set echo 1" ; # shouts and most other communications will be echoed to you
757  writechan "set cshout 0" ; # do not hear cshouts
758  }
759  setState normal
760  return
761  }
762 
763  if { $::fics::waitForRating == "wait" } {
764  if {[catch {set val [lindex $line 0]}]} {
765  return
766  } else {
767  if {[lindex $line 0] == "Standard"} {
768  set ::fics::waitForRating [lindex $line 1]
769  return
770  }
771  }
772  }
773 
774  if { $::fics::waitForMoves != "" } {
775  set m1 ""
776  set m2 ""
777  set t2 ""
778  set t4 ""
779  set line [string trim $line]
780 
781  # Because some free text may be in the form (".)
782  if {[catch {llength $line} err]} {
783  puts "Exception $err llength $line"
784  return
785  }
786 
787  if {[llength $line] == 5 && [scan $line "%d. %s (%d:%d) %s (%d:%d)" t1 m1 t2 t3 m2 t4 t5] != 7} {
788  return
789  }
790  if {[llength $line] == 3 && [scan $line "%d. %s (%d:%d)" t1 m1 t2 t3] != 4} {
791  return
792  }
793  catch { sc_move addSan $m1}
794  if {$t2 != ""} {
795  storeEmtComment 0 $t2 $t3
796  }
797  if {$m2 != ""} {
798  catch { sc_move addSan $m2}
799  }
800  if {$t4 != ""} {
801  storeEmtComment 0 $t4 $t5
802  }
803 
804  if {[sc_pos fen] == $::fics::waitForMoves } {
805  set ::fics::waitForMoves ""
806  }
807  }
808 
809  if {[string match "Challenge:*" $line]} {
810  set ans [tk_dialog .challenge [::tr "FICSChallenge"] $line "" 0 [::tr "FICSAccept"] [::tr "FICSDecline"]]
811  if {$ans == 0} {
812  writechan "accept"
813  } else {
814  writechan "decline"
815  }
816  }
817 
818  # abort request
819  # for the abort, etc requests, added the "cancel" option so that during this game
820  # the message box won't open again for the canceled type of request
821  # to avoid "denial of play" attack by the opponent constantly issuing such a request
822  # (because tk_messageBox "waits for the user to select one of the buttons")
823  if {[string match "* would like to abort the game;*" $line] && $::fics::showabortreq} {
824  set ans [tk_messageBox -title [::tr "Abort"] -icon question -type yesnocancel -message "$line\nDo you accept ?"]
825  switch -- $ans {
826  yes {writechan "accept"}
827  no {writechan "decline"}
828  cancel {set ::fics::showabortreq 0}
829  }
830  }
831 
832  # takeback
833  if {[string match "* would like to take back *" $line] && $::fics::showtakebackreq} {
834  set ans [tk_messageBox -title "Abort" -icon question -type yesnocancel -message "$line\nDo you accept ?"]
835  switch -- $ans {
836  yes {writechan "accept"}
837  no {writechan "decline"}
838  cancel {set ::fics::showtakebackreq 0}
839  }
840  }
841 
842  # draw
843  if {[string match "*offers you a draw*" $line] && $::fics::showdrawreq} {
844  set ans [tk_messageBox -title "Abort" -icon question -type yesnocancel -message "$line\nDo you accept ?"]
845  switch -- $ans {
846  yes {writechan "accept"}
847  no {writechan "decline"}
848  cancel {set ::fics::showdrawreq 0}
849  }
850  }
851 
852  # adjourn
853  if {[string match "*would like to adjourn the game*" $line] && $::fics::showadjournreq} {
854  set ans [tk_messageBox -title "Abort" -icon question -type yesnocancel -message "$line\nDo you accept ?"]
855  switch -- $ans {
856  yes {writechan "accept"}
857  no {writechan "decline"}
858  cancel {set ::fics::showadjournreq 0}
859  }
860  }
861 
862  # guest logging
863  if {[string match "Logging you in as*" $line]} {
864  set line [string map {"\"" "" ";" ""} $line]
865  set ::fics::reallogin [lindex $line 4]
866  ::setTitle .fics "Free Internet Chess Server $::fics::reallogin"
867  }
868  if {[string match "Press return to enter the server as*" $line]} {
869  writechan "\n"
870  }
871 
872  }
873  ################################################################################
874  # Set the state of user interface related to connection state
875  ################################################################################
876  proc setState { state } {
877  set w .fics
878 
879  foreach elt [winfo children $w.f.bottom.right] {
880  if { $elt != "$w.f.bottom.right.cancel" } {
881  $elt configure -state $state
882  }
883  }
884 
885  foreach elt [list $w.f.top.fconsole.f2.send $w.f.top.fconsole.f2.cmd] {
886  $elt configure -state $state
887  }
888 
889  if {$state == "normal" } {
890  $w.f.top add $w.f.top.foffers
891  } else {
892  $w.f.top hide $w.f.top.foffers
893  }
894  }
895  ################################################################################
896  #
897  ################################################################################
898  proc updateConsole {line} {
899  set t .fics.f.top.fconsole.f1.console
900 
901  if { [string match "* seeking *" $line] } {
902  $t insert end "$line\n" seeking
903  } elseif { [string match "\{Game *\}" $line] } {
904  $t insert end "$line\n" game
905  } elseif { [string match "\{Game *\} *" $line] } {
906  $t insert end "$line\n" gameresult
907  } elseif { [string match "fics% *" $line] } {
908  $t insert end "$line\n" ficspercent
909  } elseif { $line == "Type \[next\] to see next page." } {
910  $t insert end "Click or type \[next\] to see next page.\n" ficshelpnext
911  } else {
912  $t insert end "$line\n"
913  }
914 
915  set pos [ lindex [ .fics.f.top.fconsole.f1.ysc get] 1]
916  if {$pos == 1.0} {
917  $t yview moveto 1
918  }
919 
920  }
921  ################################################################################
922  #
923  ################################################################################
924  proc removeSeek {line} {
925  global ::fics::seeklist
926  foreach l $line {
927 
928  if { $l == "<sr>" } {continue}
929 
930  # remove seek from seeklist
931  for {set i 0} {$i < [llength $seeklist]} {incr i} {
932  array set a [lindex $seeklist $i]
933  if {$a(index) == $l} {
934  set seeklist [lreplace $seeklist $i $i]
935  break
936  }
937  }
938 
939  # remove seek from graph
940  if { $::fics::graphon } {
941  for {set idx 0} { $idx < [llength $::fics::soughtlist]} { incr idx} {
942  array set g [lindex $::fics::soughtlist $idx]
943  set num $g(game)
944  if { $num == $l } {
945  .fics.f.top.foffers.c delete game_$idx
946  break
947  }
948  }
949  }
950 
951  }
952  }
953  ################################################################################
954  #
955  ################################################################################
956  proc parseStyle12 {line} {
957  set color [lindex $line 9]
958  set gameNumber [lindex $line 16]
959  set white [lindex $line 17]
960  set black [lindex $line 18]
961  set relation [lindex $line 19]
962  set initialTime [lindex $line 20]
963  set increment [lindex $line 21]
964  set whiteMaterial [lindex $line 22]
965  set blackMaterial [lindex $line 23]
966  set whiteRemainingTime [lindex $line 24]
967  set blackRemainingTime [lindex $line 25]
968  set moveNumber [lindex $line 26]
969  set verbose_move [lindex $line 27]
970  set moveTime [lindex $line 28]
971  set moveSan [lindex $line 29]
972 
973  set ::fics::playing $relation
974  set ::fics::observedGame $gameNumber
975 
976  ::gameclock::setSec 1 [ expr 0 - $whiteRemainingTime]
977  ::gameclock::setSec 2 [ expr 0 - $blackRemainingTime]
978  if {$color == "W"} {
981  } else {
984  }
985 
986  set fen ""
987  for {set i 1} {$i <=8} { incr i} {
988  set l [lindex $line $i]
989  set count 0
990 
991  for { set col 0} { $col < 8 } { incr col} {
992  set c [string index $l $col]
993  if { $c == "-"} {
994  incr count
995  } else {
996  if {$count != 0} {
997  set fen "$fen$count"
998  set count 0
999  }
1000  set fen "$fen$c"
1001  }
1002  }
1003 
1004  if {$count != 0} { set fen "$fen$count"}
1005  if {$i != 8} { set fen "$fen/"}
1006  }
1007 
1008  set fen "$fen [string tolower $color]"
1009  set f [lindex $line 10]
1010 
1011  # en passant
1012  if { $f == "-1" || $verbose_move == "none"} {
1013  set enpassant "-"
1014  } else {
1015  set enpassant "-"
1016  set conv "abcdefgh"
1017  set fl [string index $conv $f]
1018  if {$color == "W"} {
1019  if { [ string index [lindex $line 4] [expr $f - 1]] == "P" || [ string index [lindex $line 4] [expr $f + 1]] == "P" } {
1020  set enpassant "${fl}6"
1021  }
1022  } else {
1023  if { [ string index [lindex $line 5] [expr $f - 1]] == "p" || [ string index [lindex $line 5] [expr $f + 1]] == "p" } {
1024  set enpassant "${fl}3"
1025  }
1026  }
1027  }
1028 
1029  set castle ""
1030  if {[lindex $line 11] == "1"} {set castle "${castle}K"}
1031  if {[lindex $line 12] == "1"} {set castle "${castle}Q"}
1032  if {[lindex $line 13] == "1"} {set castle "${castle}k"}
1033  if {[lindex $line 14] == "1"} {set castle "${castle}q"}
1034  if {$castle == ""} {set castle "-"}
1035 
1036  set fen "$fen $castle $enpassant [lindex $line 15] $moveNumber"
1037 
1038  # try to play the move and check if fen corresponds. If not this means the position needs to be set up.
1039  if {$moveSan != "none" && $::fics::playing != -1} {
1040  # first check side's coherency
1041  if { ([sc_pos side] == "white" && $color == "B") || ([sc_pos side] == "black" && $color == "W") } {
1042  # puts "sc_move addSan $moveSan"
1043  ::utils::sound::PlaySound sound_move
1045  if { [catch { sc_move addSan $moveSan} err] } {
1046  puts "error $err"
1047  } else {
1048  if { $::fics::playing == 1 } {
1050  } else {
1051  set t1 ""; set t2 ""
1052  if { [scan $moveTime "(%d:%d)" t1 t2] == 2} {
1053  storeEmtComment 0 $t1 $t2
1054  }
1055  }
1056  if { $::novag::connected } {
1057  set m $verbose_move
1058  if { [string index $m 1] == "/" } { set m [string range $m 2 end]}
1059  set m [string map { "-" "" "=" "" } $m]
1060  ::novag::addMove $m
1061  }
1062  updateBoard -pgn -animate
1063  }
1064  }
1065  }
1066 
1067  if {$fen != [sc_pos fen]} {
1068  # Create a game in an opened base
1069  if {![sc_base inUse]} {
1070  sc_base switch $::clipbase_db
1071  }
1072  sc_game new
1073 
1074  set ::fics::waitForRating "wait"
1075  writechan "finger $white /s"
1076  vwaitTimed ::fics::waitForRating 2000 "nowarn"
1077  if {$::fics::waitForRating == "wait"} { set ::fics::waitForRating "0"}
1078  sc_game tags set -white $white
1079  sc_game tags set -whiteElo $::fics::waitForRating
1080 
1081  set ::fics::waitForRating "wait"
1082  writechan "finger $black /s"
1083  vwaitTimed ::fics::waitForRating 2000 "nowarn"
1084  if {$::fics::waitForRating == "wait"} { set ::fics::waitForRating "0"}
1085  sc_game tags set -black $black
1086  sc_game tags set -blackElo $::fics::waitForRating
1087 
1088  set ::fics::waitForRating ""
1089 
1090  sc_game tags set -site "FICS freechess.org"
1091  sc_game tags set -event "FICS observed game"
1092  sc_game tags set -extra [list "Timecontrol \"$initialTime+$increment\""]
1093  sc_game tags set -date "[::utils::date::today year].[::utils::date::today month].[::utils::date::today day]"
1094 
1095  # try to get first moves of game
1096  writechan "moves $gameNumber"
1097  set ::fics::waitForMoves $fen
1098  vwaitTimed ::fics::waitForMoves 2000 "nowarn"
1099  set ::fics::waitForMoves ""
1100 
1101  # Did not manage to reconstruct the game, just set its position
1102  if {$fen != [sc_pos fen]} {
1103  sc_game startBoard $fen
1104  }
1106  }
1107  }
1108  ################################################################################
1109  #
1110  ################################################################################
1111  proc parseSeek {line} {
1112  array set seekelt {}
1113  set seekelt(index) [lindex $line 1]
1114  foreach m [split $line] {
1115  if {[string match "w=*" $m]} { set seekelt(name_from) [string range $m 2 end] ; continue}
1116  if {[string match "ti=*" $m]} { set seekelt(titles) [string range $m 3 end] ; continue}
1117  if {[string match "rt=*" $m]} { set seekelt(rating) [string range $m 3 end] ; continue}
1118  if {[string match "t=*" $m]} { set seekelt(time) [string range $m 2 end] ; continue}
1119  if {[string match "i=*" $m]} { set seekelt(increment) [string range $m 2 end] ; continue}
1120  if {[string match "r=*" $m]} { set seekelt(rated) [string range $m 2 end] ; continue}
1121  if {[string match "tp=*" $m]} { set seekelt(type) [string range $m 3 end] ; continue}
1122  if {[string match "c=*" $m]} { set seekelt(color) [string range $m 2 end] ; continue}
1123  if {[string match "rr=*" $m]} { set seekelt(rating_range) [string range $m 3 end] ; continue}
1124  if {[string match "a=*" $m]} { set seekelt(automatic) [string range $m 2 end] ; continue}
1125  if {[string match "f=*" $m]} { set seekelt(formula_checked) [string range $m 2 end] ; continue}
1126  }
1127  lappend ::fics::seeklist [array get seekelt]
1128  }
1129  ################################################################################
1130  #
1131  ################################################################################
1132  proc updateOffers { } {
1133  set ::fics::sought 1
1134  set ::fics::soughtlist {}
1135  writechan "sought"
1136  vwaitTimed ::fics::sought 5000 "nowarn"
1137  after 3000 ::fics::updateOffers
1138  }
1139  ################################################################################
1140  #
1141  ################################################################################
1142  proc configureCanvas {} {
1143  set w .fics.f.top.foffers
1144  set ::fics::height [winfo height $w]
1145  set ::fics::width [winfo width $w]
1146  $w.c configure -width $::fics::width -height $::fics::height
1148  }
1149  ################################################################################
1150  #
1151  ################################################################################
1152  proc displayOffers { } {
1153  global ::fics::width ::fics::height ::fics::off \
1154  ::fics::offers_minelo ::fics::offers_maxelo ::fics::offers_mintime ::fics::offers_maxtime
1155  after cancel ::fics::updateOffers
1156 
1157  set w .fics.f.top.foffers
1158  set size 5
1159  set idx 0
1160 
1161  #first erase the canvas
1162  foreach id [ $w.c find all] { $w.c delete $id}
1163 
1164  # Draw horizontal lines
1165  set y_unit [expr $height / 32.0]
1166  for {set i 0} {$i < 32} {incr i} {
1167  set y [expr $height - $i * $y_unit]
1168  $w.c create line 0 $y $width $y -fill "light gray"
1169  }
1170 
1171  # Draw horizontal tics and labels
1172  set x1_tick [expr $width - $off]
1173  set x_text [expr $width - 2]
1174  foreach elo [list 5 10 15 20 25 30] {
1175  set y [expr $height - $elo * $y_unit]
1176  $w.c create line $x1_tick $y $width $y -fill black
1177  $w.c create text $x_text $y -fill black -anchor se -text [expr $elo * 100]
1178  }
1179 
1180  # Draw vertical lines, tics and labels
1181  set x_unit [expr ($width - 3 * $off) / 60.0]
1182  set y2_tick [expr $height - $off]
1183  foreach t [list 2 5 10 15 30 60] {
1184  set x [expr $t * $x_unit + $off]
1185  $w.c create line $x $height $x 0 -fill "light gray"
1186  $w.c create line $x $height $x $y2_tick -fill black
1187  $w.c create text [expr $x + 2] $height -fill black -anchor sw -text "${t}m"
1188  }
1189 
1190  foreach g $::fics::soughtlist {
1191  array set l $g
1192  set fillcolor green
1193  # if the time is too large, put it in red
1194  set tt [expr $l(time_init) + $l(time_inc) * 2 / 3]
1195  if { $tt > $offers_maxtime } {
1196  set tt $offers_maxtime
1197  set fillcolor red
1198  }
1199  # if a computer, put it in blue
1200  if { [string match "*(C)" $l(name)] } {
1201  set fillcolor blue
1202  }
1203  # if player without ELO, in gray
1204  if { [string match "Guest*" $l(name)] } {
1205  set fillcolor gray
1206  }
1207 
1208  set x [expr $tt * $x_unit + $off]
1209  set y [expr $height - ($l(elo) / 100.0) * $y_unit]
1210 
1211  if { $l(rated) == "rated" } {
1212  set object "oval"
1213  } else {
1214  set object "rectangle"
1215  }
1216  $w.c create $object [expr $x - $size] [expr $y - $size] [expr $x + $size] [expr $y + $size] -tag game_$idx -fill $fillcolor
1217 
1218  $w.c bind game_$idx <Enter> "::fics::setOfferStatus $idx %x %y"
1219  $w.c bind game_$idx <Leave> "::fics::setOfferStatus -1 %x %y"
1220  $w.c bind game_$idx <ButtonPress> "::fics::getOffersGame $idx"
1221  incr idx
1222  }
1223 
1224  }
1225  ################################################################################
1226  # Play the selected game
1227  ################################################################################
1228  proc getOffersGame { idx } {
1229  array set ga [lindex $::fics::soughtlist $idx]
1230  catch { writechan "play $ga(game)"}
1231  }
1232  ################################################################################
1233  #
1234  ################################################################################
1235  proc setOfferStatus { idx x y } {
1236  global ::fics::height ::fics::width ::fics::off
1237 
1238  set w .fics.f.top.foffers
1239  if { $idx != -1 } {
1240  set gl [lindex $::fics::soughtlist $idx]
1241  if { $gl == "" } { return}
1242  array set l [lindex $::fics::soughtlist $idx]
1243  set m "$l(game) $l(name)($l(elo))\n$l(time_init)/$l(time_inc) $l(rated)\n$l(color) $l(start)"
1244 
1245  if {$y < [expr $height / 2]} {
1246  set anchor "n"
1247  } else {
1248  set anchor "s"
1249  }
1250 
1251  if {$x < [expr $width / 2]} {
1252  append anchor "w"
1253  } else {
1254  append anchor "e"
1255  }
1256 
1257  $w.c create text [expr $x + $off] $y -tags status -text $m -font font_offers -anchor $anchor
1258  $w.c raise game_$idx
1259  } else {
1260  $w.c delete status
1261  }
1262  }
1263  ################################################################################
1264  #
1265  ################################################################################
1266  proc play {index} {
1267  writechan "play $index"
1268  # set ::fics::playing 1
1269  set ::fics::observedGame $index
1270  }
1271  ################################################################################
1272  #
1273  ################################################################################
1274  proc writechan {line {echo "noecho"}} {
1275  after cancel ::fics::stayConnected
1276  if {[eof $::fics::sockchan]} {
1277  tk_messageBox -title "FICS" -icon error -type ok -message "Network error writing channel"
1278  ::fics::close "error"
1279  return
1280  }
1281  puts $::fics::sockchan $line
1282  if {$echo != "noecho"} {
1283  updateConsole "->>$line"
1284  }
1285  after 2700000 ::fics::stayConnected
1286  }
1287  ################################################################################
1288  # FICS seems to close connexion after 1 hr idle. So send a dummy command
1289  # every 45 minutes
1290  ################################################################################
1291  proc stayConnected {} {
1292  catch {
1293  writechan "date" "noecho"
1294  after 2700000 ::fics::stayConnected
1295  }
1296  }
1297  ################################################################################
1298  # returns 1 if premove is set
1299  ################################################################################
1300  proc setPremove {sq1 sq2} {
1301  if { $::fics::premoveEnabled && $::fics::playing == -1 && $sq2 != -1 } {
1302  set ::fics::premoveSq1 $sq1
1303  set ::fics::premoveSq2 $sq2
1304  ::board::mark::DrawArrow .main.board.bd $sq2 $sq1 $::highlightLastMoveColor
1305  return 1
1306  }
1307  return 0
1308  }
1309  ################################################################################
1310  # execute FICS premove if possible
1311  ################################################################################
1312  proc makePremove {} {
1313  if { $::fics::premoveEnabled && $::fics::playing == 1 && $::fics::premoveSq1 != -1 } {
1314  addMove $::fics::premoveSq1 $::fics::premoveSq2
1315  set ::fics::premoveSq1 -1
1316  }
1317  }
1318  ################################################################################
1319  # returns 1 if the player is allowed to enter a move (either playing or using puzzlebot)
1320  ################################################################################
1321  proc playerCanMove {} {
1322 
1323  if { ! [winfo exists .fics] } { return 1}
1324 
1325  if { [sc_game info white] == "puzzlebot" || [sc_game info black] == "puzzlebot" } {
1326  return 1
1327  }
1328 
1329  if { $::fics::playing == 1 } { return 1}
1330 
1331  if { $::fics::premoveEnabled && $::fics::playing == -1 } {
1332  .main.board.bd delete mark
1333  set ::fics::premoveSq1 -1
1334  return 1
1335  }
1336  return 0
1337  }
1338  ################################################################################
1339  # Handle mouse button 1 on console : observe the selected game
1340  # or handle commands (like <next>)
1341  ################################################################################
1342  proc consoleClick { x y win } {
1343  set idx [ $win index @$x,$y]
1344  if { [ scan $idx "%d.%d" l c] != 2 } {
1345  # should never happen
1346  return
1347  }
1348  set elt [$win get $l.0 $l.end]
1349 
1350  if { $elt == "Click or type \[next\] to see next page." } {
1351  writechan "next"
1352  return
1353  }
1354 
1355  regsub -all {\s+} $elt " " elt
1356  set elt [split $elt " "]
1357  set found 0
1358 
1359  if { [llength $elt] > 4} {
1360  # validate format
1361  set game [lindex $elt 0]
1362  set elow [lindex $elt 1]
1363  set white [lindex $elt 2]
1364  set elob [lindex $elt 3]
1365  set black [lindex $elt 4]
1366 
1367  if { [ scan $game "%d" tmp] != 1 || \
1368  ( [ scan $elow "%d" tmp] != 1 && $elow != "++++" ) || \
1369  ( [ scan $elob "%d" tmp] != 1 && $elob != "++++" ) } {
1370  } else {
1371  set found 1
1372  }
1373  }
1374 
1375  # Second chance : try to parse "tell relay listgames" (:104 GMxxxx GMyyyyy * B22)
1376  if { [llength $elt] == 5 && ! $found } {
1377  if { [ scan [lindex $elt 0] ":%d" game] == 1 } {
1378  set white [lindex $elt 1]
1379  set black [lindex $elt 2]
1380  set elow "-"
1381  set elob "-"
1382  set found 1
1383  }
1384  }
1385 
1386  if { ! $found } {
1387  puts "$elt not a valid game"
1388  return
1389  }
1390 
1391  # warn the user before observing a game because it can interfere with a game played or
1392  # other that would be disturbed by observing a game
1393  set ans [tk_messageBox -title "Observe game" -icon question -type yesno \
1394  -message "[ ::tr FICSObserveconfirm] $game\n$white ($elow) - $black ($elob) ?"]
1395  if { $ans == yes } {
1396  writechan "unobserve" "echo"
1397  writechan "observe $game" "echo"
1398  }
1399 
1400  }
1401  ################################################################################
1402  # updates the offers view if it is visible
1403  ################################################################################
1404  proc tabchanged {} {
1405  set nb .fics.f.top
1406  set w .fics.f.top.foffers
1407 
1408  if { [ $nb select] == $w } {
1409  updateOffers
1410  set ::fics::graphon 1
1411  } else {
1412  after cancel ::fics::updateOffers
1413  set ::fics::graphon 0
1414  }
1415  }
1416  ################################################################################
1417  #
1418  ################################################################################
1419  proc close { {mode ""} } {
1420  variable logged
1421  # stop recursive call
1422  bind .fics <Destroy> {}
1423 
1424  set ::fics::sought 0
1425  after cancel ::fics::updateOffers
1426  after cancel ::fics::stayConnected
1427  set logged 0
1428 
1429  if {$mode != "error"} {
1430  writechan "exit"
1431  }
1432 
1433  set ::fics::playing 0
1434  set ::fics::observedGame -1
1435  ::close $::fics::sockchan
1436  if { ! $::windowsOS } { catch { exec -- kill -s INT [ $::fics::timeseal_pid]}}
1437  ::win::closeWindow .fics
1438  }
1439 }
1440 ###
1441 ### End of file: fics.tcl
1442 ###