add new comparison method rgb_difference that resembles arithmetical difference per...
[imager.git] / 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