#!/usr/bin/perl
###
# Benchmarking some "wellknown" image related tools:
# - how fast can you scale-_down_ a JPEG?
#
# * check the output quality too ;-)
#
# !! always use "iterations", never "seconds" (negative argument)
# !! as Benchmark.pm doesn't handle "child process time"
#
# e.g.:
#  ./image-scale.pl 10 ; identify out.*.jpg; feh out.*.jpg
#
# altblue 2007.03.21
#
use warnings;
use strict;
use Benchmark qw(cmpthese timethese);
use File::Spec ();

my $input   = 'input.jpg';    # input file
my $ratio   = 0.15;           # output geometry ratio
my $dpi     = 100;            # output density
my $quality = 85;             # output quality

# some of the tests need a "percent" value
my $perc = ( $ratio * 100 ) . q{%};

# methods "storage" ;-)
my $methods = {};

# "system" helper
sub which {
    my $name = shift || return;
    for ( split /:/, $ENV{PATH} ) {
        my $fpath = File::Spec->catfile( $_, $name );
        return $fpath if -r $fpath && -x $fpath;
    }
    return;
}

# imagemagick.org
# = ok, it's here just to  provide some comparison to "nconvert"
#   (or any other future "spawns" )
my $convert = which('convert');
if ($convert) {
    $methods->{convert} = sub {
        system $convert, -strip,
            -format  => 'jpeg',
            -filter  => 'Lanczos',
            -quality => $quality,
            -density => $dpi,
            -resize  => $perc . 'x' . $perc,
            $input, 'out.convert.jpg';
    };
}

eval { require Image::Epeg };
if ( !$@ ) {
    $methods->{epeg} = sub {
        my $epg = Image::Epeg->new($input);
        $epg->resize( $epg->get_width * $ratio, $epg->get_height * $ratio );
        $epg->set_quality($quality);
        $epg->write_file('out.epeg.jpg');
    };
}

my $epeg = which('epeg');
if ($epeg) {
    $methods->{epeg_qx} = sub {
        system $epeg,
            -w => $perc,
            -h => $perc,
            $input, 'out.epeg_qx.jpg';
    };
}

eval { require GD };
if ( !$@ ) {
    $methods->{gd} = sub {
        my $out = 'out.gd.jpg';
        my $src = GD::Image->new($input) || die $!;
        my $dst = GD::Image->newTrueColor( $src->width * $ratio,
            $src->height * $ratio );
        $dst->copyResampled( $src, 0, 0, 0, 0, $dst->width, $dst->height,
            $src->width, $src->height );
        open my $ofh, q{>}, $out or die "Cannot write to $out: $!";
        binmode $ofh;
        print {$ofh} $dst->jpeg($quality) or die "Cannot print to $out: $!";
        close $ofh or die "Cannot close $out: $!";
    };
}

eval { require Gtk2 };
if ( !$@ ) {
    $methods->{gtk2} = sub {
        my $src    = Gtk2::Gdk::Pixbuf->new_from_file($input);
        my $scaled = $src->scale_simple( $src->get_width * $ratio,
            $src->get_height * $ratio, 'bilinear' );
        $scaled->save( 'out.gtk2.jpg', 'jpeg', quality => $quality );
    };
}

eval { require Imager };
if ( !$@ ) {
    $methods->{imager} = sub {
        my $src = Imager->new;
        $src->read( file => $input ) or die $src->errstr();
        my $dst = $src->scale(
            scalefactor => $ratio,
            qtype       => 'mixing',
        );
        $dst->write(
            file        => 'out.imager.jpg',
            type        => 'jpeg',
            jpegquality => $quality,
        );
    };
}

eval { require Image::Imlib2 };
if ( !$@ ) {
    $methods->{imlib2} = sub {
        my $src = Image::Imlib2->load($input);
        my $dst = $src->create_scaled_image( $src->width * $ratio,
            $src->height * $ratio );
        $dst->image_set_format('jpeg');
        $dst->set_quality($quality);
        $dst->save('out.imlib2.jpg');
    };
}

eval { require Image::Magick };
if ( !$@ ) {
    my $mgk = sub {
        my ( $image, $method, @args ) = @_;
        my $err = $image->$method(@args);
        return 1 if !$err;
        if ( $err =~ /(\d+)/xm && $1 < 400 ) {
            warn "WARN [$method]: $err\n";
            return 1;
        }
        warn "ERROR [$method]: $err\n";
        return;
    };
    $methods->{magick} = sub {
        my $image = Image::Magick->new;
        $mgk->( $image, 'Read', $input ) or return;
        my ( $iw, $ih ) = $image->Get( 'width', 'height' );
        $mgk->( $image, 'Strip' ) or return;
        $mgk->(
            $image, 'Set',
            magick  => 'jpeg',
            quality => $quality,
            type    => 'Optimize',
            depth   => 8,
            density => $dpi,
        ) or return;
        $mgk->(
            $image, 'Resize',
            width  => $iw * $ratio,
            height => $ih * $ratio,
            filter => 'Lanczos',
        ) or return;
        $mgk->( $image, 'Write', 'out.magick.jpg' ) or return;
    };
}

# freeware from xnview.com
my $nconvert = which('nconvert');
if ($nconvert) {
    $methods->{nconvert} = sub {
        system $nconvert, -quiet, -rmeta, -rexifthumb,
            -out    => 'jpeg',
            -c      => 5,
            -rtype  => 'lanczos',
            -q      => $quality,
            -dpi    => $dpi,
            -resize => $perc, $perc,
            -o      => 'out.nconvert.jpg',
            $input;
    };
}

eval {
    # die q{nay, Tk has no idea about "high quality image processing"};
    require Tk;
    require Tk::JPEG;
};
if ( !$@ ) {
    my $subsample = int 0.5 + 1 / $ratio;
    $methods->{tk} = sub {
        my $mw  = Tk::MainWindow->new();
        my $src = $mw->Photo( -file => $input );
        my $dst = $mw->Photo( -format => 'jpeg' );

        # BUUULLLSHIT!
        $dst->copy( $src, -shrink, -subsample => $subsample );

        $dst->write( 'out.tk.jpg', -format => 'jpeg' );
        $mw->destroy;
    };
}

# really ugly Benchmark.pm hack :(
# build a "cumulated time" summing "this process" and "child processes" times
#my $res = timethese(1, {test => $methods->{tk} } );
my $res = timethese( shift || 1, $methods );
for my $bm ( values %{$res} ) {
    $bm->[1] += $bm->[3];
    $bm->[2] += $bm->[4];
    $bm->[3] = $bm->[4] = 0;
}
cmpthese($res);