use strict;
use Tk;
use Data::Dumper;
+
my $addy1 = '32';
my $addy2 = '42';
+
my $mw = MainWindow->new(-title => 'Mac Address Input Example');
my $fr = $mw->Frame()->pack(-expand => 1, -fill => 'both');
my $lb = $fr->Label(-text => 'MAC Address')->pack(-side => 'left');
+
my $e1 = $fr->Entry();
$e1->configure(
-textvariable => \$addy1,
-width => 2,
-validate => 'focusout',
-validatecommand => \&validate,
-invalidcommand => [ \&show_invalid, $e1 ],
);
$e1->pack(-side => 'left');
+
# Need a field to go to so 'focusout' can happen.
my $e2 = $fr->Entry();
$e2->configure(
-textvariable => \$addy2,
-width => 2,
-validate => 'focusout',
-validatecommand => \&validate,
-invalidcommand => [ \&show_invalid, $e2 ],
);
$e2->pack(-side => 'left');
MainLoop;
+
+
sub validate {
my ($val) = @_;
my $b_valid = ($val =~ /^[0-9a-f]{1,2}$/i)? 1: 0;
+
# debugging, print the field.
printf"<%s>: %s valid\n", $val, $b_valid? "IS": "is NOT";
return $b_valid;
}
+
sub show_invalid {
my ($widget) = @_;
$widget->focus();
my $bg = $widget->cget(-background);
$widget->configure(-background => 'red');
$widget->update();
select(undef, undef, undef, 0.2);
$widget->configure(-background => $bg);
$widget->update();
}
Some observations / comments:
- You may want to create a Frame to pack things into rather than the MainWindow widget; it makes it easier to add to later.
- It's *much* easier to create a subroutine for your callbacks, especially since it leads to code re-use, which is a GOOD THING. That's why I created validate() and show_valid().
- If you assign your Entry widgets to specific variables (in this case $e1 and $e2), you can then pass those variables to the show_invalid() subroutine.
- Assigning a boolean ($b_valid) to the result of the regular expression match is another example of code reuse; now you only have to modify a single regular expression if it needs changing, and still use the result (both in your debugging statement, and the return value of the subroutine). For example, you might decide you want to force the hex byte to always be 2-digits, and then you only need to change {1,2} to {2} in one location.
- The subroutine show_invalid() forces the invalid Entry widget to reclaim focus, gets its background color, changes it to red, updates the widget, pauses for 0.2 seconds, changes it back to its original color, and updates it again (the updates make sure that the red "flash" is visible).
s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
| [reply]
[d/l]
[select] |
Here is my attempt. I leave the color flashing to you, but it should'nt be too hard. The only glitch with this one, is the backspace key only seems to go back 1 key. I guess you could get around it with a "Start over" button. It will force you
to enter valid hex and auto tabs you through.
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Regexp::Common qw/number/;
my $top = MainWindow->new();
$top->geometry('300x200');
$top->fontCreate('big',
-family=>'courier',
-weight=>'bold',
-size=>int(-18*18/14));
my %entries;
my $current = 1;
for(1..4){
$entries{$_}{'value'} ||= '';
$entries{$_}{'entry'} = $top->Entry(
-font => 'big',
-textvariable => \$entries{$_}{'value'},
-width => 2,
-validate => 'key',
-vcmd => \&validate,
)->pack(-side =>'left',-padx => 5);
}
$entries{$current}{'entry'}->focus;
MainLoop;
sub validate{
my $val = shift;
if( $val =~ /^$RE{num}{real}{-base=>'16'}$/ ) {
if( length $val == 2){
print "2\n";
$current++;
if($current > 4){$current = 4}
$entries{$current}{'entry'}->focusForce;
$top->update;
}
return 1;
}
return 0;
}
| [reply]
[d/l] |
#!perl
use warnings;
use strict;
use Tk;
my @mac = ( 32, 42 );
my $mw = MainWindow->new();
my $font = 'Courier 18 bold';
my @mac_entry;
for ( 0 .. 5 ) {
$mac_entry[$_] = $mw->Entry(
-textvariable => \$mac[$_],
-width => 2,
-font => $font,
-validate => 'all',
-validatecommand => \&valid,
-invalidcommand => [ sub { invalid( $_[0] ) }, $_ ]
)->pack( -side => 'left' );
$mac_entry[$_]->bind(
'<KeyRelease>',
[
sub {
if ( $mac[ $_[1] ] =~ /^[0-9a-f]{2}$/i ) {
$mac_entry[ $_[1] + 1 ]->focus
if defined $mac_entry[ $_[1] + 1 ];
}
},
$_
]
);
}
sub valid { $_[0] =~ /^[0-9a-f]{0,2}$/i }
sub invalid {
my $index = shift;
my $widget = $mac_entry[$index];
$widget->bell;
my $background = $widget->cget('-background');
$widget->configure( -background => 'red' );
$widget->update;
$widget->after( 250,
sub { $widget->configure( -background => $background ) } );
}
$mac_entry[0]->focus;
MainLoop;
| [reply]
[d/l] |
| [reply] |
All the monks who answered, regularly read all daily posts at perlmonks, and the newsgroup comp.lang.perl.tk, and save good examples which we see. These questions come up so often, that we have a good collection of scripts which we can
use to impress new users. :-) But we have no special powers, just tedious methodical study day after day. You can do it too.
Often, if you know the right words to google for, you can go to
groups.google.com and search comp.lang.perl.misc or comp.lang.perl.tk and search for answers yourself. For instance, for your question you might search for "entry focus" and/or "entry validate", and you will find most of the code which we have shown ( or close).
| [reply] |
| [reply] |
My advice? Drop that #2 requirement right now.
Humans are not machines. Humans have interruptions, humans think out of order, humans don't like it when they have no choices.
What if they just were looking for some other feature, but now they're trapped? What if they don't know what a MAC address is? What if they know it, but remembered that they need to do something else first?
The #3 requirement should serve well enough to fit your intention. If the MAC is invalid when they try to COMMIT their new entry, then you can rightfully balk. Until then, let them do whatever they want to do with the widgets.
Separately, I am not a fan of string-of-pearls input widgets. Dotted Four IP addresses, MAC addresses, credit card numbers, social security numbers, phone numbers, etc. If you feel you have to "automate" the Tab key because there are so many fields, then you have clearly been thinking the wrong direction. Offer one field with much smarter validation. Let computers do what computers are good at, but give humans a human interface. If that's not enough to convince you, how would you "cut" or "paste" a full MAC address with this scheme?
--
[ e d @ h a l l e y . c c ]
| [reply] |
Helley's comments are why I hate working on GUIs. Not to mention the huge time sink they are. I thought this would take me a couple hours and 20 lines of code, it's taking a couple days and a couple pages of code.
This is just a first cut. Once we're happy things are working right I'm replacing the tk entry widget with some sort of database query to get the MAC address (we build 100+ of these things a week). But the database server won't be available until sometime this summer, I have to start programming MACs Monday.
My current script is below. It's still got bugs, but to be honest I've spent a lot more time on it than I ever thought it would take.
#!perl -w
#
# Perl/tk script to present the user with the existing MAC address, an
+d
# allow them to enter a new one.
#
# Known bugs.
# 1) Make an invalid entry '333', and tab. You go to the next field.
# 2) I've seen the background stay red. Not sure how I do it, but on
+ce it
# goes red it stays red.
use strict;
use MyPerlConstants;
use Tk;
# Take a 6 element array and make it string.
sub makeString {
my @data = @_;
my $result = sprintf "%02s:%02s:%02s:%02s:%02s:%02s",
$data[0], $data[1], $data[2], $data[3], $data[4], $data
+[5];
return $result;
}
my $debug = $TRUE;
# If the user control-C's out, or kills my window, this will stay fals
+e
my $done = $FALSE;
# I want the first widget to have focus when I start, the only way I'v
+e
# managed to do so is to save all my entry widgets.
my @entries;
# Turns out it's useful to know what entry your on....
my $current = 0;
sub validate {
my ($val) = @_;
my $b_valid = ($val =~ /^[0-9a-f]{1,2}$/i)? 1: 0;
# debugging, print the field.
printf"<%s>: %s valid\n", $val, $b_valid? "IS": "is NOT" if $debu
+g;
whoopsie() if !$b_valid;
if($b_valid) {
$current++;
$current = 0 if $current > 5;
}
#$entries[$current]->focus();
return $b_valid;
}
# Called when the user makes an invalid entry.
sub whoopsie {
my $widget = $entries[$current];
my $bg = $widget->cget(-background);
$widget->bell;
$widget->configure(-background => 'red');
$widget->update();
$widget->after(500, sub { $widget->configure(-background => $bg) }
+);
$widget->selectionFrom(0);
$widget->selectionTo(100);
$widget->focus();
#$widget->selectionRange(0, 3);
}
sub doit {
my @addy = @_;
my $mw = MainWindow->new(-title => 'MAC Address Input');
# 3 frames: original, new, and the buttons.
my $forig = $mw->Frame()->pack(-expand => 1, -fill => 'both')->
pack(-side => 'top');
my $fnew = $mw->Frame()->pack(-expand => 1, -fill => 'both')->
pack(-side => 'top');
my $fdone = $mw->Frame()->pack(-expand => 1, -fill => 'both')->
pack(-side => 'top');
$forig->Label(-text => 'Current MAC address ', -width => 20)->
pack(-side => 'left');
$fnew->Label(-text => 'Enter new MAC address ', -width => 20)->
pack(-side => 'left');
# Now build some entry widgets to change it.
for my $i (0 .. 5) {
$forig->Label(-text => $addy[$i], -width => 2, -takefocus => 0)
->pack(-side => 'left');
# Don't add a trailing colon (jeez, the mental image that brings
+....)
if($i != 5) {
$forig->Label(-text => ':', -width => 1)->pack(-side => 'left
+');
}
$entries[$i] = $fnew->Entry(
-textvariable => \$addy[$i],
-width => 2,
-validate => 'focusout',
-validatecommand => \&validate,
#-invalidcommand => [ \&whoopsie, $entries[$i] ],
)->pack(-side => 'left');
if($i != 5) {
$fnew->Label(-text => ':', -width => 1)->pack(-side => 'left'
+);
}
}
$entries[0]->focus; # give first widget focus.
$entries[0]->selectionFrom(0);
$entries[0]->selectionTo(100);
$fdone->Label(-width => 12)->pack(-side => 'left');
$fdone->Label(-width => 12)->pack(-side => 'right');
$fdone->Button(-text => "Program",
-command => sub {$mw->destroy;$done = $TRUE},
-background => 'green',
-activebackground => 'green2',
)->pack(-side => 'left');
$fdone->Button(-text => "Cancel",
-command => sub {$mw->destroy;},
-background => 'red',
-activebackground => 'red2',
)->pack(-side => 'right');
MainLoop;
return(@addy);
}
#my @foo = (0x10, 0x22, 0x33, 0x4b, 0x5f, 0x6d);
my @foo = qw/10 22 33 4b 5f 6d/;
print "Starting with: " . makeString(@foo) . "\n";
my @bar = doit(@foo);
print "Ended with: " . makeString(@bar) . "\n";
print 'done: ' . $done . "\n";
Anyway, thanks for your help, and I'm sure you'll see some of your DNA in this script.
I'd actually enjoy any critique of this code you might write up. As I said, I'm new to this and would rather not unlearn bad habits in a few months. My email is jharkins@qualcomm.com if you want to critique it privately.
| [reply]
[d/l] |