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