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