Imager.pm

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