socket class
class testt {
inherit itk::Widget
private variable socket
public method acceptSocketConnection
public method processMessage
public method sendCommand
constructor {args} {
set server [socket -server acceptSocketConnection -myaddr 127.0.0.1 2200]
itk_component add buttone {
button .b \
-text "aaa" \
-command [code $this sendCommand GO]
}
pack $itk_component(buttone)
vwait forever
}
}
body testt::acceptSocketConnection { a_sock an_addr a_port } {
set socket $a_sock
fconfigure $socket -buffering line -translation lf -blocking 0 -buffersize 72000
fileevent $socket readable [code $this processMessage]
set ready 1
set datestamp 20110901
if { ![regexp -nocase windows $::tcl_platform(os)] } {
set l_genfile [file join [pwd] "strubio_${datestamp}.gen"]
puts $socket "GENFILE $l_genfile"
set l_matfile [file join [pwd] "strubio_${datestamp}.mat"]
puts $socket "NEWMAT $l_matfile"
puts $socket "NEWMAT $l_matfile"
}
}
body testt::processMessage { } {
gets $socket l_message
if {$l_message != ""} {
puts $l_message
}
}
body testt::sendCommand { args } {
puts $socket $args
}
testt .c
pack .c