in reply to Progress Bars TK::ProgressBars First time trying it..

Hi Rhodium,

Tk applications are generally written in an event driven framework - not linearly like many command line programs and CGI programs (let's not talk about sessions) and the vast majority of utility scripts we write. The general formula for written an event driven application in Tk is like so: 

# psuedo-code
Initialization;
Create main widget;
Create child widgets;

MainLoop;

exit;

Callbacks that do stuff;

[download]
An event driven program creates a framework for a user to do something then waits around for that user to do it. For example: 
#! /usr/bin/perl -w
use strict;
use Tk;
use Tk::DialogBox;
use Tk::ProgressBar;

my $w = new MainWindow(-title => 'Demo Tk');
my $pb = $w->ProgressBar(
    -width => 15,
    -length => 100,
    -from => 0,
    -to => 19
)->pack;
$w->Button(-text => 'Push me', -command => [ \&do_me, $w, $pb ])->pack
+;

MainLoop;
exit;

sub do_me
{
    my $w = shift;
    my $pb = shift;
    for (0..19)
    {
        $pb->value($_);
        $w->update;
        sleep(1)
    }
}

[download]
Here I initialize my code and once I have my widgets done I call MainLoop. Now the program sits there and waits for an event (a button press in this case). When the event is recieved it performs a task - in this case one that is defined in the subroutine named do_me (I have to work on my naming conventions...). The program stays within the MainLoop part of the code until it exits or is terminated.

In your case it would require a bit of re-working what you have to work in this kind of framework. You have all the pieces but you would want to stick all of your job processing into a do_me style subroutine. Then as you complete each job increment the value of your progress widget and update the window.

When I was first learning event driven programming it took me a while to 'get it'. I'm afraid I still can't explain it very well, but hopefully others will chip in here. I also expound endlessly on the subject in this node.

Good luck,
{NULE}
--
http://www.nule.org

Replies are listed 'Best First'.
Re: Re: Progress Bars TK::ProgressBars First time trying it..
by Rhodium (Scribe) on Apr 22, 2002 at 20:01 UTC
    Hi {NULE}
    <pr>Thanks a lot!! Here is what I came up with. Please comment on this!
    <pr> 
    #!/usr/local/bin/perl

use strict;
use Tk;
use Tk::DialogBox;
use Tk::ProgressBar;


my (@joblist, $job, $pid);
# Get a list of all jobs currently running..
chdir();
open (IN, ".dractrack") or die "Can't open .dracktrack for input $!\n"
+;
while (<IN>){
  chomp;
  push (@joblist, $_);
}
close IN;

if (@joblist=""){print" dractrack - Nothing currently in the que!\n";}

# For each new job create a window and display the stats

foreach $job ( @joblist) {
  if( $pid = fork ) { 
  } elsif( defined $pid ) {
    my %drac; 
    ($drac{type},$drac{primary},$drac{rundir},$drac{printfile},$drac{h
+ostname},$drac{stages}) = split / /, $job , 6; 
   
    my $MW = new MainWindow(-title => "Vampire $drac{type} : $drac{pri
+mary}"); 
    my $progress = $MW->ProgressBar(
        -width => 25,
        -length => 300,
        -borderwidth => 2,
        -relief => 'flat',
        -width => 20,
        -padx => 2,
        -pady => 2, 
        -colors => [0 => 'green', .8*$drac{stages}=>'yellow' , .9*$dra
+c{stages} => 'red'],
        -resolution => 1,
        -blocks => 100,
        -anchor => "w",
        -from => 0,
        -to => $drac{stages},
        )->pack(-fill=>"x");

    my $stats = $MW->Label(-text=>"Type:$drac{type}   Cell: $drac{prim
+ary}   Host: $drac{hostname}    Total Stages: $drac{stages}",
        -font => '-b&h-lucida sans typewriter-medium-*-*-*-*-*-*-*-*-*
+-*-*',
        -relief=>"sunken",
        -borderwidth=>2,
        -anchor=>"w")->pack;

    &CheckStage( $MW, $progress, $drac{rundir}, $drac{printfile}, $dra
+c{stages}); 
    MainLoop;
    exit;
    
  }else {
    die "Can't fork: $!";
  }
}

# Delete .dractrack dir
chdir();
open (DRACNEW, ">>.dracnew") or die "I think dracktrack is running";
rename (".dracnew", ".dractrack") or die "Can't replace .dracktrack.."
+;

sub CheckStage {
  my ($MW, $progress, $path, $log, $stages) = @_;
  my @lstage = 0; 
  while ($lstage[3] < $stages){ 
    open( LOG, "$path$log".".log" )
      or die "Cannot open $path$log.log for input: $!\n"; 
    while( <LOG> ) {
        chomp $_;
        next if ($_ !~ m/AT STAGE:/);
        @lstage = split /\s+/, $_;
    }
    close LOG;
    $progress->value($lstage[3]);
    $MW->update;
    sleep(1);
  }
  $MW->destroy;
}

    [download]

    Once again thanks!

    Rhodium

    The <it>seeker</it> of perl wisdom.

[reply]
[d/l]

In Section Seekers of Perl Wisdom