Posted to tcl by gps at Fri Mar 13 09:37:03 GMT 2009view raw

  1.  
  2.  
  3. proc A {sock} {
  4. yield
  5. while 1 {
  6. puts A
  7. gets $sock
  8. yield
  9. }
  10. }
  11.  
  12. proc B {sock} {
  13. yield
  14. while 1 {
  15. puts B
  16. gets $sock
  17. yield
  18. }
  19. }
  20.  
  21. proc C {sock} {
  22. yield
  23. while 1 {
  24. puts C
  25. gets $sock
  26. yield
  27. }
  28. }
  29.  
  30. coroutine Charlie A ""
  31. coroutine The B ""
  32. coroutine Unicorn C ""
  33.  
  34. set i 0
  35. set corolist [list Charlie The Unicorn]
  36.  
  37. puts "Creating accept"
  38.  
  39. proc accept {sock args} {
  40. global i corolist
  41.  
  42. fileevent $sock readable [list [lindex $corolist $i] $sock]
  43. incr i
  44. if {$i >= [llength $corolist]} {
  45. set i 0
  46. }
  47. }
  48.  
  49. socket -server accept 8080
  50. vwait forever
  51.