Imager.pm

   1 package Imager;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS $warn_obsolete);
   5 use IO::File;
   6
   7 use Imager::Color;
   8 use Imager::Font;
   9
  10 @EXPORT_OK = qw(
  11                 init
  12                 init_log
  13                 DSO_open
  14                 DSO_close
  15                 DSO_funclist
  16                 DSO_call
  17
  18                 load_plugin
  19                 unload_plugin
  20
  21                 i_list_formats
  22                 i_has_format
  23
  24                 i_color_new
  25                 i_color_set
  26                 i_color_info
  27
  28                 i_img_empty
  29                 i_img_empty_ch
  30                 i_img_exorcise
  31                 i_img_destroy
  32
  33                 i_img_info
  34
  35                 i_img_setmask
  36                 i_img_getmask
  37
  38                 i_line
  39                 i_line_aa
  40                 i_box
  41                 i_box_filled
  42                 i_arc
  43                 i_circle_aa
  44
  45                 i_bezier_multi
  46                 i_poly_aa
  47                 i_poly_aa_cfill
  48
  49                 i_copyto
  50                 i_rubthru
  51                 i_scaleaxis
  52                 i_scale_nn
  53                 i_haar
  54                 i_count_colors
  55
  56                 i_gaussian
  57                 i_conv
  58
  59                 i_convert
  60                 i_map
  61
  62                 i_img_diff
  63
  64                 i_init_fonts
  65                 i_t1_new
  66                 i_t1_destroy
  67                 i_t1_set_aa
  68                 i_t1_cp
  69                 i_t1_text
  70                 i_t1_bbox
  71
  72                 i_tt_set_aa
  73                 i_tt_cp
  74                 i_tt_text
  75                 i_tt_bbox
  76
  77                 i_readjpeg_wiol
  78                 i_writejpeg_wiol
  79
  80                 i_readtiff_wiol
  81                 i_writetiff_wiol
  82                 i_writetiff_wiol_faxable
  83
  84                 i_readpng_wiol
  85                 i_writepng_wiol
  86
  87                 i_readgif
  88                 i_readgif_wiol
  89                 i_readgif_callback
  90                 i_writegif
  91                 i_writegifmc
  92                 i_writegif_gen
  93                 i_writegif_callback
  94
  95                 i_readpnm_wiol
  96                 i_writeppm_wiol
  97
  98                 i_readraw_wiol
  99                 i_writeraw_wiol
 100
 101                 i_contrast
 102                 i_hardinvert
 103                 i_noise
 104                 i_bumpmap
 105                 i_postlevels
 106                 i_mosaic
 107                 i_watermark
 108
 109                 malloc_state
 110
 111                 list_formats
 112
 113                 i_gifquant
 114
 115                 newfont
 116                 newcolor
 117                 newcolour
 118                 NC
 119                 NF
 120 );
 121
 122 @EXPORT=qw(
 123            init_log
 124            i_list_formats
 125            i_has_format
 126            malloc_state
 127            i_color_new
 128
 129            i_img_empty
 130            i_img_empty_ch
 131           );
 132
 133 %EXPORT_TAGS=
 134   (handy => [qw(
 135                 newfont
 136                 newcolor
 137                 NF
 138                 NC
 139                )],
 140    all => [@EXPORT_OK],
 141    default => [qw(
 142                   load_plugin
 143                   unload_plugin
 144                  )]);
 145
 146 BEGIN {
 147   require Exporter;
 148   @ISA = qw(Exporter);
 149   $VERSION = '0.47';
 150   eval {
 151     require XSLoader;
 152     XSLoader::load(Imager => $VERSION);
 153     1;
 154   } or do {
 155     require DynaLoader;
 156     push @ISA, 'DynaLoader';
 157     bootstrap Imager $VERSION;
 158   }
 159 }
 160
 161 BEGIN {
 162   i_init_fonts(); # Initialize font engines
 163   Imager::Font::__init();
 164   for(i_list_formats()) { $formats{$_}++; }
 165
 166   if ($formats{'t1'}) {
 167     i_t1_set_aa(1);
 168   }
 169
 170   if (!$formats{'t1'} and !$formats{'tt'}
 171       && !$formats{'ft2'} && !$formats{'w32'}) {
 172     $fontstate='no font support';
 173   }
 174
 175   %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
 176
 177   $DEBUG=0;
 178
 179   # the members of the subhashes under %filters are:
 180   #  callseq - a list of the parameters to the underlying filter in the
 181   #            order they are passed
 182   #  callsub - a code ref that takes a named parameter list and calls the
 183   #            underlying filter
 184   #  defaults - a hash of default values
 185   #  names - defines names for value of given parameters so if the names
 186   #          field is foo=> { bar=>1 }, and the user supplies "bar" as the
 187   #          foo parameter, the filter will receive 1 for the foo
 188   #          parameter
 189   $filters{contrast}={
 190                       callseq => ['image','intensity'],
 191                       callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); }
 192                      };
 193
 194   $filters{noise} ={
 195                     callseq => ['image', 'amount', 'subtype'],
 196                     defaults => { amount=>3,subtype=>0 },
 197                     callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
 198                    };
 199
 200   $filters{hardinvert} ={
 201                          callseq => ['image'],
 202                          defaults => { },
 203                          callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
 204                         };
 205
 206   $filters{autolevels} ={
 207                          callseq => ['image','lsat','usat','skew'],
 208                          defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
 209                          callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
 210                         };
 211
 212   $filters{turbnoise} ={
 213                         callseq => ['image'],
 214                         defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
 215                         callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
 216                        };
 217
 218   $filters{radnoise} ={
 219                        callseq => ['image'],
 220                        defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
 221                        callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
 222                       };
 223
 224   $filters{conv} ={
 225                        callseq => ['image', 'coef'],
 226                        defaults => { },
 227                        callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
 228                       };
 229
 230   $filters{gradgen} =
 231     {
 232      callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 233      defaults => { dist => 0 },
 234      callsub =>
 235      sub {
 236        my %hsh=@_;
 237        my @colors = @{$hsh{colors}};
 238        $_ = _color($_)
 239          for @colors;
 240        i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, \@colors, $hsh{dist});
 241      }
 242     };
 243
 244   $filters{nearest_color} ={
 245                             callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 246                             defaults => { },
 247                             callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 248                            };
 249   $filters{gaussian} = {
 250                         callseq => [ 'image', 'stddev' ],
 251                         defaults => { },
 252                         callsub => sub { my %hsh = @_; i_gaussian($hsh{image}, $hsh{stddev}); },
 253                        };
 254   $filters{mosaic} =
 255     {
 256      callseq => [ qw(image size) ],
 257      defaults => { size => 20 },
 258      callsub => sub { my %hsh = @_; i_mosaic($hsh{image}, $hsh{size}) },
 259     };
 260   $filters{bumpmap} =
 261     {
 262      callseq => [ qw(image bump elevation lightx lighty st) ],
 263      defaults => { elevation=>0, st=> 2 },
 264      callsub => sub {
 265        my %hsh = @_;
 266        i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation},
 267                  $hsh{lightx}, $hsh{lighty}, $hsh{st});
 268      },
 269     };
 270   $filters{bumpmap_complex} =
 271     {
 272      callseq => [ qw(image bump channel tx ty Lx Ly Lz cd cs n Ia Il Is) ],
 273      defaults => {
 274                   channel => 0,
 275                   tx => 0,
 276                   ty => 0,
 277                   Lx => 0.2,
 278                   Ly => 0.4,
 279                   Lz => -1.0,
 280                   cd => 1.0,
 281                   cs => 40,
 282                   n => 1.3,
 283                   Ia => Imager::Color->new(rgb=>[0,0,0]),
 284                   Il => Imager::Color->new(rgb=>[255,255,255]),
 285                   Is => Imager::Color->new(rgb=>[255,255,255]),
 286                  },
 287      callsub => sub {
 288        my %hsh = @_;
 289        i_bumpmap_complex($hsh{image}, $hsh{bump}{IMG}, $hsh{channel},
 290                  $hsh{tx}, $hsh{ty}, $hsh{Lx}, $hsh{Ly}, $hsh{Lz},
 291                  $hsh{cd}, $hsh{cs}, $hsh{n}, $hsh{Ia}, $hsh{Il},
 292                  $hsh{Is});
 293      },
 294     };
 295   $filters{postlevels} =
 296     {
 297      callseq  => [ qw(image levels) ],
 298      defaults => { levels => 10 },
 299      callsub  => sub { my %hsh = @_; i_postlevels($hsh{image}, $hsh{levels}); },
 300     };
 301   $filters{watermark} =
 302     {
 303      callseq  => [ qw(image wmark tx ty pixdiff) ],
 304      defaults => { pixdiff=>10, tx=>0, ty=>0 },
 305      callsub  =>
 306      sub {
 307        my %hsh = @_;
 308        i_watermark($hsh{image}, $hsh{wmark}{IMG}, $hsh{tx}, $hsh{ty},
 309                    $hsh{pixdiff});
 310      },
 311     };
 312   $filters{fountain} =
 313     {
 314      callseq  => [ qw(image xa ya xb yb ftype repeat combine super_sample ssample_param segments) ],
 315      names    => {
 316                   ftype => { linear         => 0,
 317                              bilinear       => 1,
 318                              radial         => 2,
 319                              radial_square  => 3,
 320                              revolution     => 4,
 321                              conical        => 5 },
 322                   repeat => { none      => 0,
 323                               sawtooth  => 1,
 324                               triangle  => 2,
 325                               saw_both  => 3,
 326                               tri_both  => 4,
 327                             },
 328                   super_sample => {
 329                                    none    => 0,
 330                                    grid    => 1,
 331                                    random  => 2,
 332                                    circle  => 3,
 333                                   },
 334                   combine => {
 335                               none      => 0,
 336                               normal    => 1,
 337                               multiply  => 2, mult => 2,
 338                               dissolve  => 3,
 339                               add       => 4,
 340                               subtract  => 5, 'sub' => 5,
 341                               diff      => 6,
 342                               lighten   => 7,
 343                               darken    => 8,
 344                               hue       => 9,
 345                               sat       => 10,
 346                               value     => 11,
 347                               color     => 12,
 348                              },
 349                  },
 350      defaults => { ftype => 0, repeat => 0, combine => 0,
 351                    super_sample => 0, ssample_param => 4,
 352                    segments=>[
 353                               [ 0, 0.5, 1,
 354                                 Imager::Color->new(0,0,0),
 355                                 Imager::Color->new(255, 255, 255),
 356                                 0, 0,
 357                               ],
 358                              ],
 359                  },
 360      callsub  =>
 361      sub {
 362        my %hsh = @_;
 363
 364        # make sure the segments are specified with colors
 365        my @segments;
 366        for my $segment (@{$hsh{segments}}) {
 367          my @new_segment = @$segment;
 368
 369          $_ = _color($_) or die $Imager::ERRSTR."\n" for @new_segment[3,4];
 370          push @segments, \@new_segment;
 371        }
 372
 373        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
 374                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
 375                   $hsh{ssample_param}, \@segments);
 376      },
 377     };
 378   $filters{unsharpmask} =
 379     {
 380      callseq => [ qw(image stddev scale) ],
 381      defaults => { stddev=>2.0, scale=>1.0 },
 382      callsub =>
 383      sub {
 384        my %hsh = @_;
 385        i_unsharp_mask($hsh{image}, $hsh{stddev}, $hsh{scale});
 386      },
 387     };
 388
 389   $FORMATGUESS=\&def_guess_type;
 390
 391   $warn_obsolete = 1;
 392 }
 393
 394 #
 395 # Non methods
 396 #
 397
 398 # initlize Imager
 399 # NOTE: this might be moved to an import override later on
 400
 401 #sub import {
 402 #  my $pack = shift;
 403 #  (look through @_ for special tags, process, and remove them);
 404 #  use Data::Dumper;
 405 #  print Dumper($pack);
 406 #  print Dumper(@_);
 407 #}
 408
 409 sub init_log {
 410         m_init_log($_[0],$_[1]);
 411         log_entry("Imager $VERSION starting\n", 1);
 412 }
 413
 414
 415 sub init {
 416   my %parms=(loglevel=>1,@_);
 417   if ($parms{'log'}) {
 418     init_log($parms{'log'},$parms{'loglevel'});
 419   }
 420
 421   if (exists $parms{'warn_obsolete'}) {
 422     $warn_obsolete = $parms{'warn_obsolete'};
 423   }
 424
 425 #    if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
 426 #    if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
 427 #       i_init_fonts();
 428 #       $fontstate='ok';
 429 #    }
 430   if (exists $parms{'t1log'}) {
 431     i_init_fonts($parms{'t1log'});
 432   }
 433 }
 434
 435 END {
 436   if ($DEBUG) {
 437     print "shutdown code\n";
 438     #   for(keys %instances) { $instances{$_}->DESTROY(); }
 439     malloc_state(); # how do decide if this should be used? -- store something from the import
 440     print "Imager exiting\n";
 441   }
 442 }
 443
 444 # Load a filter plugin
 445
 446 sub load_plugin {
 447   my ($filename)=@_;
 448   my $i;
 449   my ($DSO_handle,$str)=DSO_open($filename);
 450   if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
 451   my %funcs=DSO_funclist($DSO_handle);
 452   if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf("  %2d: %s\n",$i++,$_); } }
 453   $i=0;
 454   for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
 455
 456   $DSOs{$filename}=[$DSO_handle,\%funcs];
 457
 458   for(keys %funcs) {
 459     my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
 460     $DEBUG && print "eval string:\n",$evstr,"\n";
 461     eval $evstr;
 462     print $@ if $@;
 463   }
 464   return 1;
 465 }
 466
 467 # Unload a plugin
 468
 469 sub unload_plugin {
 470   my ($filename)=@_;
 471
 472   if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
 473   my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
 474   for(keys %{$funcref}) {
 475     delete $filters{$_};
 476     $DEBUG && print "unloading: $_\n";
 477   }
 478   my $rc=DSO_close($DSO_handle);
 479   if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
 480   return 1;
 481 }
 482
 483 # take the results of i_error() and make a message out of it
 484 sub _error_as_msg {
 485   return join(": ", map $_->[0], i_errors());
 486 }
 487
 488 # this function tries to DWIM for color parameters
 489 #  color objects are used as is
 490 #  simple scalars are simply treated as single parameters to Imager::Color->new
 491 #  hashrefs are treated as named argument lists to Imager::Color->new
 492 #  arrayrefs are treated as list arguments to Imager::Color->new iff any
 493 #    parameter is > 1
 494 #  other arrayrefs are treated as list arguments to Imager::Color::Float
 495
 496 sub _color {
 497   my $arg = shift;
 498   # perl 5.6.0 seems to do weird things to $arg if we don't make an
 499   # explicitly stringified copy
 500   # I vaguely remember a bug on this on p5p, but couldn't find it
 501   # through bugs.perl.org (I had trouble getting it to find any bugs)
 502   my $copy = $arg . "";
 503   my $result;
 504
 505   if (ref $arg) {
 506     if (UNIVERSAL::isa($arg, "Imager::Color")
 507         || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
 508       $result = $arg;
 509     }
 510     else {
 511       if ($copy =~ /^HASH\(/) {
 512         $result = Imager::Color->new(%$arg);
 513       }
 514       elsif ($copy =~ /^ARRAY\(/) {
 515         if (grep $_ > 1, @$arg) {
 516           $result = Imager::Color->new(@$arg);
 517         }
 518         else {
 519           $result = Imager::Color::Float->new(@$arg);
 520         }
 521       }
 522       else {
 523         $Imager::ERRSTR = "Not a color";
 524       }
 525     }
 526   }
 527   else {
 528     # assume Imager::Color::new knows how to handle it
 529     $result = Imager::Color->new($arg);
 530   }
 531
 532   return $result;
 533 }
 534
 535
 536 #
 537 # Methods to be called on objects.
 538 #
 539
 540 # Create a new Imager object takes very few parameters.
 541 # usually you call this method and then call open from
 542 # the resulting object
 543
 544 sub new {
 545   my $class = shift;
 546   my $self ={};
 547   my %hsh=@_;
 548   bless $self,$class;
 549   $self->{IMG}=undef;    # Just to indicate what exists
 550   $self->{ERRSTR}=undef; #
 551   $self->{DEBUG}=$DEBUG;
 552   $self->{DEBUG} && print "Initialized Imager\n";
 553   if (defined $hsh{xsize} && defined $hsh{ysize}) {
 554     unless ($self->img_set(%hsh)) {
 555       $Imager::ERRSTR = $self->{ERRSTR};
 556       return;
 557     }
 558   }
 559   return $self;
 560 }
 561
 562 # Copy an entire image with no changes
 563 # - if an image has magic the copy of it will not be magical
 564
 565 sub copy {
 566   my $self = shift;
 567   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 568
 569   unless (defined wantarray) {
 570     my @caller = caller;
 571     warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
 572     return;
 573   }
 574
 575   my $newcopy=Imager->new();
 576   $newcopy->{IMG} = i_copy($self->{IMG});
 577   return $newcopy;
 578 }
 579
 580 # Paste a region
 581
 582 sub paste {
 583   my $self = shift;
 584
 585   unless ($self->{IMG}) {
 586     $self->_set_error('empty input image');
 587     return;
 588   }
 589   my %input=(left=>0, top=>0, src_minx => 0, src_miny => 0, @_);
 590   my $src = $input{img} || $input{src};
 591   unless($src) {
 592     $self->_set_error("no source image");
 593     return;
 594   }
 595   $input{left}=0 if $input{left} <= 0;
 596   $input{top}=0 if $input{top} <= 0;
 597
 598   my($r,$b)=i_img_info($src->{IMG});
 599   my ($src_left, $src_top) = @input{qw/src_minx src_miny/};
 600   my ($src_right, $src_bottom);
 601   if ($input{src_coords}) {
 602     ($src_left, $src_top, $src_right, $src_bottom) = @{$input{src_coords}}
 603   }
 604   else {
 605     if (defined $input{src_maxx}) {
 606       $src_right = $input{src_maxx};
 607     }
 608     elsif (defined $input{width}) {
 609       if ($input{width} <= 0) {
 610         $self->_set_error("paste: width must me positive");
 611         return;
 612       }
 613       $src_right = $src_left + $input{width};
 614     }
 615     else {
 616       $src_right = $r;
 617     }
 618     if (defined $input{src_maxx}) {
 619       $src_bottom = $input{src_maxy};
 620     }
 621     elsif (defined $input{height}) {
 622       if ($input{height} < 0) {
 623         $self->_set_error("paste: height must be positive");
 624         return;
 625       }
 626       $src_bottom = $src_top + $input{height};
 627     }
 628     else {
 629       $src_bottom = $b;
 630     }
 631   }
 632
 633   $src_right > $r and $src_right = $r;
 634   $src_bottom > $r and $src_bottom = $b;
 635
 636   if ($src_right <= $src_left
 637       || $src_bottom < $src_top) {
 638     $self->_set_error("nothing to paste");
 639     return;
 640   }
 641
 642   i_copyto($self->{IMG}, $src->{IMG},
 643            $src_left, $src_top, $src_right, $src_bottom,
 644            $input{left}, $input{top});
 645
 646   return $self;  # What should go here??
 647 }
 648
 649 # Crop an image - i.e. return a new image that is smaller
 650
 651 sub crop {
 652   my $self=shift;
 653   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 654
 655   unless (defined wantarray) {
 656     my @caller = caller;
 657     warn "crop() called in void context - crop() returns the cropped image at $caller[1] line $caller[2]\n";
 658     return;
 659   }
 660
 661   my %hsh=@_;
 662
 663   my ($w, $h, $l, $r, $b, $t) =
 664     @hsh{qw(width height left right bottom top)};
 665
 666   # work through the various possibilities
 667   if (defined $l) {
 668     if (defined $w) {
 669       $r = $l + $w;
 670     }
 671     elsif (!defined $r) {
 672       $r = $self->getwidth;
 673     }
 674   }
 675   elsif (defined $r) {
 676     if (defined $w) {
 677       $l = $r - $w;
 678     }
 679     else {
 680       $l = 0;
 681     }
 682   }
 683   elsif (defined $w) {
 684     $l = int(0.5+($self->getwidth()-$w)/2);
 685     $r = $l + $w;
 686   }
 687   else {
 688     $l = 0;
 689     $r = $self->getwidth;
 690   }
 691   if (defined $t) {
 692     if (defined $h) {
 693       $b = $t + $h;
 694     }
 695     elsif (!defined $b) {
 696       $b = $self->getheight;
 697     }
 698   }
 699   elsif (defined $b) {
 700     if (defined $h) {
 701       $t = $b - $h;
 702     }
 703     else {
 704       $t = 0;
 705     }
 706   }
 707   elsif (defined $h) {
 708     $t=int(0.5+($self->getheight()-$h)/2);
 709     $b=$t+$h;
 710   }
 711   else {
 712     $t = 0;
 713     $b = $self->getheight;
 714   }
 715
 716   ($l,$r)=($r,$l) if $l>$r;
 717   ($t,$b)=($b,$t) if $t>$b;
 718
 719   $l < 0 and $l = 0;
 720   $r > $self->getwidth and $r = $self->getwidth;
 721   $t < 0 and $t = 0;
 722   $b > $self->getheight and $b = $self->getheight;
 723
 724   if ($l == $r || $t == $b) {
 725     $self->_set_error("resulting image would have no content");
 726     return;
 727   }
 728
 729   my $dst = $self->_sametype(xsize=>$r-$l, ysize=>$b-$t);
 730
 731   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
 732   return $dst;
 733 }
 734
 735 sub _sametype {
 736   my ($self, %opts) = @_;
 737
 738   $self->{IMG} or return $self->_set_error("Not a valid image");
 739
 740   my $x = $opts{xsize} || $self->getwidth;
 741   my $y = $opts{ysize} || $self->getheight;
 742   my $channels = $opts{channels} || $self->getchannels;
 743
 744   my $out = Imager->new;
 745   if ($channels == $self->getchannels) {
 746     $out->{IMG} = i_sametype($self->{IMG}, $x, $y);
 747   }
 748   else {
 749     $out->{IMG} = i_sametype_chans($self->{IMG}, $x, $y, $channels);
 750   }
 751   unless ($out->{IMG}) {
 752     $self->{ERRSTR} = $self->_error_as_msg;
 753     return;
 754   }
 755
 756   return $out;
 757 }
 758
 759 # Sets an image to a certain size and channel number
 760 # if there was previously data in the image it is discarded
 761
 762 sub img_set {
 763   my $self=shift;
 764
 765   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
 766
 767   if (defined($self->{IMG})) {
 768     # let IIM_DESTROY destroy it, it's possible this image is
 769     # referenced from a virtual image (like masked)
 770     #i_img_destroy($self->{IMG});
 771     undef($self->{IMG});
 772   }
 773
 774   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
 775     $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
 776                                  $hsh{maxcolors} || 256);
 777   }
 778   elsif ($hsh{bits} eq 'double') {
 779     $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
 780   }
 781   elsif ($hsh{bits} == 16) {
 782     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
 783   }
 784   else {
 785     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
 786                                      $hsh{'channels'});
 787   }
 788
 789   unless ($self->{IMG}) {
 790     $self->{ERRSTR} = Imager->_error_as_msg();
 791     return;
 792   }
 793
 794   $self;
 795 }
 796
 797 # created a masked version of the current image
 798 sub masked {
 799   my $self = shift;
 800
 801   $self or return undef;
 802   my %opts = (left    => 0,
 803               top     => 0,
 804               right   => $self->getwidth,
 805               bottom  => $self->getheight,
 806               @_);
 807   my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
 808
 809   my $result = Imager->new;
 810   $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left},
 811                                     $opts{top}, $opts{right} - $opts{left},
 812                                     $opts{bottom} - $opts{top});
 813   # keep references to the mask and base images so they don't
 814   # disappear on us
 815   $result->{DEPENDS} = [ $self->{IMG}, $mask ];
 816
 817   $result;
 818 }
 819
 820 # convert an RGB image into a paletted image
 821 sub to_paletted {
 822   my $self = shift;
 823   my $opts;
 824   if (@_ != 1 && !ref $_[0]) {
 825     $opts = { @_ };
 826   }
 827   else {
 828     $opts = shift;
 829   }
 830
 831   unless (defined wantarray) {
 832     my @caller = caller;
 833     warn "to_paletted() called in void context - to_paletted() returns the converted image at $caller[1] line $caller[2]\n";
 834     return;
 835   }
 836
 837   my $result = Imager->new;
 838   $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
 839
 840   #print "Type ", i_img_type($result->{IMG}), "\n";
 841
 842   if ($result->{IMG}) {
 843     return $result;
 844   }
 845   else {
 846     $self->{ERRSTR} = $self->_error_as_msg;
 847     return;
 848   }
 849 }
 850
 851 # convert a paletted (or any image) to an 8-bit/channel RGB images
 852 sub to_rgb8 {
 853   my $self = shift;
 854   my $result;
 855
 856   unless (defined wantarray) {
 857     my @caller = caller;
 858     warn "to_rgb8() called in void context - to_rgb8() returns the cropped image at $caller[1] line $caller[2]\n";
 859     return;
 860   }
 861
 862   if ($self->{IMG}) {
 863     $result = Imager->new;
 864     $result->{IMG} = i_img_to_rgb($self->{IMG})
 865       or undef $result;
 866   }
 867
 868   return $result;
 869 }
 870
 871 sub addcolors {
 872   my $self = shift;
 873   my %opts = (colors=>[], @_);
 874
 875   @{$opts{colors}} or return undef;
 876
 877   $self->{IMG} and i_addcolors($self->{IMG}, @{$opts{colors}});
 878 }
 879
 880 sub setcolors {
 881   my $self = shift;
 882   my %opts = (start=>0, colors=>[], @_);
 883   @{$opts{colors}} or return undef;
 884
 885   $self->{IMG} and i_setcolors($self->{IMG}, $opts{start}, @{$opts{colors}});
 886 }
 887
 888 sub getcolors {
 889   my $self = shift;
 890   my %opts = @_;
 891   if (!exists $opts{start} && !exists $opts{count}) {
 892     # get them all
 893     $opts{start} = 0;
 894     $opts{count} = $self->colorcount;
 895   }
 896   elsif (!exists $opts{count}) {
 897     $opts{count} = 1;
 898   }
 899   elsif (!exists $opts{start}) {
 900     $opts{start} = 0;
 901   }
 902
 903   $self->{IMG} and
 904     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
 905 }
 906
 907 sub colorcount {
 908   i_colorcount($_[0]{IMG});
 909 }
 910
 911 sub maxcolors {
 912   i_maxcolors($_[0]{IMG});
 913 }
 914
 915 sub findcolor {
 916   my $self = shift;
 917   my %opts = @_;
 918   $opts{color} or return undef;
 919
 920   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
 921 }
 922
 923 sub bits {
 924   my $self = shift;
 925   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
 926   if ($bits && $bits == length(pack("d", 1)) * 8) {
 927     $bits = 'double';
 928   }
 929   $bits;
 930 }
 931
 932 sub type {
 933   my $self = shift;
 934   if ($self->{IMG}) {
 935     return i_img_type($self->{IMG}) ? "paletted" : "direct";
 936   }
 937 }
 938
 939 sub virtual {
 940   my $self = shift;
 941   $self->{IMG} and i_img_virtual($self->{IMG});
 942 }
 943
 944 sub tags {
 945   my ($self, %opts) = @_;
 946
 947   $self->{IMG} or return;
 948
 949   if (defined $opts{name}) {
 950     my @result;
 951     my $start = 0;
 952     my $found;
 953     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
 954       push @result, (i_tags_get($self->{IMG}, $found))[1];
 955       $start = $found+1;
 956     }
 957     return wantarray ? @result : $result[0];
 958   }
 959   elsif (defined $opts{code}) {
 960     my @result;
 961     my $start = 0;
 962     my $found;
 963     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
 964       push @result, (i_tags_get($self->{IMG}, $found))[1];
 965       $start = $found+1;
 966     }
 967     return @result;
 968   }
 969   else {
 970     if (wantarray) {
 971       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
 972     }
 973     else {
 974       return i_tags_count($self->{IMG});
 975     }
 976   }
 977 }
 978
 979 sub addtag {
 980   my $self = shift;
 981   my %opts = @_;
 982
 983   return -1 unless $self->{IMG};
 984   if ($opts{name}) {
 985     if (defined $opts{value}) {
 986       if ($opts{value} =~ /^\d+$/) {
 987         # add as a number
 988         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
 989       }
 990       else {
 991         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
 992       }
 993     }
 994     elsif (defined $opts{data}) {
 995       # force addition as a string
 996       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
 997     }
 998     else {
 999       $self->{ERRSTR} = "No value supplied";
1000       return undef;
1001     }
1002   }
1003   elsif ($opts{code}) {
1004     if (defined $opts{value}) {
1005       if ($opts{value} =~ /^\d+$/) {
1006         # add as a number
1007         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
1008       }
1009       else {
1010         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
1011       }
1012     }
1013     elsif (defined $opts{data}) {
1014       # force addition as a string
1015       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
1016     }
1017     else {
1018       $self->{ERRSTR} = "No value supplied";
1019       return undef;
1020     }
1021   }
1022   else {
1023     return undef;
1024   }
1025 }
1026
1027 sub deltag {
1028   my $self = shift;
1029   my %opts = @_;
1030
1031   return 0 unless $self->{IMG};
1032
1033   if (defined $opts{'index'}) {
1034     return i_tags_delete($self->{IMG}, $opts{'index'});
1035   }
1036   elsif (defined $opts{name}) {
1037     return i_tags_delbyname($self->{IMG}, $opts{name});
1038   }
1039   elsif (defined $opts{code}) {
1040     return i_tags_delbycode($self->{IMG}, $opts{code});
1041   }
1042   else {
1043     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
1044     return 0;
1045   }
1046 }
1047
1048 sub settag {
1049   my ($self, %opts) = @_;
1050
1051   if ($opts{name}) {
1052     $self->deltag(name=>$opts{name});
1053     return $self->addtag(name=>$opts{name}, value=>$opts{value});
1054   }
1055   elsif (defined $opts{code}) {
1056     $self->deltag(code=>$opts{code});
1057     return $self->addtag(code=>$opts{code}, value=>$opts{value});
1058   }
1059   else {
1060     return undef;
1061   }
1062 }
1063
1064
1065 sub _get_reader_io {
1066   my ($self, $input) = @_;
1067
1068         if ($input->{io}) {
1069                 return $input->{io}, undef;
1070         }
1071   elsif ($input->{fd}) {
1072     return io_new_fd($input->{fd});
1073   }
1074   elsif ($input->{fh}) {
1075     my $fd = fileno($input->{fh});
1076     unless ($fd) {
1077       $self->_set_error("Handle in fh option not opened");
1078       return;
1079     }
1080     return io_new_fd($fd);
1081   }
1082   elsif ($input->{file}) {
1083     my $file = IO::File->new($input->{file}, "r");
1084     unless ($file) {
1085       $self->_set_error("Could not open $input->{file}: $!");
1086       return;
1087     }
1088     binmode $file;
1089     return (io_new_fd(fileno($file)), $file);
1090   }
1091   elsif ($input->{data}) {
1092     return io_new_buffer($input->{data});
1093   }
1094   elsif ($input->{callback} || $input->{readcb}) {
1095     if (!$input->{seekcb}) {
1096       $self->_set_error("Need a seekcb parameter");
1097     }
1098     if ($input->{maxbuffer}) {
1099       return io_new_cb($input->{writecb},
1100                        $input->{callback} || $input->{readcb},
1101                        $input->{seekcb}, $input->{closecb},
1102                        $input->{maxbuffer});
1103     }
1104     else {
1105       return io_new_cb($input->{writecb},
1106                        $input->{callback} || $input->{readcb},
1107                        $input->{seekcb}, $input->{closecb});
1108     }
1109   }
1110   else {
1111     $self->_set_error("file/fd/fh/data/callback parameter missing");
1112     return;
1113   }
1114 }
1115
1116 sub _get_writer_io {
1117   my ($self, $input, $type) = @_;
1118
1119   if ($input->{fd}) {
1120     return io_new_fd($input->{fd});
1121   }
1122   elsif ($input->{fh}) {
1123     my $fd = fileno($input->{fh});
1124     unless ($fd) {
1125       $self->_set_error("Handle in fh option not opened");
1126       return;
1127     }
1128     # flush it
1129     my $oldfh = select($input->{fh});
1130     # flush anything that's buffered, and make sure anything else is flushed
1131     $| = 1;
1132     select($oldfh);
1133     return io_new_fd($fd);
1134   }
1135   elsif ($input->{file}) {
1136     my $fh = new IO::File($input->{file},"w+");
1137     unless ($fh) {
1138       $self->_set_error("Could not open file $input->{file}: $!");
1139       return;
1140     }
1141     binmode($fh) or die;
1142     return (io_new_fd(fileno($fh)), $fh);
1143   }
1144   elsif ($input->{data}) {
1145     return io_new_bufchain();
1146   }
1147   elsif ($input->{callback} || $input->{writecb}) {
1148     if ($input->{maxbuffer}) {
1149       return io_new_cb($input->{callback} || $input->{writecb},
1150                        $input->{readcb},
1151                        $input->{seekcb}, $input->{closecb},
1152                        $input->{maxbuffer});
1153     }
1154     else {
1155       return io_new_cb($input->{callback} || $input->{writecb},
1156                        $input->{readcb},
1157                        $input->{seekcb}, $input->{closecb});
1158     }
1159   }
1160   else {
1161     $self->_set_error("file/fd/fh/data/callback parameter missing");
1162     return;
1163   }
1164 }
1165
1166 # Read an image from file
1167
1168 sub read {
1169   my $self = shift;
1170   my %input=@_;
1171
1172   if (defined($self->{IMG})) {
1173     # let IIM_DESTROY do the destruction, since the image may be
1174     # referenced from elsewhere
1175     #i_img_destroy($self->{IMG});
1176     undef($self->{IMG});
1177   }
1178
1179   my ($IO, $fh) = $self->_get_reader_io(\%input) or return;
1180
1181   unless ($input{'type'}) {
1182     $input{'type'} = i_test_format_probe($IO, -1);
1183   }
1184
1185   unless ($input{'type'}) {
1186           $self->_set_error('type parameter missing and not possible to guess from extension');
1187     return undef;
1188   }
1189
1190   unless ($formats{$input{'type'}}) {
1191     $self->_set_error("format '$input{'type'}' not supported");
1192     return;
1193   }
1194
1195   # Setup data source
1196   if ( $input{'type'} eq 'jpeg' ) {
1197     ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO );
1198     if ( !defined($self->{IMG}) ) {
1199       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1200     }
1201     $self->{DEBUG} && print "loading a jpeg file\n";
1202     return $self;
1203   }
1204
1205   if ( $input{'type'} eq 'tiff' ) {
1206     my $page = $input{'page'};
1207     defined $page or $page = 0;
1208     # Fixme, check if that length parameter is ever needed
1209     $self->{IMG}=i_readtiff_wiol( $IO, -1, $page );
1210     if ( !defined($self->{IMG}) ) {
1211       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1212     }
1213     $self->{DEBUG} && print "loading a tiff file\n";
1214     return $self;
1215   }
1216
1217   if ( $input{'type'} eq 'pnm' ) {
1218     $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1219     if ( !defined($self->{IMG}) ) {
1220       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg();
1221       return undef;
1222     }
1223     $self->{DEBUG} && print "loading a pnm file\n";
1224     return $self;
1225   }
1226
1227   if ( $input{'type'} eq 'png' ) {
1228     $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1229     if ( !defined($self->{IMG}) ) {
1230       $self->{ERRSTR} = $self->_error_as_msg();
1231       return undef;
1232     }
1233     $self->{DEBUG} && print "loading a png file\n";
1234   }
1235
1236   if ( $input{'type'} eq 'bmp' ) {
1237     $self->{IMG}=i_readbmp_wiol( $IO );
1238     if ( !defined($self->{IMG}) ) {
1239       $self->{ERRSTR}=$self->_error_as_msg();
1240       return undef;
1241     }
1242     $self->{DEBUG} && print "loading a bmp file\n";
1243   }
1244
1245   if ( $input{'type'} eq 'gif' ) {
1246     if ($input{colors} && !ref($input{colors})) {
1247       # must be a reference to a scalar that accepts the colour map
1248       $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1249       return undef;
1250     }
1251     if ($input{'gif_consolidate'}) {
1252       if ($input{colors}) {
1253         my $colors;
1254         ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
1255         if ($colors) {
1256           ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1257         }
1258       }
1259       else {
1260         $self->{IMG} =i_readgif_wiol( $IO );
1261       }
1262     }
1263     else {
1264       my $page = $input{'page'};
1265       defined $page or $page = 0;
1266       $self->{IMG} = i_readgif_single_wiol( $IO, $page );
1267       if ($input{colors}) {
1268         ${ $input{colors} } =
1269           [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ];
1270       }
1271     }
1272
1273     if ( !defined($self->{IMG}) ) {
1274       $self->{ERRSTR}=$self->_error_as_msg();
1275       return undef;
1276     }
1277     $self->{DEBUG} && print "loading a gif file\n";
1278   }
1279
1280   if ( $input{'type'} eq 'tga' ) {
1281     $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1282     if ( !defined($self->{IMG}) ) {
1283       $self->{ERRSTR}=$self->_error_as_msg();
1284       return undef;
1285     }
1286     $self->{DEBUG} && print "loading a tga file\n";
1287   }
1288
1289   if ( $input{'type'} eq 'rgb' ) {
1290     $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1291     if ( !defined($self->{IMG}) ) {
1292       $self->{ERRSTR}=$self->_error_as_msg();
1293       return undef;
1294     }
1295     $self->{DEBUG} && print "loading a tga file\n";
1296   }
1297
1298
1299   if ( $input{'type'} eq 'raw' ) {
1300     my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
1301
1302     if ( !($params{xsize} && $params{ysize}) ) {
1303       $self->{ERRSTR}='missing xsize or ysize parameter for raw';
1304       return undef;
1305     }
1306
1307     $self->{IMG} = i_readraw_wiol( $IO,
1308                                    $params{xsize},
1309                                    $params{ysize},
1310                                    $params{datachannels},
1311                                    $params{storechannels},
1312                                    $params{interleave});
1313     if ( !defined($self->{IMG}) ) {
1314       $self->{ERRSTR}=$self->_error_as_msg();
1315       return undef;
1316     }
1317     $self->{DEBUG} && print "loading a raw file\n";
1318   }
1319
1320   return $self;
1321 }
1322
1323 sub _fix_gif_positions {
1324   my ($opts, $opt, $msg, @imgs) = @_;
1325
1326   my $positions = $opts->{'gif_positions'};
1327   my $index = 0;
1328   for my $pos (@$positions) {
1329     my ($x, $y) = @$pos;
1330     my $img = $imgs[$index++];
1331     $img->settag(name=>'gif_left', value=>$x);
1332     $img->settag(name=>'gif_top', value=>$y) if defined $y;
1333   }
1334   $$msg .= "replaced with the gif_left and gif_top tags";
1335 }
1336
1337 my %obsolete_opts =
1338   (
1339    gif_each_palette=>'gif_local_map',
1340    interlace       => 'gif_interlace',
1341    gif_delays => 'gif_delay',
1342    gif_positions => \&_fix_gif_positions,
1343    gif_loop_count => 'gif_loop',
1344   );
1345
1346 sub _set_opts {
1347   my ($self, $opts, $prefix, @imgs) = @_;
1348
1349   for my $opt (keys %$opts) {
1350     my $tagname = $opt;
1351     if ($obsolete_opts{$opt}) {
1352       my $new = $obsolete_opts{$opt};
1353       my $msg = "Obsolete option $opt ";
1354       if (ref $new) {
1355         $new->($opts, $opt, \$msg, @imgs);
1356       }
1357       else {
1358         $msg .= "replaced with the $new tag ";
1359         $tagname = $new;
1360       }
1361       $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1];
1362       warn $msg if $warn_obsolete && $^W;
1363     }
1364     next unless $tagname =~ /^\Q$prefix/;
1365     my $value = $opts->{$opt};
1366     if (ref $value) {
1367       if (UNIVERSAL::isa($value, "Imager::Color")) {
1368         my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1369         for my $img (@imgs) {
1370           $img->settag(name=>$tagname, value=>$tag);
1371         }
1372       }
1373       elsif (ref($value) eq 'ARRAY') {
1374         for my $i (0..$#$value) {
1375           my $val = $value->[$i];
1376           if (ref $val) {
1377             if (UNIVERSAL::isa($val, "Imager::Color")) {
1378               my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1379               $i < @imgs and
1380                 $imgs[$i]->settag(name=>$tagname, value=>$tag);
1381             }
1382             else {
1383               $self->_set_error("Unknown reference type " . ref($value) .
1384                                 " supplied in array for $opt");
1385               return;
1386             }
1387           }
1388           else {
1389             $i < @imgs
1390               and $imgs[$i]->settag(name=>$tagname, value=>$val);
1391           }
1392         }
1393       }
1394       else {
1395         $self->_set_error("Unknown reference type " . ref($value) .
1396                           " supplied for $opt");
1397         return;
1398       }
1399     }
1400     else {
1401       # set it as a tag for every image
1402       for my $img (@imgs) {
1403         $img->settag(name=>$tagname, value=>$value);
1404       }
1405     }
1406   }
1407
1408   return 1;
1409 }
1410
1411 # Write an image to file
1412 sub write {
1413   my $self = shift;
1414   my %input=(jpegquality=>75,
1415              gifquant=>'mc',
1416              lmdither=>6.0,
1417              lmfixed=>[],
1418              idstring=>"",
1419              compress=>1,
1420              wierdpack=>0,
1421              fax_fine=>1, @_);
1422   my $rc;
1423
1424   $self->_set_opts(\%input, "i_", $self)
1425     or return undef;
1426
1427   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1428
1429   if (!$input{'type'} and $input{file}) {
1430     $input{'type'}=$FORMATGUESS->($input{file});
1431   }
1432   if (!$input{'type'}) {
1433     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1434     return undef;
1435   }
1436
1437   if (!$formats{$input{'type'}}) { $self->{ERRSTR}='format not supported'; return undef; }
1438
1439   my ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1440     or return undef;
1441
1442   if ($input{'type'} eq 'tiff') {
1443     $self->_set_opts(\%input, "tiff_", $self)
1444       or return undef;
1445     $self->_set_opts(\%input, "exif_", $self)
1446       or return undef;
1447
1448     if (defined $input{class} && $input{class} eq 'fax') {
1449       if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1450         $self->{ERRSTR} = $self->_error_as_msg();
1451         return undef;
1452       }
1453     } else {
1454       if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1455         $self->{ERRSTR} = $self->_error_as_msg();
1456         return undef;
1457       }
1458     }
1459   } elsif ( $input{'type'} eq 'pnm' ) {
1460     $self->_set_opts(\%input, "pnm_", $self)
1461       or return undef;
1462     if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1463       $self->{ERRSTR} = $self->_error_as_msg();
1464       return undef;
1465     }
1466     $self->{DEBUG} && print "writing a pnm file\n";
1467   } elsif ( $input{'type'} eq 'raw' ) {
1468     $self->_set_opts(\%input, "raw_", $self)
1469       or return undef;
1470     if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1471       $self->{ERRSTR} = $self->_error_as_msg();
1472       return undef;
1473     }
1474     $self->{DEBUG} && print "writing a raw file\n";
1475   } elsif ( $input{'type'} eq 'png' ) {
1476     $self->_set_opts(\%input, "png_", $self)
1477       or return undef;
1478     if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1479       $self->{ERRSTR}='unable to write png image';
1480       return undef;
1481     }
1482     $self->{DEBUG} && print "writing a png file\n";
1483   } elsif ( $input{'type'} eq 'jpeg' ) {
1484     $self->_set_opts(\%input, "jpeg_", $self)
1485       or return undef;
1486     $self->_set_opts(\%input, "exif_", $self)
1487       or return undef;
1488     if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1489       $self->{ERRSTR} = $self->_error_as_msg();
1490       return undef;
1491     }
1492     $self->{DEBUG} && print "writing a jpeg file\n";
1493   } elsif ( $input{'type'} eq 'bmp' ) {
1494     $self->_set_opts(\%input, "bmp_", $self)
1495       or return undef;
1496     if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1497       $self->{ERRSTR}='unable to write bmp image';
1498       return undef;
1499     }
1500     $self->{DEBUG} && print "writing a bmp file\n";
1501   } elsif ( $input{'type'} eq 'tga' ) {
1502     $self->_set_opts(\%input, "tga_", $self)
1503       or return undef;
1504
1505     if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1506       $self->{ERRSTR}=$self->_error_as_msg();
1507       return undef;
1508     }
1509     $self->{DEBUG} && print "writing a tga file\n";
1510   } elsif ( $input{'type'} eq 'gif' ) {
1511     $self->_set_opts(\%input, "gif_", $self)
1512       or return undef;
1513     # compatibility with the old interfaces
1514     if ($input{gifquant} eq 'lm') {
1515       $input{make_colors} = 'addi';
1516       $input{translate} = 'perturb';
1517       $input{perturb} = $input{lmdither};
1518     } elsif ($input{gifquant} eq 'gen') {
1519       # just pass options through
1520     } else {
1521       $input{make_colors} = 'webmap'; # ignored
1522       $input{translate} = 'giflib';
1523     }
1524     if (!i_writegif_wiol($IO, \%input, $self->{IMG})) {
1525       $self->{ERRSTR} = $self->_error_as_msg;
1526       return;
1527     }
1528   }
1529
1530   if (exists $input{'data'}) {
1531     my $data = io_slurp($IO);
1532     if (!$data) {
1533       $self->{ERRSTR}='Could not slurp from buffer';
1534       return undef;
1535     }
1536     ${$input{data}} = $data;
1537   }
1538   return $self;
1539 }
1540
1541 sub write_multi {
1542   my ($class, $opts, @images) = @_;
1543
1544   if (!$opts->{'type'} && $opts->{'file'}) {
1545     $opts->{'type'} = $FORMATGUESS->($opts->{'file'});
1546   }
1547   unless ($opts->{'type'}) {
1548     $class->_set_error('type parameter missing and not possible to guess from extension');
1549     return;
1550   }
1551   # translate to ImgRaw
1552   if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1553     $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
1554     return 0;
1555   }
1556   $class->_set_opts($opts, "i_", @images)
1557     or return;
1558   my @work = map $_->{IMG}, @images;
1559   my ($IO, $file) = $class->_get_writer_io($opts, $opts->{'type'})
1560     or return undef;
1561   if ($opts->{'type'} eq 'gif') {
1562     $class->_set_opts($opts, "gif_", @images)
1563       or return;
1564     my $gif_delays = $opts->{gif_delays};
1565     local $opts->{gif_delays} = $gif_delays;
1566     if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
1567       # assume the caller wants the same delay for each frame
1568       $opts->{gif_delays} = [ ($gif_delays) x @images ];
1569     }
1570     my $res = i_writegif_wiol($IO, $opts, @work);
1571     $res or $class->_set_error($class->_error_as_msg());
1572     return $res;
1573   }
1574   elsif ($opts->{'type'} eq 'tiff') {
1575     $class->_set_opts($opts, "tiff_", @images)
1576       or return;
1577     $class->_set_opts($opts, "exif_", @images)
1578       or return;
1579     my $res;
1580     $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
1581     if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
1582       $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
1583     }
1584     else {
1585       $res = i_writetiff_multi_wiol($IO, @work);
1586     }
1587     $res or $class->_set_error($class->_error_as_msg());
1588     return $res;
1589   }
1590   else {
1591     $ERRSTR = "Sorry, write_multi doesn't support $opts->{'type'} yet";
1592     return 0;
1593   }
1594 }
1595
1596 # read multiple images from a file
1597 sub read_multi {
1598   my ($class, %opts) = @_;
1599
1600   if ($opts{file} && !exists $opts{'type'}) {
1601     # guess the type
1602     my $type = $FORMATGUESS->($opts{file});
1603     $opts{'type'} = $type;
1604   }
1605   unless ($opts{'type'}) {
1606     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1607     return;
1608   }
1609
1610   my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
1611     or return;
1612   if ($opts{'type'} eq 'gif') {
1613     my @imgs;
1614     @imgs = i_readgif_multi_wiol($IO);
1615     if (@imgs) {
1616       return map {
1617         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1618       } @imgs;
1619     }
1620     else {
1621       $ERRSTR = _error_as_msg();
1622       return;
1623     }
1624   }
1625   elsif ($opts{'type'} eq 'tiff') {
1626     my @imgs = i_readtiff_multi_wiol($IO, -1);
1627     if (@imgs) {
1628       return map {
1629         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1630       } @imgs;
1631     }
1632     else {
1633       $ERRSTR = _error_as_msg();
1634       return;
1635     }
1636   }
1637
1638   $ERRSTR = "Cannot read multiple images from $opts{'type'} files";
1639   return;
1640 }
1641
1642 # Destroy an Imager object
1643
1644 sub DESTROY {
1645   my $self=shift;
1646   #    delete $instances{$self};
1647   if (defined($self->{IMG})) {
1648     # the following is now handled by the XS DESTROY method for
1649     # Imager::ImgRaw object
1650     # Re-enabling this will break virtual images
1651     # tested for in t/t020masked.t
1652     # i_img_destroy($self->{IMG});
1653     undef($self->{IMG});
1654   } else {
1655 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1656   }
1657 }
1658
1659 # Perform an inplace filter of an image
1660 # that is the image will be overwritten with the data
1661
1662 sub filter {
1663   my $self=shift;
1664   my %input=@_;
1665   my %hsh;
1666   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1667
1668   if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1669
1670   if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
1671     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1672   }
1673
1674   if ($filters{$input{'type'}}{names}) {
1675     my $names = $filters{$input{'type'}}{names};
1676     for my $name (keys %$names) {
1677       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1678         $input{$name} = $names->{$name}{$input{$name}};
1679       }
1680     }
1681   }
1682   if (defined($filters{$input{'type'}}{defaults})) {
1683     %hsh=( image => $self->{IMG},
1684            imager => $self,
1685            %{$filters{$input{'type'}}{defaults}},
1686            %input );
1687   } else {
1688     %hsh=( image => $self->{IMG},
1689            imager => $self,
1690            %input );
1691   }
1692
1693   my @cs=@{$filters{$input{'type'}}{callseq}};
1694
1695   for(@cs) {
1696     if (!defined($hsh{$_})) {
1697       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1698     }
1699   }
1700
1701   eval {
1702     local $SIG{__DIE__}; # we don't want this processed by confess, etc
1703     &{$filters{$input{'type'}}{callsub}}(%hsh);
1704   };
1705   if ($@) {
1706     chomp($self->{ERRSTR} = $@);
1707     return;
1708   }
1709
1710   my @b=keys %hsh;
1711
1712   $self->{DEBUG} && print "callseq is: @cs\n";
1713   $self->{DEBUG} && print "matching callseq is: @b\n";
1714
1715   return $self;
1716 }
1717
1718 sub register_filter {
1719   my $class = shift;
1720   my %hsh = ( defaults => {}, @_ );
1721
1722   defined $hsh{type}
1723     or die "register_filter() with no type\n";
1724   defined $hsh{callsub}
1725     or die "register_filter() with no callsub\n";
1726   defined $hsh{callseq}
1727     or die "register_filter() with no callseq\n";
1728
1729   exists $filters{$hsh{type}}
1730     and return;
1731
1732   $filters{$hsh{type}} = \%hsh;
1733
1734   return 1;
1735 }
1736
1737 # Scale an image to requested size and return the scaled version
1738
1739 sub scale {
1740   my $self=shift;
1741   my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
1742   my $img = Imager->new();
1743   my $tmp = Imager->new();
1744
1745   unless (defined wantarray) {
1746     my @caller = caller;
1747     warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
1748     return;
1749   }
1750
1751   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1752
1753   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
1754     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1755     if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1756     if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1757   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1758   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1759
1760   if ($opts{qtype} eq 'normal') {
1761     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1762     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1763     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1764     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1765     return $img;
1766   }
1767   if ($opts{'qtype'} eq 'preview') {
1768     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
1769     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1770     return $img;
1771   }
1772   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1773 }
1774
1775 # Scales only along the X axis
1776
1777 sub scaleX {
1778   my $self=shift;
1779   my %opts=(scalefactor=>0.5,@_);
1780
1781   unless (defined wantarray) {
1782     my @caller = caller;
1783     warn "scaleX() called in void context - scaleX() returns the scaled image at $caller[1] line $caller[2]\n";
1784     return;
1785   }
1786
1787   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1788
1789   my $img = Imager->new();
1790
1791   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1792
1793   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1794   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1795
1796   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1797   return $img;
1798 }
1799
1800 # Scales only along the Y axis
1801
1802 sub scaleY {
1803   my $self=shift;
1804   my %opts=(scalefactor=>0.5,@_);
1805
1806   unless (defined wantarray) {
1807     my @caller = caller;
1808     warn "scaleY() called in void context - scaleY() returns the scaled image at $caller[1] line $caller[2]\n";
1809     return;
1810   }
1811
1812   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1813
1814   my $img = Imager->new();
1815
1816   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1817
1818   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1819   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1820
1821   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1822   return $img;
1823 }
1824
1825
1826 # Transform returns a spatial transformation of the input image
1827 # this moves pixels to a new location in the returned image.
1828 # NOTE - should make a utility function to check transforms for
1829 # stack overruns
1830
1831 sub transform {
1832   my $self=shift;
1833   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1834   my %opts=@_;
1835   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1836
1837 #  print Dumper(\%opts);
1838 #  xopcopdes
1839
1840   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1841     if (!$I2P) {
1842       eval ("use Affix::Infix2Postfix;");
1843       print $@;
1844       if ( $@ ) {
1845         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
1846         return undef;
1847       }
1848       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1849                                              {op=>'-',trans=>'Sub'},
1850                                              {op=>'*',trans=>'Mult'},
1851                                              {op=>'/',trans=>'Div'},
1852                                              {op=>'-','type'=>'unary',trans=>'u-'},
1853                                              {op=>'**'},
1854                                              {op=>'func','type'=>'unary'}],
1855                                      'grouping'=>[qw( \( \) )],
1856                                      'func'=>[qw( sin cos )],
1857                                      'vars'=>[qw( x y )]
1858                                     );
1859     }
1860
1861     @xt=$I2P->translate($opts{'xexpr'});
1862     @yt=$I2P->translate($opts{'yexpr'});
1863
1864     $numre=$I2P->{'numre'};
1865     @pt=(0,0);
1866
1867     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1868     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1869     @{$opts{'parm'}}=@pt;
1870   }
1871
1872 #  print Dumper(\%opts);
1873
1874   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1875     $self->{ERRSTR}='transform: no xopcodes given.';
1876     return undef;
1877   }
1878
1879   @op=@{$opts{'xopcodes'}};
1880   for $iop (@op) {
1881     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1882       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1883       return undef;
1884     }
1885     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1886   }
1887
1888
1889 # yopcopdes
1890
1891   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1892     $self->{ERRSTR}='transform: no yopcodes given.';
1893     return undef;
1894   }
1895
1896   @op=@{$opts{'yopcodes'}};
1897   for $iop (@op) {
1898     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1899       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1900       return undef;
1901     }
1902     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1903   }
1904
1905 #parameters
1906
1907   if ( !exists $opts{'parm'}) {
1908     $self->{ERRSTR}='transform: no parameter arg given.';
1909     return undef;
1910   }
1911
1912 #  print Dumper(\@ropx);
1913 #  print Dumper(\@ropy);
1914 #  print Dumper(\@ropy);
1915
1916   my $img = Imager->new();
1917   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1918   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1919   return $img;
1920 }
1921
1922
1923 sub transform2 {
1924   my ($opts, @imgs) = @_;
1925
1926   require "Imager/Expr.pm";
1927
1928   $opts->{variables} = [ qw(x y) ];
1929   my ($width, $height) = @{$opts}{qw(width height)};
1930   if (@imgs) {
1931     $width ||= $imgs[0]->getwidth();
1932     $height ||= $imgs[0]->getheight();
1933     my $img_num = 1;
1934     for my $img (@imgs) {
1935       $opts->{constants}{"w$img_num"} = $img->getwidth();
1936       $opts->{constants}{"h$img_num"} = $img->getheight();
1937       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1938       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1939       ++$img_num;
1940     }
1941   }
1942   if ($width) {
1943     $opts->{constants}{w} = $width;
1944     $opts->{constants}{cx} = $width/2;
1945   }
1946   else {
1947     $Imager::ERRSTR = "No width supplied";
1948     return;
1949   }
1950   if ($height) {
1951     $opts->{constants}{h} = $height;
1952     $opts->{constants}{cy} = $height/2;
1953   }
1954   else {
1955     $Imager::ERRSTR = "No height supplied";
1956     return;
1957   }
1958   my $code = Imager::Expr->new($opts);
1959   if (!$code) {
1960     $Imager::ERRSTR = Imager::Expr::error();
1961     return;
1962   }
1963   my $channels = $opts->{channels} || 3;
1964   unless ($channels >= 1 && $channels <= 4) {
1965     return Imager->_set_error("channels must be an integer between 1 and 4");
1966   }
1967
1968   my $img = Imager->new();
1969   $img->{IMG} = i_transform2($opts->{width}, $opts->{height},
1970                              $channels, $code->code(),
1971                              $code->nregs(), $code->cregs(),
1972                              [ map { $_->{IMG} } @imgs ]);
1973   if (!defined $img->{IMG}) {
1974     $Imager::ERRSTR = Imager->_error_as_msg();
1975     return;
1976   }
1977
1978   return $img;
1979 }
1980
1981 sub rubthrough {
1982   my $self=shift;
1983   my %opts=(tx => 0,ty => 0, @_);
1984
1985   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1986   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1987
1988   %opts = (src_minx => 0,
1989            src_miny => 0,
1990            src_maxx => $opts{src}->getwidth(),
1991            src_maxy => $opts{src}->getheight(),
1992            %opts);
1993
1994   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
1995           $opts{src_minx}, $opts{src_miny}, $opts{src_maxx}, $opts{src_maxy})) {
1996     $self->{ERRSTR} = $self->_error_as_msg();
1997     return undef;
1998   }
1999   return $self;
2000 }
2001
2002
2003 sub flip {
2004   my $self  = shift;
2005   my %opts  = @_;
2006   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
2007   my $dir;
2008   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
2009   $dir = $xlate{$opts{'dir'}};
2010   return $self if i_flipxy($self->{IMG}, $dir);
2011   return ();
2012 }
2013
2014 sub rotate {
2015   my $self = shift;
2016   my %opts = @_;
2017
2018   unless (defined wantarray) {
2019     my @caller = caller;
2020     warn "rotate() called in void context - rotate() returns the rotated image at $caller[1] line $caller[2]\n";
2021     return;
2022   }
2023
2024   if (defined $opts{right}) {
2025     my $degrees = $opts{right};
2026     if ($degrees < 0) {
2027       $degrees += 360 * int(((-$degrees)+360)/360);
2028     }
2029     $degrees = $degrees % 360;
2030     if ($degrees == 0) {
2031       return $self->copy();
2032     }
2033     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
2034       my $result = Imager->new();
2035       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
2036         return $result;
2037       }
2038       else {
2039         $self->{ERRSTR} = $self->_error_as_msg();
2040         return undef;
2041       }
2042     }
2043     else {
2044       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
2045       return undef;
2046     }
2047   }
2048   elsif (defined $opts{radians} || defined $opts{degrees}) {
2049     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
2050
2051     my $result = Imager->new;
2052     if ($opts{back}) {
2053       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $opts{back});
2054     }
2055     else {
2056       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);
2057     }
2058     if ($result->{IMG}) {
2059       return $result;
2060     }
2061     else {
2062       $self->{ERRSTR} = $self->_error_as_msg();
2063       return undef;
2064     }
2065   }
2066   else {
2067     $self->{ERRSTR} = "Only the 'right', 'radians' and 'degrees' parameters are available";
2068     return undef;
2069   }
2070 }
2071
2072 sub matrix_transform {
2073   my $self = shift;
2074   my %opts = @_;
2075
2076   unless (defined wantarray) {
2077     my @caller = caller;
2078     warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
2079     return;
2080   }
2081
2082   if ($opts{matrix}) {
2083     my $xsize = $opts{xsize} || $self->getwidth;
2084     my $ysize = $opts{ysize} || $self->getheight;
2085
2086     my $result = Imager->new;
2087     if ($opts{back}) {
2088       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2089                                           $opts{matrix}, $opts{back})
2090         or return undef;
2091     }
2092     else {
2093       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2094                                           $opts{matrix})
2095         or return undef;
2096     }
2097
2098     return $result;
2099   }
2100   else {
2101     $self->{ERRSTR} = "matrix parameter required";
2102     return undef;
2103   }
2104 }
2105
2106 # blame Leolo :)
2107 *yatf = \&matrix_transform;
2108
2109 # These two are supported for legacy code only
2110
2111 sub i_color_new {
2112   return Imager::Color->new(@_);
2113 }
2114
2115 sub i_color_set {
2116   return Imager::Color::set(@_);
2117 }
2118
2119 # Draws a box between the specified corner points.
2120 sub box {
2121   my $self=shift;
2122   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2123   my $dflcl=i_color_new(255,255,255,255);
2124   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
2125
2126   if (exists $opts{'box'}) {
2127     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
2128     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
2129     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
2130     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
2131   }
2132
2133   if ($opts{filled}) {
2134     my $color = _color($opts{'color'});
2135     unless ($color) {
2136       $self->{ERRSTR} = $Imager::ERRSTR;
2137       return;
2138     }
2139     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2140                  $opts{ymax}, $color);
2141   }
2142   elsif ($opts{fill}) {
2143     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2144       # assume it's a hash ref
2145       require 'Imager/Fill.pm';
2146       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2147         $self->{ERRSTR} = $Imager::ERRSTR;
2148         return undef;
2149       }
2150     }
2151     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2152                 $opts{ymax},$opts{fill}{fill});
2153   }
2154   else {
2155     my $color = _color($opts{'color'});
2156     unless ($color) {
2157       $self->{ERRSTR} = $Imager::ERRSTR;
2158       return;
2159     }
2160     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
2161           $color);
2162   }
2163   return $self;
2164 }
2165
2166 sub arc {
2167   my $self=shift;
2168   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2169   my $dflcl=i_color_new(255,255,255,255);
2170   my %opts=(color=>$dflcl,
2171             'r'=>min($self->getwidth(),$self->getheight())/3,
2172             'x'=>$self->getwidth()/2,
2173             'y'=>$self->getheight()/2,
2174             'd1'=>0, 'd2'=>361, @_);
2175   if ($opts{aa}) {
2176     if ($opts{fill}) {
2177       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2178         # assume it's a hash ref
2179         require 'Imager/Fill.pm';
2180         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2181           $self->{ERRSTR} = $Imager::ERRSTR;
2182           return;
2183         }
2184       }
2185       i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2186                      $opts{'d2'}, $opts{fill}{fill});
2187     }
2188     else {
2189       my $color = _color($opts{'color'});
2190       unless ($color) {
2191         $self->{ERRSTR} = $Imager::ERRSTR;
2192         return;
2193       }
2194       if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2195         i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
2196                     $color);
2197       }
2198       else {
2199         i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2200                  $opts{'d1'}, $opts{'d2'}, $color);
2201       }
2202     }
2203   }
2204   else {
2205     if ($opts{fill}) {
2206       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2207         # assume it's a hash ref
2208         require 'Imager/Fill.pm';
2209         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2210           $self->{ERRSTR} = $Imager::ERRSTR;
2211           return;
2212         }
2213       }
2214       i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2215                   $opts{'d2'}, $opts{fill}{fill});
2216     }
2217     else {
2218       my $color = _color($opts{'color'});
2219       unless ($color) {
2220         $self->{ERRSTR} = $Imager::ERRSTR;
2221         return;
2222       }
2223       i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2224             $opts{'d1'}, $opts{'d2'}, $color);
2225     }
2226   }
2227
2228   return $self;
2229 }
2230
2231 # Draws a line from one point to the other
2232 # the endpoint is set if the endp parameter is set which it is by default.
2233 # to turn of the endpoint being set use endp=>0 when calling line.
2234
2235 sub line {
2236   my $self=shift;
2237   my $dflcl=i_color_new(0,0,0,0);
2238   my %opts=(color=>$dflcl,
2239             endp => 1,
2240             @_);
2241   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2242
2243   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2244   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2245
2246   my $color = _color($opts{'color'});
2247   unless ($color) {
2248     $self->{ERRSTR} = $Imager::ERRSTR;
2249     return;
2250   }
2251
2252   $opts{antialias} = $opts{aa} if defined $opts{aa};
2253   if ($opts{antialias}) {
2254     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2255               $color, $opts{endp});
2256   } else {
2257     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2258            $color, $opts{endp});
2259   }
2260   return $self;
2261 }
2262
2263 # Draws a line between an ordered set of points - It more or less just transforms this
2264 # into a list of lines.
2265
2266 sub polyline {
2267   my $self=shift;
2268   my ($pt,$ls,@points);
2269   my $dflcl=i_color_new(0,0,0,0);
2270   my %opts=(color=>$dflcl,@_);
2271
2272   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2273
2274   if (exists($opts{points})) { @points=@{$opts{points}}; }
2275   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2276     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2277     }
2278
2279 #  print Dumper(\@points);
2280
2281   my $color = _color($opts{'color'});
2282   unless ($color) {
2283     $self->{ERRSTR} = $Imager::ERRSTR;
2284     return;
2285   }
2286   $opts{antialias} = $opts{aa} if defined $opts{aa};
2287   if ($opts{antialias}) {
2288     for $pt(@points) {
2289       if (defined($ls)) {
2290         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2291       }
2292       $ls=$pt;
2293     }
2294   } else {
2295     for $pt(@points) {
2296       if (defined($ls)) {
2297         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2298       }
2299       $ls=$pt;
2300     }
2301   }
2302   return $self;
2303 }
2304
2305 sub polygon {
2306   my $self = shift;
2307   my ($pt,$ls,@points);
2308   my $dflcl = i_color_new(0,0,0,0);
2309   my %opts = (color=>$dflcl, @_);
2310
2311   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2312
2313   if (exists($opts{points})) {
2314     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2315     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2316   }
2317
2318   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2319     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2320   }
2321
2322   if ($opts{'fill'}) {
2323     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2324       # assume it's a hash ref
2325       require 'Imager/Fill.pm';
2326       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2327         $self->{ERRSTR} = $Imager::ERRSTR;
2328         return undef;
2329       }
2330     }
2331     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2332                     $opts{'fill'}{'fill'});
2333   }
2334   else {
2335     my $color = _color($opts{'color'});
2336     unless ($color) {
2337       $self->{ERRSTR} = $Imager::ERRSTR;
2338       return;
2339     }
2340     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2341   }
2342
2343   return $self;
2344 }
2345
2346
2347 # this the multipoint bezier curve
2348 # this is here more for testing that actual usage since
2349 # this is not a good algorithm.  Usually the curve would be
2350 # broken into smaller segments and each done individually.
2351
2352 sub polybezier {
2353   my $self=shift;
2354   my ($pt,$ls,@points);
2355   my $dflcl=i_color_new(0,0,0,0);
2356   my %opts=(color=>$dflcl,@_);
2357
2358   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2359
2360   if (exists $opts{points}) {
2361     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2362     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2363   }
2364
2365   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2366     $self->{ERRSTR}='Missing or invalid points.';
2367     return;
2368   }
2369
2370   my $color = _color($opts{'color'});
2371   unless ($color) {
2372     $self->{ERRSTR} = $Imager::ERRSTR;
2373     return;
2374   }
2375   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2376   return $self;
2377 }
2378
2379 sub flood_fill {
2380   my $self = shift;
2381   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2382   my $rc;
2383
2384   unless (exists $opts{'x'} && exists $opts{'y'}) {
2385     $self->{ERRSTR} = "missing seed x and y parameters";
2386     return undef;
2387   }
2388
2389   if ($opts{fill}) {
2390     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2391       # assume it's a hash ref
2392       require 'Imager/Fill.pm';
2393       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2394         $self->{ERRSTR} = $Imager::ERRSTR;
2395         return;
2396       }
2397     }
2398     $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2399   }
2400   else {
2401     my $color = _color($opts{'color'});
2402     unless ($color) {
2403       $self->{ERRSTR} = $Imager::ERRSTR;
2404       return;
2405     }
2406     $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2407   }
2408   if ($rc) { $self; } else { $self->{ERRSTR} = $self->_error_as_msg(); return (); }
2409 }
2410
2411 sub setpixel {
2412   my $self = shift;
2413
2414   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2415
2416   unless (exists $opts{'x'} && exists $opts{'y'}) {
2417     $self->{ERRSTR} = 'missing x and y parameters';
2418     return undef;
2419   }
2420
2421   my $x = $opts{'x'};
2422   my $y = $opts{'y'};
2423   my $color = _color($opts{color})
2424     or return undef;
2425   if (ref $x && ref $y) {
2426     unless (@$x == @$y) {
2427       $self->{ERRSTR} = 'length of x and y mismatch';
2428       return undef;
2429     }
2430     if ($color->isa('Imager::Color')) {
2431       for my $i (0..$#{$opts{'x'}}) {
2432         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2433       }
2434     }
2435     else {
2436       for my $i (0..$#{$opts{'x'}}) {
2437         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2438       }
2439     }
2440   }
2441   else {
2442     if ($color->isa('Imager::Color')) {
2443       i_ppix($self->{IMG}, $x, $y, $color);
2444     }
2445     else {
2446       i_ppixf($self->{IMG}, $x, $y, $color);
2447     }
2448   }
2449
2450   $self;
2451 }
2452
2453 sub getpixel {
2454   my $self = shift;
2455
2456   my %opts = ( "type"=>'8bit', @_);
2457
2458   unless (exists $opts{'x'} && exists $opts{'y'}) {
2459     $self->{ERRSTR} = 'missing x and y parameters';
2460     return undef;
2461   }
2462
2463   my $x = $opts{'x'};
2464   my $y = $opts{'y'};
2465   if (ref $x && ref $y) {
2466     unless (@$x == @$y) {
2467       $self->{ERRSTR} = 'length of x and y mismatch';
2468       return undef;
2469     }
2470     my @result;
2471     if ($opts{"type"} eq '8bit') {
2472       for my $i (0..$#{$opts{'x'}}) {
2473         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2474       }
2475     }
2476     else {
2477       for my $i (0..$#{$opts{'x'}}) {
2478         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2479       }
2480     }
2481     return wantarray ? @result : \@result;
2482   }
2483   else {
2484     if ($opts{"type"} eq '8bit') {
2485       return i_get_pixel($self->{IMG}, $x, $y);
2486     }
2487     else {
2488       return i_gpixf($self->{IMG}, $x, $y);
2489     }
2490   }
2491
2492   $self;
2493 }
2494
2495 sub getscanline {
2496   my $self = shift;
2497   my %opts = ( type => '8bit', x=>0, @_);
2498
2499   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2500
2501   unless (defined $opts{'y'}) {
2502     $self->_set_error("missing y parameter");
2503     return;
2504   }
2505
2506   if ($opts{type} eq '8bit') {
2507     return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2508                   $opts{y});
2509   }
2510   elsif ($opts{type} eq 'float') {
2511     return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2512                   $opts{y});
2513   }
2514   else {
2515     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2516     return;
2517   }
2518 }
2519
2520 sub setscanline {
2521   my $self = shift;
2522   my %opts = ( x=>0, @_);
2523
2524   unless (defined $opts{'y'}) {
2525     $self->_set_error("missing y parameter");
2526     return;
2527   }
2528
2529   if (!$opts{type}) {
2530     if (ref $opts{pixels} && @{$opts{pixels}}) {
2531       # try to guess the type
2532       if ($opts{pixels}[0]->isa('Imager::Color')) {
2533         $opts{type} = '8bit';
2534       }
2535       elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
2536         $opts{type} = 'float';
2537       }
2538       else {
2539         $self->_set_error("missing type parameter and could not guess from pixels");
2540         return;
2541       }
2542     }
2543     else {
2544       # default
2545       $opts{type} = '8bit';
2546     }
2547   }
2548
2549   if ($opts{type} eq '8bit') {
2550     if (ref $opts{pixels}) {
2551       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2552     }
2553     else {
2554       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2555     }
2556   }
2557   elsif ($opts{type} eq 'float') {
2558     if (ref $opts{pixels}) {
2559       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2560     }
2561     else {
2562       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2563     }
2564   }
2565   else {
2566     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2567     return;
2568   }
2569 }
2570
2571 sub getsamples {
2572   my $self = shift;
2573   my %opts = ( type => '8bit', x=>0, @_);
2574
2575   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2576
2577   unless (defined $opts{'y'}) {
2578     $self->_set_error("missing y parameter");
2579     return;
2580   }
2581
2582   unless ($opts{channels}) {
2583     $opts{channels} = [ 0 .. $self->getchannels()-1 ];
2584   }
2585
2586   if ($opts{type} eq '8bit') {
2587     return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2588                    $opts{y}, @{$opts{channels}});
2589   }
2590   elsif ($opts{type} eq 'float') {
2591     return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2592                     $opts{y}, @{$opts{channels}});
2593   }
2594   else {
2595     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2596     return;
2597   }
2598 }
2599
2600 # make an identity matrix of the given size
2601 sub _identity {
2602   my ($size) = @_;
2603
2604   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
2605   for my $c (0 .. ($size-1)) {
2606     $matrix->[$c][$c] = 1;
2607   }
2608   return $matrix;
2609 }
2610
2611 # general function to convert an image
2612 sub convert {
2613   my ($self, %opts) = @_;
2614   my $matrix;
2615
2616   unless (defined wantarray) {
2617     my @caller = caller;
2618     warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
2619     return;
2620   }
2621
2622   # the user can either specify a matrix or preset
2623   # the matrix overrides the preset
2624   if (!exists($opts{matrix})) {
2625     unless (exists($opts{preset})) {
2626       $self->{ERRSTR} = "convert() needs a matrix or preset";
2627       return;
2628     }
2629     else {
2630       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2631         # convert to greyscale, keeping the alpha channel if any
2632         if ($self->getchannels == 3) {
2633           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2634         }
2635         elsif ($self->getchannels == 4) {
2636           # preserve the alpha channel
2637           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2638                       [ 0,     0,     0,     1 ] ];
2639         }
2640         else {
2641           # an identity
2642           $matrix = _identity($self->getchannels);
2643         }
2644       }
2645       elsif ($opts{preset} eq 'noalpha') {
2646         # strip the alpha channel
2647         if ($self->getchannels == 2 or $self->getchannels == 4) {
2648           $matrix = _identity($self->getchannels);
2649           pop(@$matrix); # lose the alpha entry
2650         }
2651         else {
2652           $matrix = _identity($self->getchannels);
2653         }
2654       }
2655       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2656         # extract channel 0
2657         $matrix = [ [ 1 ] ];
2658       }
2659       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
2660         $matrix = [ [ 0, 1 ] ];
2661       }
2662       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
2663         $matrix = [ [ 0, 0, 1 ] ];
2664       }
2665       elsif ($opts{preset} eq 'alpha') {
2666         if ($self->getchannels == 2 or $self->getchannels == 4) {
2667           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
2668         }
2669         else {
2670           # the alpha is just 1 <shrug>
2671           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
2672         }
2673       }
2674       elsif ($opts{preset} eq 'rgb') {
2675         if ($self->getchannels == 1) {
2676           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
2677         }
2678         elsif ($self->getchannels == 2) {
2679           # preserve the alpha channel
2680           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
2681         }
2682         else {
2683           $matrix = _identity($self->getchannels);
2684         }
2685       }
2686       elsif ($opts{preset} eq 'addalpha') {
2687         if ($self->getchannels == 1) {
2688           $matrix = _identity(2);
2689         }
2690         elsif ($self->getchannels == 3) {
2691           $matrix = _identity(4);
2692         }
2693         else {
2694           $matrix = _identity($self->getchannels);
2695         }
2696       }
2697       else {
2698         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
2699         return undef;
2700       }
2701     }
2702   }
2703   else {
2704     $matrix = $opts{matrix};
2705   }
2706
2707   my $new = Imager->new();
2708   $new->{IMG} = i_img_new();
2709   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
2710     # most likely a bad matrix
2711     $self->{ERRSTR} = _error_as_msg();
2712     return undef;
2713   }
2714   return $new;
2715 }
2716
2717
2718 # general function to map an image through lookup tables
2719
2720 sub map {
2721   my ($self, %opts) = @_;
2722   my @chlist = qw( red green blue alpha );
2723
2724   if (!exists($opts{'maps'})) {
2725     # make maps from channel maps
2726     my $chnum;
2727     for $chnum (0..$#chlist) {
2728       if (exists $opts{$chlist[$chnum]}) {
2729         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
2730       } elsif (exists $opts{'all'}) {
2731         $opts{'maps'}[$chnum] = $opts{'all'};
2732       }
2733     }
2734   }
2735   if ($opts{'maps'} and $self->{IMG}) {
2736     i_map($self->{IMG}, $opts{'maps'} );
2737   }
2738   return $self;
2739 }
2740
2741 sub difference {
2742   my ($self, %opts) = @_;
2743
2744   defined $opts{mindist} or $opts{mindist} = 0;
2745
2746   defined $opts{other}
2747     or return $self->_set_error("No 'other' parameter supplied");
2748   defined $opts{other}{IMG}
2749     or return $self->_set_error("No image data in 'other' image");
2750
2751   $self->{IMG}
2752     or return $self->_set_error("No image data");
2753
2754   my $result = Imager->new;
2755   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
2756                                 $opts{mindist})
2757     or return $self->_set_error($self->_error_as_msg());
2758
2759   return $result;
2760 }
2761
2762 # destructive border - image is shrunk by one pixel all around
2763
2764 sub border {
2765   my ($self,%opts)=@_;
2766   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
2767   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
2768 }
2769
2770
2771 # Get the width of an image
2772
2773 sub getwidth {
2774   my $self = shift;
2775   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2776   return (i_img_info($self->{IMG}))[0];
2777 }
2778
2779 # Get the height of an image
2780
2781 sub getheight {
2782   my $self = shift;
2783   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2784   return (i_img_info($self->{IMG}))[1];
2785 }
2786
2787 # Get number of channels in an image
2788
2789 sub getchannels {
2790   my $self = shift;
2791   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2792   return i_img_getchannels($self->{IMG});
2793 }
2794
2795 # Get channel mask
2796
2797 sub getmask {
2798   my $self = shift;
2799   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2800   return i_img_getmask($self->{IMG});
2801 }
2802
2803 # Set channel mask
2804
2805 sub setmask {
2806   my $self = shift;
2807   my %opts = @_;
2808   if (!defined($self->{IMG})) {
2809     $self->{ERRSTR} = 'image is empty';
2810     return undef;
2811   }
2812   unless (defined $opts{mask}) {
2813     $self->_set_error("mask parameter required");
2814     return;
2815   }
2816   i_img_setmask( $self->{IMG} , $opts{mask} );
2817
2818   1;
2819 }
2820
2821 # Get number of colors in an image
2822
2823 sub getcolorcount {
2824   my $self=shift;
2825   my %opts=('maxcolors'=>2**30,@_);
2826   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2827   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2828   return ($rc==-1? undef : $rc);
2829 }
2830
2831 # draw string to an image
2832
2833 sub string {
2834   my $self = shift;
2835   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2836
2837   my %input=('x'=>0, 'y'=>0, @_);
2838   $input{string}||=$input{text};
2839
2840   unless(defined $input{string}) {
2841     $self->{ERRSTR}="missing required parameter 'string'";
2842     return;
2843   }
2844
2845   unless($input{font}) {
2846     $self->{ERRSTR}="missing required parameter 'font'";
2847     return;
2848   }
2849
2850   unless ($input{font}->draw(image=>$self, %input)) {
2851     return;
2852   }
2853
2854   return $self;
2855 }
2856
2857 sub align_string {
2858   my $self = shift;
2859
2860   my $img;
2861   if (ref $self) {
2862     unless ($self->{IMG}) {
2863       $self->{ERRSTR}='empty input image';
2864       return;
2865     }
2866     $img = $self;
2867   }
2868   else {
2869     $img = undef;
2870   }
2871
2872   my %input=('x'=>0, 'y'=>0, @_);
2873   $input{string}||=$input{text};
2874
2875   unless(exists $input{string}) {
2876     $self->_set_error("missing required parameter 'string'");
2877     return;
2878   }
2879
2880   unless($input{font}) {
2881     $self->_set_error("missing required parameter 'font'");
2882     return;
2883   }
2884
2885   my @result;
2886   unless (@result = $input{font}->align(image=>$img, %input)) {
2887     return;
2888   }
2889
2890   return wantarray ? @result : $result[0];
2891 }
2892
2893 my @file_limit_names = qw/width height bytes/;
2894
2895 sub set_file_limits {
2896   shift;
2897
2898   my %opts = @_;
2899   my %values;
2900
2901   if ($opts{reset}) {
2902     @values{@file_limit_names} = (0) x @file_limit_names;
2903   }
2904   else {
2905     @values{@file_limit_names} = i_get_image_file_limits();
2906   }
2907
2908   for my $key (keys %values) {
2909     defined $opts{$key} and $values{$key} = $opts{$key};
2910   }
2911
2912   i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
2913 }
2914
2915 sub get_file_limits {
2916   i_get_image_file_limits();
2917 }
2918
2919 # Shortcuts that can be exported
2920
2921 sub newcolor { Imager::Color->new(@_); }
2922 sub newfont  { Imager::Font->new(@_); }
2923
2924 *NC=*newcolour=*newcolor;
2925 *NF=*newfont;
2926
2927 *open=\&read;
2928 *circle=\&arc;
2929
2930
2931 #### Utility routines
2932
2933 sub errstr {
2934   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2935 }
2936
2937 sub _set_error {
2938   my ($self, $msg) = @_;
2939
2940   if (ref $self) {
2941     $self->{ERRSTR} = $msg;
2942   }
2943   else {
2944     $ERRSTR = $msg;
2945   }
2946   return;
2947 }
2948
2949 # Default guess for the type of an image from extension
2950
2951 sub def_guess_type {
2952   my $name=lc(shift);
2953   my $ext;
2954   $ext=($name =~ m/\.([^\.]+)$/)[0];
2955   return 'tiff' if ($ext =~ m/^tiff?$/);
2956   return 'jpeg' if ($ext =~ m/^jpe?g$/);
2957   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
2958   return 'png'  if ($ext eq "png");
2959   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
2960   return 'tga'  if ($ext eq "tga");
2961   return 'rgb'  if ($ext eq "rgb");
2962   return 'gif'  if ($ext eq "gif");
2963   return 'raw'  if ($ext eq "raw");
2964   return ();
2965 }
2966
2967 # get the minimum of a list
2968
2969 sub min {
2970   my $mx=shift;
2971   for(@_) { if ($_<$mx) { $mx=$_; }}
2972   return $mx;
2973 }
2974
2975 # get the maximum of a list
2976
2977 sub max {
2978   my $mx=shift;
2979   for(@_) { if ($_>$mx) { $mx=$_; }}
2980   return $mx;
2981 }
2982
2983 # string stuff for iptc headers
2984
2985 sub clean {
2986   my($str)=$_[0];
2987   $str = substr($str,3);
2988   $str =~ s/[\n\r]//g;
2989   $str =~ s/\s+/ /g;
2990   $str =~ s/^\s//;
2991   $str =~ s/\s$//;
2992   return $str;
2993 }
2994
2995 # A little hack to parse iptc headers.
2996
2997 sub parseiptc {
2998   my $self=shift;
2999   my(@sar,$item,@ar);
3000   my($caption,$photogr,$headln,$credit);
3001
3002   my $str=$self->{IPTCRAW};
3003
3004   #print $str;
3005
3006   @ar=split(/8BIM/,$str);
3007
3008   my $i=0;
3009   foreach (@ar) {
3010     if (/^\004\004/) {
3011       @sar=split(/\034\002/);
3012       foreach $item (@sar) {
3013         if ($item =~ m/^x/) {
3014           $caption=&clean($item);
3015           $i++;
3016         }
3017         if ($item =~ m/^P/) {
3018           $photogr=&clean($item);
3019           $i++;
3020         }
3021         if ($item =~ m/^i/) {
3022           $headln=&clean($item);
3023           $i++;
3024         }
3025         if ($item =~ m/^n/) {
3026           $credit=&clean($item);
3027           $i++;
3028         }
3029       }
3030     }
3031   }
3032   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3033 }
3034
3035 sub Inline {
3036   my ($lang) = @_;
3037
3038   $lang eq 'C'
3039     or die "Only C language supported";
3040
3041   require Imager::ExtUtils;
3042   return Imager::ExtUtils->inline_config;
3043 }
3044
3045 1;
3046 __END__
3047 # Below is the stub of documentation for your module. You better edit it!
3048
3049 =head1 NAME
3050
3051 Imager - Perl extension for Generating 24 bit Images
3052
3053 =head1 SYNOPSIS
3054
3055   # Thumbnail example
3056
3057   #!/usr/bin/perl -w
3058   use strict;
3059   use Imager;
3060
3061   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
3062   my $file = shift;
3063
3064   my $format;
3065
3066   my $img = Imager->new();
3067   # see Imager::Files for information on the read() method
3068   $img->read(file=>$file) or die $img->errstr();
3069
3070   $file =~ s/\.[^.]*$//;
3071
3072   # Create smaller version
3073   # documented in Imager::Transformations
3074   my $thumb = $img->scale(scalefactor=>.3);
3075
3076   # Autostretch individual channels
3077   $thumb->filter(type=>'autolevels');
3078
3079   # try to save in one of these formats
3080   SAVE:
3081
3082   for $format ( qw( png gif jpg tiff ppm ) ) {
3083     # Check if given format is supported
3084     if ($Imager::formats{$format}) {
3085       $file.="_low.$format";
3086       print "Storing image as: $file\n";
3087       # documented in Imager::Files
3088       $thumb->write(file=>$file) or
3089         die $thumb->errstr;
3090       last SAVE;
3091     }
3092   }
3093
3094 =head1 DESCRIPTION
3095
3096 Imager is a module for creating and altering images.  It can read and
3097 write various image formats, draw primitive shapes like lines,and
3098 polygons, blend multiple images together in various ways, scale, crop,
3099 render text and more.
3100
3101 =head2 Overview of documentation
3102
3103 =over
3104
3105 =item *
3106
3107 Imager - This document - Synopsis Example, Table of Contents and
3108 Overview.
3109
3110 =item *
3111
3112 L<Imager::Tutorial> - a brief introduction to Imager.
3113
3114 =item *
3115
3116 L<Imager::Cookbook> - how to do various things with Imager.
3117
3118 =item *
3119
3120 L<Imager::ImageTypes> - Basics of constructing image objects with
3121 C<new()>: Direct type/virtual images, RGB(A)/paletted images,
3122 8/16/double bits/channel, color maps, channel masks, image tags, color
3123 quantization.  Also discusses basic image information methods.
3124
3125 =item *
3126
3127 L<Imager::Files> - IO interaction, reading/writing images, format
3128 specific tags.
3129
3130 =item *
3131
3132 L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
3133 flood fill.
3134
3135 =item *
3136
3137 L<Imager::Color> - Color specification.
3138
3139 =item *
3140
3141 L<Imager::Fill> - Fill pattern specification.
3142
3143 =item *
3144
3145 L<Imager::Font> - General font rendering, bounding boxes and font
3146 metrics.
3147
3148 =item *
3149
3150 L<Imager::Transformations> - Copying, scaling, cropping, flipping,
3151 blending, pasting, convert and map.
3152
3153 =item *
3154
3155 L<Imager::Engines> - Programmable transformations through
3156 C<transform()>, C<transform2()> and C<matrix_transform()>.
3157
3158 =item *
3159
3160 L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
3161 filter plugins.
3162
3163 =item *
3164
3165 L<Imager::Expr> - Expressions for evaluation engine used by
3166 transform2().
3167
3168 =item *
3169
3170 L<Imager::Matrix2d> - Helper class for affine transformations.
3171
3172 =item *
3173
3174 L<Imager::Fountain> - Helper for making gradient profiles.
3175
3176 =item *
3177
3178 L<Imager::API> - using Imager's C API
3179
3180 =item *
3181
3182 L<Imager::APIRef> - API function reference
3183
3184 =item *
3185
3186 L<Imager::Inline> - using Imager's C API from Inline::C
3187
3188 =item *
3189
3190 L<Imager::ExtUtils> - tools to get access to Imager's C API.
3191
3192 =back
3193
3194 =head2 Basic Overview
3195
3196 An Image object is created with C<$img = Imager-E<gt>new()>.
3197 Examples:
3198
3199   $img=Imager->new();                         # create empty image
3200   $img->read(file=>'lena.png',type=>'png') or # read image from file
3201      die $img->errstr();                      # give an explanation
3202                                               # if something failed
3203
3204 or if you want to create an empty image:
3205
3206   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
3207
3208 This example creates a completely black image of width 400 and height
3209 300 and 4 channels.
3210
3211 When an operation fails which can be directly associated with an image
3212 the error message is stored can be retrieved with
3213 C<$img-E<gt>errstr()>.
3214
3215 In cases where no image object is associated with an operation
3216 C<$Imager::ERRSTR> is used to report errors not directly associated
3217 with an image object.  You can also call C<Imager->errstr> to get this
3218 value.
3219
3220 The C<Imager-E<gt>new> method is described in detail in
3221 L<Imager::ImageTypes>.
3222
3223 =head1 METHOD INDEX
3224
3225 Where to find information on methods for Imager class objects.
3226
3227 addcolors() -  L<Imager::ImageTypes/addcolors>
3228
3229 addtag() -  L<Imager::ImageTypes/addtag> - add image tags
3230
3231 arc() - L<Imager::Draw/arc>
3232
3233 align_string() - L<Imager::Draw/align_string>
3234
3235 bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
3236 image
3237
3238 box() - L<Imager::Draw/box>
3239
3240 circle() - L<Imager::Draw/circle>
3241
3242 colorcount() - L<Imager::Draw/colorcount>
3243
3244 convert() - L<Imager::Transformations/"Color transformations"> -
3245 transform the color space
3246
3247 copy() - L<Imager::Transformations/copy>
3248
3249 crop() - L<Imager::Transformations/crop> - extract part of an image
3250
3251 deltag() -  L<Imager::ImageTypes/deltag> - delete image tags
3252
3253 difference() - L<Imager::Filters/"Image Difference">
3254
3255 errstr() - L<"Basic Overview">
3256
3257 filter() - L<Imager::Filters>
3258
3259 findcolor() - L<Imager::ImageTypes/findcolor> - search the image palette, if it
3260 has one
3261
3262 flip() - L<Imager::Transformations/flip>
3263
3264 flood_fill() - L<Imager::Draw/flood_fill>
3265
3266 getchannels() -  L<Imager::ImageTypes/getchannels>
3267
3268 getcolorcount() -  L<Imager::ImageTypes/getcolorcount>
3269
3270 getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
3271 palette, if it has one
3272
3273 get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3274
3275 getheight() - L<Imager::ImageTypes/getwidth>
3276
3277 getpixel() - L<Imager::Draw/getpixel>
3278
3279 getsamples() - L<Imager::Draw/getsamples>
3280
3281 getscanline() - L<Imager::Draw/getscanline>
3282
3283 getwidth() - L<Imager::ImageTypes/getwidth>
3284
3285 img_set() - L<Imager::ImageTypes/img_set>
3286
3287 line() - L<Imager::Draw/line>
3288
3289 map() - L<Imager::Transformations/"Color Mappings"> - remap color
3290 channel values
3291
3292 masked() -  L<Imager::ImageTypes/masked> - make a masked image
3293
3294 matrix_transform() - L<Imager::Engines/"Matrix Transformations">
3295
3296 maxcolors() - L<Imager::ImageTypes/maxcolors>
3297
3298 new() - L<Imager::ImageTypes/new>
3299
3300 open() - L<Imager::Files> - an alias for read()
3301
3302 paste() - L<Imager::Transformations/paste> - draw an image onto an image
3303
3304 polygon() - L<Imager::Draw/polygon>
3305
3306 polyline() - L<Imager::Draw/polyline>
3307
3308 read() - L<Imager::Files> - read a single image from an image file
3309
3310 read_multi() - L<Imager::Files> - read multiple images from an image
3311 file
3312
3313 rotate() - L<Imager::Transformations/rotate>
3314
3315 rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
3316 image and use the alpha channel
3317
3318 scale() - L<Imager::Transformations/scale>
3319
3320 setscanline() - L<Imager::Draw/setscanline>
3321
3322 scaleX() - L<Imager::Transformations/scaleX>
3323
3324 scaleY() - L<Imager::Transformations/scaleY>
3325
3326 setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
3327 a paletted image
3328
3329 setpixel() - L<Imager::Draw/setpixel>
3330
3331 set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3332
3333 string() - L<Imager::Draw/string> - draw text on an image
3334
3335 tags() -  L<Imager::ImageTypes/tags> - fetch image tags
3336
3337 to_paletted() -  L<Imager::ImageTypes/to_paletted>
3338
3339 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
3340
3341 transform() - L<Imager::Engines/"transform">
3342
3343 transform2() - L<Imager::Engines/"transform2">
3344
3345 type() -  L<Imager::ImageTypes/type> - type of image (direct vs paletted)
3346
3347 virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
3348 data
3349
3350 write() - L<Imager::Files> - write an image to a file
3351
3352 write_multi() - L<Imager::Files> - write multiple image to an image
3353 file.
3354
3355 =head1 CONCEPT INDEX
3356
3357 animated GIF - L<Imager::File/"Writing an animated GIF">
3358
3359 aspect ratio - L<Imager::ImageTypes/i_xres>,
3360 L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
3361
3362 blend - alpha blending one image onto another
3363 L<Imager::Transformations/rubthrough>
3364
3365 blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
3366
3367 boxes, drawing - L<Imager::Draw/box>
3368
3369 changes between image - L<Imager::Filter/"Image Difference">
3370
3371 color - L<Imager::Color>
3372
3373 color names - L<Imager::Color>, L<Imager::Color::Table>
3374
3375 combine modes - L<Imager::Fill/combine>
3376
3377 compare images - L<Imager::Filter/"Image Difference">
3378
3379 contrast - L<Imager::Filter/contrast>, L<Imager::Filter/autolevels>
3380
3381 convolution - L<Imager::Filter/conv>
3382
3383 cropping - L<Imager::Transformations/crop>
3384
3385 C<diff> images - L<Imager::Filter/"Image Difference">
3386
3387 dpi - L<Imager::ImageTypes/i_xres>
3388
3389 drawing boxes - L<Imager::Draw/box>
3390
3391 drawing lines - L<Imager::Draw/line>
3392
3393 drawing text - L<Imager::Font/string>, L<Imager::Font/align>
3394
3395 error message - L<"Basic Overview">
3396
3397 files, font - L<Imager::Font>
3398
3399 files, image - L<Imager::Files>
3400
3401 filling, types of fill - L<Imager::Fill>
3402
3403 filling, boxes - L<Imager::Draw/box>
3404
3405 filling, flood fill - L<Imager::Draw/flood_fill>
3406
3407 flood fill - L<Imager::Draw/flood_fill>
3408
3409 fonts - L<Imager::Font>
3410
3411 fonts, drawing with - L<Imager::Font/string>, L<Imager::Font/align>,
3412 L<Imager::Font::Wrap>
3413
3414 fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3415
3416 fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
3417
3418 fountain fill - L<Imager::Fill/"Fountain fills">,
3419 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3420 L<Imager::Filters/gradgen>
3421
3422 GIF files - L<Imager::Files/"GIF">
3423
3424 GIF files, animated - L<Imager::File/"Writing an animated GIF">
3425
3426 gradient fill - L<Imager::Fill/"Fountain fills">,
3427 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3428 L<Imager::Filters/gradgen>
3429
3430 guassian blur - L<Imager::Filter/guassian>
3431
3432 hatch fills - L<Imager::Fill/"Hatched fills">
3433
3434 invert image - L<Imager::Filter/hardinvert>
3435
3436 JPEG - L<Imager::Files/"JPEG">
3437
3438 limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
3439
3440 lines, drawing - L<Imager::Draw/line>
3441
3442 matrix - L<Imager::Matrix2d>,
3443 L<Imager::Transformations/"Matrix Transformations">,
3444 L<Imager::Font/transform>
3445
3446 metadata, image - L<Imager::ImageTypes/"Tags">
3447
3448 mosaic - L<Imager::Filter/mosaic>
3449
3450 noise, filter - L<Imager::Filter/noise>
3451
3452 noise, rendered - L<Imager::Filter/turbnoise>,
3453 L<Imager::Filter/radnoise>
3454
3455 paste - L<Imager::Transformations/paste>,
3456 L<Imager::Transformations/rubthrough>
3457
3458 pseudo-color image - L<Imager::ImageTypes/to_paletted>,
3459 L<Imager::ImageTypes/new>
3460
3461 posterize - L<Imager::Filter/postlevels>
3462
3463 png files - L<Imager::Files>, L<Imager::Files/"PNG">
3464
3465 pnm - L<Imager::Files/"PNM (Portable aNy Map)">
3466
3467 rectangles, drawing - L<Imager::Draw/box>
3468
3469 resizing an image - L<Imager::Transformations/scale>,
3470 L<Imager::Transformations/crop>
3471
3472 saving an image - L<Imager::Files>
3473
3474 scaling - L<Imager::Transformations/scale>
3475
3476 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
3477
3478 size, image - L<Imager::ImageTypes/getwidth>,
3479 L<Imager::ImageTypes/getheight>
3480
3481 size, text - L<Imager::Font/bounding_box>
3482
3483 tags, image metadata - L<Imager::ImageTypes/"Tags">
3484
3485 text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
3486 L<Imager::Font::Wrap>
3487
3488 text, wrapping text in an area - L<Imager::Font::Wrap>
3489
3490 text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3491
3492 tiles, color - L<Imager::Filter/mosaic>
3493
3494 unsharp mask - L<Imager::Filter/unsharpmask>
3495
3496 watermark - L<Imager::Filter/watermark>
3497
3498 writing an image to a file - L<Imager::Files>
3499
3500 =head1 SUPPORT
3501
3502 You can ask for help, report bugs or express your undying love for
3503 Imager on the Imager-devel mailing list.
3504
3505 To subscribe send a message with C<subscribe> in the body to:
3506
3507    imager-devel+request@molar.is
3508
3509 or use the form at:
3510
3511 =over
3512
3513 L<http://www.molar.is/en/lists/imager-devel/>
3514
3515 =back
3516
3517 where you can also find the mailing list archive.
3518
3519 If you're into IRC, you can typically find the developers in #Imager
3520 on irc.perl.org.  As with any IRC channel, the participants could be
3521 occupied or asleep, so please be patient.
3522
3523 You can report bugs by pointing your browser at:
3524
3525 =over
3526
3527 L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
3528
3529 =back
3530
3531 Please remember to include the versions of Imager, perl, supporting
3532 libraries, and any relevant code.  If you have specific images that
3533 cause the problems, please include those too.
3534
3535 =head1 BUGS
3536
3537 Bugs are listed individually for relevant pod pages.
3538
3539 =head1 AUTHOR
3540
3541 Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
3542 others. See the README for a complete list.
3543
3544 =head1 SEE ALSO
3545
3546 L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
3547 L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
3548 L<Imager::Font>(3), L<Imager::Transformations>(3),
3549 L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
3550 L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
3551
3552 L<http://imager.perl.org/>
3553
3554 L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
3555
3556 Other perl imaging modules include:
3557
3558 L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
3559
3560 =cut