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