File Coverage

blib/lib/Graphics/DZI/Document.pm

Criterion	Covered	Total	%
statement	11	13	84.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	16	18	88.8

package Graphics::DZI::Document;

use strict;
use warnings;

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

=head1 NAME

Graphics::DZI::Document - DeepZoom Image Pyramid, Sparse Document Images

=head1 SYNOPSIS

    # prepare a bunch of Image::Magick objects
    @pages = ......;

    # create the overlay itself
    use Graphics::DZI::Document;
    my $o = new Graphics::DZI::Document (pages => \@pages,
					 x => 80000, 'y' => 40000,
					 pack => 'linear',
					 squeeze => 256);

    # use the Graphics::DZI::Files and add this as overlay

=head1 DESCRIPTION

This subclass of L<Graphics::DZI::Overlay> handles documents as overlays for extremely sparse
DeepZoom images. Documents here are also images, but not a single one, but one for each document
page.

What is also different from a normal overlay image is that document overlays will show a different
number of images, depending on the zoom level. First, when the canvas is the dominant feature, only
a small first page is show. Whenever that first page is fairly readable, the first 4 pages are shown
in the slot. Then the next 9 or 16, depending on whether the growth is C<linear> or C<exponential>.

=cut

use Moose;
extends 'Graphics::DZI::Overlay';

=head1 INTERFACE

=head2 Constructor

Different to the superclass not the image, but a sequence of pages have to be passed in. Optionally,
a parameter C<pack> determines between C<linear> and C<exponential> growth of pages at higher
resolutions. With linear you actually get 1, 4, 9, 16, 25...  documents (so it is actually squared
linear). With exponential you get more aggressively 1, 4, 16, 32, ... pages.

=cut

use Moose::Util::TypeConstraints qw(enum);
enum 'packing' => qw( exponential linear );

has 'pages'     => (isa => 'ArrayRef',       is => 'rw', required => 1);
has '+image'    => (isa => 'Image::Magick',              required => 0);
has 'W'         => (isa => 'Int'   ,        is => 'rw');
has 'H'         => (isa => 'Int'   ,        is => 'rw');
has 'sqrt'      => (isa => 'Num',           is => 'rw');
has 'pack'      => (isa => 'packing',       is => 'rw', default => 'exponential');

sub BUILD {
    my $self = shift;
    ($self->{W}, $self->{H}) = $self->pages->[0]->GetAttributes ('width', 'height');     # single document

    use feature "switch";
    given ($self->{pack}) {
	when ('linear')      {
	    use POSIX;
	    $self->{ sqrt } = POSIX::ceil ( sqrt ( scalar @{$self->pages}) );     # take the root + 1
	}
	when ('exponential') {
	    use POSIX;
	    my $log2 = POSIX::ceil (log (scalar @{$self->pages}) / log (2));      # next fitting 2-potenz
	    $log2++ if $log2 % 2;                                                 # we can only use even ones
	    $self->{ sqrt }  = ( 2**($log2/2) );                                  # how many along one edge when we organize them into a square?
	}
	default { die "unhandled packing"; }
    }

    $self->{ image } = _list2huge ($self->sqrt, $self->W, $self->H, @{ $self->pages }) ;
}

sub _list2huge {
    my $sqrt = shift;
    my ($W, $H) = (shift, shift);

    my $dim = sprintf "%dx%d", map { $_ * $sqrt } ($W, $H);
    $log->debug ("building composite document: DIM $dim ($sqrt)");
    use Image::Magick;
    my $huge = Image::Magick->new ($dim);
    $huge->Read ('xc:white');
    $huge->Transparent (color => 'white');

    foreach my $a (0 .. $sqrt*$sqrt - 1) {
	last unless $_[$a];
	my ($j, $i) = ( int( $a / $sqrt)  , $a % $sqrt );
	$log->debug ("    index $a (x,y) = $i $j");

	$huge->Composite (image => $_[$a],
			  x     => $i * $W,
			 'y'    => $j * $H,
			  compose => 'Over',
	    );
    }
#    $huge->Display();
    return $huge;
}

=head2 Methods

=over

=item B<halfsize>

This will be called by the overall DZI algorithm whenever this overlay is to be size-reduced by 2.

=cut

sub halfsize {
    my $self = shift;

    my ($w, $h) = $self->image->GetAttributes ('width', 'height');                     # current dimensions
    if ($self->{ sqrt } > 1) {
	use feature "switch";
	given ($self->{pack}) {
	    when ('linear')      { $self->{ sqrt }--;    }                             # in linear packing we simply reduce the square root by one
	    when ('exponential') { $self->{ sqrt } /= 2; }
	    default {}
	}
	$self->{ image } = _list2huge ($self->sqrt,                                    # pack sqrt x sqrt A4s into one image
				       $self->W, $self->H,
				       @{ $self->pages });
    }
    $self->image->Resize (width => int($w/2), height => int($h/2));                    # half size
    $self->{x} /= 2;                                                                   # dont forget x, y
    $self->{y} /= 2;
}

=back

=head1 AUTHOR

Robert Barta, C<< <drrho at cpan.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2010 Robert Barta, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl
itself.

=cut

our $VERSION = '0.01';

"against all odds";

__END__