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

#!/usr/bin/tclsh

package require Tk

set input ""        ;# what's currently in the text entry
set sent ""         ;# what has already been sent
set rate 1          ;# max number to send per second
set outfd stdout    ;# this could be [open |...]

grid [ttk::labelframe .f -text "Type in here"] -sticky nsew
grid [entry .e -textvariable input -validate key] -in .f -sticky nsew
grid [label .l -textvariable sent] -in .f -sticky nsew
grid [button .b -text Exit -command exit] -sticky ns
grid columnconfigure . 0 -weight 1

set normalbg [.b cget -background]

fconfigure $outfd -buffering none   ;# ensure we can send one char at a time

proc every {ms script} {    ;# this comes from http://wiki.tcl.tk/every
    if 1 $script
    after $ms [list after idle [info level 0]]
}

proc sendChars {} {
    global input
    global sent
    global outfd
    if {[string length $input]} {
        .b configure -background green
        set c [string index $input 0]
        set input [string range $input 1 end]
        append sent $c
        puts -nonewline $c
        flush $outfd
    } else {
        .b configure -background red
    }
    after 100 {.b configure -background $::normalbg}    ;# note the different way of referencing a global
}

every [expr {int(1000.0/$rate)}] {sendChars}

if {!$::tcl_interactive} {    ;# this is a hack so if you [source] it into a running tclsh/wish, you can keep typing commands
    vwait forever   ;# start the event loop
}