# $Id: 30_pb.t,v 1.10 2007/08/08 04:22:35 martinthurn Exp $ use strict; my $VERSION = do { my @r = ( q$Revision: 1.10 $ =~ /\d+/g ); sprintf "%d." . "%03d" x $#r, @r }; use Cwd; use ExtUtils::testlib; use Test::More; use Tk; use lib qw(../lib . t/); BEGIN { my $mwTest; eval { $mwTest = Tk::MainWindow->new }; if ($@) { plan skip_all => 'Test irrelevant without a display'; } else { plan tests => 9; } $mwTest->destroy if Tk::Exists($mwTest); use_ok('WizTestSettings'); use_ok('Tk::Wizard'); use_ok('Tk::ProgressBar'); } our $PB; # Index number of page our $bar; # Progress bar my $wizard = new Tk::Wizard( -title => "ProgressBar Test", ); isa_ok( $wizard, "Tk::Wizard" ); $wizard->configure( -postNextButtonAction => sub { &postNextButtonAction($wizard); }, -preNextButtonAction => sub { &preNextButtonAction($wizard); }, # -finishButtonAction => sub { ok(1); $wizard->destroy; 1; }, ); isa_ok( $wizard->cget( -preNextButtonAction ), "Tk::Callback" ); is( 1, $wizard->addPage( sub { page_splash($wizard) } ), "Page one" ); $PB = $wizard->addPage( sub { pb($wizard) } ); is( 2, $PB, "Page two" ); is( 3, $wizard->addPage( sub { page_finish($wizard) } ), "Page three" ); $wizard->Show; MainLoop; pass; exit; sub page_splash { my $wizard = shift; my $frame = $wizard->blank_frame( -wait => 1, -title => "Welcome to the Wizard Test 'pb'", -text => "This script tests and hopefully demonstrates the 'postNextButtonAction' feature.\n\n" . "When you click Next, a Tk::ProgressBar widget should slowly be udpated." . "\n\nHowever in the test, the -wait flag means you don't have to..." ); return $frame; } sub page_finish { my $wizard = shift; my ( $frame, @pl ) = $wizard->blank_frame( -title => "Wizard Test 'pb' Complete", -text => "Thanks, bye.", ); $frame->after( 100, sub { $wizard->forward } ); return $frame; } sub pb { my $wizard = shift; my $frame = $wizard->blank_frame( # -wait => 1, ### Using this with a progress bar really messes things up!, How so? -title => "postNextButtonAction Test", -subtitle => "Updating a progress bar in real-time", -text => "The bar should fill, thanks to calling the 'update' method upon the Wizard, " . "and the Next button should only become available when the job is done." ); $frame->configure( -bg => 'magenta' ); # for debugging $bar = $frame->ProgressBar( -colors => [ 0 => 'yellow' ], -borderwidth => 2, -relief => 'sunken', -from => 0, -to => 3, -height => 15, )->pack( -padx => 10, -pady => 10, -side => 'top', -fill => 'x', -expand => 1 ); $wizard->{backButton}->configure( -state => 'disable' ); $wizard->{nextButton}->configure( -state => 'disable' ); $wizard->update; return $frame; } sub preNextButtonAction { my $wizard = shift; # diag('this is preNextButtonAction'); 1; } sub postNextButtonAction { my $wizard = shift; my $iPage = $wizard->currentPage; # diag(qq'this is postNextButtonAction on page $iPage'); if ( $iPage == $PB ) { # diag('step 0'); $wizard->update; # diag('step 1'); foreach my $i ( 1 .. $bar->cget( -to ) ) { sleep 1; $bar->value($i); # diag('step 2.1'); $bar->update; } # diag('step 3'); $wizard->{nextButton}->configure( -state => "normal" ); # diag('step 4'); $wizard->{nextButton}->after( 100, sub { $wizard->forward } ); # diag('step 5'); } # diag('step 6'); return 1; } __END__