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_02';
 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   unless ($self->{IMG}) {
 896     $self->_set_error("empty input image");
 897     return;
 898   }
 899
 900   my @colors = @{$opts{colors}}
 901     or return undef;
 902
 903   for my $color (@colors) {
 904     $color = _color($color);
 905     unless ($color) {
 906       $self->_set_error($Imager::ERRSTR);
 907       return;
 908     }
 909   }
 910
 911   return i_addcolors($self->{IMG}, @colors);
 912 }
 913
 914 sub setcolors {
 915   my $self = shift;
 916   my %opts = (start=>0, colors=>[], @_);
 917
 918   unless ($self->{IMG}) {
 919     $self->_set_error("empty input image");
 920     return;
 921   }
 922
 923   my @colors = @{$opts{colors}}
 924     or return undef;
 925
 926   for my $color (@colors) {
 927     $color = _color($color);
 928     unless ($color) {
 929       $self->_set_error($Imager::ERRSTR);
 930       return;
 931     }
 932   }
 933
 934   return i_setcolors($self->{IMG}, $opts{start}, @colors);
 935 }
 936
 937 sub getcolors {
 938   my $self = shift;
 939   my %opts = @_;
 940   if (!exists $opts{start} && !exists $opts{count}) {
 941     # get them all
 942     $opts{start} = 0;
 943     $opts{count} = $self->colorcount;
 944   }
 945   elsif (!exists $opts{count}) {
 946     $opts{count} = 1;
 947   }
 948   elsif (!exists $opts{start}) {
 949     $opts{start} = 0;
 950   }
 951
 952   $self->{IMG} and
 953     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
 954 }
 955
 956 sub colorcount {
 957   i_colorcount($_[0]{IMG});
 958 }
 959
 960 sub maxcolors {
 961   i_maxcolors($_[0]{IMG});
 962 }
 963
 964 sub findcolor {
 965   my $self = shift;
 966   my %opts = @_;
 967   $opts{color} or return undef;
 968
 969   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
 970 }
 971
 972 sub bits {
 973   my $self = shift;
 974   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
 975   if ($bits && $bits == length(pack("d", 1)) * 8) {
 976     $bits = 'double';
 977   }
 978   $bits;
 979 }
 980
 981 sub type {
 982   my $self = shift;
 983   if ($self->{IMG}) {
 984     return i_img_type($self->{IMG}) ? "paletted" : "direct";
 985   }
 986 }
 987
 988 sub virtual {
 989   my $self = shift;
 990   $self->{IMG} and i_img_virtual($self->{IMG});
 991 }
 992
 993 sub tags {
 994   my ($self, %opts) = @_;
 995
 996   $self->{IMG} or return;
 997
 998   if (defined $opts{name}) {
 999     my @result;
1000     my $start = 0;
1001     my $found;
1002     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
1003       push @result, (i_tags_get($self->{IMG}, $found))[1];
1004       $start = $found+1;
1005     }
1006     return wantarray ? @result : $result[0];
1007   }
1008   elsif (defined $opts{code}) {
1009     my @result;
1010     my $start = 0;
1011     my $found;
1012     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
1013       push @result, (i_tags_get($self->{IMG}, $found))[1];
1014       $start = $found+1;
1015     }
1016     return @result;
1017   }
1018   else {
1019     if (wantarray) {
1020       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
1021     }
1022     else {
1023       return i_tags_count($self->{IMG});
1024     }
1025   }
1026 }
1027
1028 sub addtag {
1029   my $self = shift;
1030   my %opts = @_;
1031
1032   return -1 unless $self->{IMG};
1033   if ($opts{name}) {
1034     if (defined $opts{value}) {
1035       if ($opts{value} =~ /^\d+$/) {
1036         # add as a number
1037         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
1038       }
1039       else {
1040         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
1041       }
1042     }
1043     elsif (defined $opts{data}) {
1044       # force addition as a string
1045       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
1046     }
1047     else {
1048       $self->{ERRSTR} = "No value supplied";
1049       return undef;
1050     }
1051   }
1052   elsif ($opts{code}) {
1053     if (defined $opts{value}) {
1054       if ($opts{value} =~ /^\d+$/) {
1055         # add as a number
1056         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
1057       }
1058       else {
1059         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
1060       }
1061     }
1062     elsif (defined $opts{data}) {
1063       # force addition as a string
1064       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
1065     }
1066     else {
1067       $self->{ERRSTR} = "No value supplied";
1068       return undef;
1069     }
1070   }
1071   else {
1072     return undef;
1073   }
1074 }
1075
1076 sub deltag {
1077   my $self = shift;
1078   my %opts = @_;
1079
1080   return 0 unless $self->{IMG};
1081
1082   if (defined $opts{'index'}) {
1083     return i_tags_delete($self->{IMG}, $opts{'index'});
1084   }
1085   elsif (defined $opts{name}) {
1086     return i_tags_delbyname($self->{IMG}, $opts{name});
1087   }
1088   elsif (defined $opts{code}) {
1089     return i_tags_delbycode($self->{IMG}, $opts{code});
1090   }
1091   else {
1092     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
1093     return 0;
1094   }
1095 }
1096
1097 sub settag {
1098   my ($self, %opts) = @_;
1099
1100   if ($opts{name}) {
1101     $self->deltag(name=>$opts{name});
1102     return $self->addtag(name=>$opts{name}, value=>$opts{value});
1103   }
1104   elsif (defined $opts{code}) {
1105     $self->deltag(code=>$opts{code});
1106     return $self->addtag(code=>$opts{code}, value=>$opts{value});
1107   }
1108   else {
1109     return undef;
1110   }
1111 }
1112
1113
1114 sub _get_reader_io {
1115   my ($self, $input) = @_;
1116
1117         if ($input->{io}) {
1118                 return $input->{io}, undef;
1119         }
1120   elsif ($input->{fd}) {
1121     return io_new_fd($input->{fd});
1122   }
1123   elsif ($input->{fh}) {
1124     my $fd = fileno($input->{fh});
1125     unless ($fd) {
1126       $self->_set_error("Handle in fh option not opened");
1127       return;
1128     }
1129     return io_new_fd($fd);
1130   }
1131   elsif ($input->{file}) {
1132     my $file = IO::File->new($input->{file}, "r");
1133     unless ($file) {
1134       $self->_set_error("Could not open $input->{file}: $!");
1135       return;
1136     }
1137     binmode $file;
1138     return (io_new_fd(fileno($file)), $file);
1139   }
1140   elsif ($input->{data}) {
1141     return io_new_buffer($input->{data});
1142   }
1143   elsif ($input->{callback} || $input->{readcb}) {
1144     if (!$input->{seekcb}) {
1145       $self->_set_error("Need a seekcb parameter");
1146     }
1147     if ($input->{maxbuffer}) {
1148       return io_new_cb($input->{writecb},
1149                        $input->{callback} || $input->{readcb},
1150                        $input->{seekcb}, $input->{closecb},
1151                        $input->{maxbuffer});
1152     }
1153     else {
1154       return io_new_cb($input->{writecb},
1155                        $input->{callback} || $input->{readcb},
1156                        $input->{seekcb}, $input->{closecb});
1157     }
1158   }
1159   else {
1160     $self->_set_error("file/fd/fh/data/callback parameter missing");
1161     return;
1162   }
1163 }
1164
1165 sub _get_writer_io {
1166   my ($self, $input, $type) = @_;
1167
1168   if ($input->{fd}) {
1169     return io_new_fd($input->{fd});
1170   }
1171   elsif ($input->{fh}) {
1172     my $fd = fileno($input->{fh});
1173     unless ($fd) {
1174       $self->_set_error("Handle in fh option not opened");
1175       return;
1176     }
1177     # flush it
1178     my $oldfh = select($input->{fh});
1179     # flush anything that's buffered, and make sure anything else is flushed
1180     $| = 1;
1181     select($oldfh);
1182     return io_new_fd($fd);
1183   }
1184   elsif ($input->{file}) {
1185     my $fh = new IO::File($input->{file},"w+");
1186     unless ($fh) {
1187       $self->_set_error("Could not open file $input->{file}: $!");
1188       return;
1189     }
1190     binmode($fh) or die;
1191     return (io_new_fd(fileno($fh)), $fh);
1192   }
1193   elsif ($input->{data}) {
1194     return io_new_bufchain();
1195   }
1196   elsif ($input->{callback} || $input->{writecb}) {
1197     if ($input->{maxbuffer}) {
1198       return io_new_cb($input->{callback} || $input->{writecb},
1199                        $input->{readcb},
1200                        $input->{seekcb}, $input->{closecb},
1201                        $input->{maxbuffer});
1202     }
1203     else {
1204       return io_new_cb($input->{callback} || $input->{writecb},
1205                        $input->{readcb},
1206                        $input->{seekcb}, $input->{closecb});
1207     }
1208   }
1209   else {
1210     $self->_set_error("file/fd/fh/data/callback parameter missing");
1211     return;
1212   }
1213 }
1214
1215 # Read an image from file
1216
1217 sub read {
1218   my $self = shift;
1219   my %input=@_;
1220
1221   if (defined($self->{IMG})) {
1222     # let IIM_DESTROY do the destruction, since the image may be
1223     # referenced from elsewhere
1224     #i_img_destroy($self->{IMG});
1225     undef($self->{IMG});
1226   }
1227
1228   my ($IO, $fh) = $self->_get_reader_io(\%input) or return;
1229
1230   unless ($input{'type'}) {
1231     $input{'type'} = i_test_format_probe($IO, -1);
1232   }
1233
1234   unless ($input{'type'}) {
1235           $self->_set_error('type parameter missing and not possible to guess from extension');
1236     return undef;
1237   }
1238
1239   _reader_autoload($input{type});
1240
1241   if ($readers{$input{type}} && $readers{$input{type}}{single}) {
1242     return $readers{$input{type}}{single}->($self, $IO, %input);
1243   }
1244
1245   unless ($formats{$input{'type'}}) {
1246     $self->_set_error("format '$input{'type'}' not supported");
1247     return;
1248   }
1249
1250   # Setup data source
1251   if ( $input{'type'} eq 'jpeg' ) {
1252     ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO );
1253     if ( !defined($self->{IMG}) ) {
1254       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1255     }
1256     $self->{DEBUG} && print "loading a jpeg file\n";
1257     return $self;
1258   }
1259
1260   if ( $input{'type'} eq 'tiff' ) {
1261     my $page = $input{'page'};
1262     defined $page or $page = 0;
1263     # Fixme, check if that length parameter is ever needed
1264     $self->{IMG}=i_readtiff_wiol( $IO, -1, $page );
1265     if ( !defined($self->{IMG}) ) {
1266       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1267     }
1268     $self->{DEBUG} && print "loading a tiff file\n";
1269     return $self;
1270   }
1271
1272   if ( $input{'type'} eq 'pnm' ) {
1273     $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1274     if ( !defined($self->{IMG}) ) {
1275       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg();
1276       return undef;
1277     }
1278     $self->{DEBUG} && print "loading a pnm file\n";
1279     return $self;
1280   }
1281
1282   if ( $input{'type'} eq 'png' ) {
1283     $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1284     if ( !defined($self->{IMG}) ) {
1285       $self->{ERRSTR} = $self->_error_as_msg();
1286       return undef;
1287     }
1288     $self->{DEBUG} && print "loading a png file\n";
1289   }
1290
1291   if ( $input{'type'} eq 'bmp' ) {
1292     $self->{IMG}=i_readbmp_wiol( $IO );
1293     if ( !defined($self->{IMG}) ) {
1294       $self->{ERRSTR}=$self->_error_as_msg();
1295       return undef;
1296     }
1297     $self->{DEBUG} && print "loading a bmp file\n";
1298   }
1299
1300   if ( $input{'type'} eq 'gif' ) {
1301     if ($input{colors} && !ref($input{colors})) {
1302       # must be a reference to a scalar that accepts the colour map
1303       $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1304       return undef;
1305     }
1306     if ($input{'gif_consolidate'}) {
1307       if ($input{colors}) {
1308         my $colors;
1309         ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
1310         if ($colors) {
1311           ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1312         }
1313       }
1314       else {
1315         $self->{IMG} =i_readgif_wiol( $IO );
1316       }
1317     }
1318     else {
1319       my $page = $input{'page'};
1320       defined $page or $page = 0;
1321       $self->{IMG} = i_readgif_single_wiol( $IO, $page );
1322       if ($input{colors}) {
1323         ${ $input{colors} } =
1324           [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ];
1325       }
1326     }
1327
1328     if ( !defined($self->{IMG}) ) {
1329       $self->{ERRSTR}=$self->_error_as_msg();
1330       return undef;
1331     }
1332     $self->{DEBUG} && print "loading a gif file\n";
1333   }
1334
1335   if ( $input{'type'} eq 'tga' ) {
1336     $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1337     if ( !defined($self->{IMG}) ) {
1338       $self->{ERRSTR}=$self->_error_as_msg();
1339       return undef;
1340     }
1341     $self->{DEBUG} && print "loading a tga file\n";
1342   }
1343
1344   if ( $input{'type'} eq 'rgb' ) {
1345     $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1346     if ( !defined($self->{IMG}) ) {
1347       $self->{ERRSTR}=$self->_error_as_msg();
1348       return undef;
1349     }
1350     $self->{DEBUG} && print "loading a tga file\n";
1351   }
1352
1353
1354   if ( $input{'type'} eq 'raw' ) {
1355     my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
1356
1357     if ( !($params{xsize} && $params{ysize}) ) {
1358       $self->{ERRSTR}='missing xsize or ysize parameter for raw';
1359       return undef;
1360     }
1361
1362     $self->{IMG} = i_readraw_wiol( $IO,
1363                                    $params{xsize},
1364                                    $params{ysize},
1365                                    $params{datachannels},
1366                                    $params{storechannels},
1367                                    $params{interleave});
1368     if ( !defined($self->{IMG}) ) {
1369       $self->{ERRSTR}=$self->_error_as_msg();
1370       return undef;
1371     }
1372     $self->{DEBUG} && print "loading a raw file\n";
1373   }
1374
1375   return $self;
1376 }
1377
1378 sub register_reader {
1379   my ($class, %opts) = @_;
1380
1381   defined $opts{type}
1382     or die "register_reader called with no type parameter\n";
1383
1384   my $type = $opts{type};
1385
1386   defined $opts{single} || defined $opts{multiple}
1387     or die "register_reader called with no single or multiple parameter\n";
1388
1389   $readers{$type} = {  };
1390   if ($opts{single}) {
1391     $readers{$type}{single} = $opts{single};
1392   }
1393   if ($opts{multiple}) {
1394     $readers{$type}{multiple} = $opts{multiple};
1395   }
1396
1397   return 1;
1398 }
1399
1400 sub register_writer {
1401   my ($class, %opts) = @_;
1402
1403   defined $opts{type}
1404     or die "register_writer called with no type parameter\n";
1405
1406   my $type = $opts{type};
1407
1408   defined $opts{single} || defined $opts{multiple}
1409     or die "register_writer called with no single or multiple parameter\n";
1410
1411   $writers{$type} = {  };
1412   if ($opts{single}) {
1413     $writers{$type}{single} = $opts{single};
1414   }
1415   if ($opts{multiple}) {
1416     $writers{$type}{multiple} = $opts{multiple};
1417   }
1418
1419   return 1;
1420 }
1421
1422 # probes for an Imager::File::whatever module
1423 sub _reader_autoload {
1424   my $type = shift;
1425
1426   return if $formats{$type} || $readers{$type};
1427
1428   return unless $type =~ /^\w+$/;
1429
1430   my $file = "Imager/File/\U$type\E.pm";
1431
1432   unless ($attempted_to_load{$file}) {
1433     eval {
1434       ++$attempted_to_load{$file};
1435       require $file;
1436     };
1437     if ($@) {
1438       # try to get a reader specific module
1439       my $file = "Imager/File/\U$type\EReader.pm";
1440       unless ($attempted_to_load{$file}) {
1441         eval {
1442           ++$attempted_to_load{$file};
1443           require $file;
1444         };
1445       }
1446     }
1447   }
1448 }
1449
1450 # probes for an Imager::File::whatever module
1451 sub _writer_autoload {
1452   my $type = shift;
1453
1454   return if $formats{$type} || $readers{$type};
1455
1456   return unless $type =~ /^\w+$/;
1457
1458   my $file = "Imager/File/\U$type\E.pm";
1459
1460   unless ($attempted_to_load{$file}) {
1461     eval {
1462       ++$attempted_to_load{$file};
1463       require $file;
1464     };
1465     if ($@) {
1466       # try to get a writer specific module
1467       my $file = "Imager/File/\U$type\EWriter.pm";
1468       unless ($attempted_to_load{$file}) {
1469         eval {
1470           ++$attempted_to_load{$file};
1471           require $file;
1472         };
1473       }
1474     }
1475   }
1476 }
1477
1478 sub _fix_gif_positions {
1479   my ($opts, $opt, $msg, @imgs) = @_;
1480
1481   my $positions = $opts->{'gif_positions'};
1482   my $index = 0;
1483   for my $pos (@$positions) {
1484     my ($x, $y) = @$pos;
1485     my $img = $imgs[$index++];
1486     $img->settag(name=>'gif_left', value=>$x);
1487     $img->settag(name=>'gif_top', value=>$y) if defined $y;
1488   }
1489   $$msg .= "replaced with the gif_left and gif_top tags";
1490 }
1491
1492 my %obsolete_opts =
1493   (
1494    gif_each_palette=>'gif_local_map',
1495    interlace       => 'gif_interlace',
1496    gif_delays => 'gif_delay',
1497    gif_positions => \&_fix_gif_positions,
1498    gif_loop_count => 'gif_loop',
1499   );
1500
1501 sub _set_opts {
1502   my ($self, $opts, $prefix, @imgs) = @_;
1503
1504   for my $opt (keys %$opts) {
1505     my $tagname = $opt;
1506     if ($obsolete_opts{$opt}) {
1507       my $new = $obsolete_opts{$opt};
1508       my $msg = "Obsolete option $opt ";
1509       if (ref $new) {
1510         $new->($opts, $opt, \$msg, @imgs);
1511       }
1512       else {
1513         $msg .= "replaced with the $new tag ";
1514         $tagname = $new;
1515       }
1516       $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1];
1517       warn $msg if $warn_obsolete && $^W;
1518     }
1519     next unless $tagname =~ /^\Q$prefix/;
1520     my $value = $opts->{$opt};
1521     if (ref $value) {
1522       if (UNIVERSAL::isa($value, "Imager::Color")) {
1523         my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1524         for my $img (@imgs) {
1525           $img->settag(name=>$tagname, value=>$tag);
1526         }
1527       }
1528       elsif (ref($value) eq 'ARRAY') {
1529         for my $i (0..$#$value) {
1530           my $val = $value->[$i];
1531           if (ref $val) {
1532             if (UNIVERSAL::isa($val, "Imager::Color")) {
1533               my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1534               $i < @imgs and
1535                 $imgs[$i]->settag(name=>$tagname, value=>$tag);
1536             }
1537             else {
1538               $self->_set_error("Unknown reference type " . ref($value) .
1539                                 " supplied in array for $opt");
1540               return;
1541             }
1542           }
1543           else {
1544             $i < @imgs
1545               and $imgs[$i]->settag(name=>$tagname, value=>$val);
1546           }
1547         }
1548       }
1549       else {
1550         $self->_set_error("Unknown reference type " . ref($value) .
1551                           " supplied for $opt");
1552         return;
1553       }
1554     }
1555     else {
1556       # set it as a tag for every image
1557       for my $img (@imgs) {
1558         $img->settag(name=>$tagname, value=>$value);
1559       }
1560     }
1561   }
1562
1563   return 1;
1564 }
1565
1566 # Write an image to file
1567 sub write {
1568   my $self = shift;
1569   my %input=(jpegquality=>75,
1570              gifquant=>'mc',
1571              lmdither=>6.0,
1572              lmfixed=>[],
1573              idstring=>"",
1574              compress=>1,
1575              wierdpack=>0,
1576              fax_fine=>1, @_);
1577   my $rc;
1578
1579   $self->_set_opts(\%input, "i_", $self)
1580     or return undef;
1581
1582   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1583
1584   if (!$input{'type'} and $input{file}) {
1585     $input{'type'}=$FORMATGUESS->($input{file});
1586   }
1587   if (!$input{'type'}) {
1588     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1589     return undef;
1590   }
1591
1592   _writer_autoload($input{type});
1593
1594   my ($IO, $fh);
1595   if ($writers{$input{type}} && $writers{$input{type}}{single}) {
1596     ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1597       or return undef;
1598
1599     $writers{$input{type}}{single}->($self, $IO, %input)
1600       or return undef;
1601   }
1602   else {
1603     if (!$formats{$input{'type'}}) {
1604       $self->{ERRSTR}='format not supported';
1605       return undef;
1606     }
1607
1608     ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1609       or return undef;
1610
1611     if ($input{'type'} eq 'tiff') {
1612       $self->_set_opts(\%input, "tiff_", $self)
1613         or return undef;
1614       $self->_set_opts(\%input, "exif_", $self)
1615         or return undef;
1616
1617       if (defined $input{class} && $input{class} eq 'fax') {
1618         if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1619           $self->{ERRSTR} = $self->_error_as_msg();
1620           return undef;
1621         }
1622       } else {
1623         if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1624           $self->{ERRSTR} = $self->_error_as_msg();
1625           return undef;
1626         }
1627       }
1628     } elsif ( $input{'type'} eq 'pnm' ) {
1629       $self->_set_opts(\%input, "pnm_", $self)
1630         or return undef;
1631       if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1632         $self->{ERRSTR} = $self->_error_as_msg();
1633         return undef;
1634       }
1635       $self->{DEBUG} && print "writing a pnm file\n";
1636     } elsif ( $input{'type'} eq 'raw' ) {
1637       $self->_set_opts(\%input, "raw_", $self)
1638         or return undef;
1639       if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1640         $self->{ERRSTR} = $self->_error_as_msg();
1641         return undef;
1642       }
1643       $self->{DEBUG} && print "writing a raw file\n";
1644     } elsif ( $input{'type'} eq 'png' ) {
1645       $self->_set_opts(\%input, "png_", $self)
1646         or return undef;
1647       if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1648         $self->{ERRSTR}='unable to write png image';
1649         return undef;
1650       }
1651       $self->{DEBUG} && print "writing a png file\n";
1652     } elsif ( $input{'type'} eq 'jpeg' ) {
1653       $self->_set_opts(\%input, "jpeg_", $self)
1654         or return undef;
1655       $self->_set_opts(\%input, "exif_", $self)
1656         or return undef;
1657       if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1658         $self->{ERRSTR} = $self->_error_as_msg();
1659         return undef;
1660       }
1661       $self->{DEBUG} && print "writing a jpeg file\n";
1662     } elsif ( $input{'type'} eq 'bmp' ) {
1663       $self->_set_opts(\%input, "bmp_", $self)
1664         or return undef;
1665       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1666         $self->{ERRSTR}='unable to write bmp image';
1667         return undef;
1668       }
1669       $self->{DEBUG} && print "writing a bmp file\n";
1670     } elsif ( $input{'type'} eq 'tga' ) {
1671       $self->_set_opts(\%input, "tga_", $self)
1672         or return undef;
1673
1674       if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1675         $self->{ERRSTR}=$self->_error_as_msg();
1676         return undef;
1677       }
1678       $self->{DEBUG} && print "writing a tga file\n";
1679     } elsif ( $input{'type'} eq 'gif' ) {
1680       $self->_set_opts(\%input, "gif_", $self)
1681         or return undef;
1682       # compatibility with the old interfaces
1683       if ($input{gifquant} eq 'lm') {
1684         $input{make_colors} = 'addi';
1685         $input{translate} = 'perturb';
1686         $input{perturb} = $input{lmdither};
1687       } elsif ($input{gifquant} eq 'gen') {
1688         # just pass options through
1689       } else {
1690         $input{make_colors} = 'webmap'; # ignored
1691         $input{translate} = 'giflib';
1692       }
1693       if (!i_writegif_wiol($IO, \%input, $self->{IMG})) {
1694         $self->{ERRSTR} = $self->_error_as_msg;
1695         return;
1696       }
1697     }
1698   }
1699
1700   if (exists $input{'data'}) {
1701     my $data = io_slurp($IO);
1702     if (!$data) {
1703       $self->{ERRSTR}='Could not slurp from buffer';
1704       return undef;
1705     }
1706     ${$input{data}} = $data;
1707   }
1708   return $self;
1709 }
1710
1711 sub write_multi {
1712   my ($class, $opts, @images) = @_;
1713
1714   my $type = $opts->{type};
1715
1716   if (!$type && $opts->{'file'}) {
1717     $type = $FORMATGUESS->($opts->{'file'});
1718   }
1719   unless ($type) {
1720     $class->_set_error('type parameter missing and not possible to guess from extension');
1721     return;
1722   }
1723   # translate to ImgRaw
1724   if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1725     $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
1726     return 0;
1727   }
1728   $class->_set_opts($opts, "i_", @images)
1729     or return;
1730   my @work = map $_->{IMG}, @images;
1731
1732   _writer_autoload($type);
1733
1734   my ($IO, $file);
1735   if ($writers{$type} && $writers{$type}{multiple}) {
1736     ($IO, $file) = $class->_get_writer_io($opts, $type)
1737       or return undef;
1738
1739     $writers{$type}{multiple}->($class, $IO, $opts, @images)
1740       or return undef;
1741   }
1742   else {
1743     if (!$formats{$type}) {
1744       $class->_set_error("format $type not supported");
1745       return undef;
1746     }
1747
1748     ($IO, $file) = $class->_get_writer_io($opts, $type)
1749       or return undef;
1750
1751     if ($type eq 'gif') {
1752       $class->_set_opts($opts, "gif_", @images)
1753         or return;
1754       my $gif_delays = $opts->{gif_delays};
1755       local $opts->{gif_delays} = $gif_delays;
1756       if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
1757         # assume the caller wants the same delay for each frame
1758         $opts->{gif_delays} = [ ($gif_delays) x @images ];
1759       }
1760       unless (i_writegif_wiol($IO, $opts, @work)) {
1761         $class->_set_error($class->_error_as_msg());
1762         return undef;
1763       }
1764     }
1765     elsif ($type eq 'tiff') {
1766       $class->_set_opts($opts, "tiff_", @images)
1767         or return;
1768       $class->_set_opts($opts, "exif_", @images)
1769         or return;
1770       my $res;
1771       $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
1772       if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
1773         $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
1774       }
1775       else {
1776         $res = i_writetiff_multi_wiol($IO, @work);
1777       }
1778       unless ($res) {
1779         $class->_set_error($class->_error_as_msg());
1780         return undef;
1781       }
1782     }
1783     else {
1784       $ERRSTR = "Sorry, write_multi doesn't support $type yet";
1785       return 0;
1786     }
1787   }
1788
1789   if (exists $opts->{'data'}) {
1790     my $data = io_slurp($IO);
1791     if (!$data) {
1792       Imager->_set_error('Could not slurp from buffer');
1793       return undef;
1794     }
1795     ${$opts->{data}} = $data;
1796   }
1797   return 1;
1798 }
1799
1800 # read multiple images from a file
1801 sub read_multi {
1802   my ($class, %opts) = @_;
1803
1804   my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
1805     or return;
1806
1807   my $type = $opts{'type'};
1808   unless ($type) {
1809     $type = i_test_format_probe($IO, -1);
1810   }
1811
1812   if ($opts{file} && !$type) {
1813     # guess the type
1814     $type = $FORMATGUESS->($opts{file});
1815   }
1816
1817   unless ($type) {
1818     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1819     return;
1820   }
1821
1822   _reader_autoload($type);
1823
1824   if ($readers{$type} && $readers{$type}{multiple}) {
1825     return $readers{$type}{multiple}->($IO, %opts);
1826   }
1827
1828   if ($type eq 'gif') {
1829     my @imgs;
1830     @imgs = i_readgif_multi_wiol($IO);
1831     if (@imgs) {
1832       return map {
1833         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1834       } @imgs;
1835     }
1836     else {
1837       $ERRSTR = _error_as_msg();
1838       return;
1839     }
1840   }
1841   elsif ($type eq 'tiff') {
1842     my @imgs = i_readtiff_multi_wiol($IO, -1);
1843     if (@imgs) {
1844       return map {
1845         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1846       } @imgs;
1847     }
1848     else {
1849       $ERRSTR = _error_as_msg();
1850       return;
1851     }
1852   }
1853
1854   $ERRSTR = "Cannot read multiple images from $type files";
1855   return;
1856 }
1857
1858 # Destroy an Imager object
1859
1860 sub DESTROY {
1861   my $self=shift;
1862   #    delete $instances{$self};
1863   if (defined($self->{IMG})) {
1864     # the following is now handled by the XS DESTROY method for
1865     # Imager::ImgRaw object
1866     # Re-enabling this will break virtual images
1867     # tested for in t/t020masked.t
1868     # i_img_destroy($self->{IMG});
1869     undef($self->{IMG});
1870   } else {
1871 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1872   }
1873 }
1874
1875 # Perform an inplace filter of an image
1876 # that is the image will be overwritten with the data
1877
1878 sub filter {
1879   my $self=shift;
1880   my %input=@_;
1881   my %hsh;
1882   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1883
1884   if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1885
1886   if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
1887     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1888   }
1889
1890   if ($filters{$input{'type'}}{names}) {
1891     my $names = $filters{$input{'type'}}{names};
1892     for my $name (keys %$names) {
1893       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1894         $input{$name} = $names->{$name}{$input{$name}};
1895       }
1896     }
1897   }
1898   if (defined($filters{$input{'type'}}{defaults})) {
1899     %hsh=( image => $self->{IMG},
1900            imager => $self,
1901            %{$filters{$input{'type'}}{defaults}},
1902            %input );
1903   } else {
1904     %hsh=( image => $self->{IMG},
1905            imager => $self,
1906            %input );
1907   }
1908
1909   my @cs=@{$filters{$input{'type'}}{callseq}};
1910
1911   for(@cs) {
1912     if (!defined($hsh{$_})) {
1913       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1914     }
1915   }
1916
1917   eval {
1918     local $SIG{__DIE__}; # we don't want this processed by confess, etc
1919     &{$filters{$input{'type'}}{callsub}}(%hsh);
1920   };
1921   if ($@) {
1922     chomp($self->{ERRSTR} = $@);
1923     return;
1924   }
1925
1926   my @b=keys %hsh;
1927
1928   $self->{DEBUG} && print "callseq is: @cs\n";
1929   $self->{DEBUG} && print "matching callseq is: @b\n";
1930
1931   return $self;
1932 }
1933
1934 sub register_filter {
1935   my $class = shift;
1936   my %hsh = ( defaults => {}, @_ );
1937
1938   defined $hsh{type}
1939     or die "register_filter() with no type\n";
1940   defined $hsh{callsub}
1941     or die "register_filter() with no callsub\n";
1942   defined $hsh{callseq}
1943     or die "register_filter() with no callseq\n";
1944
1945   exists $filters{$hsh{type}}
1946     and return;
1947
1948   $filters{$hsh{type}} = \%hsh;
1949
1950   return 1;
1951 }
1952
1953 # Scale an image to requested size and return the scaled version
1954
1955 sub scale {
1956   my $self=shift;
1957   my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
1958   my $img = Imager->new();
1959   my $tmp = Imager->new();
1960
1961   my $scalefactor = $opts{scalefactor};
1962
1963   unless (defined wantarray) {
1964     my @caller = caller;
1965     warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
1966     return;
1967   }
1968
1969   unless ($self->{IMG}) {
1970     $self->_set_error('empty input image');
1971     return undef;
1972   }
1973
1974   # work out the scaling
1975   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
1976     my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() ,
1977                         $opts{ypixels} / $self->getheight() );
1978     if ($opts{'type'} eq 'min') {
1979       $scalefactor = _min($xpix,$ypix);
1980     }
1981     elsif ($opts{'type'} eq 'max') {
1982       $scalefactor = _max($xpix,$ypix);
1983     }
1984     else {
1985       $self->_set_error('invalid value for type parameter');
1986       return undef;
1987     }
1988   } elsif ($opts{xpixels}) {
1989     $scalefactor = $opts{xpixels} / $self->getwidth();
1990   }
1991   elsif ($opts{ypixels}) {
1992     $scalefactor = $opts{ypixels}/$self->getheight();
1993   }
1994   elsif ($opts{constrain} && ref $opts{constrain}
1995          && $opts{constrain}->can('constrain')) {
1996     # we've been passed an Image::Math::Constrain object or something
1997     # that looks like one
1998     (undef, undef, $scalefactor)
1999       = $opts{constrain}->constrain($self->getwidth, $self->getheight);
2000     unless ($scalefactor) {
2001       $self->_set_error('constrain method failed on constrain parameter');
2002       return undef;
2003     }
2004   }
2005
2006   if ($opts{qtype} eq 'normal') {
2007     $tmp->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
2008     if ( !defined($tmp->{IMG}) ) {
2009       $self->{ERRSTR} = 'unable to scale image';
2010       return undef;
2011     }
2012     $img->{IMG}=i_scaleaxis($tmp->{IMG}, $scalefactor, 1);
2013     if ( !defined($img->{IMG}) ) {
2014       $self->{ERRSTR}='unable to scale image';
2015       return undef;
2016     }
2017
2018     return $img;
2019   }
2020   elsif ($opts{'qtype'} eq 'preview') {
2021     $img->{IMG} = i_scale_nn($self->{IMG}, $scalefactor, $scalefactor);
2022     if ( !defined($img->{IMG}) ) {
2023       $self->{ERRSTR}='unable to scale image';
2024       return undef;
2025     }
2026     return $img;
2027   }
2028   else {
2029     $self->_set_error('invalid value for qtype parameter');
2030     return undef;
2031   }
2032 }
2033
2034 # Scales only along the X axis
2035
2036 sub scaleX {
2037   my $self = shift;
2038   my %opts = ( scalefactor=>0.5, @_ );
2039
2040   unless (defined wantarray) {
2041     my @caller = caller;
2042     warn "scaleX() called in void context - scaleX() returns the scaled image at $caller[1] line $caller[2]\n";
2043     return;
2044   }
2045
2046   unless ($self->{IMG}) {
2047     $self->{ERRSTR} = 'empty input image';
2048     return undef;
2049   }
2050
2051   my $img = Imager->new();
2052
2053   my $scalefactor = $opts{scalefactor};
2054
2055   if ($opts{pixels}) {
2056     $scalefactor = $opts{pixels} / $self->getwidth();
2057   }
2058
2059   unless ($self->{IMG}) {
2060     $self->{ERRSTR}='empty input image';
2061     return undef;
2062   }
2063
2064   $img->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
2065
2066   if ( !defined($img->{IMG}) ) {
2067     $self->{ERRSTR} = 'unable to scale image';
2068     return undef;
2069   }
2070
2071   return $img;
2072 }
2073
2074 # Scales only along the Y axis
2075
2076 sub scaleY {
2077   my $self = shift;
2078   my %opts = ( scalefactor => 0.5, @_ );
2079
2080   unless (defined wantarray) {
2081     my @caller = caller;
2082     warn "scaleY() called in void context - scaleY() returns the scaled image at $caller[1] line $caller[2]\n";
2083     return;
2084   }
2085
2086   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2087
2088   my $img = Imager->new();
2089
2090   my $scalefactor = $opts{scalefactor};
2091
2092   if ($opts{pixels}) {
2093     $scalefactor = $opts{pixels} / $self->getheight();
2094   }
2095
2096   unless ($self->{IMG}) {
2097     $self->{ERRSTR} = 'empty input image';
2098     return undef;
2099   }
2100   $img->{IMG}=i_scaleaxis($self->{IMG}, $scalefactor, 1);
2101
2102   if ( !defined($img->{IMG}) ) {
2103     $self->{ERRSTR} = 'unable to scale image';
2104     return undef;
2105   }
2106
2107   return $img;
2108 }
2109
2110 # Transform returns a spatial transformation of the input image
2111 # this moves pixels to a new location in the returned image.
2112 # NOTE - should make a utility function to check transforms for
2113 # stack overruns
2114
2115 sub transform {
2116   my $self=shift;
2117   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2118   my %opts=@_;
2119   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
2120
2121 #  print Dumper(\%opts);
2122 #  xopcopdes
2123
2124   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
2125     if (!$I2P) {
2126       eval ("use Affix::Infix2Postfix;");
2127       print $@;
2128       if ( $@ ) {
2129         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
2130         return undef;
2131       }
2132       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
2133                                              {op=>'-',trans=>'Sub'},
2134                                              {op=>'*',trans=>'Mult'},
2135                                              {op=>'/',trans=>'Div'},
2136                                              {op=>'-','type'=>'unary',trans=>'u-'},
2137                                              {op=>'**'},
2138                                              {op=>'func','type'=>'unary'}],
2139                                      'grouping'=>[qw( \( \) )],
2140                                      'func'=>[qw( sin cos )],
2141                                      'vars'=>[qw( x y )]
2142                                     );
2143     }
2144
2145     @xt=$I2P->translate($opts{'xexpr'});
2146     @yt=$I2P->translate($opts{'yexpr'});
2147
2148     $numre=$I2P->{'numre'};
2149     @pt=(0,0);
2150
2151     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
2152     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
2153     @{$opts{'parm'}}=@pt;
2154   }
2155
2156 #  print Dumper(\%opts);
2157
2158   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
2159     $self->{ERRSTR}='transform: no xopcodes given.';
2160     return undef;
2161   }
2162
2163   @op=@{$opts{'xopcodes'}};
2164   for $iop (@op) {
2165     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2166       $self->{ERRSTR}="transform: illegal opcode '$_'.";
2167       return undef;
2168     }
2169     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2170   }
2171
2172
2173 # yopcopdes
2174
2175   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
2176     $self->{ERRSTR}='transform: no yopcodes given.';
2177     return undef;
2178   }
2179
2180   @op=@{$opts{'yopcodes'}};
2181   for $iop (@op) {
2182     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2183       $self->{ERRSTR}="transform: illegal opcode '$_'.";
2184       return undef;
2185     }
2186     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2187   }
2188
2189 #parameters
2190
2191   if ( !exists $opts{'parm'}) {
2192     $self->{ERRSTR}='transform: no parameter arg given.';
2193     return undef;
2194   }
2195
2196 #  print Dumper(\@ropx);
2197 #  print Dumper(\@ropy);
2198 #  print Dumper(\@ropy);
2199
2200   my $img = Imager->new();
2201   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
2202   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
2203   return $img;
2204 }
2205
2206
2207 sub transform2 {
2208   my ($opts, @imgs) = @_;
2209
2210   require "Imager/Expr.pm";
2211
2212   $opts->{variables} = [ qw(x y) ];
2213   my ($width, $height) = @{$opts}{qw(width height)};
2214   if (@imgs) {
2215     $width ||= $imgs[0]->getwidth();
2216     $height ||= $imgs[0]->getheight();
2217     my $img_num = 1;
2218     for my $img (@imgs) {
2219       $opts->{constants}{"w$img_num"} = $img->getwidth();
2220       $opts->{constants}{"h$img_num"} = $img->getheight();
2221       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
2222       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
2223       ++$img_num;
2224     }
2225   }
2226   if ($width) {
2227     $opts->{constants}{w} = $width;
2228     $opts->{constants}{cx} = $width/2;
2229   }
2230   else {
2231     $Imager::ERRSTR = "No width supplied";
2232     return;
2233   }
2234   if ($height) {
2235     $opts->{constants}{h} = $height;
2236     $opts->{constants}{cy} = $height/2;
2237   }
2238   else {
2239     $Imager::ERRSTR = "No height supplied";
2240     return;
2241   }
2242   my $code = Imager::Expr->new($opts);
2243   if (!$code) {
2244     $Imager::ERRSTR = Imager::Expr::error();
2245     return;
2246   }
2247   my $channels = $opts->{channels} || 3;
2248   unless ($channels >= 1 && $channels <= 4) {
2249     return Imager->_set_error("channels must be an integer between 1 and 4");
2250   }
2251
2252   my $img = Imager->new();
2253   $img->{IMG} = i_transform2($opts->{width}, $opts->{height},
2254                              $channels, $code->code(),
2255                              $code->nregs(), $code->cregs(),
2256                              [ map { $_->{IMG} } @imgs ]);
2257   if (!defined $img->{IMG}) {
2258     $Imager::ERRSTR = Imager->_error_as_msg();
2259     return;
2260   }
2261
2262   return $img;
2263 }
2264
2265 sub rubthrough {
2266   my $self=shift;
2267   my %opts=(tx => 0,ty => 0, @_);
2268
2269   unless ($self->{IMG}) {
2270     $self->{ERRSTR}='empty input image';
2271     return undef;
2272   }
2273   unless ($opts{src} && $opts{src}->{IMG}) {
2274     $self->{ERRSTR}='empty input image for src';
2275     return undef;
2276   }
2277
2278   %opts = (src_minx => 0,
2279            src_miny => 0,
2280            src_maxx => $opts{src}->getwidth(),
2281            src_maxy => $opts{src}->getheight(),
2282            %opts);
2283
2284   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
2285                     $opts{src_minx}, $opts{src_miny},
2286                     $opts{src_maxx}, $opts{src_maxy})) {
2287     $self->_set_error($self->_error_as_msg());
2288     return undef;
2289   }
2290   return $self;
2291 }
2292
2293
2294 sub flip {
2295   my $self  = shift;
2296   my %opts  = @_;
2297   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
2298   my $dir;
2299   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
2300   $dir = $xlate{$opts{'dir'}};
2301   return $self if i_flipxy($self->{IMG}, $dir);
2302   return ();
2303 }
2304
2305 sub rotate {
2306   my $self = shift;
2307   my %opts = @_;
2308
2309   unless (defined wantarray) {
2310     my @caller = caller;
2311     warn "rotate() called in void context - rotate() returns the rotated image at $caller[1] line $caller[2]\n";
2312     return;
2313   }
2314
2315   if (defined $opts{right}) {
2316     my $degrees = $opts{right};
2317     if ($degrees < 0) {
2318       $degrees += 360 * int(((-$degrees)+360)/360);
2319     }
2320     $degrees = $degrees % 360;
2321     if ($degrees == 0) {
2322       return $self->copy();
2323     }
2324     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
2325       my $result = Imager->new();
2326       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
2327         return $result;
2328       }
2329       else {
2330         $self->{ERRSTR} = $self->_error_as_msg();
2331         return undef;
2332       }
2333     }
2334     else {
2335       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
2336       return undef;
2337     }
2338   }
2339   elsif (defined $opts{radians} || defined $opts{degrees}) {
2340     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
2341
2342     my $back = $opts{back};
2343     my $result = Imager->new;
2344     if ($back) {
2345       $back = _color($back);
2346       unless ($back) {
2347         $self->_set_error(Imager->errstr);
2348         return undef;
2349       }
2350
2351       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $back);
2352     }
2353     else {
2354       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);
2355     }
2356     if ($result->{IMG}) {
2357       return $result;
2358     }
2359     else {
2360       $self->{ERRSTR} = $self->_error_as_msg();
2361       return undef;
2362     }
2363   }
2364   else {
2365     $self->{ERRSTR} = "Only the 'right', 'radians' and 'degrees' parameters are available";
2366     return undef;
2367   }
2368 }
2369
2370 sub matrix_transform {
2371   my $self = shift;
2372   my %opts = @_;
2373
2374   unless (defined wantarray) {
2375     my @caller = caller;
2376     warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
2377     return;
2378   }
2379
2380   if ($opts{matrix}) {
2381     my $xsize = $opts{xsize} || $self->getwidth;
2382     my $ysize = $opts{ysize} || $self->getheight;
2383
2384     my $result = Imager->new;
2385     if ($opts{back}) {
2386       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2387                                           $opts{matrix}, $opts{back})
2388         or return undef;
2389     }
2390     else {
2391       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2392                                           $opts{matrix})
2393         or return undef;
2394     }
2395
2396     return $result;
2397   }
2398   else {
2399     $self->{ERRSTR} = "matrix parameter required";
2400     return undef;
2401   }
2402 }
2403
2404 # blame Leolo :)
2405 *yatf = \&matrix_transform;
2406
2407 # These two are supported for legacy code only
2408
2409 sub i_color_new {
2410   return Imager::Color->new(@_);
2411 }
2412
2413 sub i_color_set {
2414   return Imager::Color::set(@_);
2415 }
2416
2417 # Draws a box between the specified corner points.
2418 sub box {
2419   my $self=shift;
2420   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2421   my $dflcl=i_color_new(255,255,255,255);
2422   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
2423
2424   if (exists $opts{'box'}) {
2425     $opts{'xmin'} = _min($opts{'box'}->[0],$opts{'box'}->[2]);
2426     $opts{'xmax'} = _max($opts{'box'}->[0],$opts{'box'}->[2]);
2427     $opts{'ymin'} = _min($opts{'box'}->[1],$opts{'box'}->[3]);
2428     $opts{'ymax'} = _max($opts{'box'}->[1],$opts{'box'}->[3]);
2429   }
2430
2431   if ($opts{filled}) {
2432     my $color = _color($opts{'color'});
2433     unless ($color) {
2434       $self->{ERRSTR} = $Imager::ERRSTR;
2435       return;
2436     }
2437     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2438                  $opts{ymax}, $color);
2439   }
2440   elsif ($opts{fill}) {
2441     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2442       # assume it's a hash ref
2443       require 'Imager/Fill.pm';
2444       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2445         $self->{ERRSTR} = $Imager::ERRSTR;
2446         return undef;
2447       }
2448     }
2449     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2450                 $opts{ymax},$opts{fill}{fill});
2451   }
2452   else {
2453     my $color = _color($opts{'color'});
2454     unless ($color) {
2455       $self->{ERRSTR} = $Imager::ERRSTR;
2456       return;
2457     }
2458     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
2459           $color);
2460   }
2461   return $self;
2462 }
2463
2464 sub arc {
2465   my $self=shift;
2466   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2467   my $dflcl=i_color_new(255,255,255,255);
2468   my %opts=(color=>$dflcl,
2469             'r'=>_min($self->getwidth(),$self->getheight())/3,
2470             'x'=>$self->getwidth()/2,
2471             'y'=>$self->getheight()/2,
2472             'd1'=>0, 'd2'=>361, @_);
2473   if ($opts{aa}) {
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_aa_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       if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2493         i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
2494                     $color);
2495       }
2496       else {
2497         i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2498                  $opts{'d1'}, $opts{'d2'}, $color);
2499       }
2500     }
2501   }
2502   else {
2503     if ($opts{fill}) {
2504       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2505         # assume it's a hash ref
2506         require 'Imager/Fill.pm';
2507         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2508           $self->{ERRSTR} = $Imager::ERRSTR;
2509           return;
2510         }
2511       }
2512       i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2513                   $opts{'d2'}, $opts{fill}{fill});
2514     }
2515     else {
2516       my $color = _color($opts{'color'});
2517       unless ($color) {
2518         $self->{ERRSTR} = $Imager::ERRSTR;
2519         return;
2520       }
2521       i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2522             $opts{'d1'}, $opts{'d2'}, $color);
2523     }
2524   }
2525
2526   return $self;
2527 }
2528
2529 # Draws a line from one point to the other
2530 # the endpoint is set if the endp parameter is set which it is by default.
2531 # to turn of the endpoint being set use endp=>0 when calling line.
2532
2533 sub line {
2534   my $self=shift;
2535   my $dflcl=i_color_new(0,0,0,0);
2536   my %opts=(color=>$dflcl,
2537             endp => 1,
2538             @_);
2539   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2540
2541   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2542   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2543
2544   my $color = _color($opts{'color'});
2545   unless ($color) {
2546     $self->{ERRSTR} = $Imager::ERRSTR;
2547     return;
2548   }
2549
2550   $opts{antialias} = $opts{aa} if defined $opts{aa};
2551   if ($opts{antialias}) {
2552     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2553               $color, $opts{endp});
2554   } else {
2555     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2556            $color, $opts{endp});
2557   }
2558   return $self;
2559 }
2560
2561 # Draws a line between an ordered set of points - It more or less just transforms this
2562 # into a list of lines.
2563
2564 sub polyline {
2565   my $self=shift;
2566   my ($pt,$ls,@points);
2567   my $dflcl=i_color_new(0,0,0,0);
2568   my %opts=(color=>$dflcl,@_);
2569
2570   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2571
2572   if (exists($opts{points})) { @points=@{$opts{points}}; }
2573   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2574     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2575     }
2576
2577 #  print Dumper(\@points);
2578
2579   my $color = _color($opts{'color'});
2580   unless ($color) {
2581     $self->{ERRSTR} = $Imager::ERRSTR;
2582     return;
2583   }
2584   $opts{antialias} = $opts{aa} if defined $opts{aa};
2585   if ($opts{antialias}) {
2586     for $pt(@points) {
2587       if (defined($ls)) {
2588         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2589       }
2590       $ls=$pt;
2591     }
2592   } else {
2593     for $pt(@points) {
2594       if (defined($ls)) {
2595         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2596       }
2597       $ls=$pt;
2598     }
2599   }
2600   return $self;
2601 }
2602
2603 sub polygon {
2604   my $self = shift;
2605   my ($pt,$ls,@points);
2606   my $dflcl = i_color_new(0,0,0,0);
2607   my %opts = (color=>$dflcl, @_);
2608
2609   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2610
2611   if (exists($opts{points})) {
2612     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2613     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2614   }
2615
2616   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2617     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2618   }
2619
2620   if ($opts{'fill'}) {
2621     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2622       # assume it's a hash ref
2623       require 'Imager/Fill.pm';
2624       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2625         $self->{ERRSTR} = $Imager::ERRSTR;
2626         return undef;
2627       }
2628     }
2629     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2630                     $opts{'fill'}{'fill'});
2631   }
2632   else {
2633     my $color = _color($opts{'color'});
2634     unless ($color) {
2635       $self->{ERRSTR} = $Imager::ERRSTR;
2636       return;
2637     }
2638     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2639   }
2640
2641   return $self;
2642 }
2643
2644
2645 # this the multipoint bezier curve
2646 # this is here more for testing that actual usage since
2647 # this is not a good algorithm.  Usually the curve would be
2648 # broken into smaller segments and each done individually.
2649
2650 sub polybezier {
2651   my $self=shift;
2652   my ($pt,$ls,@points);
2653   my $dflcl=i_color_new(0,0,0,0);
2654   my %opts=(color=>$dflcl,@_);
2655
2656   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2657
2658   if (exists $opts{points}) {
2659     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2660     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2661   }
2662
2663   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2664     $self->{ERRSTR}='Missing or invalid points.';
2665     return;
2666   }
2667
2668   my $color = _color($opts{'color'});
2669   unless ($color) {
2670     $self->{ERRSTR} = $Imager::ERRSTR;
2671     return;
2672   }
2673   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2674   return $self;
2675 }
2676
2677 sub flood_fill {
2678   my $self = shift;
2679   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2680   my $rc;
2681
2682   unless (exists $opts{'x'} && exists $opts{'y'}) {
2683     $self->{ERRSTR} = "missing seed x and y parameters";
2684     return undef;
2685   }
2686
2687   if ($opts{border}) {
2688     my $border = _color($opts{border});
2689     unless ($border) {
2690       $self->_set_error($Imager::ERRSTR);
2691       return;
2692     }
2693     if ($opts{fill}) {
2694       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2695         # assume it's a hash ref
2696         require Imager::Fill;
2697         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2698           $self->{ERRSTR} = $Imager::ERRSTR;
2699           return;
2700         }
2701       }
2702       $rc = i_flood_cfill_border($self->{IMG}, $opts{'x'}, $opts{'y'},
2703                                  $opts{fill}{fill}, $border);
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_border($self->{IMG}, $opts{'x'}, $opts{'y'},
2712                                 $color, $border);
2713     }
2714     if ($rc) {
2715       return $self;
2716     }
2717     else {
2718       $self->{ERRSTR} = $self->_error_as_msg();
2719       return;
2720     }
2721   }
2722   else {
2723     if ($opts{fill}) {
2724       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2725         # assume it's a hash ref
2726         require 'Imager/Fill.pm';
2727         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2728           $self->{ERRSTR} = $Imager::ERRSTR;
2729           return;
2730         }
2731       }
2732       $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2733     }
2734     else {
2735       my $color = _color($opts{'color'});
2736       unless ($color) {
2737         $self->{ERRSTR} = $Imager::ERRSTR;
2738         return;
2739       }
2740       $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2741     }
2742     if ($rc) {
2743       return $self;
2744     }
2745     else {
2746       $self->{ERRSTR} = $self->_error_as_msg();
2747       return;
2748     }
2749   }
2750 }
2751
2752 sub setpixel {
2753   my $self = shift;
2754
2755   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2756
2757   unless (exists $opts{'x'} && exists $opts{'y'}) {
2758     $self->{ERRSTR} = 'missing x and y parameters';
2759     return undef;
2760   }
2761
2762   my $x = $opts{'x'};
2763   my $y = $opts{'y'};
2764   my $color = _color($opts{color})
2765     or return undef;
2766   if (ref $x && ref $y) {
2767     unless (@$x == @$y) {
2768       $self->{ERRSTR} = 'length of x and y mismatch';
2769       return undef;
2770     }
2771     if ($color->isa('Imager::Color')) {
2772       for my $i (0..$#{$opts{'x'}}) {
2773         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2774       }
2775     }
2776     else {
2777       for my $i (0..$#{$opts{'x'}}) {
2778         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2779       }
2780     }
2781   }
2782   else {
2783     if ($color->isa('Imager::Color')) {
2784       i_ppix($self->{IMG}, $x, $y, $color);
2785     }
2786     else {
2787       i_ppixf($self->{IMG}, $x, $y, $color);
2788     }
2789   }
2790
2791   $self;
2792 }
2793
2794 sub getpixel {
2795   my $self = shift;
2796
2797   my %opts = ( "type"=>'8bit', @_);
2798
2799   unless (exists $opts{'x'} && exists $opts{'y'}) {
2800     $self->{ERRSTR} = 'missing x and y parameters';
2801     return undef;
2802   }
2803
2804   my $x = $opts{'x'};
2805   my $y = $opts{'y'};
2806   if (ref $x && ref $y) {
2807     unless (@$x == @$y) {
2808       $self->{ERRSTR} = 'length of x and y mismatch';
2809       return undef;
2810     }
2811     my @result;
2812     if ($opts{"type"} eq '8bit') {
2813       for my $i (0..$#{$opts{'x'}}) {
2814         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2815       }
2816     }
2817     else {
2818       for my $i (0..$#{$opts{'x'}}) {
2819         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2820       }
2821     }
2822     return wantarray ? @result : \@result;
2823   }
2824   else {
2825     if ($opts{"type"} eq '8bit') {
2826       return i_get_pixel($self->{IMG}, $x, $y);
2827     }
2828     else {
2829       return i_gpixf($self->{IMG}, $x, $y);
2830     }
2831   }
2832
2833   $self;
2834 }
2835
2836 sub getscanline {
2837   my $self = shift;
2838   my %opts = ( type => '8bit', x=>0, @_);
2839
2840   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2841
2842   unless (defined $opts{'y'}) {
2843     $self->_set_error("missing y parameter");
2844     return;
2845   }
2846
2847   if ($opts{type} eq '8bit') {
2848     return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2849                   $opts{y});
2850   }
2851   elsif ($opts{type} eq 'float') {
2852     return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2853                   $opts{y});
2854   }
2855   else {
2856     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2857     return;
2858   }
2859 }
2860
2861 sub setscanline {
2862   my $self = shift;
2863   my %opts = ( x=>0, @_);
2864
2865   unless (defined $opts{'y'}) {
2866     $self->_set_error("missing y parameter");
2867     return;
2868   }
2869
2870   if (!$opts{type}) {
2871     if (ref $opts{pixels} && @{$opts{pixels}}) {
2872       # try to guess the type
2873       if ($opts{pixels}[0]->isa('Imager::Color')) {
2874         $opts{type} = '8bit';
2875       }
2876       elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
2877         $opts{type} = 'float';
2878       }
2879       else {
2880         $self->_set_error("missing type parameter and could not guess from pixels");
2881         return;
2882       }
2883     }
2884     else {
2885       # default
2886       $opts{type} = '8bit';
2887     }
2888   }
2889
2890   if ($opts{type} eq '8bit') {
2891     if (ref $opts{pixels}) {
2892       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2893     }
2894     else {
2895       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2896     }
2897   }
2898   elsif ($opts{type} eq 'float') {
2899     if (ref $opts{pixels}) {
2900       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2901     }
2902     else {
2903       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2904     }
2905   }
2906   else {
2907     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2908     return;
2909   }
2910 }
2911
2912 sub getsamples {
2913   my $self = shift;
2914   my %opts = ( type => '8bit', x=>0, @_);
2915
2916   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2917
2918   unless (defined $opts{'y'}) {
2919     $self->_set_error("missing y parameter");
2920     return;
2921   }
2922
2923   unless ($opts{channels}) {
2924     $opts{channels} = [ 0 .. $self->getchannels()-1 ];
2925   }
2926
2927   if ($opts{type} eq '8bit') {
2928     return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2929                    $opts{y}, @{$opts{channels}});
2930   }
2931   elsif ($opts{type} eq 'float') {
2932     return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2933                     $opts{y}, @{$opts{channels}});
2934   }
2935   else {
2936     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2937     return;
2938   }
2939 }
2940
2941 # make an identity matrix of the given size
2942 sub _identity {
2943   my ($size) = @_;
2944
2945   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
2946   for my $c (0 .. ($size-1)) {
2947     $matrix->[$c][$c] = 1;
2948   }
2949   return $matrix;
2950 }
2951
2952 # general function to convert an image
2953 sub convert {
2954   my ($self, %opts) = @_;
2955   my $matrix;
2956
2957   unless (defined wantarray) {
2958     my @caller = caller;
2959     warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
2960     return;
2961   }
2962
2963   # the user can either specify a matrix or preset
2964   # the matrix overrides the preset
2965   if (!exists($opts{matrix})) {
2966     unless (exists($opts{preset})) {
2967       $self->{ERRSTR} = "convert() needs a matrix or preset";
2968       return;
2969     }
2970     else {
2971       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2972         # convert to greyscale, keeping the alpha channel if any
2973         if ($self->getchannels == 3) {
2974           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2975         }
2976         elsif ($self->getchannels == 4) {
2977           # preserve the alpha channel
2978           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2979                       [ 0,     0,     0,     1 ] ];
2980         }
2981         else {
2982           # an identity
2983           $matrix = _identity($self->getchannels);
2984         }
2985       }
2986       elsif ($opts{preset} eq 'noalpha') {
2987         # strip the alpha channel
2988         if ($self->getchannels == 2 or $self->getchannels == 4) {
2989           $matrix = _identity($self->getchannels);
2990           pop(@$matrix); # lose the alpha entry
2991         }
2992         else {
2993           $matrix = _identity($self->getchannels);
2994         }
2995       }
2996       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2997         # extract channel 0
2998         $matrix = [ [ 1 ] ];
2999       }
3000       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
3001         $matrix = [ [ 0, 1 ] ];
3002       }
3003       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
3004         $matrix = [ [ 0, 0, 1 ] ];
3005       }
3006       elsif ($opts{preset} eq 'alpha') {
3007         if ($self->getchannels == 2 or $self->getchannels == 4) {
3008           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
3009         }
3010         else {
3011           # the alpha is just 1 <shrug>
3012           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
3013         }
3014       }
3015       elsif ($opts{preset} eq 'rgb') {
3016         if ($self->getchannels == 1) {
3017           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
3018         }
3019         elsif ($self->getchannels == 2) {
3020           # preserve the alpha channel
3021           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
3022         }
3023         else {
3024           $matrix = _identity($self->getchannels);
3025         }
3026       }
3027       elsif ($opts{preset} eq 'addalpha') {
3028         if ($self->getchannels == 1) {
3029           $matrix = _identity(2);
3030         }
3031         elsif ($self->getchannels == 3) {
3032           $matrix = _identity(4);
3033         }
3034         else {
3035           $matrix = _identity($self->getchannels);
3036         }
3037       }
3038       else {
3039         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
3040         return undef;
3041       }
3042     }
3043   }
3044   else {
3045     $matrix = $opts{matrix};
3046   }
3047
3048   my $new = Imager->new();
3049   $new->{IMG} = i_img_new();
3050   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
3051     # most likely a bad matrix
3052     $self->{ERRSTR} = _error_as_msg();
3053     return undef;
3054   }
3055   return $new;
3056 }
3057
3058
3059 # general function to map an image through lookup tables
3060
3061 sub map {
3062   my ($self, %opts) = @_;
3063   my @chlist = qw( red green blue alpha );
3064
3065   if (!exists($opts{'maps'})) {
3066     # make maps from channel maps
3067     my $chnum;
3068     for $chnum (0..$#chlist) {
3069       if (exists $opts{$chlist[$chnum]}) {
3070         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
3071       } elsif (exists $opts{'all'}) {
3072         $opts{'maps'}[$chnum] = $opts{'all'};
3073       }
3074     }
3075   }
3076   if ($opts{'maps'} and $self->{IMG}) {
3077     i_map($self->{IMG}, $opts{'maps'} );
3078   }
3079   return $self;
3080 }
3081
3082 sub difference {
3083   my ($self, %opts) = @_;
3084
3085   defined $opts{mindist} or $opts{mindist} = 0;
3086
3087   defined $opts{other}
3088     or return $self->_set_error("No 'other' parameter supplied");
3089   defined $opts{other}{IMG}
3090     or return $self->_set_error("No image data in 'other' image");
3091
3092   $self->{IMG}
3093     or return $self->_set_error("No image data");
3094
3095   my $result = Imager->new;
3096   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
3097                                 $opts{mindist})
3098     or return $self->_set_error($self->_error_as_msg());
3099
3100   return $result;
3101 }
3102
3103 # destructive border - image is shrunk by one pixel all around
3104
3105 sub border {
3106   my ($self,%opts)=@_;
3107   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
3108   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
3109 }
3110
3111
3112 # Get the width of an image
3113
3114 sub getwidth {
3115   my $self = shift;
3116   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3117   return (i_img_info($self->{IMG}))[0];
3118 }
3119
3120 # Get the height of an image
3121
3122 sub getheight {
3123   my $self = shift;
3124   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3125   return (i_img_info($self->{IMG}))[1];
3126 }
3127
3128 # Get number of channels in an image
3129
3130 sub getchannels {
3131   my $self = shift;
3132   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3133   return i_img_getchannels($self->{IMG});
3134 }
3135
3136 # Get channel mask
3137
3138 sub getmask {
3139   my $self = shift;
3140   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3141   return i_img_getmask($self->{IMG});
3142 }
3143
3144 # Set channel mask
3145
3146 sub setmask {
3147   my $self = shift;
3148   my %opts = @_;
3149   if (!defined($self->{IMG})) {
3150     $self->{ERRSTR} = 'image is empty';
3151     return undef;
3152   }
3153   unless (defined $opts{mask}) {
3154     $self->_set_error("mask parameter required");
3155     return;
3156   }
3157   i_img_setmask( $self->{IMG} , $opts{mask} );
3158
3159   1;
3160 }
3161
3162 # Get number of colors in an image
3163
3164 sub getcolorcount {
3165   my $self=shift;
3166   my %opts=('maxcolors'=>2**30,@_);
3167   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
3168   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
3169   return ($rc==-1? undef : $rc);
3170 }
3171
3172 # draw string to an image
3173
3174 sub string {
3175   my $self = shift;
3176   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
3177
3178   my %input=('x'=>0, 'y'=>0, @_);
3179   $input{string}||=$input{text};
3180
3181   unless(defined $input{string}) {
3182     $self->{ERRSTR}="missing required parameter 'string'";
3183     return;
3184   }
3185
3186   unless($input{font}) {
3187     $self->{ERRSTR}="missing required parameter 'font'";
3188     return;
3189   }
3190
3191   unless ($input{font}->draw(image=>$self, %input)) {
3192     return;
3193   }
3194
3195   return $self;
3196 }
3197
3198 sub align_string {
3199   my $self = shift;
3200
3201   my $img;
3202   if (ref $self) {
3203     unless ($self->{IMG}) {
3204       $self->{ERRSTR}='empty input image';
3205       return;
3206     }
3207     $img = $self;
3208   }
3209   else {
3210     $img = undef;
3211   }
3212
3213   my %input=('x'=>0, 'y'=>0, @_);
3214   $input{string}||=$input{text};
3215
3216   unless(exists $input{string}) {
3217     $self->_set_error("missing required parameter 'string'");
3218     return;
3219   }
3220
3221   unless($input{font}) {
3222     $self->_set_error("missing required parameter 'font'");
3223     return;
3224   }
3225
3226   my @result;
3227   unless (@result = $input{font}->align(image=>$img, %input)) {
3228     return;
3229   }
3230
3231   return wantarray ? @result : $result[0];
3232 }
3233
3234 my @file_limit_names = qw/width height bytes/;
3235
3236 sub set_file_limits {
3237   shift;
3238
3239   my %opts = @_;
3240   my %values;
3241
3242   if ($opts{reset}) {
3243     @values{@file_limit_names} = (0) x @file_limit_names;
3244   }
3245   else {
3246     @values{@file_limit_names} = i_get_image_file_limits();
3247   }
3248
3249   for my $key (keys %values) {
3250     defined $opts{$key} and $values{$key} = $opts{$key};
3251   }
3252
3253   i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
3254 }
3255
3256 sub get_file_limits {
3257   i_get_image_file_limits();
3258 }
3259
3260 # Shortcuts that can be exported
3261
3262 sub newcolor { Imager::Color->new(@_); }
3263 sub newfont  { Imager::Font->new(@_); }
3264
3265 *NC=*newcolour=*newcolor;
3266 *NF=*newfont;
3267
3268 *open=\&read;
3269 *circle=\&arc;
3270
3271
3272 #### Utility routines
3273
3274 sub errstr {
3275   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
3276 }
3277
3278 sub _set_error {
3279   my ($self, $msg) = @_;
3280
3281   if (ref $self) {
3282     $self->{ERRSTR} = $msg;
3283   }
3284   else {
3285     $ERRSTR = $msg;
3286   }
3287   return;
3288 }
3289
3290 # Default guess for the type of an image from extension
3291
3292 sub def_guess_type {
3293   my $name=lc(shift);
3294   my $ext;
3295   $ext=($name =~ m/\.([^\.]+)$/)[0];
3296   return 'tiff' if ($ext =~ m/^tiff?$/);
3297   return 'jpeg' if ($ext =~ m/^jpe?g$/);
3298   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
3299   return 'png'  if ($ext eq "png");
3300   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
3301   return 'tga'  if ($ext eq "tga");
3302   return 'rgb'  if ($ext eq "rgb");
3303   return 'gif'  if ($ext eq "gif");
3304   return 'raw'  if ($ext eq "raw");
3305   return lc $ext; # best guess
3306   return ();
3307 }
3308
3309 # get the minimum of a list
3310
3311 sub _min {
3312   my $mx=shift;
3313   for(@_) { if ($_<$mx) { $mx=$_; }}
3314   return $mx;
3315 }
3316
3317 # get the maximum of a list
3318
3319 sub _max {
3320   my $mx=shift;
3321   for(@_) { if ($_>$mx) { $mx=$_; }}
3322   return $mx;
3323 }
3324
3325 # string stuff for iptc headers
3326
3327 sub _clean {
3328   my($str)=$_[0];
3329   $str = substr($str,3);
3330   $str =~ s/[\n\r]//g;
3331   $str =~ s/\s+/ /g;
3332   $str =~ s/^\s//;
3333   $str =~ s/\s$//;
3334   return $str;
3335 }
3336
3337 # A little hack to parse iptc headers.
3338
3339 sub parseiptc {
3340   my $self=shift;
3341   my(@sar,$item,@ar);
3342   my($caption,$photogr,$headln,$credit);
3343
3344   my $str=$self->{IPTCRAW};
3345
3346   defined $str
3347     or return;
3348
3349   @ar=split(/8BIM/,$str);
3350
3351   my $i=0;
3352   foreach (@ar) {
3353     if (/^\004\004/) {
3354       @sar=split(/\034\002/);
3355       foreach $item (@sar) {
3356         if ($item =~ m/^x/) {
3357           $caption = _clean($item);
3358           $i++;
3359         }
3360         if ($item =~ m/^P/) {
3361           $photogr = _clean($item);
3362           $i++;
3363         }
3364         if ($item =~ m/^i/) {
3365           $headln = _clean($item);
3366           $i++;
3367         }
3368         if ($item =~ m/^n/) {
3369           $credit = _clean($item);
3370           $i++;
3371         }
3372       }
3373     }
3374   }
3375   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3376 }
3377
3378 sub Inline {
3379   my ($lang) = @_;
3380
3381   $lang eq 'C'
3382     or die "Only C language supported";
3383
3384   require Imager::ExtUtils;
3385   return Imager::ExtUtils->inline_config;
3386 }
3387
3388 1;
3389 __END__
3390 # Below is the stub of documentation for your module. You better edit it!
3391
3392 =head1 NAME
3393
3394 Imager - Perl extension for Generating 24 bit Images
3395
3396 =head1 SYNOPSIS
3397
3398   # Thumbnail example
3399
3400   #!/usr/bin/perl -w
3401   use strict;
3402   use Imager;
3403
3404   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
3405   my $file = shift;
3406
3407   my $format;
3408
3409   my $img = Imager->new();
3410   # see Imager::Files for information on the read() method
3411   $img->read(file=>$file) or die $img->errstr();
3412
3413   $file =~ s/\.[^.]*$//;
3414
3415   # Create smaller version
3416   # documented in Imager::Transformations
3417   my $thumb = $img->scale(scalefactor=>.3);
3418
3419   # Autostretch individual channels
3420   $thumb->filter(type=>'autolevels');
3421
3422   # try to save in one of these formats
3423   SAVE:
3424
3425   for $format ( qw( png gif jpg tiff ppm ) ) {
3426     # Check if given format is supported
3427     if ($Imager::formats{$format}) {
3428       $file.="_low.$format";
3429       print "Storing image as: $file\n";
3430       # documented in Imager::Files
3431       $thumb->write(file=>$file) or
3432         die $thumb->errstr;
3433       last SAVE;
3434     }
3435   }
3436
3437 =head1 DESCRIPTION
3438
3439 Imager is a module for creating and altering images.  It can read and
3440 write various image formats, draw primitive shapes like lines,and
3441 polygons, blend multiple images together in various ways, scale, crop,
3442 render text and more.
3443
3444 =head2 Overview of documentation
3445
3446 =over
3447
3448 =item *
3449
3450 Imager - This document - Synopsis, Example, Table of Contents and
3451 Overview.
3452
3453 =item *
3454
3455 L<Imager::Tutorial> - a brief introduction to Imager.
3456
3457 =item *
3458
3459 L<Imager::Cookbook> - how to do various things with Imager.
3460
3461 =item *
3462
3463 L<Imager::ImageTypes> - Basics of constructing image objects with
3464 C<new()>: Direct type/virtual images, RGB(A)/paletted images,
3465 8/16/double bits/channel, color maps, channel masks, image tags, color
3466 quantization.  Also discusses basic image information methods.
3467
3468 =item *
3469
3470 L<Imager::Files> - IO interaction, reading/writing images, format
3471 specific tags.
3472
3473 =item *
3474
3475 L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
3476 flood fill.
3477
3478 =item *
3479
3480 L<Imager::Color> - Color specification.
3481
3482 =item *
3483
3484 L<Imager::Fill> - Fill pattern specification.
3485
3486 =item *
3487
3488 L<Imager::Font> - General font rendering, bounding boxes and font
3489 metrics.
3490
3491 =item *
3492
3493 L<Imager::Transformations> - Copying, scaling, cropping, flipping,
3494 blending, pasting, convert and map.
3495
3496 =item *
3497
3498 L<Imager::Engines> - Programmable transformations through
3499 C<transform()>, C<transform2()> and C<matrix_transform()>.
3500
3501 =item *
3502
3503 L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
3504 filter plugins.
3505
3506 =item *
3507
3508 L<Imager::Expr> - Expressions for evaluation engine used by
3509 transform2().
3510
3511 =item *
3512
3513 L<Imager::Matrix2d> - Helper class for affine transformations.
3514
3515 =item *
3516
3517 L<Imager::Fountain> - Helper for making gradient profiles.
3518
3519 =item *
3520
3521 L<Imager::API> - using Imager's C API
3522
3523 =item *
3524
3525 L<Imager::APIRef> - API function reference
3526
3527 =item *
3528
3529 L<Imager::Inline> - using Imager's C API from Inline::C
3530
3531 =item *
3532
3533 L<Imager::ExtUtils> - tools to get access to Imager's C API.
3534
3535 =back
3536
3537 =head2 Basic Overview
3538
3539 An Image object is created with C<$img = Imager-E<gt>new()>.
3540 Examples:
3541
3542   $img=Imager->new();                         # create empty image
3543   $img->read(file=>'lena.png',type=>'png') or # read image from file
3544      die $img->errstr();                      # give an explanation
3545                                               # if something failed
3546
3547 or if you want to create an empty image:
3548
3549   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
3550
3551 This example creates a completely black image of width 400 and height
3552 300 and 4 channels.
3553
3554 =head1 ERROR HANDLING
3555
3556 In general a method will return false when it fails, if it does use the errstr() method to find out why:
3557
3558 =over
3559
3560 =item errstr
3561
3562 Returns the last error message in that context.
3563
3564 If the last error you received was from calling an object method, such
3565 as read, call errstr() as an object method to find out why:
3566
3567   my $image = Imager->new;
3568   $image->read(file => 'somefile.gif')
3569      or die $image->errstr;
3570
3571 If it was a class method then call errstr() as a class method:
3572
3573   my @imgs = Imager->read_multi(file => 'somefile.gif')
3574     or die Imager->errstr;
3575
3576 Note that in some cases object methods are implemented in terms of
3577 class methods so a failing object method may set both.
3578
3579 =back
3580
3581 The C<Imager-E<gt>new> method is described in detail in
3582 L<Imager::ImageTypes>.
3583
3584 =head1 METHOD INDEX
3585
3586 Where to find information on methods for Imager class objects.
3587
3588 addcolors() -  L<Imager::ImageTypes/addcolors>
3589
3590 addtag() -  L<Imager::ImageTypes/addtag> - add image tags
3591
3592 align_string() - L<Imager::Draw/align_string>
3593
3594 arc() - L<Imager::Draw/arc>
3595
3596 bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
3597 image
3598
3599 box() - L<Imager::Draw/box>
3600
3601 circle() - L<Imager::Draw/circle>
3602
3603 colorcount() - L<Imager::Draw/colorcount>
3604
3605 convert() - L<Imager::Transformations/"Color transformations"> -
3606 transform the color space
3607
3608 copy() - L<Imager::Transformations/copy>
3609
3610 crop() - L<Imager::Transformations/crop> - extract part of an image
3611
3612 def_guess_type() - L<Imager::Files/def_guess_type>
3613
3614 deltag() -  L<Imager::ImageTypes/deltag> - delete image tags
3615
3616 difference() - L<Imager::Filters/"Image Difference">
3617
3618 errstr() - L<"Basic Overview">
3619
3620 filter() - L<Imager::Filters>
3621
3622 findcolor() - L<Imager::ImageTypes/findcolor> - search the image palette, if it
3623 has one
3624
3625 flip() - L<Imager::Transformations/flip>
3626
3627 flood_fill() - L<Imager::Draw/flood_fill>
3628
3629 getchannels() -  L<Imager::ImageTypes/getchannels>
3630
3631 getcolorcount() -  L<Imager::ImageTypes/getcolorcount>
3632
3633 getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
3634 palette, if it has one
3635
3636 get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3637
3638 getheight() - L<Imager::ImageTypes/getwidth>
3639
3640 getmask() - L<Imager::ImageTypes/getmask>
3641
3642 getpixel() - L<Imager::Draw/getpixel>
3643
3644 getsamples() - L<Imager::Draw/getsamples>
3645
3646 getscanline() - L<Imager::Draw/getscanline>
3647
3648 getwidth() - L<Imager::ImageTypes/getwidth>
3649
3650 img_set() - L<Imager::ImageTypes/img_set>
3651
3652 init() - L<Imager::ImageTypes/init>
3653
3654 line() - L<Imager::Draw/line>
3655
3656 load_plugin() - L<Imager::Filters/load_plugin>
3657
3658 map() - L<Imager::Transformations/"Color Mappings"> - remap color
3659 channel values
3660
3661 masked() -  L<Imager::ImageTypes/masked> - make a masked image
3662
3663 matrix_transform() - L<Imager::Engines/matrix_transform>
3664
3665 maxcolors() - L<Imager::ImageTypes/maxcolors>
3666
3667 NC() - L<Imager::Handy/NC>
3668
3669 new() - L<Imager::ImageTypes/new>
3670
3671 newcolor() - L<Imager::Handy/newcolor>
3672
3673 newcolour() - L<Imager::Handy/newcolour>
3674
3675 newfont() - L<Imager::Handy/newfont>
3676
3677 NF() - L<Imager::Handy/NF>
3678
3679 open() - L<Imager::Files> - an alias for read()
3680
3681 parseiptc() - L<Imager::Files/parseiptc> - parse IPTC data from a JPEG
3682 image
3683
3684 paste() - L<Imager::Transformations/paste> - draw an image onto an image
3685
3686 polygon() - L<Imager::Draw/polygon>
3687
3688 polyline() - L<Imager::Draw/polyline>
3689
3690 read() - L<Imager::Files> - read a single image from an image file
3691
3692 read_multi() - L<Imager::Files> - read multiple images from an image
3693 file
3694
3695 register_filter() - L<Imager::Filters/register_filter>
3696
3697 register_reader() - L<Imager::Filters/register_reader>
3698
3699 register_writer() - L<Imager::Filters/register_writer>
3700
3701 rotate() - L<Imager::Transformations/rotate>
3702
3703 rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
3704 image and use the alpha channel
3705
3706 scale() - L<Imager::Transformations/scale>
3707
3708 scaleX() - L<Imager::Transformations/scaleX>
3709
3710 scaleY() - L<Imager::Transformations/scaleY>
3711
3712 setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
3713 a paletted image
3714
3715 set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3716
3717 setmask() - L<Imager::ImageTypes/setmask>
3718
3719 setpixel() - L<Imager::Draw/setpixel>
3720
3721 setscanline() - L<Imager::Draw/setscanline>
3722
3723 settag() - L<Imager::ImageTypes/settag>
3724
3725 string() - L<Imager::Draw/string> - draw text on an image
3726
3727 tags() -  L<Imager::ImageTypes/tags> - fetch image tags
3728
3729 to_paletted() -  L<Imager::ImageTypes/to_paletted>
3730
3731 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
3732
3733 transform() - L<Imager::Engines/"transform">
3734
3735 transform2() - L<Imager::Engines/"transform2">
3736
3737 type() -  L<Imager::ImageTypes/type> - type of image (direct vs paletted)
3738
3739 unload_plugin() - L<Imager::Filters/unload_plugin>
3740
3741 virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
3742 data
3743
3744 write() - L<Imager::Files> - write an image to a file
3745
3746 write_multi() - L<Imager::Files> - write multiple image to an image
3747 file.
3748
3749 =head1 CONCEPT INDEX
3750
3751 animated GIF - L<Imager::File/"Writing an animated GIF">
3752
3753 aspect ratio - L<Imager::ImageTypes/i_xres>,
3754 L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
3755
3756 blend - alpha blending one image onto another
3757 L<Imager::Transformations/rubthrough>
3758
3759 blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
3760
3761 boxes, drawing - L<Imager::Draw/box>
3762
3763 changes between image - L<Imager::Filter/"Image Difference">
3764
3765 color - L<Imager::Color>
3766
3767 color names - L<Imager::Color>, L<Imager::Color::Table>
3768
3769 combine modes - L<Imager::Fill/combine>
3770
3771 compare images - L<Imager::Filter/"Image Difference">
3772
3773 contrast - L<Imager::Filter/contrast>, L<Imager::Filter/autolevels>
3774
3775 convolution - L<Imager::Filter/conv>
3776
3777 cropping - L<Imager::Transformations/crop>
3778
3779 C<diff> images - L<Imager::Filter/"Image Difference">
3780
3781 dpi - L<Imager::ImageTypes/i_xres>,
3782 L<Imager::Cookbook/"Image spatial resolution">
3783
3784 drawing boxes - L<Imager::Draw/box>
3785
3786 drawing lines - L<Imager::Draw/line>
3787
3788 drawing text - L<Imager::Draw/string>, L<Imager::Draw/align_string>
3789
3790 error message - L<"Basic Overview">
3791
3792 files, font - L<Imager::Font>
3793
3794 files, image - L<Imager::Files>
3795
3796 filling, types of fill - L<Imager::Fill>
3797
3798 filling, boxes - L<Imager::Draw/box>
3799
3800 filling, flood fill - L<Imager::Draw/flood_fill>
3801
3802 flood fill - L<Imager::Draw/flood_fill>
3803
3804 fonts - L<Imager::Font>
3805
3806 fonts, drawing with - L<Imager::Draw/string>,
3807 L<Imager::Draw/align_string>, L<Imager::Font::Wrap>
3808
3809 fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3810
3811 fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
3812
3813 fountain fill - L<Imager::Fill/"Fountain fills">,
3814 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3815 L<Imager::Filters/gradgen>
3816
3817 GIF files - L<Imager::Files/"GIF">
3818
3819 GIF files, animated - L<Imager::File/"Writing an animated GIF">
3820
3821 gradient fill - L<Imager::Fill/"Fountain fills">,
3822 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3823 L<Imager::Filters/gradgen>
3824
3825 guassian blur - L<Imager::Filter/guassian>
3826
3827 hatch fills - L<Imager::Fill/"Hatched fills">
3828
3829 invert image - L<Imager::Filter/hardinvert>
3830
3831 JPEG - L<Imager::Files/"JPEG">
3832
3833 limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
3834
3835 lines, drawing - L<Imager::Draw/line>
3836
3837 matrix - L<Imager::Matrix2d>,
3838 L<Imager::Transformations/"Matrix Transformations">,
3839 L<Imager::Font/transform>
3840
3841 metadata, image - L<Imager::ImageTypes/"Tags">
3842
3843 mosaic - L<Imager::Filter/mosaic>
3844
3845 noise, filter - L<Imager::Filter/noise>
3846
3847 noise, rendered - L<Imager::Filter/turbnoise>,
3848 L<Imager::Filter/radnoise>
3849
3850 paste - L<Imager::Transformations/paste>,
3851 L<Imager::Transformations/rubthrough>
3852
3853 pseudo-color image - L<Imager::ImageTypes/to_paletted>,
3854 L<Imager::ImageTypes/new>
3855
3856 posterize - L<Imager::Filter/postlevels>
3857
3858 png files - L<Imager::Files>, L<Imager::Files/"PNG">
3859
3860 pnm - L<Imager::Files/"PNM (Portable aNy Map)">
3861
3862 rectangles, drawing - L<Imager::Draw/box>
3863
3864 resizing an image - L<Imager::Transformations/scale>,
3865 L<Imager::Transformations/crop>
3866
3867 saving an image - L<Imager::Files>
3868
3869 scaling - L<Imager::Transformations/scale>
3870
3871 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
3872
3873 size, image - L<Imager::ImageTypes/getwidth>,
3874 L<Imager::ImageTypes/getheight>
3875
3876 size, text - L<Imager::Font/bounding_box>
3877
3878 tags, image metadata - L<Imager::ImageTypes/"Tags">
3879
3880 text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
3881 L<Imager::Font::Wrap>
3882
3883 text, wrapping text in an area - L<Imager::Font::Wrap>
3884
3885 text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3886
3887 tiles, color - L<Imager::Filter/mosaic>
3888
3889 unsharp mask - L<Imager::Filter/unsharpmask>
3890
3891 watermark - L<Imager::Filter/watermark>
3892
3893 writing an image to a file - L<Imager::Files>
3894
3895 =head1 SUPPORT
3896
3897 The best place to get help with Imager is the mailing list.
3898
3899 To subscribe send a message with C<subscribe> in the body to:
3900
3901    imager-devel+request@molar.is
3902
3903 or use the form at:
3904
3905 =over
3906
3907 L<http://www.molar.is/en/lists/imager-devel/>
3908
3909 =back
3910
3911 where you can also find the mailing list archive.
3912
3913 You can report bugs by pointing your browser at:
3914
3915 =over
3916
3917 L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
3918
3919 =back
3920
3921 Please remember to include the versions of Imager, perl, supporting
3922 libraries, and any relevant code.  If you have specific images that
3923 cause the problems, please include those too.
3924
3925 =head1 BUGS
3926
3927 Bugs are listed individually for relevant pod pages.
3928
3929 =head1 AUTHOR
3930
3931 Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
3932 others. See the README for a complete list.
3933
3934 =head1 SEE ALSO
3935
3936 L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
3937 L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
3938 L<Imager::Font>(3), L<Imager::Transformations>(3),
3939 L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
3940 L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
3941
3942 L<http://imager.perl.org/>
3943
3944 L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
3945
3946 Other perl imaging modules include:
3947
3948 L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
3949
3950 =cut