A quick Tk Application

peter renshaw goonmail at netspace.net.au
Fri Mar 26 04:11:37 CST 2004


Scott Penrose wrote:

> -----BEGIN PGP SIGNED MESSAGE-----
> Hash: SHA1
>
> Hi Dudes.
>
> I have a favour to ask if someone has time please. I am no Tk expert 
> and have run out of time to do a quick demonstration. I was wondering 
> if someone could write up a very very small Tk app for me for the VTR 
> conference tomorrow.

Hi Scott,
                   here's a quick hack. Try bashing it.
I'll add some better layout in the meantime.

Regs PR

> The purpose of it is to demonstrate both a little tiny Tk script (I 
> don't do any Tk programming and it still only took me 5 minutes to 
> learn how to do the above) - and a network connection to another 
> daemon controlling a big LED Display.

needs testing. see code below.

> My main problem is that I don't know how to trigger the call to the 
> sendit on change of text. If that is too hard, press button will be 
> just as good.

Requires
*grabbing  Edit value
*event binding of Edit widget on 'FocusOut' or loss of focus on Edit 
(move cursor out of text) to sendit method.

Found the solution in *Mastering Perl/Tk*
http://secu.zzu.edu.cn/book/Perl/Perl%20Bookshelf%20%5B3rd%20Ed%5D/tk/ch15_02.htm#mastperltk-CHP-15-SECT-2.5
http://secu.zzu.edu.cn/book/Perl/Perl%20Bookshelf%20%5B3rd%20Ed%5D/tk/ch05_02.htm

[you said......]
What I am looking for is a simple application that:

    * Has two Text Box - each 5 characters wide
    * Has a button (Clear) to clear those
    * Has a button (Exit) to exit
    * Has each of the two Text Box values 'tied' so that I can trigger 
when they change.

Then on change of the text if they could call "sendit($a, $b);" - it 
would be finished.

Here is my attempt...

#!/usr/bin/perl
use strict;
use warnings;
use Tk;

my $top = MainWindow->new;
$top->Button(-text => "Exit", -command => sub { exit 0; })->pack;
$top->Button(-text => "Clear", -command => sub { })->pack;
$top->Entry(-width => 5)->pack;    # sub { sendit(1, $val); }
$top->Entry(-width => 5)->pack;    # sub { sendit(2, $val); }
MainLoop;

sub sendit {
    my ($line, $text) = @_;
    # XXX Call send code here.
}




[I said....]
try testing this ......

#==== code begins ====
#!/usr/bin/perl -w

#====
# name: vtr.pl
# date: 26MAR2004
# programmer: scott (rest), goon(callback, some gui)
# description:
#    VTR demo code.
#
#    Purpose of it is to demonstrate both a little tiny Tk script (I don't
#    do any Tk programming and it still only took me 5 #minutes to learn
#    how to do the above) - and a network connection to another daemon
#    controlling a big LED Display.
#
#        * Has two Text Box - each 5 characters wide
#        * Has a button (Clear) to clear those
#        * Has a button (Exit) to exit
#        * Has each of the two Text Box values 'tied' so that I can 
trigger when they change.
#
#        On change of the text if they could call "sendit($a, $b);" - it 
would be finished.
#====

use strict;
use warnings;

use Tk;
use Tk ':variables';
use IO::Socket::INET;


#---- main window ----
my $mw = MainWindow->new;
$mw->minsize(qw(350 100));
$mw->maxsize(qw(400 200));
$mw->title("Melbourne Perl Mongers @ melbourne.pm.org");
$mw->Label(-text => "Some instructions. add some text here!!!!")->pack;
$mw->Button(-text => "Exit",  -command => sub { exit 0; })->pack;
$mw->Button(-text => "Clear", -command => \&clear_textedit)->pack;


#---- callback: bind entry boxes to sendit subroutine ----
my $get_line = "";
my $get_text = "";

my $entry_line = $mw->Entry(-width => 5, -textvariable => 
\$get_line)->pack();
$get_line = $entry_line->get();
$entry_line->bind('<FocusOut>' => [\&sendit, 1,  chop($get_line)]);

my $entry_text = $mw->Entry(-width => 5, -textvariable => 
\$get_text)->pack();
$get_text = $entry_text->get();
$entry_text->bind('<FocusOut>' => [\&sendit, 2, chop($get_text)]);

MainLoop;



#==== functions below ====
#
#

#---- test_input test input args ----
sub test_input {
    my ($line, $text) = @_;
    print "line = '$line'\n";
    print "text = '$text'\n";
}
#---- clear_textedit clears edit boxes ----
sub clear_textedit {
    $get_line = "";
    $get_text = "";
}
#---- sendit:  ----
sub sendit {
    my ($line, $text) = @_;
    my $sock = IO::Socket::INET->new(
            PeerPort  => 2000,
        PeerAddr  => '10.0.1.16',
        Proto     => 'tcp',
        ) or die "Can't bind : $@\n";
        $sock->send("$line $text\n");
}
#==== code ends ====






More information about the Melbourne-pm mailing list