view release on metacpan or  search on metacpan

lib/Graphics/DZI.pm  view on Meta::CPAN

package Graphics::DZI;

use strict;
use warnings;
use POSIX;

use Moose;

our $log;
use Log::Log4perl;
BEGIN {
    $log = Log::Log4perl->get_logger ();
}

=head1 NAME

Graphics::DZI - DeepZoom Image Pyramid Generation

=head1 SYNOPSIS

  use Graphics::DZI;
  my $dzi = Graphics::DZI     (image    => $image,
                               overlap  => $overlap,
                               tilesize => $tilesize,
                               format   => $format,
                               );

  write_file ('/var/www/xxx.xml', $dzi->descriptor);
  $dzi->iterate ();
  # !!! this does only display the tiles on the screen
  # !!! see Graphics::DZI::Files for a subclass which 
  # !!! actually writes to files

=head1 DESCRIPTION

This base package generates tiles from a given image in such a way that they follow the DeepZoom
image pyramid scheme. Consequently this image becomes zoomable with tools like Seadragon.

  http://en.wikipedia.org/wiki/Deep_Zoom

As this is a base class, you may want to look either at the I<deepzoom> script which operators on
the command line, or at one of the subclasses.

=head1 INTERFACE

=head2 Constructor

The constructor accepts the following fields:

=over

=item C<image>

The L<Image::Magick> object which is used as canvas.

(since 0.05)

The image can also be a whole stack (L<Image::Magick> allows you to do that). In that case the
bottom image is regarded as the one with the I<highest> degree of detail, and that is tiled first
(at the higher resolutions). Images up the stack are then taken in turn, until only the top-level
image remains. See C<pop> if you want to influence this policy.

=item C<scale> (integer, default: 1)

Specifies how much the image is stretched in the process.

=item C<overlap> (integer, default: 4)

Specifies how much the individual tiles overlap.

=item C<tilesize> (integer, default: 128)

Specifies the quadratic size of each tile.

=item C<overlays> (list reference, default: [])

An array of L<Graphics::DZI::Overlay> objects which describe how further images are supposed to be
composed onto the canvas image.

=back

=cut

has 'image'    => (isa => 'Image::Magick', is => 'rw', required => 1);
has 'scale'    => (isa => 'Int',           is => 'ro', default => 1);
has 'overlap'  => (isa => 'Int',           is => 'ro', default => 4);
has 'tilesize' => (isa => 'Int',           is => 'ro', default => 256);
has 'format'   => (isa => 'Str'   ,        is => 'ro', default => 'png');
has 'overlays' => (isa => 'ArrayRef',      is => 'rw', default => sub { [] });

=head2 Methods

=over

=item B<crop>

I<$tile> = I<$dzi>->crop (I<$scale>, I<$x>, I<$y>, I<$dx>, I<$dy>)

Given the dimensions of a tile and a current (not the original)
stretch factor this method will return a tile object.

=cut

sub crop {
    my $self = shift;
    my $scale = shift;
    my ($tx, $ty, $tdx, $tdy) = @_;

    my $tile  = $self->{image}->[-1]->clone;                                                 # always take the "last" (lowest) image
    if ($scale != 1) {                                                                       # if our image is not quite the total space
#	warn "new canvas tile scaled $scale";
	my ($htx, $hty, $htdx, $htdy) = map { int ($_ / $scale) }
	                                ($tx, $ty, $tdx, $tdy);                              # rescale this tile to the image dims we have
	$log->debug ("rescale $tx, $ty  -->  $htx, $hty");
	$tile->Crop   (geometry => "${htdx}x${htdy}+${htx}+${hty}");                         # cut that smaller one out
	$tile->Resize ("${tdx}x${tdy}");                                                     # and make it bigger
    } else {                                                                                 # otherwise we are happy with what we have, dimension-wise
#	warn "new canvas tile unscaled";
	$tile->Crop (geometry => "${tdx}x${tdy}+${tx}+${ty}");                               # cut one out
    }
    $log->debug ("tiled ${tdx}x${tdy}+${tx}+${ty}");
#    $tile->Display();
    return $tile;
}

=item B<dimensions>

(I<$W>, I<$H>) = I<$dzi>->dimensions ('total')

(I<$W>, I<$H>) = I<$dzi>->dimensions ('canvas')

This method computes how large (in pixels) the overall image will be. If C<canvas> is passed in,
then any overlays are ignored. Otherwise their size (with their squeeze factors) are used to blow up
the canvas, so that the overlays fit onto the canvas.

=cut

sub dimensions {
    my $self = shift;
    my $what = shift || 'total';

    my ($W, $H);
    if ($what eq 'total') {
	use List::Util qw(max);