Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
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;
    
    Comment on TK Progress dialog class
    Download Code

    Back to Snippets Section

    Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Node Status?
    node history
    Node Type: snippet [id://166054]
    help
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others imbibing at the Monastery: (11)
    As of 2014-10-25 17:33 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      For retirement, I am banking on:










      Results (146 votes), past polls