Category: Tcl

This is the Tcl and Tk implementation of the message bus program. The principles of the message bus are described in the main message bus article. Do read that article first.

This example uses the Tk GUI toolkit. Tk has support for events on files and sockets, so socket handling is integrated into the GUI’s event loop.

Tk is used by several implementations: Perl, Python and Tcl.

The source code

#!/usr/bin/wish
#---------------------------------------------------------------------------------------- Client
proc create_client { } {
    global client
    set client [socket localhost 4711];
    fconfigure $client -blocking 0 -translation lf
    fileevent $client readable "read_from_server $client"
}

proc notify_server { value } {
    global client colour
    puts $client "$value"
    flush $client
}

proc read_from_server { client } {
    global colour
    if {[eof $client]} {
        exit
    }
    while {[gets $client line] > 0} {
        on_incoming_message [ string trim $line ]
    }
}
#---------------------------------------------------------------------------------------- GUI
proc create_gui { } {
    set w  9
    set h  1
    button .red   -text Red   -command { notify_server 1001 } -width $w -height $h
    button .green -text Green -command { notify_server 1002 } -width $w -height $h
    button .blue  -text Blue  -command { notify_server 1003 } -width $w -height $h
    pack .red .green .blue -side left
    wm title . "Tcl and Tk"
}

proc update_button { button cond colour } {
    if $cond { set c $colour } { set c white };
    $button configure -background $c -activebackground $c
}

proc on_incoming_message { message } {
    update_button .red   [ expr 1001 == $message ] #F77
    update_button .green [ expr 1002 == $message ] #7F7
    update_button .blue  [ expr 1003 == $message ] #77F
}

#---------------------------------------------------------------------------------------- main
proc main { } {
    create_gui
    create_client
    puts " --- Entering event loop"
}

main
# Local Variables:
# coding: us-ascii-unix
# End:

You can reach me by email at “lars dash 7 dot sdu dot se” or by telephone +46 705 189090

View source for the content of this page.