home | O'Reilly's CD bookshelfs | FreeBSD | Linux | Cisco | Cisco Exam

## 17.13. Simple Photo Rotations

[47] This algorithm is courtesy of Ryan Casey's img_rotate.tcl script.

```use Tk;
use Tk::PhotoRotateSimple;
use subs qw/rotate/;
use strict;

my \$mw = MainWindow->new;
my \$p = \$mw->Photo(-file => Tk->findINC('Xcamel.gif'));

rotate 'Original';
rotate 'flip';
rotate 'l90';
rotate 'r90';

MainLoop;

sub rotate {

my \$direction = shift;

my \$f = \$mw->Frame(qw/-width 100 -height 100/)->pack(qw/-side left/);
\$f->packPropagate(0);
\$f->Label(-text => \$direction)->pack;
my \$i = \$f->Label(-image => \$p)->pack(qw/-expand 1 -fill both -anchor c/);

return if \$direction eq 'Original';

my \$tmp = \$mw->Photo;
\$tmp->copy(\$p);
\$tmp->rotate_simple(\$direction);
\$i->configure(-image => \$tmp);

}```

\$p is our friendly camel Photo object. Using it as the original, we call rotate to rotate the image three times: 180 degrees, left 90 degrees, and right 90 degrees. The first call to rotate does no rotation, it just displays the original Photo and returns. The rotate_simple method rotates the actual Photo, so we make a temporary copy in order to preserve the original. Then call rotate_simple with flip, l90, or r90.

So much for the user's point of view; let's see the actual module.

#### Figure 17-22. Rotate window

The first thing to note is that we are extending the class Tk::Photo by adding a new method, rotate_simple. The method's basic idea is to create a temporary Photo, extract pixels from the original, stuff them into the temporary Photo appropriately rearranged, then copy the temporary image over the original.

```\$Tk::PhotoRotateSimple::VERSION = '1.0';

package Tk::Photo;
use Carp;
use strict;

sub rotate_simple {

my (\$photo, \$rot) = @_;
carp "Illegal rotation '\$rot'." unless \$rot =~ /l90|r90|flip/i;

my \$tmp = \$photo->Tk::Widget::image('create', 'photo');
bless \$tmp, 'Tk::Photo';

my \$width = \$photo->width;
my \$height = \$photo->height;

if (\$rot =~ /l90/i) {
for (my \$x = 0; \$x < \$width; \$x++) {
my \$curpix = \$photo->data(-from => \$x, 0, \$x + 1, \$height);
\$curpix = "{\$curpix}";
\$tmp->put(\$curpix, -to => 0, \$width - \$x - 1);
}
} elsif (\$rot =~ /r90/i) {
for (my \$y = 0; \$y < \$height; \$y++) {
my \$curpix = \$photo->data(-from => 0, \$y, \$width, \$y + 1);
\$curpix =~ s/^{(.*)}\$/\$1/;
\$tmp->put(\$curpix, -to => \$height - \$y - 1, 0);
}
} else {
\$tmp->copy(\$photo, -subsample => -1, -1);
}

\$photo->blank;
\$photo->copy(\$tmp);
\$photo->configure(-height => \$width, -width => \$height) if \$rot !~ /flip/i;

\$tmp->delete;

} # end rotate

1;```

But there's one subtle gotcha: how to create the temporary Photo when all we've got to work with is a Photo object from the rotate_simple calling sequence. You see, the actual Photo method is a widget method, not a Photo method, so we can't simply say (and have it succeed):

`my \$tmp = \$photo->Photo;`

Instead, we do what we've been taught never to do: look inside an opaque object and take advantage of what we glean. In this case, we call image directly and bless the resulting object as a Tk::Photo.

```my \$tmp = \$photo->Tk::Widget::image('create', 'photo');
bless \$tmp, 'Tk::Photo';```

The alternative is to have another parameter—say, -parent—that the user is required to supply so we have a widget reference. It's certainly safer to do this, if not as pleasing to the eye.

The rest of rotate_simple is straightforward. To rotate l90, grab to the left-most column and put it to the bottom row of the temporary Photo, repeating until all columns are rotated. To rotate r90, grab to the top-most row and put it to the right column of the temporary Photo, repeating until all rows are rotated. flip is the easiest of all, because copy's -subsample option flips automatically if its arguments are negative.