Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

Tk Photo Slideshow, with scrolling and scaling

by jdporter (Paladin)
on Oct 18, 2006 at 17:47 UTC ( [id://579154]=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info



This is meant primarily to illustrate how to load and display photo images in Perl-Tk. Secondarily, it shows how to scale images, how to put images into a scrolling window, and how to "drag" such a image.


If no directory is specified, it uses the current directory.

Currently, it obtains a list of all jpeg files (specifically, files matching *.jpg) in the directory and shows them in slideshow. Use PageUp/PageDown, Left/Right, and Up/Down to go to the previous/next image in the list. The list circles around at both ends.

To drag the image (only possible when scrollbar(s) present), press down the main mouse button somewhere on the image, move the mouse, and let up the button.

use Tk;
use Tk::JPEG;
use Tk::Pane;
use strict;
use warnings;

my $dir = shift || '.';

chdir $dir or die "Can't go do $dir - $!\n";

my $filespec = "*.jpg";
my @files = glob $filespec
or die "No files matching $filespec in $dir !\n";

my $ii = -1; # image index

my $mw = new MainWindow;

my $scrolled = $mw
    ->Scrolled( 'Pane', -scrollbars => 'osoe', -width => 640, -height 
+=> 480, )
    ->pack( -expand => 1, -fill => 'both', );

my $imagit = $scrolled
    ->pack( -expand => 1, -fill => 'both', );

my( $xscroll, $yscroll ) = $scrolled->Subwidget( 'xscrollbar', 'yscrol
+lbar' );

my( $last_x, $last_y );

my $img2;

$mw->bind( '<Prior>' => \&prev_image );
$mw->bind( '<Up>'    => \&prev_image );
$mw->bind( '<Left>'  => \&prev_image );

$mw->bind( '<Next>'  => \&next_image );
$mw->bind( '<Down>'  => \&next_image );
$mw->bind( '<Right>' => \&next_image );

$imagit->bind( '<Button1-ButtonRelease>' => sub { undef $last_x } );
$imagit->bind( '<Button1-Motion>' => [ \&drag, Ev('X'), Ev('Y'), ] );

sub drag
    my( $w, $x, $y ) = @_;
    if ( defined $last_x )
        my( $dx, $dy ) = ( $x-$last_x, $y-$last_y );
        my( $xf1, $xf2 ) = $xscroll->get;
        my( $yf1, $yf2 ) = $yscroll->get;
        my( $iw, $ih ) = ( $img2->width, $img2->height );
        if ( $dx < 0 )
            $scrolled->xview( moveto => $xf1-($dx/$iw) );
            $scrolled->xview( moveto => $xf1-($xf2*$dx/$iw) );
        if ( $dy < 0 )
            $scrolled->yview( moveto => $yf1-($dy/$ih) );
            $scrolled->yview( moveto => $yf1-($yf2*$dy/$ih) );
    ( $last_x, $last_y ) = ( $x, $y );


Image scaling here is designed to strike a balance
between not wanting to scroll too much and not
wanting to lose too much resolution by downsampling.
The heuristic is:

1. if the image fits within the scrolled pane in one
or both dimensions (that is, only zero or one scrollbar
would be shown), no downsampling is done.

2. otherwise (i.e. if two scrollbars would be needed),
the downsampling factor is incremented (from 1) until
condition #1 (above) is met.

(Of course, we don't actually increment and check like
that; we calculate the desired factor algebraically.)

This way, when you do have to scroll, it will often be
on one axis only; and the distance you'll have to 
scroll will be minimized (or rather, optimized).

Another approach would be to downsample the picture
sufficiently such that the image always fits entirely
within the pane, and scrolling won't be necessary, but
I'd rather give minimization of resolution loss 
slightly more weight than eliminating the need to scroll.


    sub factor
        my( $n, $m ) = @_;
        ($n>$m) ? int($n/$m) : 1

    sub min
        my( $n, $m ) = @_;
        $n < $m ? $n : $m

sub show_image
    my $imgfile = $files[$ii];
    $mw->configure( -title => "($ii) - - - - - - -" );
    my $img1 = $mw->Photo( 'fullscale',
        -format => 'jpeg',
        -file => $imgfile,
    # it's possible to manipulate an image during reading
    # from disk, but unfortunately you don't get quite as
    # much control as you do when copying one image to another,
    # and some of the things we need to do we can only do
    # during copy, not reading.
    my $factor = min(
        factor( $img1->width, $scrolled->width ),
        factor( $img1->height, $scrolled->height ),
    $img2 = $mw->Photo( 'resized' );
    $img2->copy( $img1, -shrink, -subsample => $factor, $factor );
        -image => 'resized',
        -width => $img2->width,
        -height => $img2->height,
    $mw->configure( -title => "($ii) $imgfile" );

sub prev_image
    $ii = ( $ii + @files - 1 ) % @files;

sub next_image
    $ii = ( $ii + 1 ) % @files;

$mw->after( 100, \&next_image );

Replies are listed 'Best First'.
Tk Photo Slideshow - Production Release
by jdporter (Paladin) on Feb 14, 2007 at 22:20 UTC

    The following is a full-featured, production-quality image slideshow program. It began life as an enhancement of Tk Photo Slideshow, with scrolling and scaling, which is the root of this thread.


    • View any image type supported by Tk::Image.
    • Multiple ways to get a list of image files into the program: command line args (with recursive glob), read from stdin, slideshow file, etc.
    • Manually navigate through the list of images.
    • Pan/scroll around an image if it is larger than the window.
    • Shrink an image.
    • Save and load a slideshow file (it is XML formatted).
    • Filter (grep) and order (sort) the list of images based on any metadata criteria.
    • Automatic slideshow mode: advances to next image every 2 seconds.
    • Execute an external command on the current image (for example, launch an image editor)
    • All metadata for each image are persisted when you save the slideshow file.
    • A number of commands, accessible via menus, for operating on the slideshow file, the list, and the currently displayed item. Many commands are also bound to keys, and some can be executed via command-line switches.
    Command line options: (NB - All of the following is subject to change!)
    • --grep pattern = filter the image list
    • --sort sortcode = order the image list
    • --byname = order the image list by file name
    • --bysize = order the image list by file size
    • --random = randomize the order of the image list
    • --first = jump to the first image in the list. Useful if any of the above are specified.
    • --auto = start the automatic slideshow right away.
    • --file FILE = load slideshow file. format as generated by the Save as... command.
    • --input = read file specifications from stdin rather than getting them on the command line
    • --scale N = pre-scale all images. The default, 0, means full scale. 1 = 1/2 scale, 2 = 1/3 scale, etc. You can think of it as the number of times you hit the - key.
    • --icon = start the gui in the iconified state.
    • --exit = exit, rather than lauching gui. still does all the data initialization.
    Some of the commands accessible through the GUI:
    • PageUp / PageDown = go to previous/next image (loops around)
    • Up / Down arrows = scroll the image vertically
    • Left / Right arrows = scroll the image horizontally
    • + / - = zoom in/out
    • F3 = Order list by file name
    • F4 = Order list by file size
    • F5 = Randomize the list's order
    • F5 = Reverse the list's order
    • G = Enter custom filter (grep) code
    • S = Enter custom ordering (sort) code
    • 0 = Jump to the first image in the list
    • Delete = Remove the current image from the list
    • space = Select/unselect the current image (and go to next)
    • s = Save slideshow file as...
    • l = List slideshow to stdout
    • c = Copy list to the Clipboard
    • q = Exit
    • Escape = Exit
    • mouse Click+Drag on the image = move the image around in the viewport
    • mouse wheel = scroll up/down
    and many more. See the actual menus for complete set.

    List-oriented commands, such as s, l, and c, operate on the entire list currently in memory, in its current order. The filtering and ordering functions operations alter the image list.

    Currently, very few operations are aware of the selected subset of images. More are planned.

    For the custom grep and custom sort operations, the text you enter is whatever you'd put inside the curlies if you were writing a grep or sort block in perl. $_, $a, and $b are filenames, as displayed in the window title bar.

    Grep and sort can be invoked on the command line as well, via the --grep and --sort commandline options. Multiple --grep and --sort options can be given; their effects will be cumulative.

    Note that the sorting is stable: if the current sort operation's comparator finds no difference between two files ($a and $b), their relative ordering will remain unchanged.

    Currently, this program has a number of unpleasant hacks for working on Windows. It has only been tested on Windows, but my desire is for it to be cross-platform. If you have any feedback on how well it doesn't work on another platform, please send it to me. I appreciate it very much.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://579154]
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (2)
As of 2024-06-20 19:04 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.