view release on metacpan or  search on metacpan

bin/entile  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;
use Image::Magick;

my $image = new Image::Magick;
$image->Read (shift);

my $path_prefix = shift || 't';

my $pix_tile = shift || 256;

my ($pix_width, $pix_height) = $image->Get ('width', 'height');

my $pix_size = 1;
$pix_size *= 2 while ($pix_size < $pix_width || $pix_size < $pix_height);

unless ($pix_size == $pix_width && $pix_size == $pix_height)
{
    my $x_offset = $pix_size - $pix_width +1;
    my $y_offset = $pix_size - $pix_height +1;
    $image->Border (geometry => $x_offset .'x'. $y_offset);
    $image->Crop (geometry => $pix_size .'x'. $pix_size .'+'. $x_offset .'+'. $y_offset);
    $image->Set (page => '0x0+0+0');
}

entile ($image, $path_prefix, $pix_tile);

sub entile
{
    my $image = shift;
    my $path_prefix = shift;
    my $pix_tile = shift;

    my $pix_width = $image->Get ('width');
    my $w2 = $pix_width/2;

    my $q = $image->Clone;
    my $r = $image->Clone;
    my $s = $image->Clone;
    my $t = $image->Clone;

    $q->Crop (geometry => $w2.'x'."$w2+0+0");
    $q->Set ( page => '0x0+0+0');
    $r->Crop (geometry => $w2.'x'."$w2+$w2+0");
    $r->Set ( page => '0x0+0+0');
    $s->Crop (geometry => $w2.'x'."$w2+$w2+$w2");
    $s->Set ( page => '0x0+0+0');
    $t->Crop (geometry => $w2.'x'."$w2+0+$w2");
    $t->Set ( page => '0x0+0+0');

    if ($w2 == $pix_tile)
    {
        $q->Write ($path_prefix .'q.jpg');
        $r->Write ($path_prefix .'r.jpg');
        $s->Write ($path_prefix .'s.jpg');
        $t->Write ($path_prefix .'t.jpg');
    }
    elsif ($w2 < $pix_tile)
    {
        exit;
    }
    else
    {
        entile ($q, $path_prefix .'q', $pix_tile);
        entile ($r, $path_prefix .'r', $pix_tile);