Imager.pm

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