Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
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 browsing the Monastery: (3)
    As of 2014-10-01 01:33 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      How do you remember the number of days in each month?











      Results (386 votes), past polls