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