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