Busy script - Processing - Displaying a Label - Perl Tk 1

[dmazzini]

Hi

I would like to present a label showing to the user that script is working or processing something, then destroy label after script finish whatever is doing. Same concept as $mw->Busy icon.

I have got the routines, however when I call "working_on" routine, script will stop there and it will not going to execute next perl code.

Any advices how to display a label, o kind of progress bar.

Basically:

1. Main window have some options.
2. User select options an press ok.
3. Main windows dissapear.
4. Script executes some routines based on input user. Dring this processing I want show label
5. Script finish processing routines. Destroy label.

[url=http://perldoc.perl.org/functions/use.html][black][b]use[/b][/black][/url] [green]strict[/green][red];[/red] 
[black][b]use[/b][/black] [green]Tk[/green][red];[/red] 

[url=http://perldoc.perl.org/functions/my.html][black][b]my[/b][/black][/url] [blue]$mw_status[/blue][red];[/red]

[maroon]working_on[/maroon][red]([/red][red])[/red][red];[/red]
[maroon]resting_on[/maroon][red]([/red][red])[/red][red];[/red]


[url=http://perldoc.perl.org/functions/sub.html][black][b]sub[/b][/black][/url] [maroon]resting_on[/maroon][red]{[/red]	
       [blue]$mw_status[/blue]->[maroon]DESTROY[/maroon] [olive][b]if[/b][/olive] [maroon]Tk::Exists[/maroon][red]([/red][blue]$mw_status[/blue][red])[/red][red];[/red]
[red]}[/red] 

[black][b]sub[/b][/black] [maroon]working_on[/maroon] [red]{[/red]
[black][b]my[/b][/black] [blue]$mw_status[/blue]=MainWindow->[maroon]new[/maroon][red];[/red] 
[blue]$mw_status[/blue]->[maroon]overrideredirect[/maroon][red]([/red][fuchsia]1[/fuchsia][red])[/red][red];[/red]
[black][b]my[/b][/black] [blue]$percent[/blue][red];[/red] 

[black][b]my[/b][/black] [blue]$width[/blue]  = [fuchsia]200[/fuchsia][red];[/red]
[black][b]my[/b][/black] [blue]$height[/blue] = [fuchsia]10[/fuchsia][red];[/red]
[black][b]my[/b][/black] [blue]$xpos[/blue] = [url=http://perldoc.perl.org/functions/int.html][black][b]int[/b][/black][/url][red]([/red][red]([/red][blue]$mw_status[/blue]->[maroon]winfo[/maroon][red]([/red][red]'[/red][purple]screenwidth[/purple][red]'[/red][red])[/red]-[blue]$width[/blue][red])[/red]/[fuchsia]2[/fuchsia][red])[/red][red];[/red]
[black][b]my[/b][/black] [blue]$ypos[/blue] = [black][b]int[/b][/black][red]([/red][red]([/red][blue]$mw_status[/blue]->[maroon]winfo[/maroon][red]([/red][red]'[/red][purple]screenheight[/purple][red]'[/red][red])[/red]-[blue]$height[/blue][red])[/red]/[fuchsia]2[/fuchsia][red])[/red][red];[/red]
[blue]$mw_status[/blue]->[maroon]wm[/maroon][red]([/red][purple]geometry[/purple] => [red]"[/red][purple][blue]$width[/blue][/purple][red]"[/red].[red]"[/red][purple]x[blue]$height[/blue]+[blue]$xpos[/blue]+[blue]$ypos[/blue][/purple][red]"[/red][red])[/red][red];[/red]


[black][b]my[/b][/black] [blue]$pb[/blue]= [blue]$mw_status[/blue]->[maroon]Label[/maroon][red]([/red] 
    -[purple]bg[/purple] => [red]'[/red][purple]white[/purple][red]'[/red], 
    -[purple]fg[/purple] => [red]'[/red][purple]blue[/purple][red]'[/red], 
    -[purple]width[/purple]       => [fuchsia]40[/fuchsia], 
    -[purple]justify[/purple] => [red]'[/red][purple]left[/purple][red]'[/red], 
    -[purple]anchor[/purple] => [red]'[/red][purple]w[/purple][red]'[/red], 
    [red])[/red]->[maroon]pack[/maroon][red]([/red][red])[/red][red];[/red] 

[black][b]my[/b][/black] [blue]$timer[/blue] = [blue]$mw_status[/blue]->[maroon]repeat[/maroon][red]([/red][fuchsia]10[/fuchsia],\[maroon]&show_progress[/maroon][red])[/red][red];[/red] 


MainLoop[red];[/red] 

[black][b]sub[/b][/black] [maroon]show_progress[/maroon][red]{[/red] 
        [blue]$percent[/blue] += [fuchsia]1[/fuchsia][red];[/red] 
        [olive][b]if[/b][/olive][red]([/red][blue]$percent[/blue] >= [fuchsia]100[/fuchsia][red])[/red][red]{[/red][blue]$percent[/blue] = [fuchsia]0[/fuchsia][red]}[/red] 
        [black][b]my[/b][/black] [blue]$str[/blue] = [red]'[/red][purple]|[/purple][red]'[/red] x [blue]$percent[/blue][red];[/red]                               
        [blue]$pb[/blue]->[maroon]configure[/maroon][red]([/red]-[purple]text[/purple] => [blue]$str[/blue] [red])[/red][red];[/red]   
[red]}[/red] 

[red]}[/red]

[tt]------------------------------------------------------------
Pragmas (perl 5.10.0) used :
[ul]
[li]strict - Perl pragma to restrict unsafe constructs[/li]
[/ul]
Other Modules used :
[ul]
[li]Tk[/li]
[/ul]
[/tt]

dmazzini
GSM/UMTS System and Telecomm Consultant

 

[Kirsle]

First

[red][b]my[/b][/red] $mw_status;

working_on();
resting_on();


sub resting_on{    
       $mw_status->DESTROY if Tk::Exists($mw_status);
}

sub working_on {
[red][b]my[/b][/red] $mw_status=MainWindow->new;

In sub working_on, $mw_status is a lexical variable for that subroutine only. It overrides the other $mw_status instead of setting its value. So drop the second "my".

I would guess that the perl "stops executing" because of the MainLoop thing. MainLoop basically starts an infinite loop of

while (1) {
   $mw->update;
}

And so when MainLoop is called, your procedural Perl code stops running and everything becomes event-based (button clicks on your GUI, etc.)

Add some print commands everywhere so you can see in your terminal where it gets stuck at to be sure.

Cuvou.com | My personal homepage

perl -e '$|=$i=1;print" oo\n<|>\n_|_";x:sleep$|;print"\b",$i++%2?"/":"_";goto x;'

 

[dmazzini]

Hi Kirsle

Actually the problem is with the MainLoop, basically it starts an infinite loop.

See code below:

MainLoop basically starts an infinite loop of

#!/usr/bin/perl 
use strict; 
use Tk; 
my $mw_status;


working_on();
print "Hello\n";
#resting_on();


sub resting_on{	
       $mw_status->DESTROY if Tk::Exists($mw_status);
} 



sub working_on {
$mw_status=MainWindow->new; 
$mw_status->overrideredirect(1);
my $percent; 

my $width  = 200;
my $height = 10;
my $xpos = int(($mw_status->winfo('screenwidth')-$width)/2);
my $ypos = int(($mw_status->winfo('screenheight')-$height)/2);
$mw_status->wm(geometry => "$width"."x$height+$xpos+$ypos");


my $pb= $mw_status->Label( 
    -bg => 'white', 
    -fg => 'blue', 
    -width       => 40, 
    -justify => 'left', 
    -anchor => 'w', 
    )->pack(); 

my $timer = $mw_status->repeat(10,\&show_progress); 
print "Hello\n";

MainLoop; 

sub show_progress{ 
        $percent += 1; 
        if($percent >= 100){$percent = 0} 
        my $str = '|' x $percent;                               
        $pb->configure(-text => $str );   
} 

}


__END__

How Can I show a "label progress" and avoid MainLoop?. As you can see I want to show a label or progress indicator and at the same time process some sub-routines. I want to create a generic subroutine to do it and incorporate to any perl script.

Any ideas?






dmazzini
GSM/UMTS System and Telecomm Consultant

 

[dmazzini]

Replace thos part of code:

working_on();
print "Hello\n";
#resting_on();

with

working_on();
print "Hello2\n";
#resting_on();

You will see that print for Hello2 is not executed.

dmazzini
GSM/UMTS System and Telecomm Consultant

 

[Kirsle]

You can "roll your own" MainLoop by just calling $mw->update() whenever you want the GUI to refresh (failing to update() will make the GUI appear to have frozen and if ya prod it enough your window manager will start asking if ya wanna kill the program).

my $mw = MainWindow->new;

my $percent = '';
my $lbl = $mw->Label (
   -textvariable => \$percent,
)->pack;

$mw->update(); # first update lets the MainWindow resize itself for widgets etc

for (my $i = 0; $i < 20; $i++) {
   select(undef,undef,undef,0.50); # sleep half second

   # change label
   $percent .= '|';

   # refresh gui
   $mw->update();
}

# nothing else to do now...
MainLoop;

MainLoop will basically do a loop of $mw->update for you. If an event such as a buttonpress executes a subroutine, you can do $mw->update inside the subroutine if it's a long-running one.

my $mw = MainWindow->new;

my $button = $mw->Button (
   -text => "Press Me!",
   -command => \&omg,
)->pack;

MainLoop;

sub omg {
   $button->configure(-state => 'disabled');
   $button->configure(-text => 'Have Patience');
   $mw->update;
   for (my $i = 0; $i < 30; $i++) {
      sleep 1;
      print "Omg check your terminal\n";
      $mw->update;
   }
   $button->configure(-text => 'Press Me!');
   $button->configure(-state => 'normal');
   $mw->update;
}

Cuvou.com | My personal homepage

perl -e '$|=$i=1;print" oo\n<|>\n_|_";x:sleep$|;print"\b",$i++%2?"/":"_";goto x;'

 

[dmazzini]

Hi

I' ve got the idea, looks like I have to roll "move" the MainLoop.

Many thanks

dmazzini
GSM/UMTS System and Telecomm Consultant