#!/usr/bin/perl -w
use strict;
use warnings;
use threads;
use threads::Shared;
use Tkx;
my $child_finished_flag: shared = 0;
my $child_request_flag: shared = 0;
my $ChildThread = threads->create( \&child_thread );
$ChildThread->detach();
my $mw = Tkx::widget->new(".");
$mw->g_wm_title("4 Test");
my $container = $mw->new_ttk__frame;
my $frame = $container->new_ttk__frame();
my $testt = $frame->new_ttk__entry(-textvariable => \my $test);
my $ok = $frame->new_ttk__button(-text => "Test...", -command =>
\&process);
$container->g_grid(-column => 0, -row => 0);
$frame->g_grid(-column => 0, -row => 0, -sticky => "w");
$testt->g_grid(-column => 0, -row => 0);
$ok->g_grid(-column => 0, -row => 1);
Tkx::MainLoop();
sub process {
$child_request_flag= 1;
&check_status_1;
}
#
sub check_status_1 {
Tkx::after(500, sub {
if ($child_finished_flag== 1) {
$child_finished_flag = 0;
$child_request_flag = 0;
print "child_request finished\n";
}
else {
&check_status_2;
print "child_request processing\n";
}
});
}
#
sub check_status_2 {
Tkx::after(500, sub {
&check_status_1;
});
}
#
sub child_thread {
while (1) {
sleep 2;
if ($child_request_flag== 1) {
print "begin child_request\n";
&test;
$child_finished_flag= 1;
}else {
print "waiting for child_request\n";
}
}
}
sub test {
$test= $testt->get();
print "test is: $test\n";
}
在entry中输入任意字符
点击command
Thread 1 terminated abnormally: Can't call method "get" on an
undefined value at demo.pl line 69.
子线程中为何没法get?
在tk的那个线程就算是get了获得的值 shared后 貌似也无法传递过来?
一头雾水。。。
谢谢
--
您收到此邮件是因为您订阅了 Google 网上论坛的"PerlChina Mongers 讨论组"论坛。
要向此网上论坛发帖,请发送电子邮件至 perlchina@googlegroups.com。
要取消订阅此网上论坛,请发送电子邮件至 perlchina+unsubscribe@googlegroups.com。
若有更多问题,请通过 http://groups.google.com/group/perlchina?hl=zh-CN 访问此网上论坛。
没有评论:
发表评论