Imager.pm

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