#!/usr/bin/perl -w # Always use 'strict' and 'warnings' use strict; use warnings; # Libraries use threads; use threads::shared; use Thread::Queue; use Tk; use Tk::ROText; # Globals my $rotext = 0; # The Read-only text widget my $n_lines_waiting: shared = 0; # Message passing between threads my $p_queue = Thread::Queue->new(); # Construct message 'Queue' #################### ### Main program ### #################### # Startup worker thread my $gui_thr = threads->create(\&worker_thread); # Only *now* is it safe to construct the GUI, from the parent thread gui(); ################### ### Subroutines ### ################### # This subroutine is ONLY called from the parent thread sub gui { my $mw = MainWindow->new(); my $top = $mw->Frame()->pack(-expand => 1, -fill => 'both'); my $bt = $top->Button(-bg => 'skyblue', -text => "Exit"); $bt->configure(-command => sub { $mw->destroy() }); $rotext = $top->ROText(-bg => 'white'); $rotext->pack(); $bt->pack(); $mw->repeat(1000 => \&main_loop); MainLoop; } sub main_loop { if ($n_lines_waiting) { fetch_worker_data(); } } sub fetch_worker_data { for (my $i = 0; $i < $n_lines_waiting; $i++) { my $line = $p_queue->dequeue(); $rotext->insert("end", "$line\n"); } $rotext->insert("end", "--- End of $n_lines_waiting line(s) ---\n"); $rotext->see("end"); my $mw = $rotext->toplevel(); $mw->update(); $n_lines_waiting = 0; } # This subroutine is ONLY called in the worker thread sub worker_thread { while (1) { sleep 3; worker_simulate_data(); } } sub worker_simulate_data { my $nlines = int(rand(10)); ($nlines > 0) or return; my $timestamp = localtime(time); for (my $i = 0; $i < $nlines; $i++) { my $idx = $i + 1; my $line = "[$timestamp] Random line of text #$idx"; $p_queue->enqueue($line); } $n_lines_waiting = $nlines; }