Imager.pm

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