Scid  4.6.5
novag.tcl
Go to the documentation of this file.
1 ###
2 ### novag.tcl: part of Scid.
3 ### Copyright (C) 2007 Pascal Georges
4 ###
5 ######################################################################
6 ### add NOVAG board support
7 
8 namespace eval novag {
9  set fd ""
10  set connected 0
11  set waitBetweenMessages 0
12 
13  ##########################################################
14  proc connect {} {
15  global ::novag::fd
16 
17  set serial $::ExtHardware::port
18 
19  set w .novag
21  ::setTitle $w "Novag Citrine"
22  pack [ttk::panedwindow $w.f -orient vertical] -expand 1 -fill both
23 
24  ttk::frame $w.f.top
25  ttk::frame $w.f.bottom
26  $w.f add $w.f.top -weight 1
27  $w.f add $w.f.bottom -weight 1
28 
29  ttk::scrollbar $w.f.top.ysc -command { .novag.f.top.output yview }
30  text $w.f.top.output -width 20 -height 20 -wrap word -yscrollcommand ".novag.f.top.ysc set"
31  pack $w.f.top.ysc -side left -fill y -side right
32  pack .novag.f.top.output -side left -fill both -expand 1 -side right
33 
34  entry $w.f.bottom.input -width 20
35  ttk::button $w.f.bottom.send -text Send -command {
36  ::novag::send [.novag.f.bottom.input get]
37  .novag.f.bottom.input delete 0 end
38  }
39  bind $w.f.bottom.input <Return> " $w.f.bottom.send invoke "
40  bind $w <Destroy> { catch ::novag::disconnect }
41  bind $w <F1> { helpWindow Novag}
43 
44  ttk::checkbutton $w.f.bottom.cbref -text [tr "NovagReferee"] -variable ::novag::referee -offvalue "OFF" -onvalue "ON" -command { ::novag::send "U $::novag::referee" }
45 
46  pack $w.f.top.output -fill both -expand 1
47  pack $w.f.bottom.input $w.f.bottom.send $w.f.bottom.cbref -side left
48  update
49 
50  # Set button to "connection in progress"
51  ::ExtHardware::HWbuttonImg tb_eng_connecting
52 
53  if {[catch { set fd [open $serial r+]} err]} {
54  tk_messageBox -type ok -icon error -parent . -title "Novag Citrine" -message "Connection error for $serial \n $err"
55  destroy $w
56  return
57  }
58 
59  # 57600 bauds, no parity, 8 bits, 1 stop
60  fconfigure $fd -mode 57600,n,8,1 -blocking 0 -buffering line
61  fileevent $fd readable ::novag::recv
62  # human / human mode
63  # get info
64  ::novag::send "I"
65  wait 200
66  # new game
67  ::novag::send "N"
68  wait 200
69  ::novag::send "X ON"
70  wait 200
71  ::novag::send "U ON"
72  set ::novag::connected 1
73 
74  # Set button to "connected, ready to use"
76  }
77  ##########################################################
78  proc disconnect {} {
79  global ::novag::fd
80  close $fd
81  set ::novag::connected 0
82  }
83 
84  ##########################################################
85  proc addMove {san} {
86  # if promotion add "/"
87  if {[string length $san] == 5} {
88  set san "[string range $san 0 3]/[string range $san 4 end]"
89  }
90 
91  ::novag::send "M $san"
92  if { [ string first "x" [sc_game info previousMove]] != -1 } {
93  wait 3000
94  } else {
95  wait 200
96  }
97  # ::novag::send "T"
98  ::novag::send "M $san"
99  }
100  ##########################################################
101  proc send {msg} {
102  global ::novag::fd
103  puts $fd "$msg\n\r"
104  }
105  ##########################################################
106  proc recv {} {
107  global ::novag::fd
108 
109  set output .novag.f.top.output
110 
111  set l [gets $fd]
112  if { $l == "" } { return}
113  $output insert end "$l\n"
114  $output yview moveto 1
115 
116  if {[string match -nocase "New Game*" $l]} {
117  sc_game new
118  updateBoard -pgn
119  ::novag::send "U $::novag::referee"
120  return
121  }
122 
123  if {[lindex $l 0] == "M"} {
124 
125  if {[sc_pos side] == "white" && [string index [lindex $l 1] end] == ","} { return}
126  if {[sc_pos side] == "black" && [string index [lindex $l 1] end] != ","} { return}
127 
128  set m [lindex $l 2]
129  set m [regsub -- "-" $m ""]
130  set m [regsub -- "/" $m ""]
131  if { [ catch { sc_move addSan $m} err] } {
132  puts $err
133  } else {
134  if {[winfo exists .fics]} {
135  if { $::fics::playing == 1} {
136  ::fics::writechan [ sc_game info previousMoveNT]
137  }
138  }
139  }
140  updateBoard -pgn
141  return
142  }
143 
144  if {[lindex $l 0] == "T"} {
145  sc_move back
146  updateBoard -pgn
147  return
148  }
149 
150  }
151  ##########################################################
152  proc wait {ms} {
153  after $ms {set ::novag::waitBetweenMessages 1}
154  vwait ::novag::waitBetweenMessages
155  }
156 }
157 
158 ###
159 ### End of file: novag.tcl
160 ###