#!/usr/bin/perl
use warnings;
use Tk;
use strict;
#by Thomas Koenig -- free to use

my($mw) = MainWindow->new;
my(@realvar, @e);
$mw->Label(-text => "Input real numbers")->pack;
foreach my $i (0..4) {
$e[$i] = $mw->Entry(-textvariable    => \$realvar[$i],
-validate        =>'all',
-validatecommand =>\&check_real)->pack;
}
$mw->Button(-text => "Quit",
-command => sub { print join (" ",@realvar),"\n"; exit ;})->pack;
MainLoop;

sub check_real
{
my($proposed, $changes, $current) = @_;
my($ok);
if ($changes) {
$ok = $proposed =~ /^
[+-]?
(
((\d+(\.\d*)?)|(\.\d+))
([eE][+-]?\d*)?
)?
$/x;
}
else {
$ok =
$proposed =~ /^[+-]?((\d+(\.\d*)?)|(\.\d+))([eE][+-]?\d+)?$/;
}
print "current $current changes $changes proposed $proposed: " .
($ok ? "" : "not" ) . "OK\n";
$ok;
}
[download]