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