File Coverage

blib/lib/Image/Magick/Tiler.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Image::Magick::Tiler;

use strict;
use warnings;

use File::Spec;

use Image::Magick;

use Moo;

use Types::Standard qw/Any ArrayRef Int Str/;

has count =>
(
	default 	=> sub {return 0},
	is			=> 'rw',
	isa			=> Int,
	required	=> 0,
);

has input_file =>
(
	default		=> sub {return ''},
	is			=> 'rw',
	isa			=> Str,
	required	=> 0,
);

has geometry =>
(
	default		=> sub {return '2x2+0+0'},
	is			=> 'rw',
	isa			=> Str,
	required	=> 0,
);

has geometry_set =>
(
	default		=> sub {return [2, undef, 2, 0, 0]},
	is			=> 'rw',
	isa			=> ArrayRef,
	required	=> 0,
);

has output_dir =>
(
	default		=> sub {return ''},
	is			=> 'rw',
	isa			=> Any,
	required	=> 0,
);

has output_type =>
(
	default		=> sub {return 'png'},
	is			=> 'rw',
	isa			=> Str,
	required	=> 0,
);

has verbose =>
(
	default 	=> sub {return 0},
	is			=> 'rw',
	isa			=> Int,
	required	=> 0,
);

has write =>
(
	default		=> sub {return 0},
	is			=> 'rw',
	isa			=> Int,
	required	=> 0,
);

our $VERSION = '2.00';

# -----------------------------------------------

sub BUILD
{
	my($self) = @_;

	die "Error. You must call new as new(input_file => 'path/to/x.suffix')\n" if (! $self -> input_file);

	my($g)	= $self -> geometry;
	$g		= ($g =~ /^\d+x\d+$/) ? "$g+0+0" : $g;

	my(@g);

	if ($g =~ /^(\d+)(x)(\d)([+-])(\d+)([+-])(\d+)$/)
	{
		@g = ($1, $2, $3, $4, $5, $6, $7);

		$self -> geometry("$g[0]$g[1]$g[2]$g[3]$g[4]$g[5]$g[6]");
		$self -> geometry_set([$g[0], $g[1], $g[2], $g[3], $g[4], $g[5], $g[6] ]);

		if ($self -> verbose)
		{
			print "Image::Magick:        V @{[$Image::Magick::VERSION || 'undef']}\n";
			print "Image::Magick::Tiler: V $Image::Magick::Tiler::VERSION\n";
			print "Geometry:             $g parsed as NxM+x+y = " . $self -> geometry . "\n";
		}
	}
	else
	{
		die "Error. Geometry (NxM+x+y = $g) is not in the correct format. \n";
	}

}	# End of BUILD.

# -----------------------------------------------

sub tile
{
	my($self)	= @_;
	my($image)	= Image::Magick -> new();
	my($result)	= $image -> Read($self -> input_file);

	die "Error. Unable to read file $self -> input_file. Image::Magick error: $result\n" if ($result);

	my(@g)											= @{$self -> geometry_set};
	my($param)										= {};
	$$param{image}									= {};
	($$param{image}{width}, $$param{image}{height})	= $image -> Get('width', 'height');
	$$param{tile}									= {};
	$$param{tile}{width}							= int($$param{image}{width} / $g[0]);
	$$param{tile}{height}							= int($$param{image}{height} / $g[2]);

	if ($self -> verbose)
	{
		print 'Image:                ' . $self -> input_file . "\n";
		print "Image size:           ($$param{image}{width}, $$param{image}{height})\n";
		print "Tile size:            ($$param{tile}{width}, $$param{tile}{height}) (before applying x and y)\n";
	}

	die "Error. Tile width ($$param{tile}{width}) < input x ($g[4]). \n"	if ($$param{tile}{width} < abs($g[4]) );
	die "Error. Tile height ($$param{tile}{height}) < input y ($g[6]). \n"	if ($$param{tile}{height} < abs($g[6]) );

	$$param{tile}{width}	+= $g[4];
	$$param{tile}{height}	+= $g[6];

	if ($self -> verbose)
	{
		print "Tile size:            ($$param{tile}{width}, $$param{tile}{height}) (after applying x and y)\n";
	}

	my($count)	= 0;
	my($output)	= [];
	my($x)		= 0;

	my($y, $tile, $output_file_name);

	for my $xg (1 .. $g[0])
	{
		$y = 0;

		for my $yg (1 .. $g[2])
		{
			$count++;

			$output_file_name	= "$yg-$xg." . $self -> output_type;
			$output_file_name	= File::Spec -> catfile($self -> output_dir, $output_file_name) if ($self -> output_dir);
			$tile				= $image -> Clone();

			die "Error. Unable to clone image $output_file_name\n" if (! ref $tile);

			$result = $tile -> Crop(x => $x, y => $y, width => $$param{tile}{width}, height => $$param{tile}{height});

			die "Error. Unable to crop image $output_file_name. Image::Magick error: $result\n" if ($result);

			push @{$output},
			{
				file_name	=> $output_file_name,
				image		=> $tile,
			};

			if ($self -> write)
			{
				$tile -> Write($output_file_name);

				if ($self -> verbose > 1)
				{
					print 'Wrote tile ' . sprintf('%4d', $count) . "       $output_file_name\n";
				}
			}

			$y += $$param{tile}{height};
		}

		$x += $$param{tile}{width};
	}

	if ($self -> verbose)
	{
		print "Tile count:           $count\n";
	}

	$self -> count($count);

	return $output;

}	# End of tile.

# -----------------------------------------------

1;

__END__