Imager.pm

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