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