Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

TK Progress dialog class

by hagus (Monk)
on May 12, 2002 at 23:18 UTC ( #166054=snippet: print w/replies, xml ) Need Help??
Description: Here's a useful class to create a flexible progress bar dialog. Features include:

  • Arbitrary number of progress bars.
  • Space for debug messages to be outputted, with colour and everything!
  • Nice OO interface.
  • Uses pipes to communicate, so you can run the MainLoop in one process and update the widgets in another process.

    TODO:

  • Scroll the text widget down when it gets filled.
  • Not exiting correctly?

    Sample usage:

    END { $widget->quit; } # create two bars - 'execution report' and 'some other report' my $widget = new ProgressWidget("Execution Report", "Some Other Report +"); my $pid; if ($pid = fork) { # run the Tk Mainloop off by itself $widget->run(); waitpid($pid, 0); } else { # actually do the work. increment each progress bar # the bars scale from 0% to 100%, so scale your # range down between these two values. # (progress/totalProgress*100) for (my $i=0; $i<100; $i++) { $widget->incrementBar(0, $i); } sleep 5; for (my $i=0; $i<100; $i++) { $widget->incrementBar(1, $i); } # put a green 'info' message into the dialog. $widget->insertText('info', 'green', "Complete"); }
  • package progressWidget;
    
    use warnings;
    use strict;
    use Tk;
    use Fcntl;
    use Tk::ProgressBar;
    
    sub new
    {
        my $classname = shift;
        my $self = {};
    
        # create the pipe
        pipe(FROM, TO) or die "pipe $!";
        fcntl(FROM, F_SETFL, O_NONBLOCK) or die "can't fcntl $!\n";
        fcntl(TO, F_SETFL, O_NONBLOCK) or die "can't fcntl $!\n";
    
        $self->{fromFh} = \*FROM;
        $self->{toFh} = \*TO;
    
    
        $self->{mainTk} = new MainWindow(-title => 'Generating report ...'
    +);
        # $self->{mainTk} = new MainWindow;
        
        my $maxsize = 0;
        for (my $i=0; $i<@_; $i++)
        {
            if (length($_[$i]) > $maxsize)
            {
                $maxsize = length($_[$i]);
            }
        }
    
        
        for (my $i=0; $i<@_; $i++)
        {
            my $frame = $self->{mainTk}->Frame;
            $frame->Label(-text => $_[$i],
                          -width => $maxsize
                          )->pack(-side => 'left', -expand => 1);
            $self->{bars}[$i] = $frame->ProgressBar(
                                                    -borderwidth => 2,
                                                    -relief => 'sunken',
                                                    -width => 20,
                                                    -length => 200,
                                                    -anchor => 'w',
                                                    -blocks => 50,
                                                    -from => 0,
                                                    -to => 100
                                                   )->pack(-expand => 1);
            $frame->pack;
        }
    
        my $frame = $self->{mainTk}->Frame;
    
        require Tk::ROText;
        $self->{output} = $frame->Scrolled('ROText');
    
        $self->{output}->pack(-side => 'left', -expand => 1, -fill =>'both
    +');
        $frame->pack(-fill => 'both', -expand => 1);
        
        $self->{mainTk}->after(50, \&guiUpdateLoop, $self);
        
        return bless($self, $classname);
    }
    
    sub incrementBar
    {
        my $self = shift;
        my $barnum = shift;
        my $barvalue = shift;
        
        my $fh = $self->{toFh};
        select($fh); $|=1;
        
        print $fh "$barnum:$barvalue\n";
        select(STDOUT);
    }
    
    sub insertText
    {
        my $self = shift;
        my $title = shift;
        my $colour = shift;
        my $message = shift;
    
        my $fh = $self->{toFh};
        select($fh); $|=1;
    
        print $fh "log:$title:$colour:$message\n";
        select(STDOUT);
    }
    
    sub quit
    {
        my $self = shift;
        my $fh = $self->{toFh};
        select($fh); $|=1;
        print $fh "exit\n";
        select(STDOUT);
    }
    
    sub run
    {
        my $self = shift;
        MainLoop;
    }
    
    
    sub guiUpdateLoop
    {
        my $self = $_[0];
    
        my $fh = $self->{fromFh};
        while (my $stuff = <$fh>)
        {
            if ($stuff =~ /exit/)
            {
                # exit;
            }
            elsif ($stuff =~ /^log:/)
            {
                my ($log, $title, $colour, $text) = split(/:/, $stuff, 4);
                # find the end.
                my $tag = 'foo' . ++$self->{tag};
                $self->{output}->insert('end', $title . ": ", $tag);
                $self->{output}->tagConfigure($tag, 'foreground', $colour)
    +;
                $self->{output}->insert('end', $text);
            }
            else
            {
                my @break = split(/:/, $stuff);
                my $bar = $self->{bars}[$break[0]];
                $bar->value($break[1]);
            }
            
            $self->{mainTk}->update;
        }
        $self->{mainTk}->after(5, \&guiUpdateLoop, $self);
    
    }
    
    1;
    
    Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Node Status?
    node history
    Node Type: snippet [id://166054]
    help
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others rifling through the Monastery: (2)
    As of 2016-12-03 16:52 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      On a regular basis, I'm most likely to spy upon:













      Results (56 votes). Check out past polls.