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},%{$filters{$input{'type'}}{defaults}},%input);
1684   } else {
1685     %hsh=('image',$self->{IMG},%input);
1686   }
1687
1688   my @cs=@{$filters{$input{'type'}}{callseq}};
1689
1690   for(@cs) {
1691     if (!defined($hsh{$_})) {
1692       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1693     }
1694   }
1695
1696   eval {
1697     local $SIG{__DIE__}; # we don't want this processed by confess, etc
1698     &{$filters{$input{'type'}}{callsub}}(%hsh);
1699   };
1700   if ($@) {
1701     chomp($self->{ERRSTR} = $@);
1702     return;
1703   }
1704
1705   my @b=keys %hsh;
1706
1707   $self->{DEBUG} && print "callseq is: @cs\n";
1708   $self->{DEBUG} && print "matching callseq is: @b\n";
1709
1710   return $self;
1711 }
1712
1713 sub register_filter {
1714   my $class = shift;
1715   my %hsh = ( defaults => {}, @_ );
1716
1717   defined $hsh{type}
1718     or die "register_filter() with no type\n";
1719   defined $hsh{callsub}
1720     or die "register_filter() with no callsub\n";
1721   defined $hsh{callseq}
1722     or die "register_filter() with no callseq\n";
1723
1724   exists $filters{$hsh{type}}
1725     and return;
1726
1727   $filters{$hsh{type}} = \%hsh;
1728
1729   return 1;
1730 }
1731
1732 # Scale an image to requested size and return the scaled version
1733
1734 sub scale {
1735   my $self=shift;
1736   my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
1737   my $img = Imager->new();
1738   my $tmp = Imager->new();
1739
1740   unless (defined wantarray) {
1741     my @caller = caller;
1742     warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
1743     return;
1744   }
1745
1746   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1747
1748   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
1749     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1750     if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1751     if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1752   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1753   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1754
1755   if ($opts{qtype} eq 'normal') {
1756     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1757     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1758     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1759     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1760     return $img;
1761   }
1762   if ($opts{'qtype'} eq 'preview') {
1763     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
1764     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1765     return $img;
1766   }
1767   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1768 }
1769
1770 # Scales only along the X axis
1771
1772 sub scaleX {
1773   my $self=shift;
1774   my %opts=(scalefactor=>0.5,@_);
1775
1776   unless (defined wantarray) {
1777     my @caller = caller;
1778     warn "scaleX() called in void context - scaleX() returns the scaled image at $caller[1] line $caller[2]\n";
1779     return;
1780   }
1781
1782   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1783
1784   my $img = Imager->new();
1785
1786   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1787
1788   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1789   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1790
1791   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1792   return $img;
1793 }
1794
1795 # Scales only along the Y axis
1796
1797 sub scaleY {
1798   my $self=shift;
1799   my %opts=(scalefactor=>0.5,@_);
1800
1801   unless (defined wantarray) {
1802     my @caller = caller;
1803     warn "scaleY() called in void context - scaleY() returns the scaled image at $caller[1] line $caller[2]\n";
1804     return;
1805   }
1806
1807   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1808
1809   my $img = Imager->new();
1810
1811   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1812
1813   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1814   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1815
1816   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1817   return $img;
1818 }
1819
1820
1821 # Transform returns a spatial transformation of the input image
1822 # this moves pixels to a new location in the returned image.
1823 # NOTE - should make a utility function to check transforms for
1824 # stack overruns
1825
1826 sub transform {
1827   my $self=shift;
1828   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1829   my %opts=@_;
1830   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1831
1832 #  print Dumper(\%opts);
1833 #  xopcopdes
1834
1835   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1836     if (!$I2P) {
1837       eval ("use Affix::Infix2Postfix;");
1838       print $@;
1839       if ( $@ ) {
1840         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
1841         return undef;
1842       }
1843       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1844                                              {op=>'-',trans=>'Sub'},
1845                                              {op=>'*',trans=>'Mult'},
1846                                              {op=>'/',trans=>'Div'},
1847                                              {op=>'-','type'=>'unary',trans=>'u-'},
1848                                              {op=>'**'},
1849                                              {op=>'func','type'=>'unary'}],
1850                                      'grouping'=>[qw( \( \) )],
1851                                      'func'=>[qw( sin cos )],
1852                                      'vars'=>[qw( x y )]
1853                                     );
1854     }
1855
1856     @xt=$I2P->translate($opts{'xexpr'});
1857     @yt=$I2P->translate($opts{'yexpr'});
1858
1859     $numre=$I2P->{'numre'};
1860     @pt=(0,0);
1861
1862     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1863     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1864     @{$opts{'parm'}}=@pt;
1865   }
1866
1867 #  print Dumper(\%opts);
1868
1869   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1870     $self->{ERRSTR}='transform: no xopcodes given.';
1871     return undef;
1872   }
1873
1874   @op=@{$opts{'xopcodes'}};
1875   for $iop (@op) {
1876     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1877       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1878       return undef;
1879     }
1880     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1881   }
1882
1883
1884 # yopcopdes
1885
1886   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1887     $self->{ERRSTR}='transform: no yopcodes given.';
1888     return undef;
1889   }
1890
1891   @op=@{$opts{'yopcodes'}};
1892   for $iop (@op) {
1893     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1894       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1895       return undef;
1896     }
1897     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1898   }
1899
1900 #parameters
1901
1902   if ( !exists $opts{'parm'}) {
1903     $self->{ERRSTR}='transform: no parameter arg given.';
1904     return undef;
1905   }
1906
1907 #  print Dumper(\@ropx);
1908 #  print Dumper(\@ropy);
1909 #  print Dumper(\@ropy);
1910
1911   my $img = Imager->new();
1912   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1913   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1914   return $img;
1915 }
1916
1917
1918 sub transform2 {
1919   my ($opts, @imgs) = @_;
1920
1921   require "Imager/Expr.pm";
1922
1923   $opts->{variables} = [ qw(x y) ];
1924   my ($width, $height) = @{$opts}{qw(width height)};
1925   if (@imgs) {
1926     $width ||= $imgs[0]->getwidth();
1927     $height ||= $imgs[0]->getheight();
1928     my $img_num = 1;
1929     for my $img (@imgs) {
1930       $opts->{constants}{"w$img_num"} = $img->getwidth();
1931       $opts->{constants}{"h$img_num"} = $img->getheight();
1932       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1933       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1934       ++$img_num;
1935     }
1936   }
1937   if ($width) {
1938     $opts->{constants}{w} = $width;
1939     $opts->{constants}{cx} = $width/2;
1940   }
1941   else {
1942     $Imager::ERRSTR = "No width supplied";
1943     return;
1944   }
1945   if ($height) {
1946     $opts->{constants}{h} = $height;
1947     $opts->{constants}{cy} = $height/2;
1948   }
1949   else {
1950     $Imager::ERRSTR = "No height supplied";
1951     return;
1952   }
1953   my $code = Imager::Expr->new($opts);
1954   if (!$code) {
1955     $Imager::ERRSTR = Imager::Expr::error();
1956     return;
1957   }
1958   my $channels = $opts->{channels} || 3;
1959   unless ($channels >= 1 && $channels <= 4) {
1960     return Imager->_set_error("channels must be an integer between 1 and 4");
1961   }
1962
1963   my $img = Imager->new();
1964   $img->{IMG} = i_transform2($opts->{width}, $opts->{height},
1965                              $channels, $code->code(),
1966                              $code->nregs(), $code->cregs(),
1967                              [ map { $_->{IMG} } @imgs ]);
1968   if (!defined $img->{IMG}) {
1969     $Imager::ERRSTR = Imager->_error_as_msg();
1970     return;
1971   }
1972
1973   return $img;
1974 }
1975
1976 sub rubthrough {
1977   my $self=shift;
1978   my %opts=(tx => 0,ty => 0, @_);
1979
1980   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1981   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1982
1983   %opts = (src_minx => 0,
1984            src_miny => 0,
1985            src_maxx => $opts{src}->getwidth(),
1986            src_maxy => $opts{src}->getheight(),
1987            %opts);
1988
1989   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
1990           $opts{src_minx}, $opts{src_miny}, $opts{src_maxx}, $opts{src_maxy})) {
1991     $self->{ERRSTR} = $self->_error_as_msg();
1992     return undef;
1993   }
1994   return $self;
1995 }
1996
1997
1998 sub flip {
1999   my $self  = shift;
2000   my %opts  = @_;
2001   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
2002   my $dir;
2003   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
2004   $dir = $xlate{$opts{'dir'}};
2005   return $self if i_flipxy($self->{IMG}, $dir);
2006   return ();
2007 }
2008
2009 sub rotate {
2010   my $self = shift;
2011   my %opts = @_;
2012
2013   unless (defined wantarray) {
2014     my @caller = caller;
2015     warn "rotate() called in void context - rotate() returns the rotated image at $caller[1] line $caller[2]\n";
2016     return;
2017   }
2018
2019   if (defined $opts{right}) {
2020     my $degrees = $opts{right};
2021     if ($degrees < 0) {
2022       $degrees += 360 * int(((-$degrees)+360)/360);
2023     }
2024     $degrees = $degrees % 360;
2025     if ($degrees == 0) {
2026       return $self->copy();
2027     }
2028     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
2029       my $result = Imager->new();
2030       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
2031         return $result;
2032       }
2033       else {
2034         $self->{ERRSTR} = $self->_error_as_msg();
2035         return undef;
2036       }
2037     }
2038     else {
2039       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
2040       return undef;
2041     }
2042   }
2043   elsif (defined $opts{radians} || defined $opts{degrees}) {
2044     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
2045
2046     my $result = Imager->new;
2047     if ($opts{back}) {
2048       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $opts{back});
2049     }
2050     else {
2051       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);
2052     }
2053     if ($result->{IMG}) {
2054       return $result;
2055     }
2056     else {
2057       $self->{ERRSTR} = $self->_error_as_msg();
2058       return undef;
2059     }
2060   }
2061   else {
2062     $self->{ERRSTR} = "Only the 'right', 'radians' and 'degrees' parameters are available";
2063     return undef;
2064   }
2065 }
2066
2067 sub matrix_transform {
2068   my $self = shift;
2069   my %opts = @_;
2070
2071   unless (defined wantarray) {
2072     my @caller = caller;
2073     warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
2074     return;
2075   }
2076
2077   if ($opts{matrix}) {
2078     my $xsize = $opts{xsize} || $self->getwidth;
2079     my $ysize = $opts{ysize} || $self->getheight;
2080
2081     my $result = Imager->new;
2082     if ($opts{back}) {
2083       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2084                                           $opts{matrix}, $opts{back})
2085         or return undef;
2086     }
2087     else {
2088       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2089                                           $opts{matrix})
2090         or return undef;
2091     }
2092
2093     return $result;
2094   }
2095   else {
2096     $self->{ERRSTR} = "matrix parameter required";
2097     return undef;
2098   }
2099 }
2100
2101 # blame Leolo :)
2102 *yatf = \&matrix_transform;
2103
2104 # These two are supported for legacy code only
2105
2106 sub i_color_new {
2107   return Imager::Color->new(@_);
2108 }
2109
2110 sub i_color_set {
2111   return Imager::Color::set(@_);
2112 }
2113
2114 # Draws a box between the specified corner points.
2115 sub box {
2116   my $self=shift;
2117   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2118   my $dflcl=i_color_new(255,255,255,255);
2119   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
2120
2121   if (exists $opts{'box'}) {
2122     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
2123     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
2124     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
2125     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
2126   }
2127
2128   if ($opts{filled}) {
2129     my $color = _color($opts{'color'});
2130     unless ($color) {
2131       $self->{ERRSTR} = $Imager::ERRSTR;
2132       return;
2133     }
2134     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2135                  $opts{ymax}, $color);
2136   }
2137   elsif ($opts{fill}) {
2138     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2139       # assume it's a hash ref
2140       require 'Imager/Fill.pm';
2141       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2142         $self->{ERRSTR} = $Imager::ERRSTR;
2143         return undef;
2144       }
2145     }
2146     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2147                 $opts{ymax},$opts{fill}{fill});
2148   }
2149   else {
2150     my $color = _color($opts{'color'});
2151     unless ($color) {
2152       $self->{ERRSTR} = $Imager::ERRSTR;
2153       return;
2154     }
2155     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
2156           $color);
2157   }
2158   return $self;
2159 }
2160
2161 sub arc {
2162   my $self=shift;
2163   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2164   my $dflcl=i_color_new(255,255,255,255);
2165   my %opts=(color=>$dflcl,
2166             'r'=>min($self->getwidth(),$self->getheight())/3,
2167             'x'=>$self->getwidth()/2,
2168             'y'=>$self->getheight()/2,
2169             'd1'=>0, 'd2'=>361, @_);
2170   if ($opts{aa}) {
2171     if ($opts{fill}) {
2172       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2173         # assume it's a hash ref
2174         require 'Imager/Fill.pm';
2175         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2176           $self->{ERRSTR} = $Imager::ERRSTR;
2177           return;
2178         }
2179       }
2180       i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2181                      $opts{'d2'}, $opts{fill}{fill});
2182     }
2183     else {
2184       my $color = _color($opts{'color'});
2185       unless ($color) {
2186         $self->{ERRSTR} = $Imager::ERRSTR;
2187         return;
2188       }
2189       if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2190         i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
2191                     $color);
2192       }
2193       else {
2194         i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2195                  $opts{'d1'}, $opts{'d2'}, $color);
2196       }
2197     }
2198   }
2199   else {
2200     if ($opts{fill}) {
2201       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2202         # assume it's a hash ref
2203         require 'Imager/Fill.pm';
2204         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2205           $self->{ERRSTR} = $Imager::ERRSTR;
2206           return;
2207         }
2208       }
2209       i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2210                   $opts{'d2'}, $opts{fill}{fill});
2211     }
2212     else {
2213       my $color = _color($opts{'color'});
2214       unless ($color) {
2215         $self->{ERRSTR} = $Imager::ERRSTR;
2216         return;
2217       }
2218       i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2219             $opts{'d1'}, $opts{'d2'}, $color);
2220     }
2221   }
2222
2223   return $self;
2224 }
2225
2226 # Draws a line from one point to the other
2227 # the endpoint is set if the endp parameter is set which it is by default.
2228 # to turn of the endpoint being set use endp=>0 when calling line.
2229
2230 sub line {
2231   my $self=shift;
2232   my $dflcl=i_color_new(0,0,0,0);
2233   my %opts=(color=>$dflcl,
2234             endp => 1,
2235             @_);
2236   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2237
2238   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2239   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2240
2241   my $color = _color($opts{'color'});
2242   unless ($color) {
2243     $self->{ERRSTR} = $Imager::ERRSTR;
2244     return;
2245   }
2246
2247   $opts{antialias} = $opts{aa} if defined $opts{aa};
2248   if ($opts{antialias}) {
2249     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2250               $color, $opts{endp});
2251   } else {
2252     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2253            $color, $opts{endp});
2254   }
2255   return $self;
2256 }
2257
2258 # Draws a line between an ordered set of points - It more or less just transforms this
2259 # into a list of lines.
2260
2261 sub polyline {
2262   my $self=shift;
2263   my ($pt,$ls,@points);
2264   my $dflcl=i_color_new(0,0,0,0);
2265   my %opts=(color=>$dflcl,@_);
2266
2267   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2268
2269   if (exists($opts{points})) { @points=@{$opts{points}}; }
2270   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2271     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2272     }
2273
2274 #  print Dumper(\@points);
2275
2276   my $color = _color($opts{'color'});
2277   unless ($color) {
2278     $self->{ERRSTR} = $Imager::ERRSTR;
2279     return;
2280   }
2281   $opts{antialias} = $opts{aa} if defined $opts{aa};
2282   if ($opts{antialias}) {
2283     for $pt(@points) {
2284       if (defined($ls)) {
2285         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2286       }
2287       $ls=$pt;
2288     }
2289   } else {
2290     for $pt(@points) {
2291       if (defined($ls)) {
2292         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2293       }
2294       $ls=$pt;
2295     }
2296   }
2297   return $self;
2298 }
2299
2300 sub polygon {
2301   my $self = shift;
2302   my ($pt,$ls,@points);
2303   my $dflcl = i_color_new(0,0,0,0);
2304   my %opts = (color=>$dflcl, @_);
2305
2306   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2307
2308   if (exists($opts{points})) {
2309     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2310     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2311   }
2312
2313   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2314     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2315   }
2316
2317   if ($opts{'fill'}) {
2318     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2319       # assume it's a hash ref
2320       require 'Imager/Fill.pm';
2321       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2322         $self->{ERRSTR} = $Imager::ERRSTR;
2323         return undef;
2324       }
2325     }
2326     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2327                     $opts{'fill'}{'fill'});
2328   }
2329   else {
2330     my $color = _color($opts{'color'});
2331     unless ($color) {
2332       $self->{ERRSTR} = $Imager::ERRSTR;
2333       return;
2334     }
2335     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2336   }
2337
2338   return $self;
2339 }
2340
2341
2342 # this the multipoint bezier curve
2343 # this is here more for testing that actual usage since
2344 # this is not a good algorithm.  Usually the curve would be
2345 # broken into smaller segments and each done individually.
2346
2347 sub polybezier {
2348   my $self=shift;
2349   my ($pt,$ls,@points);
2350   my $dflcl=i_color_new(0,0,0,0);
2351   my %opts=(color=>$dflcl,@_);
2352
2353   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2354
2355   if (exists $opts{points}) {
2356     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2357     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2358   }
2359
2360   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2361     $self->{ERRSTR}='Missing or invalid points.';
2362     return;
2363   }
2364
2365   my $color = _color($opts{'color'});
2366   unless ($color) {
2367     $self->{ERRSTR} = $Imager::ERRSTR;
2368     return;
2369   }
2370   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2371   return $self;
2372 }
2373
2374 sub flood_fill {
2375   my $self = shift;
2376   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2377   my $rc;
2378
2379   unless (exists $opts{'x'} && exists $opts{'y'}) {
2380     $self->{ERRSTR} = "missing seed x and y parameters";
2381     return undef;
2382   }
2383
2384   if ($opts{fill}) {
2385     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2386       # assume it's a hash ref
2387       require 'Imager/Fill.pm';
2388       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2389         $self->{ERRSTR} = $Imager::ERRSTR;
2390         return;
2391       }
2392     }
2393     $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2394   }
2395   else {
2396     my $color = _color($opts{'color'});
2397     unless ($color) {
2398       $self->{ERRSTR} = $Imager::ERRSTR;
2399       return;
2400     }
2401     $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2402   }
2403   if ($rc) { $self; } else { $self->{ERRSTR} = $self->_error_as_msg(); return (); }
2404 }
2405
2406 sub setpixel {
2407   my $self = shift;
2408
2409   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2410
2411   unless (exists $opts{'x'} && exists $opts{'y'}) {
2412     $self->{ERRSTR} = 'missing x and y parameters';
2413     return undef;
2414   }
2415
2416   my $x = $opts{'x'};
2417   my $y = $opts{'y'};
2418   my $color = _color($opts{color})
2419     or return undef;
2420   if (ref $x && ref $y) {
2421     unless (@$x == @$y) {
2422       $self->{ERRSTR} = 'length of x and y mismatch';
2423       return undef;
2424     }
2425     if ($color->isa('Imager::Color')) {
2426       for my $i (0..$#{$opts{'x'}}) {
2427         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2428       }
2429     }
2430     else {
2431       for my $i (0..$#{$opts{'x'}}) {
2432         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2433       }
2434     }
2435   }
2436   else {
2437     if ($color->isa('Imager::Color')) {
2438       i_ppix($self->{IMG}, $x, $y, $color);
2439     }
2440     else {
2441       i_ppixf($self->{IMG}, $x, $y, $color);
2442     }
2443   }
2444
2445   $self;
2446 }
2447
2448 sub getpixel {
2449   my $self = shift;
2450
2451   my %opts = ( "type"=>'8bit', @_);
2452
2453   unless (exists $opts{'x'} && exists $opts{'y'}) {
2454     $self->{ERRSTR} = 'missing x and y parameters';
2455     return undef;
2456   }
2457
2458   my $x = $opts{'x'};
2459   my $y = $opts{'y'};
2460   if (ref $x && ref $y) {
2461     unless (@$x == @$y) {
2462       $self->{ERRSTR} = 'length of x and y mismatch';
2463       return undef;
2464     }
2465     my @result;
2466     if ($opts{"type"} eq '8bit') {
2467       for my $i (0..$#{$opts{'x'}}) {
2468         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2469       }
2470     }
2471     else {
2472       for my $i (0..$#{$opts{'x'}}) {
2473         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2474       }
2475     }
2476     return wantarray ? @result : \@result;
2477   }
2478   else {
2479     if ($opts{"type"} eq '8bit') {
2480       return i_get_pixel($self->{IMG}, $x, $y);
2481     }
2482     else {
2483       return i_gpixf($self->{IMG}, $x, $y);
2484     }
2485   }
2486
2487   $self;
2488 }
2489
2490 sub getscanline {
2491   my $self = shift;
2492   my %opts = ( type => '8bit', x=>0, @_);
2493
2494   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2495
2496   unless (defined $opts{'y'}) {
2497     $self->_set_error("missing y parameter");
2498     return;
2499   }
2500
2501   if ($opts{type} eq '8bit') {
2502     return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2503                   $opts{y});
2504   }
2505   elsif ($opts{type} eq 'float') {
2506     return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2507                   $opts{y});
2508   }
2509   else {
2510     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2511     return;
2512   }
2513 }
2514
2515 sub setscanline {
2516   my $self = shift;
2517   my %opts = ( x=>0, @_);
2518
2519   unless (defined $opts{'y'}) {
2520     $self->_set_error("missing y parameter");
2521     return;
2522   }
2523
2524   if (!$opts{type}) {
2525     if (ref $opts{pixels} && @{$opts{pixels}}) {
2526       # try to guess the type
2527       if ($opts{pixels}[0]->isa('Imager::Color')) {
2528         $opts{type} = '8bit';
2529       }
2530       elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
2531         $opts{type} = 'float';
2532       }
2533       else {
2534         $self->_set_error("missing type parameter and could not guess from pixels");
2535         return;
2536       }
2537     }
2538     else {
2539       # default
2540       $opts{type} = '8bit';
2541     }
2542   }
2543
2544   if ($opts{type} eq '8bit') {
2545     if (ref $opts{pixels}) {
2546       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2547     }
2548     else {
2549       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2550     }
2551   }
2552   elsif ($opts{type} eq 'float') {
2553     if (ref $opts{pixels}) {
2554       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2555     }
2556     else {
2557       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2558     }
2559   }
2560   else {
2561     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2562     return;
2563   }
2564 }
2565
2566 sub getsamples {
2567   my $self = shift;
2568   my %opts = ( type => '8bit', x=>0, @_);
2569
2570   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2571
2572   unless (defined $opts{'y'}) {
2573     $self->_set_error("missing y parameter");
2574     return;
2575   }
2576
2577   unless ($opts{channels}) {
2578     $opts{channels} = [ 0 .. $self->getchannels()-1 ];
2579   }
2580
2581   if ($opts{type} eq '8bit') {
2582     return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2583                    $opts{y}, @{$opts{channels}});
2584   }
2585   elsif ($opts{type} eq 'float') {
2586     return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2587                     $opts{y}, @{$opts{channels}});
2588   }
2589   else {
2590     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2591     return;
2592   }
2593 }
2594
2595 # make an identity matrix of the given size
2596 sub _identity {
2597   my ($size) = @_;
2598
2599   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
2600   for my $c (0 .. ($size-1)) {
2601     $matrix->[$c][$c] = 1;
2602   }
2603   return $matrix;
2604 }
2605
2606 # general function to convert an image
2607 sub convert {
2608   my ($self, %opts) = @_;
2609   my $matrix;
2610
2611   unless (defined wantarray) {
2612     my @caller = caller;
2613     warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
2614     return;
2615   }
2616
2617   # the user can either specify a matrix or preset
2618   # the matrix overrides the preset
2619   if (!exists($opts{matrix})) {
2620     unless (exists($opts{preset})) {
2621       $self->{ERRSTR} = "convert() needs a matrix or preset";
2622       return;
2623     }
2624     else {
2625       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2626         # convert to greyscale, keeping the alpha channel if any
2627         if ($self->getchannels == 3) {
2628           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2629         }
2630         elsif ($self->getchannels == 4) {
2631           # preserve the alpha channel
2632           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2633                       [ 0,     0,     0,     1 ] ];
2634         }
2635         else {
2636           # an identity
2637           $matrix = _identity($self->getchannels);
2638         }
2639       }
2640       elsif ($opts{preset} eq 'noalpha') {
2641         # strip the alpha channel
2642         if ($self->getchannels == 2 or $self->getchannels == 4) {
2643           $matrix = _identity($self->getchannels);
2644           pop(@$matrix); # lose the alpha entry
2645         }
2646         else {
2647           $matrix = _identity($self->getchannels);
2648         }
2649       }
2650       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2651         # extract channel 0
2652         $matrix = [ [ 1 ] ];
2653       }
2654       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
2655         $matrix = [ [ 0, 1 ] ];
2656       }
2657       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
2658         $matrix = [ [ 0, 0, 1 ] ];
2659       }
2660       elsif ($opts{preset} eq 'alpha') {
2661         if ($self->getchannels == 2 or $self->getchannels == 4) {
2662           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
2663         }
2664         else {
2665           # the alpha is just 1 <shrug>
2666           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
2667         }
2668       }
2669       elsif ($opts{preset} eq 'rgb') {
2670         if ($self->getchannels == 1) {
2671           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
2672         }
2673         elsif ($self->getchannels == 2) {
2674           # preserve the alpha channel
2675           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
2676         }
2677         else {
2678           $matrix = _identity($self->getchannels);
2679         }
2680       }
2681       elsif ($opts{preset} eq 'addalpha') {
2682         if ($self->getchannels == 1) {
2683           $matrix = _identity(2);
2684         }
2685         elsif ($self->getchannels == 3) {
2686           $matrix = _identity(4);
2687         }
2688         else {
2689           $matrix = _identity($self->getchannels);
2690         }
2691       }
2692       else {
2693         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
2694         return undef;
2695       }
2696     }
2697   }
2698   else {
2699     $matrix = $opts{matrix};
2700   }
2701
2702   my $new = Imager->new();
2703   $new->{IMG} = i_img_new();
2704   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
2705     # most likely a bad matrix
2706     $self->{ERRSTR} = _error_as_msg();
2707     return undef;
2708   }
2709   return $new;
2710 }
2711
2712
2713 # general function to map an image through lookup tables
2714
2715 sub map {
2716   my ($self, %opts) = @_;
2717   my @chlist = qw( red green blue alpha );
2718
2719   if (!exists($opts{'maps'})) {
2720     # make maps from channel maps
2721     my $chnum;
2722     for $chnum (0..$#chlist) {
2723       if (exists $opts{$chlist[$chnum]}) {
2724         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
2725       } elsif (exists $opts{'all'}) {
2726         $opts{'maps'}[$chnum] = $opts{'all'};
2727       }
2728     }
2729   }
2730   if ($opts{'maps'} and $self->{IMG}) {
2731     i_map($self->{IMG}, $opts{'maps'} );
2732   }
2733   return $self;
2734 }
2735
2736 sub difference {
2737   my ($self, %opts) = @_;
2738
2739   defined $opts{mindist} or $opts{mindist} = 0;
2740
2741   defined $opts{other}
2742     or return $self->_set_error("No 'other' parameter supplied");
2743   defined $opts{other}{IMG}
2744     or return $self->_set_error("No image data in 'other' image");
2745
2746   $self->{IMG}
2747     or return $self->_set_error("No image data");
2748
2749   my $result = Imager->new;
2750   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
2751                                 $opts{mindist})
2752     or return $self->_set_error($self->_error_as_msg());
2753
2754   return $result;
2755 }
2756
2757 # destructive border - image is shrunk by one pixel all around
2758
2759 sub border {
2760   my ($self,%opts)=@_;
2761   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
2762   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
2763 }
2764
2765
2766 # Get the width of an image
2767
2768 sub getwidth {
2769   my $self = shift;
2770   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2771   return (i_img_info($self->{IMG}))[0];
2772 }
2773
2774 # Get the height of an image
2775
2776 sub getheight {
2777   my $self = shift;
2778   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2779   return (i_img_info($self->{IMG}))[1];
2780 }
2781
2782 # Get number of channels in an image
2783
2784 sub getchannels {
2785   my $self = shift;
2786   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2787   return i_img_getchannels($self->{IMG});
2788 }
2789
2790 # Get channel mask
2791
2792 sub getmask {
2793   my $self = shift;
2794   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2795   return i_img_getmask($self->{IMG});
2796 }
2797
2798 # Set channel mask
2799
2800 sub setmask {
2801   my $self = shift;
2802   my %opts = @_;
2803   if (!defined($self->{IMG})) {
2804     $self->{ERRSTR} = 'image is empty';
2805     return undef;
2806   }
2807   unless (defined $opts{mask}) {
2808     $self->_set_error("mask parameter required");
2809     return;
2810   }
2811   i_img_setmask( $self->{IMG} , $opts{mask} );
2812
2813   1;
2814 }
2815
2816 # Get number of colors in an image
2817
2818 sub getcolorcount {
2819   my $self=shift;
2820   my %opts=('maxcolors'=>2**30,@_);
2821   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2822   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2823   return ($rc==-1? undef : $rc);
2824 }
2825
2826 # draw string to an image
2827
2828 sub string {
2829   my $self = shift;
2830   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2831
2832   my %input=('x'=>0, 'y'=>0, @_);
2833   $input{string}||=$input{text};
2834
2835   unless(defined $input{string}) {
2836     $self->{ERRSTR}="missing required parameter 'string'";
2837     return;
2838   }
2839
2840   unless($input{font}) {
2841     $self->{ERRSTR}="missing required parameter 'font'";
2842     return;
2843   }
2844
2845   unless ($input{font}->draw(image=>$self, %input)) {
2846     return;
2847   }
2848
2849   return $self;
2850 }
2851
2852 sub align_string {
2853   my $self = shift;
2854
2855   my $img;
2856   if (ref $self) {
2857     unless ($self->{IMG}) {
2858       $self->{ERRSTR}='empty input image';
2859       return;
2860     }
2861     $img = $self;
2862   }
2863   else {
2864     $img = undef;
2865   }
2866
2867   my %input=('x'=>0, 'y'=>0, @_);
2868   $input{string}||=$input{text};
2869
2870   unless(exists $input{string}) {
2871     $self->_set_error("missing required parameter 'string'");
2872     return;
2873   }
2874
2875   unless($input{font}) {
2876     $self->_set_error("missing required parameter 'font'");
2877     return;
2878   }
2879
2880   my @result;
2881   unless (@result = $input{font}->align(image=>$img, %input)) {
2882     return;
2883   }
2884
2885   return wantarray ? @result : $result[0];
2886 }
2887
2888 my @file_limit_names = qw/width height bytes/;
2889
2890 sub set_file_limits {
2891   shift;
2892
2893   my %opts = @_;
2894   my %values;
2895
2896   if ($opts{reset}) {
2897     @values{@file_limit_names} = (0) x @file_limit_names;
2898   }
2899   else {
2900     @values{@file_limit_names} = i_get_image_file_limits();
2901   }
2902
2903   for my $key (keys %values) {
2904     defined $opts{$key} and $values{$key} = $opts{$key};
2905   }
2906
2907   i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
2908 }
2909
2910 sub get_file_limits {
2911   i_get_image_file_limits();
2912 }
2913
2914 # Shortcuts that can be exported
2915
2916 sub newcolor { Imager::Color->new(@_); }
2917 sub newfont  { Imager::Font->new(@_); }
2918
2919 *NC=*newcolour=*newcolor;
2920 *NF=*newfont;
2921
2922 *open=\&read;
2923 *circle=\&arc;
2924
2925
2926 #### Utility routines
2927
2928 sub errstr {
2929   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2930 }
2931
2932 sub _set_error {
2933   my ($self, $msg) = @_;
2934
2935   if (ref $self) {
2936     $self->{ERRSTR} = $msg;
2937   }
2938   else {
2939     $ERRSTR = $msg;
2940   }
2941   return;
2942 }
2943
2944 # Default guess for the type of an image from extension
2945
2946 sub def_guess_type {
2947   my $name=lc(shift);
2948   my $ext;
2949   $ext=($name =~ m/\.([^\.]+)$/)[0];
2950   return 'tiff' if ($ext =~ m/^tiff?$/);
2951   return 'jpeg' if ($ext =~ m/^jpe?g$/);
2952   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
2953   return 'png'  if ($ext eq "png");
2954   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
2955   return 'tga'  if ($ext eq "tga");
2956   return 'rgb'  if ($ext eq "rgb");
2957   return 'gif'  if ($ext eq "gif");
2958   return 'raw'  if ($ext eq "raw");
2959   return ();
2960 }
2961
2962 # get the minimum of a list
2963
2964 sub min {
2965   my $mx=shift;
2966   for(@_) { if ($_<$mx) { $mx=$_; }}
2967   return $mx;
2968 }
2969
2970 # get the maximum of a list
2971
2972 sub max {
2973   my $mx=shift;
2974   for(@_) { if ($_>$mx) { $mx=$_; }}
2975   return $mx;
2976 }
2977
2978 # string stuff for iptc headers
2979
2980 sub clean {
2981   my($str)=$_[0];
2982   $str = substr($str,3);
2983   $str =~ s/[\n\r]//g;
2984   $str =~ s/\s+/ /g;
2985   $str =~ s/^\s//;
2986   $str =~ s/\s$//;
2987   return $str;
2988 }
2989
2990 # A little hack to parse iptc headers.
2991
2992 sub parseiptc {
2993   my $self=shift;
2994   my(@sar,$item,@ar);
2995   my($caption,$photogr,$headln,$credit);
2996
2997   my $str=$self->{IPTCRAW};
2998
2999   #print $str;
3000
3001   @ar=split(/8BIM/,$str);
3002
3003   my $i=0;
3004   foreach (@ar) {
3005     if (/^\004\004/) {
3006       @sar=split(/\034\002/);
3007       foreach $item (@sar) {
3008         if ($item =~ m/^x/) {
3009           $caption=&clean($item);
3010           $i++;
3011         }
3012         if ($item =~ m/^P/) {
3013           $photogr=&clean($item);
3014           $i++;
3015         }
3016         if ($item =~ m/^i/) {
3017           $headln=&clean($item);
3018           $i++;
3019         }
3020         if ($item =~ m/^n/) {
3021           $credit=&clean($item);
3022           $i++;
3023         }
3024       }
3025     }
3026   }
3027   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3028 }
3029
3030 sub Inline {
3031   my ($lang) = @_;
3032
3033   $lang eq 'C'
3034     or die "Only C language supported";
3035
3036   require Imager::ExtUtils;
3037   return Imager::ExtUtils->inline_config;
3038 }
3039
3040 1;
3041 __END__
3042 # Below is the stub of documentation for your module. You better edit it!
3043
3044 =head1 NAME
3045
3046 Imager - Perl extension for Generating 24 bit Images
3047
3048 =head1 SYNOPSIS
3049
3050   # Thumbnail example
3051
3052   #!/usr/bin/perl -w
3053   use strict;
3054   use Imager;
3055
3056   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
3057   my $file = shift;
3058
3059   my $format;
3060
3061   my $img = Imager->new();
3062   # see Imager::Files for information on the read() method
3063   $img->read(file=>$file) or die $img->errstr();
3064
3065   $file =~ s/\.[^.]*$//;
3066
3067   # Create smaller version
3068   # documented in Imager::Transformations
3069   my $thumb = $img->scale(scalefactor=>.3);
3070
3071   # Autostretch individual channels
3072   $thumb->filter(type=>'autolevels');
3073
3074   # try to save in one of these formats
3075   SAVE:
3076
3077   for $format ( qw( png gif jpg tiff ppm ) ) {
3078     # Check if given format is supported
3079     if ($Imager::formats{$format}) {
3080       $file.="_low.$format";
3081       print "Storing image as: $file\n";
3082       # documented in Imager::Files
3083       $thumb->write(file=>$file) or
3084         die $thumb->errstr;
3085       last SAVE;
3086     }
3087   }
3088
3089 =head1 DESCRIPTION
3090
3091 Imager is a module for creating and altering images.  It can read and
3092 write various image formats, draw primitive shapes like lines,and
3093 polygons, blend multiple images together in various ways, scale, crop,
3094 render text and more.
3095
3096 =head2 Overview of documentation
3097
3098 =over
3099
3100 =item *
3101
3102 Imager - This document - Synopsis Example, Table of Contents and
3103 Overview.
3104
3105 =item *
3106
3107 L<Imager::Tutorial> - a brief introduction to Imager.
3108
3109 =item *
3110
3111 L<Imager::Cookbook> - how to do various things with Imager.
3112
3113 =item *
3114
3115 L<Imager::ImageTypes> - Basics of constructing image objects with
3116 C<new()>: Direct type/virtual images, RGB(A)/paletted images,
3117 8/16/double bits/channel, color maps, channel masks, image tags, color
3118 quantization.  Also discusses basic image information methods.
3119
3120 =item *
3121
3122 L<Imager::Files> - IO interaction, reading/writing images, format
3123 specific tags.
3124
3125 =item *
3126
3127 L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
3128 flood fill.
3129
3130 =item *
3131
3132 L<Imager::Color> - Color specification.
3133
3134 =item *
3135
3136 L<Imager::Fill> - Fill pattern specification.
3137
3138 =item *
3139
3140 L<Imager::Font> - General font rendering, bounding boxes and font
3141 metrics.
3142
3143 =item *
3144
3145 L<Imager::Transformations> - Copying, scaling, cropping, flipping,
3146 blending, pasting, convert and map.
3147
3148 =item *
3149
3150 L<Imager::Engines> - Programmable transformations through
3151 C<transform()>, C<transform2()> and C<matrix_transform()>.
3152
3153 =item *
3154
3155 L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
3156 filter plugins.
3157
3158 =item *
3159
3160 L<Imager::Expr> - Expressions for evaluation engine used by
3161 transform2().
3162
3163 =item *
3164
3165 L<Imager::Matrix2d> - Helper class for affine transformations.
3166
3167 =item *
3168
3169 L<Imager::Fountain> - Helper for making gradient profiles.
3170
3171 =item *
3172
3173 L<Imager::API> - using Imager's C API
3174
3175 =item *
3176
3177 L<Imager::APIRef> - API function reference
3178
3179 =item *
3180
3181 L<Imager::Inline> - using Imager's C API from Inline::C
3182
3183 =item *
3184
3185 L<Imager::ExtUtils> - tools to get access to Imager's C API.
3186
3187 =back
3188
3189 =head2 Basic Overview
3190
3191 An Image object is created with C<$img = Imager-E<gt>new()>.
3192 Examples:
3193
3194   $img=Imager->new();                         # create empty image
3195   $img->read(file=>'lena.png',type=>'png') or # read image from file
3196      die $img->errstr();                      # give an explanation
3197                                               # if something failed
3198
3199 or if you want to create an empty image:
3200
3201   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
3202
3203 This example creates a completely black image of width 400 and height
3204 300 and 4 channels.
3205
3206 When an operation fails which can be directly associated with an image
3207 the error message is stored can be retrieved with
3208 C<$img-E<gt>errstr()>.
3209
3210 In cases where no image object is associated with an operation
3211 C<$Imager::ERRSTR> is used to report errors not directly associated
3212 with an image object.  You can also call C<Imager->errstr> to get this
3213 value.
3214
3215 The C<Imager-E<gt>new> method is described in detail in
3216 L<Imager::ImageTypes>.
3217
3218 =head1 METHOD INDEX
3219
3220 Where to find information on methods for Imager class objects.
3221
3222 addcolors() -  L<Imager::ImageTypes/addcolors>
3223
3224 addtag() -  L<Imager::ImageTypes/addtag> - add image tags
3225
3226 arc() - L<Imager::Draw/arc>
3227
3228 align_string() - L<Imager::Draw/align_string>
3229
3230 bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
3231 image
3232
3233 box() - L<Imager::Draw/box>
3234
3235 circle() - L<Imager::Draw/circle>
3236
3237 colorcount() - L<Imager::Draw/colorcount>
3238
3239 convert() - L<Imager::Transformations/"Color transformations"> -
3240 transform the color space
3241
3242 copy() - L<Imager::Transformations/copy>
3243
3244 crop() - L<Imager::Transformations/crop> - extract part of an image
3245
3246 deltag() -  L<Imager::ImageTypes/deltag> - delete image tags
3247
3248 difference() - L<Imager::Filters/"Image Difference">
3249
3250 errstr() - L<"Basic Overview">
3251
3252 filter() - L<Imager::Filters>
3253
3254 findcolor() - L<Imager::ImageTypes/findcolor> - search the image palette, if it
3255 has one
3256
3257 flip() - L<Imager::Transformations/flip>
3258
3259 flood_fill() - L<Imager::Draw/flood_fill>
3260
3261 getchannels() -  L<Imager::ImageTypes/getchannels>
3262
3263 getcolorcount() -  L<Imager::ImageTypes/getcolorcount>
3264
3265 getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
3266 palette, if it has one
3267
3268 get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3269
3270 getheight() - L<Imager::ImageTypes/getwidth>
3271
3272 getpixel() - L<Imager::Draw/getpixel>
3273
3274 getsamples() - L<Imager::Draw/getsamples>
3275
3276 getscanline() - L<Imager::Draw/getscanline>
3277
3278 getwidth() - L<Imager::ImageTypes/getwidth>
3279
3280 img_set() - L<Imager::ImageTypes/img_set>
3281
3282 line() - L<Imager::Draw/line>
3283
3284 map() - L<Imager::Transformations/"Color Mappings"> - remap color
3285 channel values
3286
3287 masked() -  L<Imager::ImageTypes/masked> - make a masked image
3288
3289 matrix_transform() - L<Imager::Engines/"Matrix Transformations">
3290
3291 maxcolors() - L<Imager::ImageTypes/maxcolors>
3292
3293 new() - L<Imager::ImageTypes/new>
3294
3295 open() - L<Imager::Files> - an alias for read()
3296
3297 paste() - L<Imager::Transformations/paste> - draw an image onto an image
3298
3299 polygon() - L<Imager::Draw/polygon>
3300
3301 polyline() - L<Imager::Draw/polyline>
3302
3303 read() - L<Imager::Files> - read a single image from an image file
3304
3305 read_multi() - L<Imager::Files> - read multiple images from an image
3306 file
3307
3308 rotate() - L<Imager::Transformations/rotate>
3309
3310 rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
3311 image and use the alpha channel
3312
3313 scale() - L<Imager::Transformations/scale>
3314
3315 setscanline() - L<Imager::Draw/setscanline>
3316
3317 scaleX() - L<Imager::Transformations/scaleX>
3318
3319 scaleY() - L<Imager::Transformations/scaleY>
3320
3321 setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
3322 a paletted image
3323
3324 setpixel() - L<Imager::Draw/setpixel>
3325
3326 set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3327
3328 string() - L<Imager::Draw/string> - draw text on an image
3329
3330 tags() -  L<Imager::ImageTypes/tags> - fetch image tags
3331
3332 to_paletted() -  L<Imager::ImageTypes/to_paletted>
3333
3334 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
3335
3336 transform() - L<Imager::Engines/"transform">
3337
3338 transform2() - L<Imager::Engines/"transform2">
3339
3340 type() -  L<Imager::ImageTypes/type> - type of image (direct vs paletted)
3341
3342 virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
3343 data
3344
3345 write() - L<Imager::Files> - write an image to a file
3346
3347 write_multi() - L<Imager::Files> - write multiple image to an image
3348 file.
3349
3350 =head1 CONCEPT INDEX
3351
3352 animated GIF - L<Imager::File/"Writing an animated GIF">
3353
3354 aspect ratio - L<Imager::ImageTypes/i_xres>,
3355 L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
3356
3357 blend - alpha blending one image onto another
3358 L<Imager::Transformations/rubthrough>
3359
3360 blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
3361
3362 boxes, drawing - L<Imager::Draw/box>
3363
3364 changes between image - L<Imager::Filter/"Image Difference">
3365
3366 color - L<Imager::Color>
3367
3368 color names - L<Imager::Color>, L<Imager::Color::Table>
3369
3370 combine modes - L<Imager::Fill/combine>
3371
3372 compare images - L<Imager::Filter/"Image Difference">
3373
3374 contrast - L<Imager::Filter/contrast>, L<Imager::Filter/autolevels>
3375
3376 convolution - L<Imager::Filter/conv>
3377
3378 cropping - L<Imager::Transformations/crop>
3379
3380 C<diff> images - L<Imager::Filter/"Image Difference">
3381
3382 dpi - L<Imager::ImageTypes/i_xres>
3383
3384 drawing boxes - L<Imager::Draw/box>
3385
3386 drawing lines - L<Imager::Draw/line>
3387
3388 drawing text - L<Imager::Font/string>, L<Imager::Font/align>
3389
3390 error message - L<"Basic Overview">
3391
3392 files, font - L<Imager::Font>
3393
3394 files, image - L<Imager::Files>
3395
3396 filling, types of fill - L<Imager::Fill>
3397
3398 filling, boxes - L<Imager::Draw/box>
3399
3400 filling, flood fill - L<Imager::Draw/flood_fill>
3401
3402 flood fill - L<Imager::Draw/flood_fill>
3403
3404 fonts - L<Imager::Font>
3405
3406 fonts, drawing with - L<Imager::Font/string>, L<Imager::Font/align>,
3407 L<Imager::Font::Wrap>
3408
3409 fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3410
3411 fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
3412
3413 fountain fill - L<Imager::Fill/"Fountain fills">,
3414 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3415 L<Imager::Filters/gradgen>
3416
3417 GIF files - L<Imager::Files/"GIF">
3418
3419 GIF files, animated - L<Imager::File/"Writing an animated GIF">
3420
3421 gradient fill - L<Imager::Fill/"Fountain fills">,
3422 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3423 L<Imager::Filters/gradgen>
3424
3425 guassian blur - L<Imager::Filter/guassian>
3426
3427 hatch fills - L<Imager::Fill/"Hatched fills">
3428
3429 invert image - L<Imager::Filter/hardinvert>
3430
3431 JPEG - L<Imager::Files/"JPEG">
3432
3433 limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
3434
3435 lines, drawing - L<Imager::Draw/line>
3436
3437 matrix - L<Imager::Matrix2d>,
3438 L<Imager::Transformations/"Matrix Transformations">,
3439 L<Imager::Font/transform>
3440
3441 metadata, image - L<Imager::ImageTypes/"Tags">
3442
3443 mosaic - L<Imager::Filter/mosaic>
3444
3445 noise, filter - L<Imager::Filter/noise>
3446
3447 noise, rendered - L<Imager::Filter/turbnoise>,
3448 L<Imager::Filter/radnoise>
3449
3450 paste - L<Imager::Transformations/paste>,
3451 L<Imager::Transformations/rubthrough>
3452
3453 pseudo-color image - L<Imager::ImageTypes/to_paletted>,
3454 L<Imager::ImageTypes/new>
3455
3456 posterize - L<Imager::Filter/postlevels>
3457
3458 png files - L<Imager::Files>, L<Imager::Files/"PNG">
3459
3460 pnm - L<Imager::Files/"PNM (Portable aNy Map)">
3461
3462 rectangles, drawing - L<Imager::Draw/box>
3463
3464 resizing an image - L<Imager::Transformations/scale>,
3465 L<Imager::Transformations/crop>
3466
3467 saving an image - L<Imager::Files>
3468
3469 scaling - L<Imager::Transformations/scale>
3470
3471 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
3472
3473 size, image - L<Imager::ImageTypes/getwidth>,
3474 L<Imager::ImageTypes/getheight>
3475
3476 size, text - L<Imager::Font/bounding_box>
3477
3478 tags, image metadata - L<Imager::ImageTypes/"Tags">
3479
3480 text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
3481 L<Imager::Font::Wrap>
3482
3483 text, wrapping text in an area - L<Imager::Font::Wrap>
3484
3485 text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3486
3487 tiles, color - L<Imager::Filter/mosaic>
3488
3489 unsharp mask - L<Imager::Filter/unsharpmask>
3490
3491 watermark - L<Imager::Filter/watermark>
3492
3493 writing an image to a file - L<Imager::Files>
3494
3495 =head1 SUPPORT
3496
3497 You can ask for help, report bugs or express your undying love for
3498 Imager on the Imager-devel mailing list.
3499
3500 To subscribe send a message with C<subscribe> in the body to:
3501
3502    imager-devel+request@molar.is
3503
3504 or use the form at:
3505
3506 =over
3507
3508 L<http://www.molar.is/en/lists/imager-devel/>
3509
3510 =back
3511
3512 where you can also find the mailing list archive.
3513
3514 If you're into IRC, you can typically find the developers in #Imager
3515 on irc.perl.org.  As with any IRC channel, the participants could be
3516 occupied or asleep, so please be patient.
3517
3518 You can report bugs by pointing your browser at:
3519
3520 =over
3521
3522 L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
3523
3524 =back
3525
3526 Please remember to include the versions of Imager, perl, supporting
3527 libraries, and any relevant code.  If you have specific images that
3528 cause the problems, please include those too.
3529
3530 =head1 BUGS
3531
3532 Bugs are listed individually for relevant pod pages.
3533
3534 =head1 AUTHOR
3535
3536 Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
3537 others. See the README for a complete list.
3538
3539 =head1 SEE ALSO
3540
3541 L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
3542 L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
3543 L<Imager::Font>(3), L<Imager::Transformations>(3),
3544 L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
3545 L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
3546
3547 L<http://imager.perl.org/>
3548
3549 L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
3550
3551 Other perl imaging modules include:
3552
3553 L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
3554
3555 =cut