http://www.perlmonks.org?node_id=1228683


in reply to Re^2: AnyEvent + Wx, Gtk2/3 or Tk ?
in thread [Solved] AnyEvent + Wx, Gtk2/3 or Tk ?

The same demo using threads, again at the 1 ms repeat interval. Thread::Queue lacks the clear method and likely not necessary. Thought to clear the memory before the main process exits mainly to minimize any possibility for threads seg-faulting. Not yet sure if this is helpful. Was trying things at the time.

Gtk2 + Tk + threads + Thread::Queue

#!/usr/bin/perl # Re: AnyEvent + Wx, Gtk2/3 or Tk ? # https://www.perlmonks.org/?node_id=1008085 use strict; use warnings; use threads; use threads::shared; use Thread::Queue; use Gtk2; use Tk; use Time::HiRes 'time'; $| = 1; my $que = Thread::Queue->new(); my $count : shared = 0; my $count_tk = 0; sub Thread::Queue::clear { my ( $self ) = @_; lock $self; @{ $_[0]->{queue} } = (); return; } threads->create( sub { $SIG{QUIT} = sub { threads->exit(0) }; while (defined (my $c = $que->dequeue)) { print "$c\n"; } })->detach() for (1..3); my $start = time; # setup Tk loop my $mw = MainWindow->new(-title=>'Tk Window'); my $labtk = $mw->Label(-textvariable => \$count_tk)->pack; # setup Gtk2 loop Gtk2->init; my $window = Gtk2::Window->new('toplevel'); $window->set_title('Gtk2 Window'); my $glabel = Gtk2::Label->new("This is a Gtk2 Label 0"); $window->add($glabel); $window->show_all; # make Tk loop the master, but you could make Gtk2 master if desired # the lower the repeat rate, i.e. 1 ms, # will give more cpu time to the gtk2 loop # this is sometimes called manually pumping the event loop my $tktimer = $mw->repeat( 1, sub { my $c = ++$count; $count_tk = $c; $glabel->set_text("This is a Gtk2 Label $c"); Gtk2->main_iteration while Gtk2->events_pending; quit() if ($c >= 2000); $que->enqueue(($c) x 3); }); $mw->Button( -text => ' Tk control Quit ', -command => \&quit )->pack; $mw->protocol( WM_DELETE_WINDOW => \&quit ); MainLoop; sub quit { $tktimer->cancel(), $que->clear(), $que->end(); $_->kill('QUIT') for threads->list(); printf "duration: %0.03f seconds\n", time - $start; kill('TERM', -$$); exit; }

Regards, Mario