#!/usr/bin/perl -w
use strict;
use Tkx;
my ($i, $mw, $labelframe, $label);
$i = 0;
$mw = Tkx::widget->new('.');
$mw->g_wm_title("My Window");
$labelframe = $mw->new_ttk__labelframe( -text => "labelframe", -padding => q/5 5 5 5/ );
$labelframe->g_grid(-stick => "w", -padx => 10, -pady => 10);
$label = $labelframe->new_ttk__label(-text => "$i");
$label->g_grid( -row => 0, -column => 0, -stick => "w" );
&update;
Tkx::MainLoop();
sub update {
$label->configure(-text => $i);
Tkx::after(5000,\&update);
$i++;
}
Perl+Tkx
Добрый день. Есть следующий код, в котором метка lable обновляется раз в 5 сек.
Работает отлично, но если &update содержит что-то такое, что требует несколько секунд на выполнение, то все окно подвисает на это время.
Как быть?
Спасибо.
Код:
Работает отлично, но если &update содержит что-то такое, что требует несколько секунд на выполнение, то все окно подвисает на это время.
Как быть?
Спасибо.
может использовать потоки?
да, нужно использовать потоки, используйте.
Цитата: Artem_3A
да, нужно использовать потоки, используйте.
А можно хотя бы немножко поподробнее ? :)
Получилось примерно так, не знаю насколько правильно реализовал...
Код:
#!/usr/bin/perl -w
use strict;
use threads;
use threads::shared;
use Tkx;
my $i:shared = 0;
my $thread = threads->create(\&incr)->detach();
my $mw = Tkx::widget->new('.');
$mw->g_wm_title("EMy Window");
my $label = $mw->new_ttk__label(-text => "$i");
$label->g_grid( -row => 0, -column => 0, -stick => "w" );
&update;
Tkx::MainLoop();
sub incr {
while (1) {
sleep 5;
print "$i\n";
$i++;
}
}
sub update {
$label->configure(-text => "$i");
Tkx::after(10000,\&update);
}
use strict;
use threads;
use threads::shared;
use Tkx;
my $i:shared = 0;
my $thread = threads->create(\&incr)->detach();
my $mw = Tkx::widget->new('.');
$mw->g_wm_title("EMy Window");
my $label = $mw->new_ttk__label(-text => "$i");
$label->g_grid( -row => 0, -column => 0, -stick => "w" );
&update;
Tkx::MainLoop();
sub incr {
while (1) {
sleep 5;
print "$i\n";
$i++;
}
}
sub update {
$label->configure(-text => "$i");
Tkx::after(10000,\&update);
}
Единственное что, при закрытии окна программы, реализованной на подобии выше приведенного примера в консоли появляется ошибка:
Код:
Free to wrong pool 245f40 not 56b0320 at (eval 3) line 1.
следует обработать событие закрытия окна, то есть при возникновении оного события следует завершать работу потока.
Цитата: Artem_3A
следует обработать событие закрытия окна, то есть при возникновении оного события следует завершать работу потока.
Код:
$mw->g_wm_protocol( 'WM_DELETE_WINDOW', [\&close, $mw] );
Код:
sub close {
$thread = threads->exit();
$mw->g_destroy();
}
$thread = threads->exit();
$mw->g_destroy();
}
и тоже самое...или я что-то не так делаю?
Разобрался, там не в закрытии потока дело было :)
ну тогда решение в студию, дабы поделиться опытом с сообществом, внести свою лепту так сказать.