#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::Photo;
use Tk::JPEG;

#this one stores the photo objects in a hash 

my (%img_obj, @keys, $image);
my $count = 0;

my $main   = new MainWindow;

&load_images;

my $imglab = $main->Label(
              -height => 600,
          -width => 600,
              -image => $image )->pack;
         
my $label   = $main->Label()->pack;
my $label2  = $main->Label()->pack;

my $button1 = $main->Button(
    -text    => 'faster',
    -command => \&faster )->pack;

my $button2 = $main->Button(
    -text    => 'slower',
    -command => \&slower)->pack;


my $rpt    = 400;
my $min    = 60;     # increase this if it starts to freeze at fastest
+ setting
my $max    = 5000;    # increase if you want more time per image
my $incdec = 20;      # default 50ms increase/decrease

my $time_this = $main->repeat( $rpt, \&show_pic );

$label2->configure( -text => $rpt );

MainLoop;

sub slower {
    return if $rpt > $max;
    $rpt += $incdec;
    $time_this->time($rpt);
    $label2->configure( -text => $rpt );
}

sub faster {
    return if $rpt < $min;
    $rpt -= $incdec;
    $time_this->time($rpt);
    $label2->configure( -text => $rpt );
}

sub show_pic {
    push (@keys,shift(@keys)); #circular list
    $image->blank;
    $imglab->configure(-image => $img_obj{ $keys[0] }  );
    $label->configure( -text => $keys[0] );
}

sub load_images {
    my @files = <pics/*.jpg>;
    foreach my $file (@files) {
         $img_obj{ $file } = $main->Photo(
                      '-format' => 'jpeg',
                      '-file'   => $file);
        }
  @keys = keys %img_obj;
  $image = $img_obj{ $keys[0] };
}
__END__
[download]

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $w=20;
my $x=0;
my $y=0;

my %colors = (
   0 => ['black','yellow'], 
   1 => ['yellow','black'], 
   2 => ['white','green'],    
   3 => ['green','white'], 
   4 => ['grey','red'], 
   5 => ['red','grey'], 
   6 => ['blue','white'], 
   7 => ['white','blue'], 
   8 => ['orange','grey45'], 
   9 => ['grey45','orange'], 
);

my %bardata = (
   0 => rand 200,
   1 => rand 200,
   2 => rand 200,
   3 => rand 200,
   4 => rand 200,
   5 => rand 200,
   6 => rand 200,
   7 => rand 200,
   8 => rand 200,
   9 => rand 200,
);

my %bars;

my $mw=tkinit;
my $c = $mw->Canvas->pack;

for (0..9) {
  $bars{$_} = $c->createRectangle($x,$y,$x+20,$bardata{$_},
             -fill=> ${$colors{$_}}[0],
          );

my $text = $c->createText($x+10,$y+10,
           -anchor=>'center',
       -fill => ${$colors{$_}}[1],
       -text => $_
          );
      
      $x+=20;
}

$mw->Button(
    -text    => "Save",
    -command => [sub {
         $c->update;
         my @capture=();
         my ($x0,$y0,$x1,$y1)=$c->bbox('all');
         @capture=('-x'=>$x0,'-y'=>$y0,-height=>$y1-$y0,-width=>$x1-$x
+0);
         $c -> postscript(-colormode=>'color',
                               -file=>$0.'.ps',
                   -rotate=>90,
                   -width=>800,
                   -height=>500,    
                   @capture);
                               
                  } 
   
  ]  )->pack;

$mw->repeat(200, sub{ &update });
 
MainLoop;
##########################################################
sub update{

$x=0;
$y=0;

 %bardata = (
   0 => rand 200,
   1 => rand 200,
   2 => rand 200,
   3 => rand 200,
   4 => rand 200,
   5 => rand 200,
   6 => rand 200,
   7 => rand 200,
   8 => rand 200,
   9 => rand 200,
);


for (0..9) {

  $c->delete( $bars{$_}  );

  $bars{$_} = $c->createRectangle($x,$y,$x+20,$bardata{$_},
             -fill=> ${$colors{$_}}[0],
          );

  my $text = $c->createText($x+10,$y+10,
           -anchor=>'center',
       -fill => ${$colors{$_}}[1],
       -text => $_
          );
      
      $x+=20;
}
}
__END__
[download]