Posted to tcl by evilotto at Mon Nov 29 22:56:26 GMT 2010view pretty

proc server {s r p} {
    after 1000 "puts $s xyz; close $s"
}

set socket 11111
set host localhost

set ssock [socket -server server $socket]

# comment out this next line and this works normally!
close [socket $host 11111]

# calibrate
set ms 200
set s [clock clicks]
after $ms
set e [clock clicks]
set r [expr {($e-$s)/$ms}]

proc evwait {s} {
    _evwait ::_ev [expr [clock clicks]+$s*$::r]
    vwait ::_ev
    unset ::_ev
}

proc _evwait {v e} {
    if {[clock clicks] < $e} {
        after idle [list _evwait $v $e]
        return
    } else {
        set $v 0
    }
}

set count no
proc report {} {
    puts "$::count loops"
    if {$::count == 0} {
        puts stderr "count died!"
        # close $::ssock
        exit
    }
    set ::count 0
    after 100 report
}

report

proc start {s} {
    puts $s "hi"
    flush $s
    fileevent $s writable {}
    fileevent $s readable "end $s"
}

proc end {s} {
    read $s
    if [eof $s] {
        close $s
    }
}

after 10000 exit

while {1} {
    set s [socket -async $host $socket]
    fconfigure $s -blocking 0
    fileevent $s writable "start $s"
    puts -nonewline "[incr count] "
    evwait 50
}


vwait forever