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.41';
 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 ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1526
1527   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
1528     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1529     if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1530     if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1531   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1532   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1533
1534   if ($opts{qtype} eq 'normal') {
1535     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1536     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1537     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1538     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1539     return $img;
1540   }
1541   if ($opts{'qtype'} eq 'preview') {
1542     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
1543     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1544     return $img;
1545   }
1546   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1547 }
1548
1549 # Scales only along the X axis
1550
1551 sub scaleX {
1552   my $self=shift;
1553   my %opts=(scalefactor=>0.5,@_);
1554
1555   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1556
1557   my $img = Imager->new();
1558
1559   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1560
1561   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1562   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1563
1564   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1565   return $img;
1566 }
1567
1568 # Scales only along the Y axis
1569
1570 sub scaleY {
1571   my $self=shift;
1572   my %opts=(scalefactor=>0.5,@_);
1573
1574   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1575
1576   my $img = Imager->new();
1577
1578   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1579
1580   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1581   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1582
1583   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1584   return $img;
1585 }
1586
1587
1588 # Transform returns a spatial transformation of the input image
1589 # this moves pixels to a new location in the returned image.
1590 # NOTE - should make a utility function to check transforms for
1591 # stack overruns
1592
1593 sub transform {
1594   my $self=shift;
1595   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1596   my %opts=@_;
1597   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1598
1599 #  print Dumper(\%opts);
1600 #  xopcopdes
1601
1602   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1603     if (!$I2P) {
1604       eval ("use Affix::Infix2Postfix;");
1605       print $@;
1606       if ( $@ ) {
1607         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
1608         return undef;
1609       }
1610       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1611                                              {op=>'-',trans=>'Sub'},
1612                                              {op=>'*',trans=>'Mult'},
1613                                              {op=>'/',trans=>'Div'},
1614                                              {op=>'-','type'=>'unary',trans=>'u-'},
1615                                              {op=>'**'},
1616                                              {op=>'func','type'=>'unary'}],
1617                                      'grouping'=>[qw( \( \) )],
1618                                      'func'=>[qw( sin cos )],
1619                                      'vars'=>[qw( x y )]
1620                                     );
1621     }
1622
1623     @xt=$I2P->translate($opts{'xexpr'});
1624     @yt=$I2P->translate($opts{'yexpr'});
1625
1626     $numre=$I2P->{'numre'};
1627     @pt=(0,0);
1628
1629     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1630     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1631     @{$opts{'parm'}}=@pt;
1632   }
1633
1634 #  print Dumper(\%opts);
1635
1636   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1637     $self->{ERRSTR}='transform: no xopcodes given.';
1638     return undef;
1639   }
1640
1641   @op=@{$opts{'xopcodes'}};
1642   for $iop (@op) {
1643     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1644       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1645       return undef;
1646     }
1647     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1648   }
1649
1650
1651 # yopcopdes
1652
1653   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1654     $self->{ERRSTR}='transform: no yopcodes given.';
1655     return undef;
1656   }
1657
1658   @op=@{$opts{'yopcodes'}};
1659   for $iop (@op) {
1660     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1661       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1662       return undef;
1663     }
1664     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1665   }
1666
1667 #parameters
1668
1669   if ( !exists $opts{'parm'}) {
1670     $self->{ERRSTR}='transform: no parameter arg given.';
1671     return undef;
1672   }
1673
1674 #  print Dumper(\@ropx);
1675 #  print Dumper(\@ropy);
1676 #  print Dumper(\@ropy);
1677
1678   my $img = Imager->new();
1679   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1680   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1681   return $img;
1682 }
1683
1684
1685 sub transform2 {
1686   my ($opts, @imgs) = @_;
1687
1688   require "Imager/Expr.pm";
1689
1690   $opts->{variables} = [ qw(x y) ];
1691   my ($width, $height) = @{$opts}{qw(width height)};
1692   if (@imgs) {
1693     $width ||= $imgs[0]->getwidth();
1694     $height ||= $imgs[0]->getheight();
1695     my $img_num = 1;
1696     for my $img (@imgs) {
1697       $opts->{constants}{"w$img_num"} = $img->getwidth();
1698       $opts->{constants}{"h$img_num"} = $img->getheight();
1699       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1700       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1701       ++$img_num;
1702     }
1703   }
1704   if ($width) {
1705     $opts->{constants}{w} = $width;
1706     $opts->{constants}{cx} = $width/2;
1707   }
1708   else {
1709     $Imager::ERRSTR = "No width supplied";
1710     return;
1711   }
1712   if ($height) {
1713     $opts->{constants}{h} = $height;
1714     $opts->{constants}{cy} = $height/2;
1715   }
1716   else {
1717     $Imager::ERRSTR = "No height supplied";
1718     return;
1719   }
1720   my $code = Imager::Expr->new($opts);
1721   if (!$code) {
1722     $Imager::ERRSTR = Imager::Expr::error();
1723     return;
1724   }
1725
1726   my $img = Imager->new();
1727   $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
1728                              $code->nregs(), $code->cregs(),
1729                              [ map { $_->{IMG} } @imgs ]);
1730   if (!defined $img->{IMG}) {
1731     $Imager::ERRSTR = Imager->_error_as_msg();
1732     return;
1733   }
1734
1735   return $img;
1736 }
1737
1738 sub rubthrough {
1739   my $self=shift;
1740   my %opts=(tx => 0,ty => 0, @_);
1741
1742   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1743   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1744
1745   %opts = (src_minx => 0,
1746            src_miny => 0,
1747            src_maxx => $opts{src}->getwidth(),
1748            src_maxy => $opts{src}->getheight(),
1749            %opts);
1750
1751   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
1752           $opts{src_minx}, $opts{src_miny}, $opts{src_maxx}, $opts{src_maxy})) {
1753     $self->{ERRSTR} = $self->_error_as_msg();
1754     return undef;
1755   }
1756   return $self;
1757 }
1758
1759
1760 sub flip {
1761   my $self  = shift;
1762   my %opts  = @_;
1763   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
1764   my $dir;
1765   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
1766   $dir = $xlate{$opts{'dir'}};
1767   return $self if i_flipxy($self->{IMG}, $dir);
1768   return ();
1769 }
1770
1771 sub rotate {
1772   my $self = shift;
1773   my %opts = @_;
1774   if (defined $opts{right}) {
1775     my $degrees = $opts{right};
1776     if ($degrees < 0) {
1777       $degrees += 360 * int(((-$degrees)+360)/360);
1778     }
1779     $degrees = $degrees % 360;
1780     if ($degrees == 0) {
1781       return $self->copy();
1782     }
1783     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
1784       my $result = Imager->new();
1785       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
1786         return $result;
1787       }
1788       else {
1789         $self->{ERRSTR} = $self->_error_as_msg();
1790         return undef;
1791       }
1792     }
1793     else {
1794       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
1795       return undef;
1796     }
1797   }
1798   elsif (defined $opts{radians} || defined $opts{degrees}) {
1799     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
1800
1801     my $result = Imager->new;
1802     if ($result->{IMG} = i_rotate_exact($self->{IMG}, $amount)) {
1803       return $result;
1804     }
1805     else {
1806       $self->{ERRSTR} = $self->_error_as_msg();
1807       return undef;
1808     }
1809   }
1810   else {
1811     $self->{ERRSTR} = "Only the 'right' parameter is available";
1812     return undef;
1813   }
1814 }
1815
1816 sub matrix_transform {
1817   my $self = shift;
1818   my %opts = @_;
1819
1820   if ($opts{matrix}) {
1821     my $xsize = $opts{xsize} || $self->getwidth;
1822     my $ysize = $opts{ysize} || $self->getheight;
1823
1824     my $result = Imager->new;
1825     $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
1826                                         $opts{matrix})
1827       or return undef;
1828
1829     return $result;
1830   }
1831   else {
1832     $self->{ERRSTR} = "matrix parameter required";
1833     return undef;
1834   }
1835 }
1836
1837 # blame Leolo :)
1838 *yatf = \&matrix_transform;
1839
1840 # These two are supported for legacy code only
1841
1842 sub i_color_new {
1843   return Imager::Color->new(@_);
1844 }
1845
1846 sub i_color_set {
1847   return Imager::Color::set(@_);
1848 }
1849
1850 # Draws a box between the specified corner points.
1851 sub box {
1852   my $self=shift;
1853   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1854   my $dflcl=i_color_new(255,255,255,255);
1855   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1856
1857   if (exists $opts{'box'}) {
1858     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1859     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1860     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1861     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1862   }
1863
1864   if ($opts{filled}) {
1865     my $color = _color($opts{'color'});
1866     unless ($color) {
1867       $self->{ERRSTR} = $Imager::ERRSTR;
1868       return;
1869     }
1870     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1871                  $opts{ymax}, $color);
1872   }
1873   elsif ($opts{fill}) {
1874     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1875       # assume it's a hash ref
1876       require 'Imager/Fill.pm';
1877       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1878         $self->{ERRSTR} = $Imager::ERRSTR;
1879         return undef;
1880       }
1881     }
1882     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1883                 $opts{ymax},$opts{fill}{fill});
1884   }
1885   else {
1886     my $color = _color($opts{'color'});
1887     unless ($color) {
1888       $self->{ERRSTR} = $Imager::ERRSTR;
1889       return;
1890     }
1891     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
1892           $color);
1893   }
1894   return $self;
1895 }
1896
1897 # Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1898
1899 sub arc {
1900   my $self=shift;
1901   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1902   my $dflcl=i_color_new(255,255,255,255);
1903   my %opts=(color=>$dflcl,
1904             'r'=>min($self->getwidth(),$self->getheight())/3,
1905             'x'=>$self->getwidth()/2,
1906             'y'=>$self->getheight()/2,
1907             'd1'=>0, 'd2'=>361, @_);
1908   if ($opts{fill}) {
1909     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1910       # assume it's a hash ref
1911       require 'Imager/Fill.pm';
1912       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1913         $self->{ERRSTR} = $Imager::ERRSTR;
1914         return;
1915       }
1916     }
1917     i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
1918                 $opts{'d2'}, $opts{fill}{fill});
1919   }
1920   else {
1921     my $color = _color($opts{'color'});
1922     unless ($color) {
1923       $self->{ERRSTR} = $Imager::ERRSTR;
1924       return;
1925     }
1926     if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
1927       i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
1928                   $color);
1929     }
1930     else {
1931       if ($opts{'d1'} <= $opts{'d2'}) {
1932         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1933               $opts{'d1'}, $opts{'d2'}, $color);
1934       }
1935       else {
1936         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1937               $opts{'d1'}, 361,         $color);
1938         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1939               0,           $opts{'d2'}, $color);
1940       }
1941     }
1942   }
1943
1944   return $self;
1945 }
1946
1947 # Draws a line from one point to the other
1948 # the endpoint is set if the endp parameter is set which it is by default.
1949 # to turn of the endpoint being set use endp=>0 when calling line.
1950
1951 sub line {
1952   my $self=shift;
1953   my $dflcl=i_color_new(0,0,0,0);
1954   my %opts=(color=>$dflcl,
1955             endp => 1,
1956             @_);
1957   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1958
1959   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
1960   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
1961
1962   my $color = _color($opts{'color'});
1963   unless ($color) {
1964     $self->{ERRSTR} = $Imager::ERRSTR;
1965     return;
1966   }
1967
1968   $opts{antialias} = $opts{aa} if defined $opts{aa};
1969   if ($opts{antialias}) {
1970     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
1971               $color, $opts{endp});
1972   } else {
1973     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
1974            $color, $opts{endp});
1975   }
1976   return $self;
1977 }
1978
1979 # Draws a line between an ordered set of points - It more or less just transforms this
1980 # into a list of lines.
1981
1982 sub polyline {
1983   my $self=shift;
1984   my ($pt,$ls,@points);
1985   my $dflcl=i_color_new(0,0,0,0);
1986   my %opts=(color=>$dflcl,@_);
1987
1988   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1989
1990   if (exists($opts{points})) { @points=@{$opts{points}}; }
1991   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
1992     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
1993     }
1994
1995 #  print Dumper(\@points);
1996
1997   my $color = _color($opts{'color'});
1998   unless ($color) {
1999     $self->{ERRSTR} = $Imager::ERRSTR;
2000     return;
2001   }
2002   $opts{antialias} = $opts{aa} if defined $opts{aa};
2003   if ($opts{antialias}) {
2004     for $pt(@points) {
2005       if (defined($ls)) {
2006         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2007       }
2008       $ls=$pt;
2009     }
2010   } else {
2011     for $pt(@points) {
2012       if (defined($ls)) {
2013         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2014       }
2015       $ls=$pt;
2016     }
2017   }
2018   return $self;
2019 }
2020
2021 sub polygon {
2022   my $self = shift;
2023   my ($pt,$ls,@points);
2024   my $dflcl = i_color_new(0,0,0,0);
2025   my %opts = (color=>$dflcl, @_);
2026
2027   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2028
2029   if (exists($opts{points})) {
2030     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2031     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2032   }
2033
2034   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2035     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2036   }
2037
2038   if ($opts{'fill'}) {
2039     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2040       # assume it's a hash ref
2041       require 'Imager/Fill.pm';
2042       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2043         $self->{ERRSTR} = $Imager::ERRSTR;
2044         return undef;
2045       }
2046     }
2047     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2048                     $opts{'fill'}{'fill'});
2049   }
2050   else {
2051     my $color = _color($opts{'color'});
2052     unless ($color) {
2053       $self->{ERRSTR} = $Imager::ERRSTR;
2054       return;
2055     }
2056     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2057   }
2058
2059   return $self;
2060 }
2061
2062
2063 # this the multipoint bezier curve
2064 # this is here more for testing that actual usage since
2065 # this is not a good algorithm.  Usually the curve would be
2066 # broken into smaller segments and each done individually.
2067
2068 sub polybezier {
2069   my $self=shift;
2070   my ($pt,$ls,@points);
2071   my $dflcl=i_color_new(0,0,0,0);
2072   my %opts=(color=>$dflcl,@_);
2073
2074   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2075
2076   if (exists $opts{points}) {
2077     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2078     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2079   }
2080
2081   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2082     $self->{ERRSTR}='Missing or invalid points.';
2083     return;
2084   }
2085
2086   my $color = _color($opts{'color'});
2087   unless ($color) {
2088     $self->{ERRSTR} = $Imager::ERRSTR;
2089     return;
2090   }
2091   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2092   return $self;
2093 }
2094
2095 sub flood_fill {
2096   my $self = shift;
2097   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2098   my $rc;
2099
2100   unless (exists $opts{'x'} && exists $opts{'y'}) {
2101     $self->{ERRSTR} = "missing seed x and y parameters";
2102     return undef;
2103   }
2104
2105   if ($opts{fill}) {
2106     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2107       # assume it's a hash ref
2108       require 'Imager/Fill.pm';
2109       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2110         $self->{ERRSTR} = $Imager::ERRSTR;
2111         return;
2112       }
2113     }
2114     $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2115   }
2116   else {
2117     my $color = _color($opts{'color'});
2118     unless ($color) {
2119       $self->{ERRSTR} = $Imager::ERRSTR;
2120       return;
2121     }
2122     $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2123   }
2124   if ($rc) { $self; } else { $self->{ERRSTR} = $self->_error_as_msg(); return (); }
2125 }
2126
2127 sub setpixel {
2128   my $self = shift;
2129
2130   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2131
2132   unless (exists $opts{'x'} && exists $opts{'y'}) {
2133     $self->{ERRSTR} = 'missing x and y parameters';
2134     return undef;
2135   }
2136
2137   my $x = $opts{'x'};
2138   my $y = $opts{'y'};
2139   my $color = _color($opts{color})
2140     or return undef;
2141   if (ref $x && ref $y) {
2142     unless (@$x == @$y) {
2143       $self->{ERRSTR} = 'length of x and y mismatch';
2144       return undef;
2145     }
2146     if ($color->isa('Imager::Color')) {
2147       for my $i (0..$#{$opts{'x'}}) {
2148         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2149       }
2150     }
2151     else {
2152       for my $i (0..$#{$opts{'x'}}) {
2153         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2154       }
2155     }
2156   }
2157   else {
2158     if ($color->isa('Imager::Color')) {
2159       i_ppix($self->{IMG}, $x, $y, $color);
2160     }
2161     else {
2162       i_ppixf($self->{IMG}, $x, $y, $color);
2163     }
2164   }
2165
2166   $self;
2167 }
2168
2169 sub getpixel {
2170   my $self = shift;
2171
2172   my %opts = ( "type"=>'8bit', @_);
2173
2174   unless (exists $opts{'x'} && exists $opts{'y'}) {
2175     $self->{ERRSTR} = 'missing x and y parameters';
2176     return undef;
2177   }
2178
2179   my $x = $opts{'x'};
2180   my $y = $opts{'y'};
2181   if (ref $x && ref $y) {
2182     unless (@$x == @$y) {
2183       $self->{ERRSTR} = 'length of x and y mismatch';
2184       return undef;
2185     }
2186     my @result;
2187     if ($opts{"type"} eq '8bit') {
2188       for my $i (0..$#{$opts{'x'}}) {
2189         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2190       }
2191     }
2192     else {
2193       for my $i (0..$#{$opts{'x'}}) {
2194         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2195       }
2196     }
2197     return wantarray ? @result : \@result;
2198   }
2199   else {
2200     if ($opts{"type"} eq '8bit') {
2201       return i_get_pixel($self->{IMG}, $x, $y);
2202     }
2203     else {
2204       return i_gpixf($self->{IMG}, $x, $y);
2205     }
2206   }
2207
2208   $self;
2209 }
2210
2211 # make an identity matrix of the given size
2212 sub _identity {
2213   my ($size) = @_;
2214
2215   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
2216   for my $c (0 .. ($size-1)) {
2217     $matrix->[$c][$c] = 1;
2218   }
2219   return $matrix;
2220 }
2221
2222 # general function to convert an image
2223 sub convert {
2224   my ($self, %opts) = @_;
2225   my $matrix;
2226
2227   # the user can either specify a matrix or preset
2228   # the matrix overrides the preset
2229   if (!exists($opts{matrix})) {
2230     unless (exists($opts{preset})) {
2231       $self->{ERRSTR} = "convert() needs a matrix or preset";
2232       return;
2233     }
2234     else {
2235       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2236         # convert to greyscale, keeping the alpha channel if any
2237         if ($self->getchannels == 3) {
2238           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2239         }
2240         elsif ($self->getchannels == 4) {
2241           # preserve the alpha channel
2242           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2243                       [ 0,     0,     0,     1 ] ];
2244         }
2245         else {
2246           # an identity
2247           $matrix = _identity($self->getchannels);
2248         }
2249       }
2250       elsif ($opts{preset} eq 'noalpha') {
2251         # strip the alpha channel
2252         if ($self->getchannels == 2 or $self->getchannels == 4) {
2253           $matrix = _identity($self->getchannels);
2254           pop(@$matrix); # lose the alpha entry
2255         }
2256         else {
2257           $matrix = _identity($self->getchannels);
2258         }
2259       }
2260       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2261         # extract channel 0
2262         $matrix = [ [ 1 ] ];
2263       }
2264       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
2265         $matrix = [ [ 0, 1 ] ];
2266       }
2267       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
2268         $matrix = [ [ 0, 0, 1 ] ];
2269       }
2270       elsif ($opts{preset} eq 'alpha') {
2271         if ($self->getchannels == 2 or $self->getchannels == 4) {
2272           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
2273         }
2274         else {
2275           # the alpha is just 1 <shrug>
2276           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
2277         }
2278       }
2279       elsif ($opts{preset} eq 'rgb') {
2280         if ($self->getchannels == 1) {
2281           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
2282         }
2283         elsif ($self->getchannels == 2) {
2284           # preserve the alpha channel
2285           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
2286         }
2287         else {
2288           $matrix = _identity($self->getchannels);
2289         }
2290       }
2291       elsif ($opts{preset} eq 'addalpha') {
2292         if ($self->getchannels == 1) {
2293           $matrix = _identity(2);
2294         }
2295         elsif ($self->getchannels == 3) {
2296           $matrix = _identity(4);
2297         }
2298         else {
2299           $matrix = _identity($self->getchannels);
2300         }
2301       }
2302       else {
2303         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
2304         return undef;
2305       }
2306     }
2307   }
2308   else {
2309     $matrix = $opts{matrix};
2310   }
2311
2312   my $new = Imager->new();
2313   $new->{IMG} = i_img_new();
2314   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
2315     # most likely a bad matrix
2316     $self->{ERRSTR} = _error_as_msg();
2317     return undef;
2318   }
2319   return $new;
2320 }
2321
2322
2323 # general function to map an image through lookup tables
2324
2325 sub map {
2326   my ($self, %opts) = @_;
2327   my @chlist = qw( red green blue alpha );
2328
2329   if (!exists($opts{'maps'})) {
2330     # make maps from channel maps
2331     my $chnum;
2332     for $chnum (0..$#chlist) {
2333       if (exists $opts{$chlist[$chnum]}) {
2334         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
2335       } elsif (exists $opts{'all'}) {
2336         $opts{'maps'}[$chnum] = $opts{'all'};
2337       }
2338     }
2339   }
2340   if ($opts{'maps'} and $self->{IMG}) {
2341     i_map($self->{IMG}, $opts{'maps'} );
2342   }
2343   return $self;
2344 }
2345
2346 sub difference {
2347   my ($self, %opts) = @_;
2348
2349   defined $opts{mindist} or $opts{mindist} = 0;
2350
2351   defined $opts{other}
2352     or return $self->_set_error("No 'other' parameter supplied");
2353   defined $opts{other}{IMG}
2354     or return $self->_set_error("No image data in 'other' image");
2355
2356   $self->{IMG}
2357     or return $self->_set_error("No image data");
2358
2359   my $result = Imager->new;
2360   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
2361                                 $opts{mindist})
2362     or return $self->_set_error($self->_error_as_msg());
2363
2364   return $result;
2365 }
2366
2367 # destructive border - image is shrunk by one pixel all around
2368
2369 sub border {
2370   my ($self,%opts)=@_;
2371   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
2372   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
2373 }
2374
2375
2376 # Get the width of an image
2377
2378 sub getwidth {
2379   my $self = shift;
2380   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2381   return (i_img_info($self->{IMG}))[0];
2382 }
2383
2384 # Get the height of an image
2385
2386 sub getheight {
2387   my $self = shift;
2388   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2389   return (i_img_info($self->{IMG}))[1];
2390 }
2391
2392 # Get number of channels in an image
2393
2394 sub getchannels {
2395   my $self = shift;
2396   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2397   return i_img_getchannels($self->{IMG});
2398 }
2399
2400 # Get channel mask
2401
2402 sub getmask {
2403   my $self = shift;
2404   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2405   return i_img_getmask($self->{IMG});
2406 }
2407
2408 # Set channel mask
2409
2410 sub setmask {
2411   my $self = shift;
2412   my %opts = @_;
2413   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2414   i_img_setmask( $self->{IMG} , $opts{mask} );
2415 }
2416
2417 # Get number of colors in an image
2418
2419 sub getcolorcount {
2420   my $self=shift;
2421   my %opts=('maxcolors'=>2**30,@_);
2422   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2423   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2424   return ($rc==-1? undef : $rc);
2425 }
2426
2427 # draw string to an image
2428
2429 sub string {
2430   my $self = shift;
2431   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2432
2433   my %input=('x'=>0, 'y'=>0, @_);
2434   $input{string}||=$input{text};
2435
2436   unless(exists $input{string}) {
2437     $self->{ERRSTR}="missing required parameter 'string'";
2438     return;
2439   }
2440
2441   unless($input{font}) {
2442     $self->{ERRSTR}="missing required parameter 'font'";
2443     return;
2444   }
2445
2446   unless ($input{font}->draw(image=>$self, %input)) {
2447     $self->{ERRSTR} = $self->_error_as_msg();
2448     return;
2449   }
2450
2451   return $self;
2452 }
2453
2454 # Shortcuts that can be exported
2455
2456 sub newcolor { Imager::Color->new(@_); }
2457 sub newfont  { Imager::Font->new(@_); }
2458
2459 *NC=*newcolour=*newcolor;
2460 *NF=*newfont;
2461
2462 *open=\&read;
2463 *circle=\&arc;
2464
2465
2466 #### Utility routines
2467
2468 sub errstr {
2469   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2470 }
2471
2472 sub _set_error {
2473   my ($self, $msg) = @_;
2474
2475   if (ref $self) {
2476     $self->{ERRSTR} = $msg;
2477   }
2478   else {
2479     $ERRSTR = $msg;
2480   }
2481   return;
2482 }
2483
2484 # Default guess for the type of an image from extension
2485
2486 sub def_guess_type {
2487   my $name=lc(shift);
2488   my $ext;
2489   $ext=($name =~ m/\.([^\.]+)$/)[0];
2490   return 'tiff' if ($ext =~ m/^tiff?$/);
2491   return 'jpeg' if ($ext =~ m/^jpe?g$/);
2492   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
2493   return 'png'  if ($ext eq "png");
2494   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
2495   return 'tga'  if ($ext eq "tga");
2496   return 'rgb'  if ($ext eq "rgb");
2497   return 'gif'  if ($ext eq "gif");
2498   return 'raw'  if ($ext eq "raw");
2499   return ();
2500 }
2501
2502 # get the minimum of a list
2503
2504 sub min {
2505   my $mx=shift;
2506   for(@_) { if ($_<$mx) { $mx=$_; }}
2507   return $mx;
2508 }
2509
2510 # get the maximum of a list
2511
2512 sub max {
2513   my $mx=shift;
2514   for(@_) { if ($_>$mx) { $mx=$_; }}
2515   return $mx;
2516 }
2517
2518 # string stuff for iptc headers
2519
2520 sub clean {
2521   my($str)=$_[0];
2522   $str = substr($str,3);
2523   $str =~ s/[\n\r]//g;
2524   $str =~ s/\s+/ /g;
2525   $str =~ s/^\s//;
2526   $str =~ s/\s$//;
2527   return $str;
2528 }
2529
2530 # A little hack to parse iptc headers.
2531
2532 sub parseiptc {
2533   my $self=shift;
2534   my(@sar,$item,@ar);
2535   my($caption,$photogr,$headln,$credit);
2536
2537   my $str=$self->{IPTCRAW};
2538
2539   #print $str;
2540
2541   @ar=split(/8BIM/,$str);
2542
2543   my $i=0;
2544   foreach (@ar) {
2545     if (/^\004\004/) {
2546       @sar=split(/\034\002/);
2547       foreach $item (@sar) {
2548         if ($item =~ m/^x/) {
2549           $caption=&clean($item);
2550           $i++;
2551         }
2552         if ($item =~ m/^P/) {
2553           $photogr=&clean($item);
2554           $i++;
2555         }
2556         if ($item =~ m/^i/) {
2557           $headln=&clean($item);
2558           $i++;
2559         }
2560         if ($item =~ m/^n/) {
2561           $credit=&clean($item);
2562           $i++;
2563         }
2564       }
2565     }
2566   }
2567   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
2568 }
2569
2570 # Autoload methods go after =cut, and are processed by the autosplit program.
2571
2572 1;
2573 __END__
2574 # Below is the stub of documentation for your module. You better edit it!
2575
2576 =head1 NAME
2577
2578 Imager - Perl extension for Generating 24 bit Images
2579
2580 =head1 SYNOPSIS
2581
2582   # Thumbnail example
2583
2584   #!/usr/bin/perl -w
2585   use strict;
2586   use Imager;
2587
2588   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
2589   my $file = shift;
2590
2591   my $format;
2592
2593   my $img = Imager->new();
2594   $img->open(file=>$file) or die $img->errstr();
2595
2596   $file =~ s/\.[^.]*$//;
2597
2598   # Create smaller version
2599   my $thumb = $img->scale(scalefactor=>.3);
2600
2601   # Autostretch individual channels
2602   $thumb->filter(type=>'autolevels');
2603
2604   # try to save in one of these formats
2605   SAVE:
2606
2607   for $format ( qw( png gif jpg tiff ppm ) ) {
2608     # Check if given format is supported
2609     if ($Imager::formats{$format}) {
2610       $file.="_low.$format";
2611       print "Storing image as: $file\n";
2612       $thumb->write(file=>$file) or
2613         die $thumb->errstr;
2614       last SAVE;
2615     }
2616   }
2617
2618
2619
2620
2621 =head1 DESCRIPTION
2622
2623 Imager is a module for creating and altering images.  It can read and
2624 write various image formats, draw primitive shapes like lines,and
2625 polygons, blend multiple images together in various ways, scale, crop,
2626 render text and more.
2627
2628 =head2 Overview of documentation
2629
2630 =over
2631
2632 =item Imager
2633
2634 This document - Synopsis Example, Table of Contents and Overview.
2635
2636 =item Imager::ImageTypes
2637
2638 Basics of constructing image objects with C<new()>:
2639 Direct type/virtual images, RGB(A)/paletted images, 8/16/double
2640 bits/channel, color maps, channel masks, image tags, color
2641 quantization.  Also discusses basic image information methods.
2642
2643 =item Imager::Files
2644
2645 IO interaction, reading/writing images, format specific tags.
2646
2647 =item Imager::Draw
2648
2649 Drawing Primitives, lines, boxes, circles, arcs, flood fill.
2650
2651 =item Imager::Color
2652
2653 Color specification.
2654
2655 =item Imager::Fill
2656
2657 Fill pattern specification.
2658
2659 =item Imager::Font
2660
2661 General font rendering, bounding boxes and font metrics.
2662
2663 =item Imager::Transformations
2664
2665 Copying, scaling, cropping, flipping, blending, pasting, convert and
2666 map.
2667
2668 =item Imager::Engines
2669
2670 Programmable transformations through C<transform()>, C<transform2()>
2671 and C<matrix_transform()>.
2672
2673 =item Imager::Filters
2674
2675 Filters, sharpen, blur, noise, convolve etc. and filter plugins.
2676
2677 =item Imager::Expr
2678
2679 Expressions for evaluation engine used by transform2().
2680
2681 =item Imager::Matrix2d
2682
2683 Helper class for affine transformations.
2684
2685 =item Imager::Fountain
2686
2687 Helper for making gradient profiles.
2688
2689 =back
2690
2691
2692
2693 =head2 Basic Overview
2694
2695 An Image object is created with C<$img = Imager-E<gt>new()>.
2696 Examples:
2697
2698   $img=Imager->new();                         # create empty image
2699   $img->open(file=>'lena.png',type=>'png') or # read image from file
2700      die $img->errstr();                      # give an explanation
2701                                               # if something failed
2702
2703 or if you want to create an empty image:
2704
2705   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
2706
2707 This example creates a completely black image of width 400 and height
2708 300 and 4 channels.
2709
2710 When an operation fails which can be directly associated with an image
2711 the error message is stored can be retrieved with
2712 C<$img-E<gt>errstr()>.
2713
2714 In cases where no image object is associated with an operation
2715 C<$Imager::ERRSTR> is used to report errors not directly associated
2716 with an image object.
2717
2718 The C<Imager-E<gt>new> method is described in detail in the
2719 Imager::ImageTypes manpage.
2720
2721 =head1 SUPPORT
2722
2723 You can ask for help, report bugs or express your undying love for
2724 Imager on the Imager-devel mailing list.
2725
2726 To subscribe send a message with C<subscribe> in the body to:
2727
2728    imager-devel+request@molar.is
2729
2730 or use the form at:
2731
2732    http://www.molar.is/en/lists/imager-devel/
2733    (annonymous is temporarily off due to spam)
2734
2735 where you can also find the mailing list archive.
2736
2737 If you're into IRC, you can typically find the developers in #Imager
2738 on irc.rhizomatic.net.  As with any IRC channel, the participants
2739 could be occupied or asleep, so please be patient.
2740
2741 =head1 BUGS
2742
2743 Bugs are listed individually for relevant pod pages.
2744
2745 =head1 AUTHOR
2746
2747 Arnar M. Hrafnkelsson (addi@imager.perl.org) and Tony Cook
2748 (tony@imager.perl.org) See the README for a complete list.
2749
2750 =head1 SEE ALSO
2751
2752 perl(1), Imager::ImageTypes(3), Imager::Files(3), Imager::Draw(3),
2753 Imager::Color(3), Imager::Fill(3), Imager::Font(3),
2754 Imager::Transformations(3), Imager::Engines(3), Imager::Filters(3),
2755 Imager::Expr(3), Imager::Matrix2d(3), Imager::Fountain(3)
2756
2757 Affix::Infix2Postfix(3), Parse::RecDescent(3)
2758 http://www.eecs.umich.edu/~addi/perl/Imager/
2759
2760 =cut
2761
2762
2763
2764