Posted to tcl by aspect at Thu Apr 17 05:22:54 GMT 2014view raw

  1. #!/usr/bin/tclsh
  2.  
  3. package require Tk
  4.  
  5. set input "" ;# what's currently in the text entry
  6. set sent "" ;# what has already been sent
  7. set rate 1 ;# max number to send per second
  8. set outfd stdout ;# this could be [open |...]
  9.  
  10. grid [ttk::labelframe .f -text "Type in here"] -sticky nsew
  11. grid [entry .e -textvariable input -validate key] -in .f -sticky nsew
  12. grid [label .l -textvariable sent] -in .f -sticky nsew
  13. grid [button .b -text Exit -command exit] -sticky ns
  14. grid columnconfigure . 0 -weight 1
  15.  
  16. set normalbg [.b cget -background]
  17.  
  18. fconfigure $outfd -buffering none ;# ensure we can send one char at a time
  19.  
  20. proc every {ms script} { ;# this comes from http://wiki.tcl.tk/every
  21. if 1 $script
  22. after $ms [list after idle [info level 0]]
  23. }
  24.  
  25. proc sendChars {} {
  26. global input
  27. global sent
  28. global outfd
  29. if {[string length $input]} {
  30. .b configure -background green
  31. set c [string index $input 0]
  32. set input [string range $input 1 end]
  33. append sent $c
  34. puts -nonewline $c
  35. flush $outfd
  36. } else {
  37. .b configure -background red
  38. }
  39. after 100 {.b configure -background $::normalbg} ;# note the different way of referencing a global
  40. }
  41.  
  42. every [expr {int(1000.0/$rate)}] {sendChars}
  43.  
  44. if {!$::tcl_interactive} { ;# this is a hack so if you [source] it into a running tclsh/wish, you can keep typing commands
  45. vwait forever ;# start the event loop
  46. }