bench/quantone.perl

   1 #!perl -w
   2 use Imager;
   3 use Benchmark;
   4
   5 # actual benchmarking code for quantbench.pl - not intended to be used
   6 # directly
   7
   8 my %imgs;
   9
  10 my $out = shift;
  11
  12 # rgbtile and hsvgrad are both difficult images - they both have
  13 # more than 256 colours
  14 my $img = Imager->new;
  15 $img->open(file=>'bench/rgbtile.png')
  16   or die "Cannot load bench/rgbtile.png:",$img->errstr;
  17 $imgs{rgbtile} = $img;
  18
  19 $img = Imager->new;
  20 $img->open(file=>'bench/hsvgrad.png')
  21   or die "Cannot load bench/hsvgrad.png:", $img->errstr;
  22 $imgs{hsvgrad} = $img;
  23
  24 $img = Imager->new;
  25 $img->open(file=>'bench/kscdisplay.png')
  26   or die "Cannot load bench/kscdisplay.png:", $img->errstr;
  27 $imgs{kscdisplay} = $img;
  28
  29 # I need some other images
  30 for my $key (keys %imgs) {
  31   for my $tran (qw(closest errdiff)) {
  32     my $img = $imgs{$key};
  33     print "** $key $tran\n";
  34     timethese(10,
  35               {
  36                addi=>sub {
  37                  $img->write(file=>out($out, $key, $tran, 'addi'), type=>'gif',
  38                              gifquant=>'gen', make_colors=>'addi',
  39                             translate=>$tran)
  40                    or die "addi",$img->errstr;
  41                },
  42                webmap=>sub {
  43                  $img->write(file=>out($out, $key, $tran, 'webmap'),
  44                              type=>'gif',
  45                              gifquant=>'gen', make_colors=>'webmap',
  46                             translate=>$tran)
  47                    or die "webmap",$img->errstr;
  48                },
  49                mono=>sub {
  50                  $img->write(file=>out($out, $key, $tran, 'mono'), type=>'gif',
  51                              gifquant=>'gen', make_colors=>'none',
  52                              colors=>[Imager::Color->new(0,0,0),
  53                                       Imager::Color->new(255,255,255) ],
  54                             translate=>$tran)
  55                    or die "mono",$img->errstr;
  56                },
  57               });
  58   }
  59 }
  60
  61 sub out {
  62   my ($out, $in, $tran, $pal) = @_;
  63   $out or return '/dev/null';
  64   return "bench/${out}_${in}_${tran}_$pal.gif";
  65 }
  66
  67 __END__
  68
  69 =head1 NAME
  70
  71 quantone.perl - benchmarks image quantization with various options
  72
  73 =head1 SYNOPSIS
  74
  75   # just benchmark
  76   perl bench/quantone.perl
  77   # produce output images too
  78   perl bench/quantone.perl prefix
  79
  80 =head1 DESCRIPTION
  81
  82 Benchmarks image quantization on some test images, and with various
  83 options.
  84
  85 The current images are 2 synthesized images (rgbtile.png and
  86 hsvgrad.png), and a cropped photo (kscdisplay.png).
  87
  88 This program is designed to be run by L<quantbench.perl>.
  89
  90 =cut