BillKSmith has asked for the wisdom of the Perl Monks concerning the following question:

My goal is to compute and set the color of every pixel in a 500x500 image. Placing the entire computation in a single call back leaves my machine unresponsive for fifteen to thirty seconds. The only solution that I could think of was to compute one row of pixels at a time. Here is a demo of my implementation: 

use strict;
use warnings;
use v5.14;
use Tk;



my $mw = new MainWindow( -title => 'Event demo');
my $drawarea = $mw->Frame()->pack( -side => 'top', -fill => 'both' );
$mw->bind('<<RowDone>>' => \&next_row);
my $p = $mw->Photo(-width=>500, -height=>500);

my $canvas = $drawarea->Canvas(
    -relief      => 'ridge',
    -width       => 500,
    -height      => 500,
    -borderwidth => 4
)->pack();

$canvas->bind('<<RowDone>>' => \&next_row);
$canvas->createImage(0,0, -anchor=>'nw', image=>$p);


my $plot = $mw->Button(-text=>'Plot', -command=>\&init)
    ->pack(-side=>'left');

MainLoop;

# Callbacks

sub init {
    our $y = 0;
    $mw->eventGenerate('<<RowDone>>');
    return;
}

sub next_row {
    our $y;
    for  my $x ( 0..499 ) {
        my $quality = long_computation($x, $y);
        $p->put(color($quality), '-to', $x, $y);
    }
    $canvas->update;
    if (++$y < 500) {
        $mw->eventGenerate('<<RowDone>>', -when => 'tail' );
    }
    return;
}

# stubs for demo only
sub color {
    return 'red'
}

sub long_computation {
    return 10;
}

[download]

This works as intended, but brings up some new issues.

The current row number ($y) must be declared globally with 'our'. I would prefer to pass a lexical value from one iteration to the next through the event structure. I have not been able to find a way to do this.

There does not seem to be any way to cancel a calculation in progress. I am unable to cancel a <<RowDone>> event which is already scheduled (or soon will be).

This is very likely an X-Y problem. I am interested in better solutions to the original problem as well as improvements to my solution.

Bill

Replies are listed 'Best First'.
Re: long computation in TK
by choroba (Cardinal) on Jun 25, 2018 at 16:31 UTC
    You don't need to make $y global, it's enough to share it among the subroutines that need it. I made them close over the $y, but you can also abstract the whole logic into a class where y is the attribute.

    I don't know whether it's possible to create custom events with any event structure you'd like to define, but I fear it's not.

    I'm not sure whether an event can be cancelled, but you can definitely not schedule the following one, and do nothing in the current one. 

    #! /usr/bin/perl
use strict;
use warnings;

use Time::HiRes qw{ usleep };
use Tk;

my $mw = 'MainWindow'->new(-title => 'Event demo');
$mw->bind('<<RowDone>>' => \&next_row);

my $drawarea = $mw->Frame->pack(-side => 'top', -fill => 'both');
my $p = $mw->Photo(-width => 500, -height => 500);

my $canvas = $drawarea->Canvas(
    -relief      => 'ridge',
    -width       => 500,
    -height      => 500,
    -borderwidth => 4
)->pack;

$canvas->createImage(0, 0, -anchor => 'nw', image => $p);

$mw->Button(-text => 'Plot', -command => \&init)
    ->pack(-side => 'left');

$mw->Button(-text => 'Stop', -command => \&stop)
    ->pack(-side => 'left');

$mw->Button(-text => 'Quit', -command => sub { Tk::exit() })
    ->pack(-side => 'left');

MainLoop();


{   my ($y, $done);

    sub init {
        undef $done;
        $y = 0 if ! defined $y || $y == 500;
        $mw->eventGenerate('<<RowDone>>');
    }

    sub next_row {
        return if $done;
        for my $x ( 0..499 ) {
            my $quality = long_computation($x, $y);
            $p->put(color($quality), '-to', $x, $y);
        }
        $canvas->update;
        if (++$y < 500) {
            $mw->eventGenerate('<<RowDone>>', -when => 'tail' );
        }
    }

    sub stop { $done = 1 }
}

sub color { qw( red blue )[ rand 2 ] }

sub long_computation { usleep(100) }

    [download]

    *Update*: return from next_row at the very beginning.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

    [download]
[reply]
[d/l]
[select]
Re: long computation in TK
by zentara (Cardinal) on Jun 26, 2018 at 10:33 UTC
    Hi, you have been given much good advice. I just would add that this is reminscent of steganography.

    I am thrown off a bit by your use of generating custom events to signal a row done. Remember, Tk should only be used for the display of the result, don't use it to do calculations. Put the calculations in a forked process or thread, and pass it back to Tk for display. It would be very responsive to a binding to the q key to stop. The Tk event loop would use a timer or a fileevent to get the resultant image data back from the thread and update the display. I probably would use GD to do the pixel manipulation, with set_pixel, in the thread or fork. Do one line at a time and return the array. Then use Tk to display the accumulated results on the canvas. Be careful with creating a new image each time you need to update the canvas, you may get a memory leak. Instead, clear out the current image object's data, and refill it.

    See Re: Tk photo display: memory never released (not leaking solution feeding -data to Tk::Photo)

    Here is a basic example to use threads with Tk. Re^2: Tk-with-worker-threads. Notice Tk needs a timer to read the thread data. Alternatively, you could use a fileevent to read the filhandle from the thread directly.

    Read more... (3 kB)

    Good luck.

    I'm not really a human, but I play one on earth. ..... an animated JAPH
[reply]
[d/l]
Re: long computation in TK
by bliako (Abbot) on Jun 25, 2018 at 18:46 UTC

    I would also suggest using a class to encapsulate all computations with all its internal variables like y which get updated whenever something is done internally and are never exposed. The class could have a stop() method which will interrupt any loops via a stop-flag for example.

    Passing a ref to a method in the class, e.g. in

    my $plot = $mw->Button(-text=>'Plot', -command=>\&init)
    ->pack(-side=>'left');

    [download]

    can be done like:

    my $computator = Computator->new($p, $mw, whatever ...);
$computator->reset();
my $plot = $mw->Button(-text=>'Plot', -command=>sub { $computator->ini
+t()} )
    ->pack(-side=>'left');

# create a stop-button
my $stop = $mw->Button(-text=>'Stop', -command=>sub { $computator->sto
+p()})
    ->pack(-side=>'left');

    [download]

    Warning, my Tk skills are minimal.

    What I do not like is that the side-effect of the long computation seems to go away when you break the long computation in a lot of per-row computations. But this is very subjective to given photo size, host computer speed, Tk internals.

    Can you not tell Tk to process event queue every time you complete the innermost loop? So as to have long loops without Tk becoming unresponsive?

    If that fails, spawning a thread to do the long computation sounds to me like a good idea but it's tricky and it may open a can of worms, as per Perl Tk and Threads

[reply]
[d/l]
[select]
Re: long computation in TK
by Anonymous Monk on Jun 25, 2018 at 18:24 UTC
    "Holy Windows 3.1, Batman!" A much better strategy would be to launch a (single ...) background thread to recompute the bitmap, then signal you by some means that the computation is done so that you can in one step replace the existing bitmap with the recomputed one. Your present strategy will, at best, make the display look very strange for about 30 seconds, and take a whole lot longer due to Tk overhead.
[reply]
      I may be wrong about this, but I don't think that Tk is "thread-safe".
[reply]

        Usually, Tk is not thread safe. Which is why there is only one thread talking to Tk, and the other thread doing the work. The worker thread is not allowed to speak to Tk. Usually, the two threads communicate through a Thread::Queue.

[reply]
      How sentient! Twenty years ago, I wrote a version of this program in C++ for 3.1. The executable failed to load in XP. The source was backed up on floppy (long since discarded). I do remember solving the analogous problem in an analogous way.

      It recently occurred to me that modern hardware could probably compensate for the overhead of Tk and perl. I was right. My current version achieves slightly better performance than I remember from the ancient past.

      Bill
[reply]
Re: long computation in TK
by BillKSmith (Monsignor) on Jun 26, 2018 at 19:45 UTC
    Thanks for all your answers. I have decided that my own design is 'good enough' for my own use on my own machine. In fact, I like the way the image develops, serving as its own 'progress bar'. Fork and thread solutions are beyond my current skill. That has got to change. (future versions???). The 'class' suggestion seems like a minor change which provides the 'stop' function in a natural way. I expect to adopt it soon. I do not see much difference between the global $y and the closure over $y. The class approach makes that issue moot anyhow.
    Bill
[reply]
[reply]
        Right now I am taking a break to enjoy my success. I am keeping a long and growing list of possible future features and enhancements. Thanks for the contribution. (I suspect that your examples will prove useful even if they are not used directly.)
        Bill
[reply]

Back to Seekers of Perl Wisdom