The code below "almost" works.
if you run it, you get a perl/Tk gui,
with a button labeled "quit" and a
label that says "paddle".
run the script and move the mouse over
the word "paddle" and toggle the mouse button.
It turns the bell on, but doesn't turn it off.
The script forks off a simple process that
loops forever and tests a boolean called
$bellon. If bellon is true, the script prints
"\a". (well, because it doesn't work,
it only prints "a\n" right now, because the
beep was too annnoying)
The loop also has two signal handlers
associated with it, one to set $bellon
to true and one to set it to false.
The other half of the fork process
creates the gui, and sets two callbacks
on the mouse button when over the "paddle" label.
the mousebutton press callback sends the
signal to the subprocess to set $bellon true.
the mousepress release callback sends the
signal to the subprocess to set the $bellon false.
The only problem is that it doesn't work.
For some reason, when you push the
mouse button over the "paddle" label,
the $bellon gets set true, and the subprocess
prints out "a\n", but when you release the
mouse button, the signal gets lost and
the boolean never gets cleared.
it seems like this should work.
Am I missing something?
or is fork/signals/perltk not a reliable mix?
I'm running this on ActiveState perl on my PC.
use warnings;
use strict;
use Data::Dumper;
use Tk;
use Time::HiRes qw(gettimeofday);
#print Dumper \%SIG; exit;
my $bellsig = 'NUM07';
my $silentsig = 'NUM06';
my $pid;
my $bellon = 0;
if(!($pid=fork)) {
# this is the bell server
die "cannot fork: $!" unless defined $pid;
$SIG{$bellsig} = sub{$bellon=1;};
$SIG{$silentsig} = sub{$bellon=0;};
while(1) {
if($bellon){
print "a\n";
}
}
} else {
sub finish {
print "called 'finish'\n";
kill 9 => $pid;
exit;
}
DESTROY { finish; }
END {finish;}
my $top = MainWindow->new();
$top->resizable('no','yes');
$top->title('morse code');
my $top_frame = $top->Frame(
-relief =>'groove',
-borderwidth=>5)
->pack(-anchor=>'w',-fill => 'both');
$top_frame->Button (
-text=>'QUIT',
-command=> sub{finish;},
)
->grid(-row=>10,-column=>1,-columnspan=>4,-sticky=>'ew');
my $paddle = $top_frame->Label (
-text=>'paddle',
)
->grid(-row=>20,-column=>1,-columnspan=>4,-sticky=>'ew');
my @timedelays;
my $lasttime_b1;
sub press1 {
kill $bellsig => $pid; $bellon=1;
my $currenttime = gettimeofday;
if(defined($lasttime_b1)) {
my $delta = $currenttime - $lasttime_b1;
push(@timedelays, $delta);
}
$lasttime_b1 = $currenttime;
}
sub release1 {
kill $silentsig => $pid; $bellon=0;
my $currenttime = gettimeofday;
if(defined($lasttime_b1)) {
my $delta = $currenttime - $lasttime_b1;
push(@timedelays, $delta);
}
$lasttime_b1 = $currenttime;
}
sub parsetones {
print "\n";
print Dumper [EMAIL PROTECTED];
@timedelays=();
}
$paddle->bind('<ButtonPress-1>' => [sub{press1()}, Ev('A')]);
$paddle->bind('<ButtonRelease-1>' => [sub{release1()}, Ev('A')]);
$paddle->bind('<Leave>' => [sub{parsetones;}, Ev('A')]);
MainLoop();
}
_______________________________________________
Boston-pm mailing list
[email protected]
http://mail.pm.org/mailman/listinfo/boston-pm
