Imager.pm

   1 package Imager;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS $warn_obsolete);
   5 use IO::File;
   6
   7 use Imager::Color;
   8 use Imager::Font;
   9
  10 @EXPORT_OK = qw(
  11                 init
  12                 init_log
  13                 DSO_open
  14                 DSO_close
  15                 DSO_funclist
  16                 DSO_call
  17
  18                 load_plugin
  19                 unload_plugin
  20
  21                 i_list_formats
  22                 i_has_format
  23
  24                 i_color_new
  25                 i_color_set
  26                 i_color_info
  27
  28                 i_img_empty
  29                 i_img_empty_ch
  30                 i_img_exorcise
  31                 i_img_destroy
  32
  33                 i_img_info
  34
  35                 i_img_setmask
  36                 i_img_getmask
  37
  38                 i_line
  39                 i_line_aa
  40                 i_box
  41                 i_box_filled
  42                 i_arc
  43                 i_circle_aa
  44
  45                 i_bezier_multi
  46                 i_poly_aa
  47                 i_poly_aa_cfill
  48
  49                 i_copyto
  50                 i_rubthru
  51                 i_scaleaxis
  52                 i_scale_nn
  53                 i_haar
  54                 i_count_colors
  55
  56                 i_gaussian
  57                 i_conv
  58
  59                 i_convert
  60                 i_map
  61
  62                 i_img_diff
  63
  64                 i_init_fonts
  65                 i_t1_new
  66                 i_t1_destroy
  67                 i_t1_set_aa
  68                 i_t1_cp
  69                 i_t1_text
  70                 i_t1_bbox
  71
  72                 i_tt_set_aa
  73                 i_tt_cp
  74                 i_tt_text
  75                 i_tt_bbox
  76
  77                 i_readjpeg_wiol
  78                 i_writejpeg_wiol
  79
  80                 i_readtiff_wiol
  81                 i_writetiff_wiol
  82                 i_writetiff_wiol_faxable
  83
  84                 i_readpng_wiol
  85                 i_writepng_wiol
  86
  87                 i_readgif
  88                 i_readgif_wiol
  89                 i_readgif_callback
  90                 i_writegif
  91                 i_writegifmc
  92                 i_writegif_gen
  93                 i_writegif_callback
  94
  95                 i_readpnm_wiol
  96                 i_writeppm_wiol
  97
  98                 i_readraw_wiol
  99                 i_writeraw_wiol
 100
 101                 i_contrast
 102                 i_hardinvert
 103                 i_noise
 104                 i_bumpmap
 105                 i_postlevels
 106                 i_mosaic
 107                 i_watermark
 108
 109                 malloc_state
 110
 111                 list_formats
 112
 113                 i_gifquant
 114
 115                 newfont
 116                 newcolor
 117                 newcolour
 118                 NC
 119                 NF
 120 );
 121
 122 @EXPORT=qw(
 123            init_log
 124            i_list_formats
 125            i_has_format
 126            malloc_state
 127            i_color_new
 128
 129            i_img_empty
 130            i_img_empty_ch
 131           );
 132
 133 %EXPORT_TAGS=
 134   (handy => [qw(
 135                 newfont
 136                 newcolor
 137                 NF
 138                 NC
 139                )],
 140    all => [@EXPORT_OK],
 141    default => [qw(
 142                   load_plugin
 143                   unload_plugin
 144                  )]);
 145
 146 BEGIN {
 147   require Exporter;
 148   require DynaLoader;
 149
 150   $VERSION = '0.43';
 151   @ISA = qw(Exporter DynaLoader);
 152   bootstrap Imager $VERSION;
 153 }
 154
 155 BEGIN {
 156   i_init_fonts(); # Initialize font engines
 157   Imager::Font::__init();
 158   for(i_list_formats()) { $formats{$_}++; }
 159
 160   if ($formats{'t1'}) {
 161     i_t1_set_aa(1);
 162   }
 163
 164   if (!$formats{'t1'} and !$formats{'tt'}
 165       && !$formats{'ft2'} && !$formats{'w32'}) {
 166     $fontstate='no font support';
 167   }
 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{autolevels} ={
 201                          callseq => ['image','lsat','usat','skew'],
 202                          defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
 203                          callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
 204                         };
 205
 206   $filters{turbnoise} ={
 207                         callseq => ['image'],
 208                         defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
 209                         callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
 210                        };
 211
 212   $filters{radnoise} ={
 213                        callseq => ['image'],
 214                        defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
 215                        callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
 216                       };
 217
 218   $filters{conv} ={
 219                        callseq => ['image', 'coef'],
 220                        defaults => { },
 221                        callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
 222                       };
 223
 224   $filters{gradgen} ={
 225                        callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 226                        defaults => { },
 227                        callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 228                       };
 229
 230   $filters{nearest_color} ={
 231                             callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 232                             defaults => { },
 233                             callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 234                            };
 235   $filters{gaussian} = {
 236                         callseq => [ 'image', 'stddev' ],
 237                         defaults => { },
 238                         callsub => sub { my %hsh = @_; i_gaussian($hsh{image}, $hsh{stddev}); },
 239                        };
 240   $filters{mosaic} =
 241     {
 242      callseq => [ qw(image size) ],
 243      defaults => { size => 20 },
 244      callsub => sub { my %hsh = @_; i_mosaic($hsh{image}, $hsh{size}) },
 245     };
 246   $filters{bumpmap} =
 247     {
 248      callseq => [ qw(image bump elevation lightx lighty st) ],
 249      defaults => { elevation=>0, st=> 2 },
 250      callsub => sub {
 251        my %hsh = @_;
 252        i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation},
 253                  $hsh{lightx}, $hsh{lighty}, $hsh{st});
 254      },
 255     };
 256   $filters{bumpmap_complex} =
 257     {
 258      callseq => [ qw(image bump channel tx ty Lx Ly Lz cd cs n Ia Il Is) ],
 259      defaults => {
 260                   channel => 0,
 261                   tx => 0,
 262                   ty => 0,
 263                   Lx => 0.2,
 264                   Ly => 0.4,
 265                   Lz => -1.0,
 266                   cd => 1.0,
 267                   cs => 40,
 268                   n => 1.3,
 269                   Ia => Imager::Color->new(rgb=>[0,0,0]),
 270                   Il => Imager::Color->new(rgb=>[255,255,255]),
 271                   Is => Imager::Color->new(rgb=>[255,255,255]),
 272                  },
 273      callsub => sub {
 274        my %hsh = @_;
 275        i_bumpmap_complex($hsh{image}, $hsh{bump}{IMG}, $hsh{channel},
 276                  $hsh{tx}, $hsh{ty}, $hsh{Lx}, $hsh{Ly}, $hsh{Lz},
 277                  $hsh{cd}, $hsh{cs}, $hsh{n}, $hsh{Ia}, $hsh{Il},
 278                  $hsh{Is});
 279      },
 280     };
 281   $filters{postlevels} =
 282     {
 283      callseq  => [ qw(image levels) ],
 284      defaults => { levels => 10 },
 285      callsub  => sub { my %hsh = @_; i_postlevels($hsh{image}, $hsh{levels}); },
 286     };
 287   $filters{watermark} =
 288     {
 289      callseq  => [ qw(image wmark tx ty pixdiff) ],
 290      defaults => { pixdiff=>10, tx=>0, ty=>0 },
 291      callsub  =>
 292      sub {
 293        my %hsh = @_;
 294        i_watermark($hsh{image}, $hsh{wmark}{IMG}, $hsh{tx}, $hsh{ty},
 295                    $hsh{pixdiff});
 296      },
 297     };
 298   $filters{fountain} =
 299     {
 300      callseq  => [ qw(image xa ya xb yb ftype repeat combine super_sample ssample_param segments) ],
 301      names    => {
 302                   ftype => { linear         => 0,
 303                              bilinear       => 1,
 304                              radial         => 2,
 305                              radial_square  => 3,
 306                              revolution     => 4,
 307                              conical        => 5 },
 308                   repeat => { none      => 0,
 309                               sawtooth  => 1,
 310                               triangle  => 2,
 311                               saw_both  => 3,
 312                               tri_both  => 4,
 313                             },
 314                   super_sample => {
 315                                    none    => 0,
 316                                    grid    => 1,
 317                                    random  => 2,
 318                                    circle  => 3,
 319                                   },
 320                   combine => {
 321                               none      => 0,
 322                               normal    => 1,
 323                               multiply  => 2, mult => 2,
 324                               dissolve  => 3,
 325                               add       => 4,
 326                               subtract  => 5, 'sub' => 5,
 327                               diff      => 6,
 328                               lighten   => 7,
 329                               darken    => 8,
 330                               hue       => 9,
 331                               sat       => 10,
 332                               value     => 11,
 333                               color     => 12,
 334                              },
 335                  },
 336      defaults => { ftype => 0, repeat => 0, combine => 0,
 337                    super_sample => 0, ssample_param => 4,
 338                    segments=>[
 339                               [ 0, 0.5, 1,
 340                                 Imager::Color->new(0,0,0),
 341                                 Imager::Color->new(255, 255, 255),
 342                                 0, 0,
 343                               ],
 344                              ],
 345                  },
 346      callsub  =>
 347      sub {
 348        my %hsh = @_;
 349        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
 350                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
 351                   $hsh{ssample_param}, $hsh{segments});
 352      },
 353     };
 354   $filters{unsharpmask} =
 355     {
 356      callseq => [ qw(image stddev scale) ],
 357      defaults => { stddev=>2.0, scale=>1.0 },
 358      callsub =>
 359      sub {
 360        my %hsh = @_;
 361        i_unsharp_mask($hsh{image}, $hsh{stddev}, $hsh{scale});
 362      },
 363     };
 364
 365   $FORMATGUESS=\&def_guess_type;
 366
 367   $warn_obsolete = 1;
 368 }
 369
 370 #
 371 # Non methods
 372 #
 373
 374 # initlize Imager
 375 # NOTE: this might be moved to an import override later on
 376
 377 #sub import {
 378 #  my $pack = shift;
 379 #  (look through @_ for special tags, process, and remove them);
 380 #  use Data::Dumper;
 381 #  print Dumper($pack);
 382 #  print Dumper(@_);
 383 #}
 384
 385 sub init_log {
 386         m_init_log($_[0],$_[1]);
 387         log_entry("Imager $VERSION starting\n", 1);
 388 }
 389
 390
 391 sub init {
 392   my %parms=(loglevel=>1,@_);
 393   if ($parms{'log'}) {
 394     init_log($parms{'log'},$parms{'loglevel'});
 395   }
 396
 397   if (exists $parms{'warn_obsolete'}) {
 398     $warn_obsolete = $parms{'warn_obsolete'};
 399   }
 400
 401 #    if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
 402 #    if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
 403 #       i_init_fonts();
 404 #       $fontstate='ok';
 405 #    }
 406   if (exists $parms{'t1log'}) {
 407     i_init_fonts($parms{'t1log'});
 408   }
 409 }
 410
 411 END {
 412   if ($DEBUG) {
 413     print "shutdown code\n";
 414     #   for(keys %instances) { $instances{$_}->DESTROY(); }
 415     malloc_state(); # how do decide if this should be used? -- store something from the import
 416     print "Imager exiting\n";
 417   }
 418 }
 419
 420 # Load a filter plugin
 421
 422 sub load_plugin {
 423   my ($filename)=@_;
 424   my $i;
 425   my ($DSO_handle,$str)=DSO_open($filename);
 426   if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
 427   my %funcs=DSO_funclist($DSO_handle);
 428   if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf("  %2d: %s\n",$i++,$_); } }
 429   $i=0;
 430   for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
 431
 432   $DSOs{$filename}=[$DSO_handle,\%funcs];
 433
 434   for(keys %funcs) {
 435     my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
 436     $DEBUG && print "eval string:\n",$evstr,"\n";
 437     eval $evstr;
 438     print $@ if $@;
 439   }
 440   return 1;
 441 }
 442
 443 # Unload a plugin
 444
 445 sub unload_plugin {
 446   my ($filename)=@_;
 447
 448   if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
 449   my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
 450   for(keys %{$funcref}) {
 451     delete $filters{$_};
 452     $DEBUG && print "unloading: $_\n";
 453   }
 454   my $rc=DSO_close($DSO_handle);
 455   if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
 456   return 1;
 457 }
 458
 459 # take the results of i_error() and make a message out of it
 460 sub _error_as_msg {
 461   return join(": ", map $_->[0], i_errors());
 462 }
 463
 464 # this function tries to DWIM for color parameters
 465 #  color objects are used as is
 466 #  simple scalars are simply treated as single parameters to Imager::Color->new
 467 #  hashrefs are treated as named argument lists to Imager::Color->new
 468 #  arrayrefs are treated as list arguments to Imager::Color->new iff any
 469 #    parameter is > 1
 470 #  other arrayrefs are treated as list arguments to Imager::Color::Float
 471
 472 sub _color {
 473   my $arg = shift;
 474   # perl 5.6.0 seems to do weird things to $arg if we don't make an
 475   # explicitly stringified copy
 476   # I vaguely remember a bug on this on p5p, but couldn't find it
 477   # through bugs.perl.org (I had trouble getting it to find any bugs)
 478   my $copy = $arg . "";
 479   my $result;
 480
 481   if (ref $arg) {
 482     if (UNIVERSAL::isa($arg, "Imager::Color")
 483         || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
 484       $result = $arg;
 485     }
 486     else {
 487       if ($copy =~ /^HASH\(/) {
 488         $result = Imager::Color->new(%$arg);
 489       }
 490       elsif ($copy =~ /^ARRAY\(/) {
 491         if (grep $_ > 1, @$arg) {
 492           $result = Imager::Color->new(@$arg);
 493         }
 494         else {
 495           $result = Imager::Color::Float->new(@$arg);
 496         }
 497       }
 498       else {
 499         $Imager::ERRSTR = "Not a color";
 500       }
 501     }
 502   }
 503   else {
 504     # assume Imager::Color::new knows how to handle it
 505     $result = Imager::Color->new($arg);
 506   }
 507
 508   return $result;
 509 }
 510
 511
 512 #
 513 # Methods to be called on objects.
 514 #
 515
 516 # Create a new Imager object takes very few parameters.
 517 # usually you call this method and then call open from
 518 # the resulting object
 519
 520 sub new {
 521   my $class = shift;
 522   my $self ={};
 523   my %hsh=@_;
 524   bless $self,$class;
 525   $self->{IMG}=undef;    # Just to indicate what exists
 526   $self->{ERRSTR}=undef; #
 527   $self->{DEBUG}=$DEBUG;
 528   $self->{DEBUG} && print "Initialized Imager\n";
 529   if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
 530   return $self;
 531 }
 532
 533 # Copy an entire image with no changes
 534 # - if an image has magic the copy of it will not be magical
 535
 536 sub copy {
 537   my $self = shift;
 538   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 539
 540   my $newcopy=Imager->new();
 541   $newcopy->{IMG}=i_img_new();
 542   i_copy($newcopy->{IMG},$self->{IMG});
 543   return $newcopy;
 544 }
 545
 546 # Paste a region
 547
 548 sub paste {
 549   my $self = shift;
 550   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 551   my %input=(left=>0, top=>0, @_);
 552   unless($input{img}) {
 553     $self->{ERRSTR}="no source image";
 554     return;
 555   }
 556   $input{left}=0 if $input{left} <= 0;
 557   $input{top}=0 if $input{top} <= 0;
 558   my $src=$input{img};
 559   my($r,$b)=i_img_info($src->{IMG});
 560
 561   i_copyto($self->{IMG}, $src->{IMG},
 562            0,0, $r, $b, $input{left}, $input{top});
 563   return $self;  # What should go here??
 564 }
 565
 566 # Crop an image - i.e. return a new image that is smaller
 567
 568 sub crop {
 569   my $self=shift;
 570   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 571   my %hsh=(left=>0,right=>$self->getwidth(),top=>0,bottom=>$self->getheight(),@_);
 572
 573   my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
 574                                 @hsh{qw(left right bottom top)});
 575   $l=0 if not defined $l;
 576   $t=0 if not defined $t;
 577
 578   $r||=$l+delete $hsh{'width'}    if defined $l and exists $hsh{'width'};
 579   $b||=$t+delete $hsh{'height'}   if defined $t and exists $hsh{'height'};
 580   $l||=$r-delete $hsh{'width'}    if defined $r and exists $hsh{'width'};
 581   $t||=$b-delete $hsh{'height'}   if defined $b and exists $hsh{'height'};
 582
 583   $r=$self->getwidth if not defined $r;
 584   $b=$self->getheight if not defined $b;
 585
 586   ($l,$r)=($r,$l) if $l>$r;
 587   ($t,$b)=($b,$t) if $t>$b;
 588
 589   if ($hsh{'width'}) {
 590     $l=int(0.5+($w-$hsh{'width'})/2);
 591     $r=$l+$hsh{'width'};
 592   } else {
 593     $hsh{'width'}=$r-$l;
 594   }
 595   if ($hsh{'height'}) {
 596     $b=int(0.5+($h-$hsh{'height'})/2);
 597     $t=$h+$hsh{'height'};
 598   } else {
 599     $hsh{'height'}=$b-$t;
 600   }
 601
 602 #    print "l=$l, r=$r, h=$hsh{'width'}\n";
 603 #    print "t=$t, b=$b, w=$hsh{'height'}\n";
 604
 605   my $dst=Imager->new(xsize=>$hsh{'width'}, ysize=>$hsh{'height'}, channels=>$self->getchannels());
 606
 607   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
 608   return $dst;
 609 }
 610
 611 # Sets an image to a certain size and channel number
 612 # if there was previously data in the image it is discarded
 613
 614 sub img_set {
 615   my $self=shift;
 616
 617   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
 618
 619   if (defined($self->{IMG})) {
 620     # let IIM_DESTROY destroy it, it's possible this image is
 621     # referenced from a virtual image (like masked)
 622     #i_img_destroy($self->{IMG});
 623     undef($self->{IMG});
 624   }
 625
 626   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
 627     $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
 628                                  $hsh{maxcolors} || 256);
 629   }
 630   elsif ($hsh{bits} eq 'double') {
 631     $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
 632   }
 633   elsif ($hsh{bits} == 16) {
 634     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
 635   }
 636   else {
 637     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
 638                                      $hsh{'channels'});
 639   }
 640 }
 641
 642 # created a masked version of the current image
 643 sub masked {
 644   my $self = shift;
 645
 646   $self or return undef;
 647   my %opts = (left    => 0,
 648               top     => 0,
 649               right   => $self->getwidth,
 650               bottom  => $self->getheight,
 651               @_);
 652   my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
 653
 654   my $result = Imager->new;
 655   $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left},
 656                                     $opts{top}, $opts{right} - $opts{left},
 657                                     $opts{bottom} - $opts{top});
 658   # keep references to the mask and base images so they don't
 659   # disappear on us
 660   $result->{DEPENDS} = [ $self->{IMG}, $mask ];
 661
 662   $result;
 663 }
 664
 665 # convert an RGB image into a paletted image
 666 sub to_paletted {
 667   my $self = shift;
 668   my $opts;
 669   if (@_ != 1 && !ref $_[0]) {
 670     $opts = { @_ };
 671   }
 672   else {
 673     $opts = shift;
 674   }
 675
 676   my $result = Imager->new;
 677   $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
 678
 679   #print "Type ", i_img_type($result->{IMG}), "\n";
 680
 681   $result->{IMG} or undef $result;
 682
 683   return $result;
 684 }
 685
 686 # convert a paletted (or any image) to an 8-bit/channel RGB images
 687 sub to_rgb8 {
 688   my $self = shift;
 689   my $result;
 690
 691   if ($self->{IMG}) {
 692     $result = Imager->new;
 693     $result->{IMG} = i_img_to_rgb($self->{IMG})
 694       or undef $result;
 695   }
 696
 697   return $result;
 698 }
 699
 700 sub addcolors {
 701   my $self = shift;
 702   my %opts = (colors=>[], @_);
 703
 704   @{$opts{colors}} or return undef;
 705
 706   $self->{IMG} and i_addcolors($self->{IMG}, @{$opts{colors}});
 707 }
 708
 709 sub setcolors {
 710   my $self = shift;
 711   my %opts = (start=>0, colors=>[], @_);
 712   @{$opts{colors}} or return undef;
 713
 714   $self->{IMG} and i_setcolors($self->{IMG}, $opts{start}, @{$opts{colors}});
 715 }
 716
 717 sub getcolors {
 718   my $self = shift;
 719   my %opts = @_;
 720   if (!exists $opts{start} && !exists $opts{count}) {
 721     # get them all
 722     $opts{start} = 0;
 723     $opts{count} = $self->colorcount;
 724   }
 725   elsif (!exists $opts{count}) {
 726     $opts{count} = 1;
 727   }
 728   elsif (!exists $opts{start}) {
 729     $opts{start} = 0;
 730   }
 731
 732   $self->{IMG} and
 733     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
 734 }
 735
 736 sub colorcount {
 737   i_colorcount($_[0]{IMG});
 738 }
 739
 740 sub maxcolors {
 741   i_maxcolors($_[0]{IMG});
 742 }
 743
 744 sub findcolor {
 745   my $self = shift;
 746   my %opts = @_;
 747   $opts{color} or return undef;
 748
 749   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
 750 }
 751
 752 sub bits {
 753   my $self = shift;
 754   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
 755   if ($bits && $bits == length(pack("d", 1)) * 8) {
 756     $bits = 'double';
 757   }
 758   $bits;
 759 }
 760
 761 sub type {
 762   my $self = shift;
 763   if ($self->{IMG}) {
 764     return i_img_type($self->{IMG}) ? "paletted" : "direct";
 765   }
 766 }
 767
 768 sub virtual {
 769   my $self = shift;
 770   $self->{IMG} and i_img_virtual($self->{IMG});
 771 }
 772
 773 sub tags {
 774   my ($self, %opts) = @_;
 775
 776   $self->{IMG} or return;
 777
 778   if (defined $opts{name}) {
 779     my @result;
 780     my $start = 0;
 781     my $found;
 782     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
 783       push @result, (i_tags_get($self->{IMG}, $found))[1];
 784       $start = $found+1;
 785     }
 786     return wantarray ? @result : $result[0];
 787   }
 788   elsif (defined $opts{code}) {
 789     my @result;
 790     my $start = 0;
 791     my $found;
 792     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
 793       push @result, (i_tags_get($self->{IMG}, $found))[1];
 794       $start = $found+1;
 795     }
 796     return @result;
 797   }
 798   else {
 799     if (wantarray) {
 800       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
 801     }
 802     else {
 803       return i_tags_count($self->{IMG});
 804     }
 805   }
 806 }
 807
 808 sub addtag {
 809   my $self = shift;
 810   my %opts = @_;
 811
 812   return -1 unless $self->{IMG};
 813   if ($opts{name}) {
 814     if (defined $opts{value}) {
 815       if ($opts{value} =~ /^\d+$/) {
 816         # add as a number
 817         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
 818       }
 819       else {
 820         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
 821       }
 822     }
 823     elsif (defined $opts{data}) {
 824       # force addition as a string
 825       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
 826     }
 827     else {
 828       $self->{ERRSTR} = "No value supplied";
 829       return undef;
 830     }
 831   }
 832   elsif ($opts{code}) {
 833     if (defined $opts{value}) {
 834       if ($opts{value} =~ /^\d+$/) {
 835         # add as a number
 836         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
 837       }
 838       else {
 839         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
 840       }
 841     }
 842     elsif (defined $opts{data}) {
 843       # force addition as a string
 844       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
 845     }
 846     else {
 847       $self->{ERRSTR} = "No value supplied";
 848       return undef;
 849     }
 850   }
 851   else {
 852     return undef;
 853   }
 854 }
 855
 856 sub deltag {
 857   my $self = shift;
 858   my %opts = @_;
 859
 860   return 0 unless $self->{IMG};
 861
 862   if (defined $opts{'index'}) {
 863     return i_tags_delete($self->{IMG}, $opts{'index'});
 864   }
 865   elsif (defined $opts{name}) {
 866     return i_tags_delbyname($self->{IMG}, $opts{name});
 867   }
 868   elsif (defined $opts{code}) {
 869     return i_tags_delbycode($self->{IMG}, $opts{code});
 870   }
 871   else {
 872     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
 873     return 0;
 874   }
 875 }
 876
 877 sub settag {
 878   my ($self, %opts) = @_;
 879
 880   if ($opts{name}) {
 881     $self->deltag(name=>$opts{name});
 882     return $self->addtag(name=>$opts{name}, value=>$opts{value});
 883   }
 884   elsif (defined $opts{code}) {
 885     $self->deltag(code=>$opts{code});
 886     return $self->addtag(code=>$opts{code}, value=>$opts{value});
 887   }
 888   else {
 889     return undef;
 890   }
 891 }
 892
 893
 894 sub _get_reader_io {
 895   my ($self, $input) = @_;
 896
 897         if ($input->{io}) {
 898                 return $input->{io}, undef;
 899         }
 900   elsif ($input->{fd}) {
 901     return io_new_fd($input->{fd});
 902   }
 903   elsif ($input->{fh}) {
 904     my $fd = fileno($input->{fh});
 905     unless ($fd) {
 906       $self->_set_error("Handle in fh option not opened");
 907       return;
 908     }
 909     return io_new_fd($fd);
 910   }
 911   elsif ($input->{file}) {
 912     my $file = IO::File->new($input->{file}, "r");
 913     unless ($file) {
 914       $self->_set_error("Could not open $input->{file}: $!");
 915       return;
 916     }
 917     binmode $file;
 918     return (io_new_fd(fileno($file)), $file);
 919   }
 920   elsif ($input->{data}) {
 921     return io_new_buffer($input->{data});
 922   }
 923   elsif ($input->{callback} || $input->{readcb}) {
 924     if (!$input->{seekcb}) {
 925       $self->_set_error("Need a seekcb parameter");
 926     }
 927     if ($input->{maxbuffer}) {
 928       return io_new_cb($input->{writecb},
 929                        $input->{callback} || $input->{readcb},
 930                        $input->{seekcb}, $input->{closecb},
 931                        $input->{maxbuffer});
 932     }
 933     else {
 934       return io_new_cb($input->{writecb},
 935                        $input->{callback} || $input->{readcb},
 936                        $input->{seekcb}, $input->{closecb});
 937     }
 938   }
 939   else {
 940     $self->_set_error("file/fd/fh/data/callback parameter missing");
 941     return;
 942   }
 943 }
 944
 945 sub _get_writer_io {
 946   my ($self, $input, $type) = @_;
 947
 948   if ($input->{fd}) {
 949     return io_new_fd($input->{fd});
 950   }
 951   elsif ($input->{fh}) {
 952     my $fd = fileno($input->{fh});
 953     unless ($fd) {
 954       $self->_set_error("Handle in fh option not opened");
 955       return;
 956     }
 957     # flush it
 958     my $oldfh = select($input->{fh});
 959     # flush anything that's buffered, and make sure anything else is flushed
 960     $| = 1;
 961     select($oldfh);
 962     return io_new_fd($fd);
 963   }
 964   elsif ($input->{file}) {
 965     my $fh = new IO::File($input->{file},"w+");
 966     unless ($fh) {
 967       $self->_set_error("Could not open file $input->{file}: $!");
 968       return;
 969     }
 970     binmode($fh) or die;
 971     return (io_new_fd(fileno($fh)), $fh);
 972   }
 973   elsif ($input->{data}) {
 974     return io_new_bufchain();
 975   }
 976   elsif ($input->{callback} || $input->{writecb}) {
 977     if ($input->{maxbuffer}) {
 978       return io_new_cb($input->{callback} || $input->{writecb},
 979                        $input->{readcb},
 980                        $input->{seekcb}, $input->{closecb},
 981                        $input->{maxbuffer});
 982     }
 983     else {
 984       return io_new_cb($input->{callback} || $input->{writecb},
 985                        $input->{readcb},
 986                        $input->{seekcb}, $input->{closecb});
 987     }
 988   }
 989   else {
 990     $self->_set_error("file/fd/fh/data/callback parameter missing");
 991     return;
 992   }
 993 }
 994
 995 # Read an image from file
 996
 997 sub read {
 998   my $self = shift;
 999   my %input=@_;
1000
1001   if (defined($self->{IMG})) {
1002     # let IIM_DESTROY do the destruction, since the image may be
1003     # referenced from elsewhere
1004     #i_img_destroy($self->{IMG});
1005     undef($self->{IMG});
1006   }
1007
1008   # FIXME: Find the format here if not specified
1009   # yes the code isn't here yet - next week maybe?
1010   # Next week?  Are you high or something?  That comment
1011   # has been there for half a year dude.
1012   # Look, i just work here, ok?
1013
1014   my ($IO, $fh) = $self->_get_reader_io(\%input) or return;
1015
1016   unless ($input{'type'}) {
1017                 $input{'type'} = i_test_format_probe($IO, -1);
1018         }
1019
1020   unless ($input{'type'}) {
1021           $self->_set_error('type parameter missing and not possible to guess from extension');
1022     return undef;
1023   }
1024
1025   # Setup data source
1026   if ( $input{'type'} eq 'jpeg' ) {
1027     ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO );
1028     if ( !defined($self->{IMG}) ) {
1029       $self->{ERRSTR}='unable to read jpeg image'; return undef;
1030     }
1031     $self->{DEBUG} && print "loading a jpeg file\n";
1032     return $self;
1033   }
1034
1035   if ( $input{'type'} eq 'tiff' ) {
1036     $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1037     if ( !defined($self->{IMG}) ) {
1038       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1039     }
1040     $self->{DEBUG} && print "loading a tiff file\n";
1041     return $self;
1042   }
1043
1044   if ( $input{'type'} eq 'pnm' ) {
1045     $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1046     if ( !defined($self->{IMG}) ) {
1047       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef;
1048     }
1049     $self->{DEBUG} && print "loading a pnm file\n";
1050     return $self;
1051   }
1052
1053   if ( $input{'type'} eq 'png' ) {
1054     $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1055     if ( !defined($self->{IMG}) ) {
1056       $self->{ERRSTR}='unable to read png image';
1057       return undef;
1058     }
1059     $self->{DEBUG} && print "loading a png file\n";
1060   }
1061
1062   if ( $input{'type'} eq 'bmp' ) {
1063     $self->{IMG}=i_readbmp_wiol( $IO );
1064     if ( !defined($self->{IMG}) ) {
1065       $self->{ERRSTR}=$self->_error_as_msg();
1066       return undef;
1067     }
1068     $self->{DEBUG} && print "loading a bmp file\n";
1069   }
1070
1071   if ( $input{'type'} eq 'gif' ) {
1072     if ($input{colors} && !ref($input{colors})) {
1073       # must be a reference to a scalar that accepts the colour map
1074       $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1075       return undef;
1076     }
1077     if ($input{colors}) {
1078       my $colors;
1079       ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
1080       if ($colors) {
1081         ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1082       }
1083     }
1084     else {
1085       $self->{IMG} =i_readgif_wiol( $IO );
1086     }
1087     if ( !defined($self->{IMG}) ) {
1088       $self->{ERRSTR}=$self->_error_as_msg();
1089       return undef;
1090     }
1091     $self->{DEBUG} && print "loading a gif file\n";
1092   }
1093
1094   if ( $input{'type'} eq 'tga' ) {
1095     $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1096     if ( !defined($self->{IMG}) ) {
1097       $self->{ERRSTR}=$self->_error_as_msg();
1098       return undef;
1099     }
1100     $self->{DEBUG} && print "loading a tga file\n";
1101   }
1102
1103   if ( $input{'type'} eq 'rgb' ) {
1104     $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1105     if ( !defined($self->{IMG}) ) {
1106       $self->{ERRSTR}=$self->_error_as_msg();
1107       return undef;
1108     }
1109     $self->{DEBUG} && print "loading a tga file\n";
1110   }
1111
1112
1113   if ( $input{'type'} eq 'raw' ) {
1114     my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
1115
1116     if ( !($params{xsize} && $params{ysize}) ) {
1117       $self->{ERRSTR}='missing xsize or ysize parameter for raw';
1118       return undef;
1119     }
1120
1121     $self->{IMG} = i_readraw_wiol( $IO,
1122                                    $params{xsize},
1123                                    $params{ysize},
1124                                    $params{datachannels},
1125                                    $params{storechannels},
1126                                    $params{interleave});
1127     if ( !defined($self->{IMG}) ) {
1128       $self->{ERRSTR}='unable to read raw image';
1129       return undef;
1130     }
1131     $self->{DEBUG} && print "loading a raw file\n";
1132   }
1133
1134   return $self;
1135 }
1136
1137 sub _fix_gif_positions {
1138   my ($opts, $opt, $msg, @imgs) = @_;
1139
1140   my $positions = $opts->{'gif_positions'};
1141   my $index = 0;
1142   for my $pos (@$positions) {
1143     my ($x, $y) = @$pos;
1144     my $img = $imgs[$index++];
1145     $img->settag(name=>'gif_left', value=>$x);
1146     $img->settag(name=>'gif_top', value=>$y) if defined $y;
1147   }
1148   $$msg .= "replaced with the gif_left and gif_top tags";
1149 }
1150
1151 my %obsolete_opts =
1152   (
1153    gif_each_palette=>'gif_local_map',
1154    interlace       => 'gif_interlace',
1155    gif_delays => 'gif_delay',
1156    gif_positions => \&_fix_gif_positions,
1157    gif_loop_count => 'gif_loop',
1158   );
1159
1160 sub _set_opts {
1161   my ($self, $opts, $prefix, @imgs) = @_;
1162
1163   for my $opt (keys %$opts) {
1164     my $tagname = $opt;
1165     if ($obsolete_opts{$opt}) {
1166       my $new = $obsolete_opts{$opt};
1167       my $msg = "Obsolete option $opt ";
1168       if (ref $new) {
1169         $new->($opts, $opt, \$msg, @imgs);
1170       }
1171       else {
1172         $msg .= "replaced with the $new tag ";
1173         $tagname = $new;
1174       }
1175       $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1];
1176       warn $msg if $warn_obsolete && $^W;
1177     }
1178     next unless $tagname =~ /^\Q$prefix/;
1179     my $value = $opts->{$opt};
1180     if (ref $value) {
1181       if (UNIVERSAL::isa($value, "Imager::Color")) {
1182         my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1183         for my $img (@imgs) {
1184           $img->settag(name=>$tagname, value=>$tag);
1185         }
1186       }
1187       elsif (ref($value) eq 'ARRAY') {
1188         for my $i (0..$#$value) {
1189           my $val = $value->[$i];
1190           if (ref $val) {
1191             if (UNIVERSAL::isa($val, "Imager::Color")) {
1192               my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1193               $i < @imgs and
1194                 $imgs[$i]->settag(name=>$tagname, value=>$tag);
1195             }
1196             else {
1197               $self->_set_error("Unknown reference type " . ref($value) .
1198                                 " supplied in array for $opt");
1199               return;
1200             }
1201           }
1202           else {
1203             $i < @imgs
1204               and $imgs[$i]->settag(name=>$tagname, value=>$val);
1205           }
1206         }
1207       }
1208       else {
1209         $self->_set_error("Unknown reference type " . ref($value) .
1210                           " supplied for $opt");
1211         return;
1212       }
1213     }
1214     else {
1215       # set it as a tag for every image
1216       for my $img (@imgs) {
1217         $img->settag(name=>$tagname, value=>$value);
1218       }
1219     }
1220   }
1221
1222   return 1;
1223 }
1224
1225 # Write an image to file
1226 sub write {
1227   my $self = shift;
1228   my %input=(jpegquality=>75,
1229              gifquant=>'mc',
1230              lmdither=>6.0,
1231              lmfixed=>[],
1232              idstring=>"",
1233              compress=>1,
1234              wierdpack=>0,
1235              fax_fine=>1, @_);
1236   my $rc;
1237
1238   $self->_set_opts(\%input, "i_", $self)
1239     or return undef;
1240
1241   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1242
1243   if (!$input{'type'} and $input{file}) {
1244     $input{'type'}=$FORMATGUESS->($input{file});
1245   }
1246   if (!$input{'type'}) {
1247     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1248     return undef;
1249   }
1250
1251   if (!$formats{$input{'type'}}) { $self->{ERRSTR}='format not supported'; return undef; }
1252
1253   my ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1254     or return undef;
1255
1256   if ($input{'type'} eq 'tiff') {
1257     $self->_set_opts(\%input, "tiff_", $self)
1258       or return undef;
1259     $self->_set_opts(\%input, "exif_", $self)
1260       or return undef;
1261
1262     if (defined $input{class} && $input{class} eq 'fax') {
1263       if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1264         $self->{ERRSTR}='Could not write to buffer';
1265         return undef;
1266       }
1267     } else {
1268       if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1269         $self->{ERRSTR}='Could not write to buffer';
1270         return undef;
1271       }
1272     }
1273   } elsif ( $input{'type'} eq 'pnm' ) {
1274     $self->_set_opts(\%input, "pnm_", $self)
1275       or return undef;
1276     if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1277       $self->{ERRSTR}='unable to write pnm image';
1278       return undef;
1279     }
1280     $self->{DEBUG} && print "writing a pnm file\n";
1281   } elsif ( $input{'type'} eq 'raw' ) {
1282     $self->_set_opts(\%input, "raw_", $self)
1283       or return undef;
1284     if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1285       $self->{ERRSTR}='unable to write raw image';
1286       return undef;
1287     }
1288     $self->{DEBUG} && print "writing a raw file\n";
1289   } elsif ( $input{'type'} eq 'png' ) {
1290     $self->_set_opts(\%input, "png_", $self)
1291       or return undef;
1292     if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1293       $self->{ERRSTR}='unable to write png image';
1294       return undef;
1295     }
1296     $self->{DEBUG} && print "writing a png file\n";
1297   } elsif ( $input{'type'} eq 'jpeg' ) {
1298     $self->_set_opts(\%input, "jpeg_", $self)
1299       or return undef;
1300     $self->_set_opts(\%input, "exif_", $self)
1301       or return undef;
1302     if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1303       $self->{ERRSTR} = $self->_error_as_msg();
1304       return undef;
1305     }
1306     $self->{DEBUG} && print "writing a jpeg file\n";
1307   } elsif ( $input{'type'} eq 'bmp' ) {
1308     $self->_set_opts(\%input, "bmp_", $self)
1309       or return undef;
1310     if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1311       $self->{ERRSTR}='unable to write bmp image';
1312       return undef;
1313     }
1314     $self->{DEBUG} && print "writing a bmp file\n";
1315   } elsif ( $input{'type'} eq 'tga' ) {
1316     $self->_set_opts(\%input, "tga_", $self)
1317       or return undef;
1318
1319     if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1320       $self->{ERRSTR}=$self->_error_as_msg();
1321       return undef;
1322     }
1323     $self->{DEBUG} && print "writing a tga file\n";
1324   } elsif ( $input{'type'} eq 'gif' ) {
1325     $self->_set_opts(\%input, "gif_", $self)
1326       or return undef;
1327     # compatibility with the old interfaces
1328     if ($input{gifquant} eq 'lm') {
1329       $input{make_colors} = 'addi';
1330       $input{translate} = 'perturb';
1331       $input{perturb} = $input{lmdither};
1332     } elsif ($input{gifquant} eq 'gen') {
1333       # just pass options through
1334     } else {
1335       $input{make_colors} = 'webmap'; # ignored
1336       $input{translate} = 'giflib';
1337     }
1338     $rc = i_writegif_wiol($IO, \%input, $self->{IMG});
1339   }
1340
1341   if (exists $input{'data'}) {
1342     my $data = io_slurp($IO);
1343     if (!$data) {
1344       $self->{ERRSTR}='Could not slurp from buffer';
1345       return undef;
1346     }
1347     ${$input{data}} = $data;
1348   }
1349   return $self;
1350 }
1351
1352 sub write_multi {
1353   my ($class, $opts, @images) = @_;
1354
1355   if (!$opts->{'type'} && $opts->{'file'}) {
1356     $opts->{'type'} = $FORMATGUESS->($opts->{'file'});
1357   }
1358   unless ($opts->{'type'}) {
1359     $class->_set_error('type parameter missing and not possible to guess from extension');
1360     return;
1361   }
1362   # translate to ImgRaw
1363   if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1364     $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
1365     return 0;
1366   }
1367   $class->_set_opts($opts, "i_", @images)
1368     or return;
1369   my @work = map $_->{IMG}, @images;
1370   my ($IO, $file) = $class->_get_writer_io($opts, $opts->{'type'})
1371     or return undef;
1372   if ($opts->{'type'} eq 'gif') {
1373     $class->_set_opts($opts, "gif_", @images)
1374       or return;
1375     my $gif_delays = $opts->{gif_delays};
1376     local $opts->{gif_delays} = $gif_delays;
1377     if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
1378       # assume the caller wants the same delay for each frame
1379       $opts->{gif_delays} = [ ($gif_delays) x @images ];
1380     }
1381     my $res = i_writegif_wiol($IO, $opts, @work);
1382     $res or $class->_set_error($class->_error_as_msg());
1383     return $res;
1384   }
1385   elsif ($opts->{'type'} eq 'tiff') {
1386     $class->_set_opts($opts, "tiff_", @images)
1387       or return;
1388     $class->_set_opts($opts, "exif_", @images)
1389       or return;
1390     my $res;
1391     $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
1392     if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
1393       $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
1394     }
1395     else {
1396       $res = i_writetiff_multi_wiol($IO, @work);
1397     }
1398     $res or $class->_set_error($class->_error_as_msg());
1399     return $res;
1400   }
1401   else {
1402     $ERRSTR = "Sorry, write_multi doesn't support $opts->{'type'} yet";
1403     return 0;
1404   }
1405 }
1406
1407 # read multiple images from a file
1408 sub read_multi {
1409   my ($class, %opts) = @_;
1410
1411   if ($opts{file} && !exists $opts{'type'}) {
1412     # guess the type
1413     my $type = $FORMATGUESS->($opts{file});
1414     $opts{'type'} = $type;
1415   }
1416   unless ($opts{'type'}) {
1417     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1418     return;
1419   }
1420
1421   my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
1422     or return;
1423   if ($opts{'type'} eq 'gif') {
1424     my @imgs;
1425     @imgs = i_readgif_multi_wiol($IO);
1426     if (@imgs) {
1427       return map {
1428         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1429       } @imgs;
1430     }
1431     else {
1432       $ERRSTR = _error_as_msg();
1433       return;
1434     }
1435   }
1436   elsif ($opts{'type'} eq 'tiff') {
1437     my @imgs = i_readtiff_multi_wiol($IO, -1);
1438     if (@imgs) {
1439       return map {
1440         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1441       } @imgs;
1442     }
1443     else {
1444       $ERRSTR = _error_as_msg();
1445       return;
1446     }
1447   }
1448
1449   $ERRSTR = "Cannot read multiple images from $opts{'type'} files";
1450   return;
1451 }
1452
1453 # Destroy an Imager object
1454
1455 sub DESTROY {
1456   my $self=shift;
1457   #    delete $instances{$self};
1458   if (defined($self->{IMG})) {
1459     # the following is now handled by the XS DESTROY method for
1460     # Imager::ImgRaw object
1461     # Re-enabling this will break virtual images
1462     # tested for in t/t020masked.t
1463     # i_img_destroy($self->{IMG});
1464     undef($self->{IMG});
1465   } else {
1466 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1467   }
1468 }
1469
1470 # Perform an inplace filter of an image
1471 # that is the image will be overwritten with the data
1472
1473 sub filter {
1474   my $self=shift;
1475   my %input=@_;
1476   my %hsh;
1477   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1478
1479   if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1480
1481   if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
1482     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1483   }
1484
1485   if ($filters{$input{'type'}}{names}) {
1486     my $names = $filters{$input{'type'}}{names};
1487     for my $name (keys %$names) {
1488       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1489         $input{$name} = $names->{$name}{$input{$name}};
1490       }
1491     }
1492   }
1493   if (defined($filters{$input{'type'}}{defaults})) {
1494     %hsh=('image',$self->{IMG},%{$filters{$input{'type'}}{defaults}},%input);
1495   } else {
1496     %hsh=('image',$self->{IMG},%input);
1497   }
1498
1499   my @cs=@{$filters{$input{'type'}}{callseq}};
1500
1501   for(@cs) {
1502     if (!defined($hsh{$_})) {
1503       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1504     }
1505   }
1506
1507   &{$filters{$input{'type'}}{callsub}}(%hsh);
1508
1509   my @b=keys %hsh;
1510
1511   $self->{DEBUG} && print "callseq is: @cs\n";
1512   $self->{DEBUG} && print "matching callseq is: @b\n";
1513
1514   return $self;
1515 }
1516
1517 # Scale an image to requested size and return the scaled version
1518
1519 sub scale {
1520   my $self=shift;
1521   my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
1522   my $img = Imager->new();
1523   my $tmp = Imager->new();
1524
1525   unless (defined wantarray) {
1526     warn "scale() called in void context - scale() returns the scaled image";
1527     return;
1528   }
1529
1530   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1531
1532   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
1533     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1534     if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1535     if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1536   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1537   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1538
1539   if ($opts{qtype} eq 'normal') {
1540     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1541     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1542     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1543     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1544     return $img;
1545   }
1546   if ($opts{'qtype'} eq 'preview') {
1547     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
1548     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1549     return $img;
1550   }
1551   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1552 }
1553
1554 # Scales only along the X axis
1555
1556 sub scaleX {
1557   my $self=shift;
1558   my %opts=(scalefactor=>0.5,@_);
1559
1560   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1561
1562   my $img = Imager->new();
1563
1564   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1565
1566   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1567   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1568
1569   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1570   return $img;
1571 }
1572
1573 # Scales only along the Y axis
1574
1575 sub scaleY {
1576   my $self=shift;
1577   my %opts=(scalefactor=>0.5,@_);
1578
1579   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1580
1581   my $img = Imager->new();
1582
1583   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1584
1585   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1586   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1587
1588   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1589   return $img;
1590 }
1591
1592
1593 # Transform returns a spatial transformation of the input image
1594 # this moves pixels to a new location in the returned image.
1595 # NOTE - should make a utility function to check transforms for
1596 # stack overruns
1597
1598 sub transform {
1599   my $self=shift;
1600   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1601   my %opts=@_;
1602   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1603
1604 #  print Dumper(\%opts);
1605 #  xopcopdes
1606
1607   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1608     if (!$I2P) {
1609       eval ("use Affix::Infix2Postfix;");
1610       print $@;
1611       if ( $@ ) {
1612         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
1613         return undef;
1614       }
1615       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1616                                              {op=>'-',trans=>'Sub'},
1617                                              {op=>'*',trans=>'Mult'},
1618                                              {op=>'/',trans=>'Div'},
1619                                              {op=>'-','type'=>'unary',trans=>'u-'},
1620                                              {op=>'**'},
1621                                              {op=>'func','type'=>'unary'}],
1622                                      'grouping'=>[qw( \( \) )],
1623                                      'func'=>[qw( sin cos )],
1624                                      'vars'=>[qw( x y )]
1625                                     );
1626     }
1627
1628     @xt=$I2P->translate($opts{'xexpr'});
1629     @yt=$I2P->translate($opts{'yexpr'});
1630
1631     $numre=$I2P->{'numre'};
1632     @pt=(0,0);
1633
1634     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1635     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1636     @{$opts{'parm'}}=@pt;
1637   }
1638
1639 #  print Dumper(\%opts);
1640
1641   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1642     $self->{ERRSTR}='transform: no xopcodes given.';
1643     return undef;
1644   }
1645
1646   @op=@{$opts{'xopcodes'}};
1647   for $iop (@op) {
1648     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1649       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1650       return undef;
1651     }
1652     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1653   }
1654
1655
1656 # yopcopdes
1657
1658   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1659     $self->{ERRSTR}='transform: no yopcodes given.';
1660     return undef;
1661   }
1662
1663   @op=@{$opts{'yopcodes'}};
1664   for $iop (@op) {
1665     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1666       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1667       return undef;
1668     }
1669     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1670   }
1671
1672 #parameters
1673
1674   if ( !exists $opts{'parm'}) {
1675     $self->{ERRSTR}='transform: no parameter arg given.';
1676     return undef;
1677   }
1678
1679 #  print Dumper(\@ropx);
1680 #  print Dumper(\@ropy);
1681 #  print Dumper(\@ropy);
1682
1683   my $img = Imager->new();
1684   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1685   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1686   return $img;
1687 }
1688
1689
1690 sub transform2 {
1691   my ($opts, @imgs) = @_;
1692
1693   require "Imager/Expr.pm";
1694
1695   $opts->{variables} = [ qw(x y) ];
1696   my ($width, $height) = @{$opts}{qw(width height)};
1697   if (@imgs) {
1698     $width ||= $imgs[0]->getwidth();
1699     $height ||= $imgs[0]->getheight();
1700     my $img_num = 1;
1701     for my $img (@imgs) {
1702       $opts->{constants}{"w$img_num"} = $img->getwidth();
1703       $opts->{constants}{"h$img_num"} = $img->getheight();
1704       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1705       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1706       ++$img_num;
1707     }
1708   }
1709   if ($width) {
1710     $opts->{constants}{w} = $width;
1711     $opts->{constants}{cx} = $width/2;
1712   }
1713   else {
1714     $Imager::ERRSTR = "No width supplied";
1715     return;
1716   }
1717   if ($height) {
1718     $opts->{constants}{h} = $height;
1719     $opts->{constants}{cy} = $height/2;
1720   }
1721   else {
1722     $Imager::ERRSTR = "No height supplied";
1723     return;
1724   }
1725   my $code = Imager::Expr->new($opts);
1726   if (!$code) {
1727     $Imager::ERRSTR = Imager::Expr::error();
1728     return;
1729   }
1730   my $channels = $opts->{channels} || 3;
1731   unless ($channels >= 1 && $channels <= 4) {
1732     return Imager->_set_error("channels must be an integer between 1 and 4");
1733   }
1734
1735   my $img = Imager->new();
1736   $img->{IMG} = i_transform2($opts->{width}, $opts->{height},
1737                              $channels, $code->code(),
1738                              $code->nregs(), $code->cregs(),
1739                              [ map { $_->{IMG} } @imgs ]);
1740   if (!defined $img->{IMG}) {
1741     $Imager::ERRSTR = Imager->_error_as_msg();
1742     return;
1743   }
1744
1745   return $img;
1746 }
1747
1748 sub rubthrough {
1749   my $self=shift;
1750   my %opts=(tx => 0,ty => 0, @_);
1751
1752   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1753   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1754
1755   %opts = (src_minx => 0,
1756            src_miny => 0,
1757            src_maxx => $opts{src}->getwidth(),
1758            src_maxy => $opts{src}->getheight(),
1759            %opts);
1760
1761   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
1762           $opts{src_minx}, $opts{src_miny}, $opts{src_maxx}, $opts{src_maxy})) {
1763     $self->{ERRSTR} = $self->_error_as_msg();
1764     return undef;
1765   }
1766   return $self;
1767 }
1768
1769
1770 sub flip {
1771   my $self  = shift;
1772   my %opts  = @_;
1773   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
1774   my $dir;
1775   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
1776   $dir = $xlate{$opts{'dir'}};
1777   return $self if i_flipxy($self->{IMG}, $dir);
1778   return ();
1779 }
1780
1781 sub rotate {
1782   my $self = shift;
1783   my %opts = @_;
1784   if (defined $opts{right}) {
1785     my $degrees = $opts{right};
1786     if ($degrees < 0) {
1787       $degrees += 360 * int(((-$degrees)+360)/360);
1788     }
1789     $degrees = $degrees % 360;
1790     if ($degrees == 0) {
1791       return $self->copy();
1792     }
1793     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
1794       my $result = Imager->new();
1795       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
1796         return $result;
1797       }
1798       else {
1799         $self->{ERRSTR} = $self->_error_as_msg();
1800         return undef;
1801       }
1802     }
1803     else {
1804       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
1805       return undef;
1806     }
1807   }
1808   elsif (defined $opts{radians} || defined $opts{degrees}) {
1809     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
1810
1811     my $result = Imager->new;
1812     if ($result->{IMG} = i_rotate_exact($self->{IMG}, $amount)) {
1813       return $result;
1814     }
1815     else {
1816       $self->{ERRSTR} = $self->_error_as_msg();
1817       return undef;
1818     }
1819   }
1820   else {
1821     $self->{ERRSTR} = "Only the 'right' parameter is available";
1822     return undef;
1823   }
1824 }
1825
1826 sub matrix_transform {
1827   my $self = shift;
1828   my %opts = @_;
1829
1830   if ($opts{matrix}) {
1831     my $xsize = $opts{xsize} || $self->getwidth;
1832     my $ysize = $opts{ysize} || $self->getheight;
1833
1834     my $result = Imager->new;
1835     $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
1836                                         $opts{matrix})
1837       or return undef;
1838
1839     return $result;
1840   }
1841   else {
1842     $self->{ERRSTR} = "matrix parameter required";
1843     return undef;
1844   }
1845 }
1846
1847 # blame Leolo :)
1848 *yatf = \&matrix_transform;
1849
1850 # These two are supported for legacy code only
1851
1852 sub i_color_new {
1853   return Imager::Color->new(@_);
1854 }
1855
1856 sub i_color_set {
1857   return Imager::Color::set(@_);
1858 }
1859
1860 # Draws a box between the specified corner points.
1861 sub box {
1862   my $self=shift;
1863   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1864   my $dflcl=i_color_new(255,255,255,255);
1865   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1866
1867   if (exists $opts{'box'}) {
1868     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1869     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1870     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1871     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1872   }
1873
1874   if ($opts{filled}) {
1875     my $color = _color($opts{'color'});
1876     unless ($color) {
1877       $self->{ERRSTR} = $Imager::ERRSTR;
1878       return;
1879     }
1880     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1881                  $opts{ymax}, $color);
1882   }
1883   elsif ($opts{fill}) {
1884     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1885       # assume it's a hash ref
1886       require 'Imager/Fill.pm';
1887       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1888         $self->{ERRSTR} = $Imager::ERRSTR;
1889         return undef;
1890       }
1891     }
1892     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1893                 $opts{ymax},$opts{fill}{fill});
1894   }
1895   else {
1896     my $color = _color($opts{'color'});
1897     unless ($color) {
1898       $self->{ERRSTR} = $Imager::ERRSTR;
1899       return;
1900     }
1901     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
1902           $color);
1903   }
1904   return $self;
1905 }
1906
1907 # Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1908
1909 sub arc {
1910   my $self=shift;
1911   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1912   my $dflcl=i_color_new(255,255,255,255);
1913   my %opts=(color=>$dflcl,
1914             'r'=>min($self->getwidth(),$self->getheight())/3,
1915             'x'=>$self->getwidth()/2,
1916             'y'=>$self->getheight()/2,
1917             'd1'=>0, 'd2'=>361, @_);
1918   if ($opts{fill}) {
1919     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1920       # assume it's a hash ref
1921       require 'Imager/Fill.pm';
1922       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1923         $self->{ERRSTR} = $Imager::ERRSTR;
1924         return;
1925       }
1926     }
1927     i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
1928                 $opts{'d2'}, $opts{fill}{fill});
1929   }
1930   else {
1931     my $color = _color($opts{'color'});
1932     unless ($color) {
1933       $self->{ERRSTR} = $Imager::ERRSTR;
1934       return;
1935     }
1936     if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
1937       i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
1938                   $color);
1939     }
1940     else {
1941       if ($opts{'d1'} <= $opts{'d2'}) {
1942         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1943               $opts{'d1'}, $opts{'d2'}, $color);
1944       }
1945       else {
1946         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1947               $opts{'d1'}, 361,         $color);
1948         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1949               0,           $opts{'d2'}, $color);
1950       }
1951     }
1952   }
1953
1954   return $self;
1955 }
1956
1957 # Draws a line from one point to the other
1958 # the endpoint is set if the endp parameter is set which it is by default.
1959 # to turn of the endpoint being set use endp=>0 when calling line.
1960
1961 sub line {
1962   my $self=shift;
1963   my $dflcl=i_color_new(0,0,0,0);
1964   my %opts=(color=>$dflcl,
1965             endp => 1,
1966             @_);
1967   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1968
1969   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
1970   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
1971
1972   my $color = _color($opts{'color'});
1973   unless ($color) {
1974     $self->{ERRSTR} = $Imager::ERRSTR;
1975     return;
1976   }
1977
1978   $opts{antialias} = $opts{aa} if defined $opts{aa};
1979   if ($opts{antialias}) {
1980     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
1981               $color, $opts{endp});
1982   } else {
1983     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
1984            $color, $opts{endp});
1985   }
1986   return $self;
1987 }
1988
1989 # Draws a line between an ordered set of points - It more or less just transforms this
1990 # into a list of lines.
1991
1992 sub polyline {
1993   my $self=shift;
1994   my ($pt,$ls,@points);
1995   my $dflcl=i_color_new(0,0,0,0);
1996   my %opts=(color=>$dflcl,@_);
1997
1998   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1999
2000   if (exists($opts{points})) { @points=@{$opts{points}}; }
2001   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2002     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2003     }
2004
2005 #  print Dumper(\@points);
2006
2007   my $color = _color($opts{'color'});
2008   unless ($color) {
2009     $self->{ERRSTR} = $Imager::ERRSTR;
2010     return;
2011   }
2012   $opts{antialias} = $opts{aa} if defined $opts{aa};
2013   if ($opts{antialias}) {
2014     for $pt(@points) {
2015       if (defined($ls)) {
2016         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2017       }
2018       $ls=$pt;
2019     }
2020   } else {
2021     for $pt(@points) {
2022       if (defined($ls)) {
2023         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2024       }
2025       $ls=$pt;
2026     }
2027   }
2028   return $self;
2029 }
2030
2031 sub polygon {
2032   my $self = shift;
2033   my ($pt,$ls,@points);
2034   my $dflcl = i_color_new(0,0,0,0);
2035   my %opts = (color=>$dflcl, @_);
2036
2037   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2038
2039   if (exists($opts{points})) {
2040     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2041     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2042   }
2043
2044   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2045     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2046   }
2047
2048   if ($opts{'fill'}) {
2049     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2050       # assume it's a hash ref
2051       require 'Imager/Fill.pm';
2052       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2053         $self->{ERRSTR} = $Imager::ERRSTR;
2054         return undef;
2055       }
2056     }
2057     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2058                     $opts{'fill'}{'fill'});
2059   }
2060   else {
2061     my $color = _color($opts{'color'});
2062     unless ($color) {
2063       $self->{ERRSTR} = $Imager::ERRSTR;
2064       return;
2065     }
2066     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2067   }
2068
2069   return $self;
2070 }
2071
2072
2073 # this the multipoint bezier curve
2074 # this is here more for testing that actual usage since
2075 # this is not a good algorithm.  Usually the curve would be
2076 # broken into smaller segments and each done individually.
2077
2078 sub polybezier {
2079   my $self=shift;
2080   my ($pt,$ls,@points);
2081   my $dflcl=i_color_new(0,0,0,0);
2082   my %opts=(color=>$dflcl,@_);
2083
2084   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2085
2086   if (exists $opts{points}) {
2087     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2088     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2089   }
2090
2091   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2092     $self->{ERRSTR}='Missing or invalid points.';
2093     return;
2094   }
2095
2096   my $color = _color($opts{'color'});
2097   unless ($color) {
2098     $self->{ERRSTR} = $Imager::ERRSTR;
2099     return;
2100   }
2101   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2102   return $self;
2103 }
2104
2105 sub flood_fill {
2106   my $self = shift;
2107   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2108   my $rc;
2109
2110   unless (exists $opts{'x'} && exists $opts{'y'}) {
2111     $self->{ERRSTR} = "missing seed x and y parameters";
2112     return undef;
2113   }
2114
2115   if ($opts{fill}) {
2116     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2117       # assume it's a hash ref
2118       require 'Imager/Fill.pm';
2119       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2120         $self->{ERRSTR} = $Imager::ERRSTR;
2121         return;
2122       }
2123     }
2124     $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2125   }
2126   else {
2127     my $color = _color($opts{'color'});
2128     unless ($color) {
2129       $self->{ERRSTR} = $Imager::ERRSTR;
2130       return;
2131     }
2132     $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2133   }
2134   if ($rc) { $self; } else { $self->{ERRSTR} = $self->_error_as_msg(); return (); }
2135 }
2136
2137 sub setpixel {
2138   my $self = shift;
2139
2140   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2141
2142   unless (exists $opts{'x'} && exists $opts{'y'}) {
2143     $self->{ERRSTR} = 'missing x and y parameters';
2144     return undef;
2145   }
2146
2147   my $x = $opts{'x'};
2148   my $y = $opts{'y'};
2149   my $color = _color($opts{color})
2150     or return undef;
2151   if (ref $x && ref $y) {
2152     unless (@$x == @$y) {
2153       $self->{ERRSTR} = 'length of x and y mismatch';
2154       return undef;
2155     }
2156     if ($color->isa('Imager::Color')) {
2157       for my $i (0..$#{$opts{'x'}}) {
2158         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2159       }
2160     }
2161     else {
2162       for my $i (0..$#{$opts{'x'}}) {
2163         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2164       }
2165     }
2166   }
2167   else {
2168     if ($color->isa('Imager::Color')) {
2169       i_ppix($self->{IMG}, $x, $y, $color);
2170     }
2171     else {
2172       i_ppixf($self->{IMG}, $x, $y, $color);
2173     }
2174   }
2175
2176   $self;
2177 }
2178
2179 sub getpixel {
2180   my $self = shift;
2181
2182   my %opts = ( "type"=>'8bit', @_);
2183
2184   unless (exists $opts{'x'} && exists $opts{'y'}) {
2185     $self->{ERRSTR} = 'missing x and y parameters';
2186     return undef;
2187   }
2188
2189   my $x = $opts{'x'};
2190   my $y = $opts{'y'};
2191   if (ref $x && ref $y) {
2192     unless (@$x == @$y) {
2193       $self->{ERRSTR} = 'length of x and y mismatch';
2194       return undef;
2195     }
2196     my @result;
2197     if ($opts{"type"} eq '8bit') {
2198       for my $i (0..$#{$opts{'x'}}) {
2199         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2200       }
2201     }
2202     else {
2203       for my $i (0..$#{$opts{'x'}}) {
2204         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2205       }
2206     }
2207     return wantarray ? @result : \@result;
2208   }
2209   else {
2210     if ($opts{"type"} eq '8bit') {
2211       return i_get_pixel($self->{IMG}, $x, $y);
2212     }
2213     else {
2214       return i_gpixf($self->{IMG}, $x, $y);
2215     }
2216   }
2217
2218   $self;
2219 }
2220
2221 # make an identity matrix of the given size
2222 sub _identity {
2223   my ($size) = @_;
2224
2225   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
2226   for my $c (0 .. ($size-1)) {
2227     $matrix->[$c][$c] = 1;
2228   }
2229   return $matrix;
2230 }
2231
2232 # general function to convert an image
2233 sub convert {
2234   my ($self, %opts) = @_;
2235   my $matrix;
2236
2237   # the user can either specify a matrix or preset
2238   # the matrix overrides the preset
2239   if (!exists($opts{matrix})) {
2240     unless (exists($opts{preset})) {
2241       $self->{ERRSTR} = "convert() needs a matrix or preset";
2242       return;
2243     }
2244     else {
2245       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2246         # convert to greyscale, keeping the alpha channel if any
2247         if ($self->getchannels == 3) {
2248           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2249         }
2250         elsif ($self->getchannels == 4) {
2251           # preserve the alpha channel
2252           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2253                       [ 0,     0,     0,     1 ] ];
2254         }
2255         else {
2256           # an identity
2257           $matrix = _identity($self->getchannels);
2258         }
2259       }
2260       elsif ($opts{preset} eq 'noalpha') {
2261         # strip the alpha channel
2262         if ($self->getchannels == 2 or $self->getchannels == 4) {
2263           $matrix = _identity($self->getchannels);
2264           pop(@$matrix); # lose the alpha entry
2265         }
2266         else {
2267           $matrix = _identity($self->getchannels);
2268         }
2269       }
2270       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2271         # extract channel 0
2272         $matrix = [ [ 1 ] ];
2273       }
2274       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
2275         $matrix = [ [ 0, 1 ] ];
2276       }
2277       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
2278         $matrix = [ [ 0, 0, 1 ] ];
2279       }
2280       elsif ($opts{preset} eq 'alpha') {
2281         if ($self->getchannels == 2 or $self->getchannels == 4) {
2282           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
2283         }
2284         else {
2285           # the alpha is just 1 <shrug>
2286           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
2287         }
2288       }
2289       elsif ($opts{preset} eq 'rgb') {
2290         if ($self->getchannels == 1) {
2291           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
2292         }
2293         elsif ($self->getchannels == 2) {
2294           # preserve the alpha channel
2295           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
2296         }
2297         else {
2298           $matrix = _identity($self->getchannels);
2299         }
2300       }
2301       elsif ($opts{preset} eq 'addalpha') {
2302         if ($self->getchannels == 1) {
2303           $matrix = _identity(2);
2304         }
2305         elsif ($self->getchannels == 3) {
2306           $matrix = _identity(4);
2307         }
2308         else {
2309           $matrix = _identity($self->getchannels);
2310         }
2311       }
2312       else {
2313         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
2314         return undef;
2315       }
2316     }
2317   }
2318   else {
2319     $matrix = $opts{matrix};
2320   }
2321
2322   my $new = Imager->new();
2323   $new->{IMG} = i_img_new();
2324   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
2325     # most likely a bad matrix
2326     $self->{ERRSTR} = _error_as_msg();
2327     return undef;
2328   }
2329   return $new;
2330 }
2331
2332
2333 # general function to map an image through lookup tables
2334
2335 sub map {
2336   my ($self, %opts) = @_;
2337   my @chlist = qw( red green blue alpha );
2338
2339   if (!exists($opts{'maps'})) {
2340     # make maps from channel maps
2341     my $chnum;
2342     for $chnum (0..$#chlist) {
2343       if (exists $opts{$chlist[$chnum]}) {
2344         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
2345       } elsif (exists $opts{'all'}) {
2346         $opts{'maps'}[$chnum] = $opts{'all'};
2347       }
2348     }
2349   }
2350   if ($opts{'maps'} and $self->{IMG}) {
2351     i_map($self->{IMG}, $opts{'maps'} );
2352   }
2353   return $self;
2354 }
2355
2356 sub difference {
2357   my ($self, %opts) = @_;
2358
2359   defined $opts{mindist} or $opts{mindist} = 0;
2360
2361   defined $opts{other}
2362     or return $self->_set_error("No 'other' parameter supplied");
2363   defined $opts{other}{IMG}
2364     or return $self->_set_error("No image data in 'other' image");
2365
2366   $self->{IMG}
2367     or return $self->_set_error("No image data");
2368
2369   my $result = Imager->new;
2370   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
2371                                 $opts{mindist})
2372     or return $self->_set_error($self->_error_as_msg());
2373
2374   return $result;
2375 }
2376
2377 # destructive border - image is shrunk by one pixel all around
2378
2379 sub border {
2380   my ($self,%opts)=@_;
2381   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
2382   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
2383 }
2384
2385
2386 # Get the width of an image
2387
2388 sub getwidth {
2389   my $self = shift;
2390   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2391   return (i_img_info($self->{IMG}))[0];
2392 }
2393
2394 # Get the height of an image
2395
2396 sub getheight {
2397   my $self = shift;
2398   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2399   return (i_img_info($self->{IMG}))[1];
2400 }
2401
2402 # Get number of channels in an image
2403
2404 sub getchannels {
2405   my $self = shift;
2406   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2407   return i_img_getchannels($self->{IMG});
2408 }
2409
2410 # Get channel mask
2411
2412 sub getmask {
2413   my $self = shift;
2414   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2415   return i_img_getmask($self->{IMG});
2416 }
2417
2418 # Set channel mask
2419
2420 sub setmask {
2421   my $self = shift;
2422   my %opts = @_;
2423   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2424   i_img_setmask( $self->{IMG} , $opts{mask} );
2425 }
2426
2427 # Get number of colors in an image
2428
2429 sub getcolorcount {
2430   my $self=shift;
2431   my %opts=('maxcolors'=>2**30,@_);
2432   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2433   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2434   return ($rc==-1? undef : $rc);
2435 }
2436
2437 # draw string to an image
2438
2439 sub string {
2440   my $self = shift;
2441   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2442
2443   my %input=('x'=>0, 'y'=>0, @_);
2444   $input{string}||=$input{text};
2445
2446   unless(exists $input{string}) {
2447     $self->{ERRSTR}="missing required parameter 'string'";
2448     return;
2449   }
2450
2451   unless($input{font}) {
2452     $self->{ERRSTR}="missing required parameter 'font'";
2453     return;
2454   }
2455
2456   unless ($input{font}->draw(image=>$self, %input)) {
2457     $self->{ERRSTR} = $self->_error_as_msg();
2458     return;
2459   }
2460
2461   return $self;
2462 }
2463
2464 # Shortcuts that can be exported
2465
2466 sub newcolor { Imager::Color->new(@_); }
2467 sub newfont  { Imager::Font->new(@_); }
2468
2469 *NC=*newcolour=*newcolor;
2470 *NF=*newfont;
2471
2472 *open=\&read;
2473 *circle=\&arc;
2474
2475
2476 #### Utility routines
2477
2478 sub errstr {
2479   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2480 }
2481
2482 sub _set_error {
2483   my ($self, $msg) = @_;
2484
2485   if (ref $self) {
2486     $self->{ERRSTR} = $msg;
2487   }
2488   else {
2489     $ERRSTR = $msg;
2490   }
2491   return;
2492 }
2493
2494 # Default guess for the type of an image from extension
2495
2496 sub def_guess_type {
2497   my $name=lc(shift);
2498   my $ext;
2499   $ext=($name =~ m/\.([^\.]+)$/)[0];
2500   return 'tiff' if ($ext =~ m/^tiff?$/);
2501   return 'jpeg' if ($ext =~ m/^jpe?g$/);
2502   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
2503   return 'png'  if ($ext eq "png");
2504   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
2505   return 'tga'  if ($ext eq "tga");
2506   return 'rgb'  if ($ext eq "rgb");
2507   return 'gif'  if ($ext eq "gif");
2508   return 'raw'  if ($ext eq "raw");
2509   return ();
2510 }
2511
2512 # get the minimum of a list
2513
2514 sub min {
2515   my $mx=shift;
2516   for(@_) { if ($_<$mx) { $mx=$_; }}
2517   return $mx;
2518 }
2519
2520 # get the maximum of a list
2521
2522 sub max {
2523   my $mx=shift;
2524   for(@_) { if ($_>$mx) { $mx=$_; }}
2525   return $mx;
2526 }
2527
2528 # string stuff for iptc headers
2529
2530 sub clean {
2531   my($str)=$_[0];
2532   $str = substr($str,3);
2533   $str =~ s/[\n\r]//g;
2534   $str =~ s/\s+/ /g;
2535   $str =~ s/^\s//;
2536   $str =~ s/\s$//;
2537   return $str;
2538 }
2539
2540 # A little hack to parse iptc headers.
2541
2542 sub parseiptc {
2543   my $self=shift;
2544   my(@sar,$item,@ar);
2545   my($caption,$photogr,$headln,$credit);
2546
2547   my $str=$self->{IPTCRAW};
2548
2549   #print $str;
2550
2551   @ar=split(/8BIM/,$str);
2552
2553   my $i=0;
2554   foreach (@ar) {
2555     if (/^\004\004/) {
2556       @sar=split(/\034\002/);
2557       foreach $item (@sar) {
2558         if ($item =~ m/^x/) {
2559           $caption=&clean($item);
2560           $i++;
2561         }
2562         if ($item =~ m/^P/) {
2563           $photogr=&clean($item);
2564           $i++;
2565         }
2566         if ($item =~ m/^i/) {
2567           $headln=&clean($item);
2568           $i++;
2569         }
2570         if ($item =~ m/^n/) {
2571           $credit=&clean($item);
2572           $i++;
2573         }
2574       }
2575     }
2576   }
2577   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
2578 }
2579
2580 # Autoload methods go after =cut, and are processed by the autosplit program.
2581
2582 1;
2583 __END__
2584 # Below is the stub of documentation for your module. You better edit it!
2585
2586 =head1 NAME
2587
2588 Imager - Perl extension for Generating 24 bit Images
2589
2590 =head1 SYNOPSIS
2591
2592   # Thumbnail example
2593
2594   #!/usr/bin/perl -w
2595   use strict;
2596   use Imager;
2597
2598   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
2599   my $file = shift;
2600
2601   my $format;
2602
2603   my $img = Imager->new();
2604   # see Imager::Files for information on the open() method
2605   $img->open(file=>$file) or die $img->errstr();
2606
2607   $file =~ s/\.[^.]*$//;
2608
2609   # Create smaller version
2610   # documented in Imager::Transformations
2611   my $thumb = $img->scale(scalefactor=>.3);
2612
2613   # Autostretch individual channels
2614   $thumb->filter(type=>'autolevels');
2615
2616   # try to save in one of these formats
2617   SAVE:
2618
2619   for $format ( qw( png gif jpg tiff ppm ) ) {
2620     # Check if given format is supported
2621     if ($Imager::formats{$format}) {
2622       $file.="_low.$format";
2623       print "Storing image as: $file\n";
2624       # documented in Imager::Files
2625       $thumb->write(file=>$file) or
2626         die $thumb->errstr;
2627       last SAVE;
2628     }
2629   }
2630
2631 =head1 DESCRIPTION
2632
2633 Imager is a module for creating and altering images.  It can read and
2634 write various image formats, draw primitive shapes like lines,and
2635 polygons, blend multiple images together in various ways, scale, crop,
2636 render text and more.
2637
2638 =head2 Overview of documentation
2639
2640 =over
2641
2642 =item *
2643
2644 Imager - This document - Synopsis Example, Table of Contents and
2645 Overview.
2646
2647 =item *
2648
2649 L<Imager::ImageTypes> - Basics of constructing image objects with
2650 C<new()>: Direct type/virtual images, RGB(A)/paletted images,
2651 8/16/double bits/channel, color maps, channel masks, image tags, color
2652 quantization.  Also discusses basic image information methods.
2653
2654 =item *
2655
2656 L<Imager::Files> - IO interaction, reading/writing images, format
2657 specific tags.
2658
2659 =item *
2660
2661 L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
2662 flood fill.
2663
2664 =item *
2665
2666 L<Imager::Color> - Color specification.
2667
2668 =item *
2669
2670 L<Imager::Fill> - Fill pattern specification.
2671
2672 =item *
2673
2674 L<Imager::Font> - General font rendering, bounding boxes and font
2675 metrics.
2676
2677 =item *
2678
2679 L<Imager::Transformations> - Copying, scaling, cropping, flipping,
2680 blending, pasting, convert and map.
2681
2682 =item *
2683
2684 L<Imager::Engines> - Programmable transformations through
2685 C<transform()>, C<transform2()> and C<matrix_transform()>.
2686
2687 =item *
2688
2689 L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
2690 filter plugins.
2691
2692 =item *
2693
2694 L<Imager::Expr> - Expressions for evaluation engine used by
2695 transform2().
2696
2697 =item *
2698
2699 L<Imager::Matrix2d> - Helper class for affine transformations.
2700
2701 =item *
2702
2703 L<Imager::Fountain> - Helper for making gradient profiles.
2704
2705 =back
2706
2707 =head2 Basic Overview
2708
2709 An Image object is created with C<$img = Imager-E<gt>new()>.
2710 Examples:
2711
2712   $img=Imager->new();                         # create empty image
2713   $img->open(file=>'lena.png',type=>'png') or # read image from file
2714      die $img->errstr();                      # give an explanation
2715                                               # if something failed
2716
2717 or if you want to create an empty image:
2718
2719   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
2720
2721 This example creates a completely black image of width 400 and height
2722 300 and 4 channels.
2723
2724 When an operation fails which can be directly associated with an image
2725 the error message is stored can be retrieved with
2726 C<$img-E<gt>errstr()>.
2727
2728 In cases where no image object is associated with an operation
2729 C<$Imager::ERRSTR> is used to report errors not directly associated
2730 with an image object.
2731
2732 The C<Imager-E<gt>new> method is described in detail in
2733 L<Imager::ImageTypes>.
2734
2735 =head1 SUPPORT
2736
2737 You can ask for help, report bugs or express your undying love for
2738 Imager on the Imager-devel mailing list.
2739
2740 To subscribe send a message with C<subscribe> in the body to:
2741
2742    imager-devel+request@molar.is
2743
2744 or use the form at:
2745
2746    http://www.molar.is/en/lists/imager-devel/
2747    (annonymous is temporarily off due to spam)
2748
2749 where you can also find the mailing list archive.
2750
2751 If you're into IRC, you can typically find the developers in #Imager
2752 on irc.rhizomatic.net.  As with any IRC channel, the participants
2753 could be occupied or asleep, so please be patient.
2754
2755 =head1 BUGS
2756
2757 Bugs are listed individually for relevant pod pages.
2758
2759 =head1 AUTHOR
2760
2761 Arnar M. Hrafnkelsson (addi@imager.perl.org) and Tony Cook
2762 (tony@imager.perl.org) See the README for a complete list.
2763
2764 =head1 SEE ALSO
2765
2766 perl(1), Imager::ImageTypes(3), Imager::Files(3), Imager::Draw(3),
2767 Imager::Color(3), Imager::Fill(3), Imager::Font(3),
2768 Imager::Transformations(3), Imager::Engines(3), Imager::Filters(3),
2769 Imager::Expr(3), Imager::Matrix2d(3), Imager::Fountain(3)
2770
2771 Affix::Infix2Postfix(3), Parse::RecDescent(3)
2772 http://imager.perl.org/~addi/perl/Imager/
2773
2774 =cut