Tk: Call subroutine when MainWindow is realized?

[Josef Moellers]

Hi,

In a small(ish) application that communicates with a smart card reader,
I'd like to test the link at the beginning. Since the MainLoop is not
yet called, I seem to be unable to create a Dialog to tell the user.

Is there any way to call a sub the first thing after the MainWindow is
created?

 

[Steve Lidie]

In perldoc Tk::Widget there is
$mw->waitVisibility;
and
$mw->waitVariable(\$var);
and
$mw->waitWindow;

Use waitVisibility().

 

[Josef Moellers]

Use waitVisibility().

I don't see how this solves my problem. I'd need two threads: one which
realizes the MainWindow, one which waits for its visibility.

I had hoped for a callback mechanism, e.g.

waitVisibility($top, \&checkconnection);

 

[Steve Lidie]

You'll get better, more, help in comp.lang.perl.tk.

I'm having trouble understanding what you really want to do from above.

I don't see how this solves my problem. I'd need two threads: one which
realizes the MainWindow, one which waits for its visibility.

?

Anyway, Tk is n ot thread-safe.

I had hoped for a callback mechanism, e.g.

waitVisibility($top, \&checkconnection);

Again, what do you really want to do? And comp.lang.perl.tk is a better place to ask

 

[Josef Moellers]

Do you really mean you want 2 threads? I can show you an example
where you start a thread, before you create the mainwindow in the
main thread. You can communicate through threads::shared.

No, I don't want to use threads explicitly. I have done some X
programming in the past and I recall having seen the mechanism where a
callback is run when a window is realized/becomes visible.

I guess I'll follow Steve's advice and turn to comp.lang.perl.tk.

Thanks for your time anyway,

Josef

 

[Josef Moellers]

You'll get better, more, help in comp.lang.perl.tk.

I didn't know that group existed B-{(

I'm having trouble understanding what you really want to do from above.

I'm creating a GUI application whose main/only task is to communicate
with a smart card reader through a serial port. As the reader may not
have been switched on, I'd like to "ping" it at a very early time and,
if that fails, create a Dialog widget notifying the user of the fact and
asking him to switch it on.

I have tried something like this:

use Tk;
use Tk:ialog;
my $top = new MainWindow;
# populate the window
my $cardterminal = new CardTerminal();
unless ($cardterminal->ready()) {
my $d = $top->Dialog(-text => "Please switch on the card terminal",
...);
$d->Show(-global);
}
MainLoop;

and I recall having had problems.

However, I just tried this and it appears that the MainLoop is somehow
invoked when the Show method is called. So, it worked

In essence, please let's all forget I asked B-{).

Sorry to have wasted your time,

Josef, promising to check better before asking nonesense questions.

 

[Steve Lidie]

I didn't know that group existed B-{(


....


I'm creating a GUI application whose main/only task is to communicate
with a smart card reader through a serial port. As the reader may not
have been switched on, I'd like to "ping" it at a very early time and,
if that fails, create a Dialog widget notifying the user of the fact and
asking him to switch it on.

That's what I thought you said ... given that, I couldn't understand why
you would have so much trouble

I have tried something like this:

use Tk;
use Tk:ialog;
my $top = new MainWindow;
# populate the window
my $cardterminal = new CardTerminal();
unless ($cardterminal->ready()) {
my $d = $top->Dialog(-text => "Please switch on the card terminal",
...);
$d->Show(-global);
}
MainLoop;

Looks just like what I might write.

and I recall having had problems.

However, I just tried this and it appears that the MainLoop is somehow
invoked when the Show method is called. So, it worked

Not MainLopp(), but the event loop in general. If you had created a
good CardTerminal object the above code would have fallen through to
the MainLoop() statement.

Now, back to threads. You can't use them, but with care you can use
fork() with Perl/Tk. W/O knowing anything about your CardTerminal class,
if it's methods block the event loop then the GUI will stop working. The
traditional way to solve this is to fork() a child that talks to the
hardware device, and uses, say, pipes to communicate with the Tk parent.
Perl/Tk's filevent() can watch the pipes in a non-blocking fashion.

Goto comp.lang.perl.tk for the best info.

In essence, please let's all forget I asked B-{).

Sorry to have wasted your time,

Josef, promising to check better before asking nonesense questions.

Not a problem!

 

[Steve Lidie]

It may be presumptuous of me to argue with the "teacher",

And why? I'm always willing to learn more ...

but I have been able to use threads with Tk, with 2 caveats.

OK, re-phrase: Tk is not thread safe. "can't use them" seemed
sufficient for a non-Tk group BTW, we're still not in
comp.lang.perl.tk.

1. No passing objects around, only simple text and scalars.
2. Threads must be created before Tk is init'ed.

Similar to the fork() caveat that the child cannot touch in any way
parent Tk data structures.

In this example, I start 3 threads before Tk is started, and put them
to sleep. I control them with shared vars. It look more complicated
than it actually is, because I add an activity bar, and have 3 worker
threads, intead of one, with the associated hash complexities. This
concept can easily be used to start a worker thread to communicate with
the card. The thread can report back it's findings to Tk thru shared
variables, and you could manipulate you window accordingly.

Another big reason "we" Tk-ers don't use threads is probably because
over the last decade their implementation has been a moving target,
and bug-prone. fork()/exec()/pipe() are better known and better
tested, etc. It's another idiom to learn, but, I and I'm sure others
would love to see/hear your experiences on the mailing list and
newsgroup.

Then maybe the following code would make more sense. Still the "no
passing objects" rule might be too hard to live with. Can you
explain more?

#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use Tk;
use Tk::ActivityBar;
use Tk:ialog;

my $data = shift || ' '; #sample code to pass to thread

my %shash;
#share(%shash); #will work only for first level keys
my %hash;
my %workers;
my $numworkers = 3;

foreach my $dthread(1..$numworkers){
share ($shash{$dthread}{'go'});
share ($shash{$dthread}{'progress'});
share ($shash{$dthread}{'timekey'}); #actual instance of the thread
share ($shash{$dthread}{'frame_open'}); #open or close the frame
share ($shash{$dthread}{'handle'});
share ($shash{$dthread}{'data'});
share ($shash{$dthread}{'pid'});
share ($shash{$dthread}{'die'});

$shash{$dthread}{'go'} = 0;
$shash{$dthread}{'progress'} = 0;
$shash{$dthread}{'timekey'} = 0;
$shash{$dthread}{'frame_open'} = 0;
$shash{$dthread}{'handle'} = 0;
$shash{$dthread}{'data'} = $data;
$shash{$dthread}{'pid'} = -1;
$shash{$dthread}{'die'} = 0;
$hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
}

my $mw = MainWindow->new(-background => 'gray50');

my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
->pack(-side =>'left' ,-fill=>'y');
my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
->pack(-side =>'right',-fill =>'both' );

my %actives = (); #hash to hold reusable numbered widgets used for
downloads
my @ready = (); #array to hold markers indicating activity is needed
my $activity = $lframe->ActivityBar()->pack(-side => 'top',-anchor =>
'n');

#make 3 reusable downloader widget sets-------------------------
foreach(1..$numworkers){
push @ready, $_;
#frames to hold indicator
$actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );

$actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
-text => "Stop Worker $_",
-background => 'lightyellow',
-command => sub { } )->pack( -side => 'left', -padx => 10 );

$actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
-width => 3,
-background => 'black',
-foreground => 'lightgreen',
-textvariable => \$shash{$_}{'progress'},
)->pack( -side => 'left' );

$actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
-width => 1,
-text => '%',
-background => 'black',
-foreground => 'lightgreen',
)->pack( -side => 'left' );


$actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
-text => '',
-background => 'black',
-foreground => 'skyblue',
)->pack( -side => 'left',-padx =>10 );

}
#--------------------------------------------------

my $button = $lframe->Button(
-text => 'Get a worker',
-background => 'lightgreen',
-command => sub { &get_a_worker(time) }
)->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady =>
20 );

my $text = $rframe->Scrolled("Text",
-scrollbars => 'ose',
-background => 'black',
-foreground => 'lightskyblue',
)->pack(-side =>'top', -anchor =>'n');

my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $lframe->Button(
-text => 'Start Test Count',
-background => 'hotpink',
-command => sub {
my $count = 0;
$startbut->configure( -state => 'disabled' );
$repeat = $mw->repeat(
100,
sub {
$count++;
$text->insert( 'end', "$count\n" );
$text->see('end');
}
);
$repeaton = 1;
})->pack( -side => 'top', -fill=>'x', -pady => 20);

my $stoptbut = $lframe->Button(
-text => 'Stop Count',
-command => sub {
$repeat->cancel;
$repeaton = 0;
$startbut->configure( -state => 'normal' );
})->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 );

my $exitbut = $lframe->Button(
-text => 'Exit',
-command => sub {

foreach my $dthread(keys %hash){
$shash{$dthread}{'die'} = 1;
$hash{$dthread}{'thread'}->join
}

if ($repeaton) { $repeat->cancel }
#foreach ( keys %downloads ) {
# #$downloads{$_}{'repeater'}->cancel;
#}
# $mw->destroy;
exit;
})->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20
);


#dialog to get file url---------------------
my $dialog = $mw->Dialog(
-background => 'lightyellow',
-title => 'Get File',
-buttons => [ "OK", "Cancel" ]
);

my $hostl = $dialog->add(
'Label',
-text => 'Enter File Url',
-background => 'lightyellow'
)->pack();

my $hostd = $dialog->add(
'Entry',
-width => 100,
-textvariable => '',
-background => 'white'
)->pack();

$dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );

my $message = $mw->Dialog(
-background => 'lightyellow',
-title => 'ERROR',
-buttons => [ "OK" ]
);

my $messagel = $message->add(
'Label',
-text => ' ',
-background => 'hotpink'
)->pack();

$mw->repeat(10, sub{
if(scalar @ready == $numworkers){return}

foreach my $set(1..$numworkers){
$actives{$set}{'label1'}->
configure(-text =>\$shash{$set}{'progress'});

if(($shash{$set}{'go'} == 0) and
($shash{$set}{'frame_open'} == 1))
{
my $timekey = $shash{$set}{'timekey'};
$workers{ $timekey }{'frame'}->packForget;
$shash{$set}{'frame_open'} = 0;
push @ready, $workers{$timekey}{'setnum'};
if((scalar @ready) == 3)
{ $activity->configure(-value => 0) }
$workers{$timekey} = ();
delete $workers{$timekey};
}
}
});

$mw->MainLoop;
###################################################################

sub get_a_worker {

my $timekey = shift;

$hostd->configure( -textvariable => \$data);
if ( $dialog->Show() eq 'Cancel' ) { return }

#----------------------------------------------
#get an available frameset
my $setnum;
if($setnum = shift @ready){print "setnum->$setnum\n"}
else{ print "no setnum available\n"; return}

$workers{$timekey}{'setnum'} = $setnum;
$shash{$setnum}{'timekey'} = $timekey;

$workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
$workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );

$workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
$workers{$timekey}{'stopbut'}->configure(
-command => sub {
$workers{$timekey}{'frame'}->packForget;
$shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
$shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;
push @ready, $workers{$timekey}{'setnum'};
if((scalar @ready) == $numworkers)
{ $activity->configure(-value => 0) }
$workers{$timekey} = ();
delete $workers{$timekey};
});

$workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
$workers{$timekey}{'label1'}->configure(
-textvariable => \$shash{$setnum}{'progress'},
);
$workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};
$workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
$workers{$timekey}{'label3'}->configure(-text => $timekey);

$activity->startActivity();

$shash{$setnum}{'go'} = 1;
$shash{$setnum}{'frame_open'} = 1;
#--------end of get_file sub--------------------------
}

##################################################################
sub work{
my $dthread = shift;
$|++;
while(1){
if($shash{$dthread}{'die'} == 1){ goto END };

if ( $shash{$dthread}{'go'} == 1 ){

eval( system( $shash{$dthread}{'data'} ) );

foreach my $num (1..100){
$shash{$dthread}{'progress'} = $num;
print "\t" x $dthread,"$dthread->$num\n";
select(undef,undef,undef, .5);
if($shash{$dthread}{'go'} == 0){last}
if($shash{$dthread}{'die'} == 1){ goto END };
}

$shash{$dthread}{'go'} = 0; #turn off self before returning
}else
{ sleep 1 }
}
END:
}
######################################################
__END__