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);
   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_draw
  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_callback
  89                 i_writegif
  90                 i_writegifmc
  91                 i_writegif_gen
  92                 i_writegif_callback
  93
  94                 i_readpnm_wiol
  95                 i_writeppm_wiol
  96
  97                 i_readraw_wiol
  98                 i_writeraw_wiol
  99
 100                 i_contrast
 101                 i_hardinvert
 102                 i_noise
 103                 i_bumpmap
 104                 i_postlevels
 105                 i_mosaic
 106                 i_watermark
 107
 108                 malloc_state
 109
 110                 list_formats
 111
 112                 i_gifquant
 113
 114                 newfont
 115                 newcolor
 116                 newcolour
 117                 NC
 118                 NF
 119 );
 120
 121 @EXPORT=qw(
 122            init_log
 123            i_list_formats
 124            i_has_format
 125            malloc_state
 126            i_color_new
 127
 128            i_img_empty
 129            i_img_empty_ch
 130           );
 131
 132 %EXPORT_TAGS=
 133   (handy => [qw(
 134                 newfont
 135                 newcolor
 136                 NF
 137                 NC
 138                )],
 139    all => [@EXPORT_OK],
 140    default => [qw(
 141                   load_plugin
 142                   unload_plugin
 143                  )]);
 144
 145 BEGIN {
 146   require Exporter;
 147   require DynaLoader;
 148
 149   $VERSION = '0.39';
 150   @ISA = qw(Exporter DynaLoader);
 151   bootstrap Imager $VERSION;
 152 }
 153
 154 BEGIN {
 155   i_init_fonts(); # Initialize font engines
 156   Imager::Font::__init();
 157   for(i_list_formats()) { $formats{$_}++; }
 158
 159   if ($formats{'t1'}) {
 160     i_t1_set_aa(1);
 161   }
 162
 163   if (!$formats{'t1'} and !$formats{'tt'}
 164       && !$formats{'ft2'} && !$formats{'w32'}) {
 165     $fontstate='no font support';
 166   }
 167
 168   %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
 169
 170   $DEBUG=0;
 171
 172   # the members of the subhashes under %filters are:
 173   #  callseq - a list of the parameters to the underlying filter in the
 174   #            order they are passed
 175   #  callsub - a code ref that takes a named parameter list and calls the
 176   #            underlying filter
 177   #  defaults - a hash of default values
 178   #  names - defines names for value of given parameters so if the names
 179   #          field is foo=> { bar=>1 }, and the user supplies "bar" as the
 180   #          foo parameter, the filter will receive 1 for the foo
 181   #          parameter
 182   $filters{contrast}={
 183                       callseq => ['image','intensity'],
 184                       callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); }
 185                      };
 186
 187   $filters{noise} ={
 188                     callseq => ['image', 'amount', 'subtype'],
 189                     defaults => { amount=>3,subtype=>0 },
 190                     callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
 191                    };
 192
 193   $filters{hardinvert} ={
 194                          callseq => ['image'],
 195                          defaults => { },
 196                          callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
 197                         };
 198
 199   $filters{autolevels} ={
 200                          callseq => ['image','lsat','usat','skew'],
 201                          defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
 202                          callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
 203                         };
 204
 205   $filters{turbnoise} ={
 206                         callseq => ['image'],
 207                         defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
 208                         callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
 209                        };
 210
 211   $filters{radnoise} ={
 212                        callseq => ['image'],
 213                        defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
 214                        callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
 215                       };
 216
 217   $filters{conv} ={
 218                        callseq => ['image', 'coef'],
 219                        defaults => { },
 220                        callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
 221                       };
 222
 223   $filters{gradgen} ={
 224                        callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 225                        defaults => { },
 226                        callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 227                       };
 228
 229   $filters{nearest_color} ={
 230                             callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 231                             defaults => { },
 232                             callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 233                            };
 234   $filters{gaussian} = {
 235                         callseq => [ 'image', 'stddev' ],
 236                         defaults => { },
 237                         callsub => sub { my %hsh = @_; i_gaussian($hsh{image}, $hsh{stddev}); },
 238                        };
 239   $filters{mosaic} =
 240     {
 241      callseq => [ qw(image size) ],
 242      defaults => { size => 20 },
 243      callsub => sub { my %hsh = @_; i_mosaic($hsh{image}, $hsh{size}) },
 244     };
 245   $filters{bumpmap} =
 246     {
 247      callseq => [ qw(image bump elevation lightx lighty st) ],
 248      defaults => { elevation=>0, st=> 2 },
 249      callsub => sub {
 250        my %hsh = @_;
 251        i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation},
 252                  $hsh{lightx}, $hsh{lighty}, $hsh{st});
 253      },
 254     };
 255   $filters{bumpmap_complex} =
 256     {
 257      callseq => [ qw(image bump channel tx ty Lx Ly Lz cd cs n Ia Il Is) ],
 258      defaults => {
 259                   channel => 0,
 260                   tx => 0,
 261                   ty => 0,
 262                   Lx => 0.2,
 263                   Ly => 0.4,
 264                   Lz => -1.0,
 265                   cd => 1.0,
 266                   cs => 40,
 267                   n => 1.3,
 268                   Ia => Imager::Color->new(rgb=>[0,0,0]),
 269                   Il => Imager::Color->new(rgb=>[255,255,255]),
 270                   Is => Imager::Color->new(rgb=>[255,255,255]),
 271                  },
 272      callsub => sub {
 273        my %hsh = @_;
 274        i_bumpmap_complex($hsh{image}, $hsh{bump}{IMG}, $hsh{channel},
 275                  $hsh{tx}, $hsh{ty}, $hsh{Lx}, $hsh{Ly}, $hsh{Lz},
 276                  $hsh{cd}, $hsh{cs}, $hsh{n}, $hsh{Ia}, $hsh{Il},
 277                  $hsh{Is});
 278      },
 279     };
 280   $filters{postlevels} =
 281     {
 282      callseq  => [ qw(image levels) ],
 283      defaults => { levels => 10 },
 284      callsub  => sub { my %hsh = @_; i_postlevels($hsh{image}, $hsh{levels}); },
 285     };
 286   $filters{watermark} =
 287     {
 288      callseq  => [ qw(image wmark tx ty pixdiff) ],
 289      defaults => { pixdiff=>10, tx=>0, ty=>0 },
 290      callsub  =>
 291      sub {
 292        my %hsh = @_;
 293        i_watermark($hsh{image}, $hsh{wmark}{IMG}, $hsh{tx}, $hsh{ty},
 294                    $hsh{pixdiff});
 295      },
 296     };
 297   $filters{fountain} =
 298     {
 299      callseq  => [ qw(image xa ya xb yb ftype repeat combine super_sample ssample_param segments) ],
 300      names    => {
 301                   ftype => { linear         => 0,
 302                              bilinear       => 1,
 303                              radial         => 2,
 304                              radial_square  => 3,
 305                              revolution     => 4,
 306                              conical        => 5 },
 307                   repeat => { none      => 0,
 308                               sawtooth  => 1,
 309                               triangle  => 2,
 310                               saw_both  => 3,
 311                               tri_both  => 4,
 312                             },
 313                   super_sample => {
 314                                    none    => 0,
 315                                    grid    => 1,
 316                                    random  => 2,
 317                                    circle  => 3,
 318                                   },
 319                   combine => {
 320                               none      => 0,
 321                               normal    => 1,
 322                               multiply  => 2, mult => 2,
 323                               dissolve  => 3,
 324                               add       => 4,
 325                               subtract  => 5, 'sub' => 5,
 326                               diff      => 6,
 327                               lighten   => 7,
 328                               darken    => 8,
 329                               hue       => 9,
 330                               sat       => 10,
 331                               value     => 11,
 332                               color     => 12,
 333                              },
 334                  },
 335      defaults => { ftype => 0, repeat => 0, combine => 0,
 336                    super_sample => 0, ssample_param => 4,
 337                    segments=>[
 338                               [ 0, 0.5, 1,
 339                                 Imager::Color->new(0,0,0),
 340                                 Imager::Color->new(255, 255, 255),
 341                                 0, 0,
 342                               ],
 343                              ],
 344                  },
 345      callsub  =>
 346      sub {
 347        my %hsh = @_;
 348        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
 349                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
 350                   $hsh{ssample_param}, $hsh{segments});
 351      },
 352     };
 353   $filters{unsharpmask} =
 354     {
 355      callseq => [ qw(image stddev scale) ],
 356      defaults => { stddev=>2.0, scale=>1.0 },
 357      callsub =>
 358      sub {
 359        my %hsh = @_;
 360        i_unsharp_mask($hsh{image}, $hsh{stddev}, $hsh{scale});
 361      },
 362     };
 363
 364   $FORMATGUESS=\&def_guess_type;
 365 }
 366
 367 #
 368 # Non methods
 369 #
 370
 371 # initlize Imager
 372 # NOTE: this might be moved to an import override later on
 373
 374 #sub import {
 375 #  my $pack = shift;
 376 #  (look through @_ for special tags, process, and remove them);
 377 #  use Data::Dumper;
 378 #  print Dumper($pack);
 379 #  print Dumper(@_);
 380 #}
 381
 382 sub init {
 383   my %parms=(loglevel=>1,@_);
 384   if ($parms{'log'}) {
 385     init_log($parms{'log'},$parms{'loglevel'});
 386   }
 387
 388 #    if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
 389 #    if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
 390 #       i_init_fonts();
 391 #       $fontstate='ok';
 392 #    }
 393 }
 394
 395 END {
 396   if ($DEBUG) {
 397     print "shutdown code\n";
 398     #   for(keys %instances) { $instances{$_}->DESTROY(); }
 399     malloc_state(); # how do decide if this should be used? -- store something from the import
 400     print "Imager exiting\n";
 401   }
 402 }
 403
 404 # Load a filter plugin
 405
 406 sub load_plugin {
 407   my ($filename)=@_;
 408   my $i;
 409   my ($DSO_handle,$str)=DSO_open($filename);
 410   if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
 411   my %funcs=DSO_funclist($DSO_handle);
 412   if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf("  %2d: %s\n",$i++,$_); } }
 413   $i=0;
 414   for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
 415
 416   $DSOs{$filename}=[$DSO_handle,\%funcs];
 417
 418   for(keys %funcs) {
 419     my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
 420     $DEBUG && print "eval string:\n",$evstr,"\n";
 421     eval $evstr;
 422     print $@ if $@;
 423   }
 424   return 1;
 425 }
 426
 427 # Unload a plugin
 428
 429 sub unload_plugin {
 430   my ($filename)=@_;
 431
 432   if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
 433   my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
 434   for(keys %{$funcref}) {
 435     delete $filters{$_};
 436     $DEBUG && print "unloading: $_\n";
 437   }
 438   my $rc=DSO_close($DSO_handle);
 439   if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
 440   return 1;
 441 }
 442
 443 # take the results of i_error() and make a message out of it
 444 sub _error_as_msg {
 445   return join(": ", map $_->[0], i_errors());
 446 }
 447
 448 # this function tries to DWIM for color parameters
 449 #  color objects are used as is
 450 #  simple scalars are simply treated as single parameters to Imager::Color->new
 451 #  hashrefs are treated as named argument lists to Imager::Color->new
 452 #  arrayrefs are treated as list arguments to Imager::Color->new iff any
 453 #    parameter is > 1
 454 #  other arrayrefs are treated as list arguments to Imager::Color::Float
 455
 456 sub _color {
 457   my $arg = shift;
 458   my $result;
 459
 460   if (ref $arg) {
 461     if (UNIVERSAL::isa($arg, "Imager::Color")
 462         || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
 463       $result = $arg;
 464     }
 465     else {
 466       if ($arg =~ /^HASH\(/) {
 467         $result = Imager::Color->new(%$arg);
 468       }
 469       elsif ($arg =~ /^ARRAY\(/) {
 470         if (grep $_ > 1, @$arg) {
 471           $result = Imager::Color->new(@$arg);
 472         }
 473         else {
 474           $result = Imager::Color::Float->new(@$arg);
 475         }
 476       }
 477       else {
 478         $Imager::ERRSTR = "Not a color";
 479       }
 480     }
 481   }
 482   else {
 483     # assume Imager::Color::new knows how to handle it
 484     $result = Imager::Color->new($arg);
 485   }
 486
 487   return $result;
 488 }
 489
 490
 491 #
 492 # Methods to be called on objects.
 493 #
 494
 495 # Create a new Imager object takes very few parameters.
 496 # usually you call this method and then call open from
 497 # the resulting object
 498
 499 sub new {
 500   my $class = shift;
 501   my $self ={};
 502   my %hsh=@_;
 503   bless $self,$class;
 504   $self->{IMG}=undef;    # Just to indicate what exists
 505   $self->{ERRSTR}=undef; #
 506   $self->{DEBUG}=$DEBUG;
 507   $self->{DEBUG} && print "Initialized Imager\n";
 508   if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
 509   return $self;
 510 }
 511
 512 # Copy an entire image with no changes
 513 # - if an image has magic the copy of it will not be magical
 514
 515 sub copy {
 516   my $self = shift;
 517   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 518
 519   my $newcopy=Imager->new();
 520   $newcopy->{IMG}=i_img_new();
 521   i_copy($newcopy->{IMG},$self->{IMG});
 522   return $newcopy;
 523 }
 524
 525 # Paste a region
 526
 527 sub paste {
 528   my $self = shift;
 529   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 530   my %input=(left=>0, top=>0, @_);
 531   unless($input{img}) {
 532     $self->{ERRSTR}="no source image";
 533     return;
 534   }
 535   $input{left}=0 if $input{left} <= 0;
 536   $input{top}=0 if $input{top} <= 0;
 537   my $src=$input{img};
 538   my($r,$b)=i_img_info($src->{IMG});
 539
 540   i_copyto($self->{IMG}, $src->{IMG},
 541            0,0, $r, $b, $input{left}, $input{top});
 542   return $self;  # What should go here??
 543 }
 544
 545 # Crop an image - i.e. return a new image that is smaller
 546
 547 sub crop {
 548   my $self=shift;
 549   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 550   my %hsh=(left=>0,right=>0,top=>0,bottom=>0,@_);
 551
 552   my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
 553                                 @hsh{qw(left right bottom top)});
 554   $l=0 if not defined $l;
 555   $t=0 if not defined $t;
 556
 557   $r||=$l+delete $hsh{'width'}    if defined $l and exists $hsh{'width'};
 558   $b||=$t+delete $hsh{'height'}   if defined $t and exists $hsh{'height'};
 559   $l||=$r-delete $hsh{'width'}    if defined $r and exists $hsh{'width'};
 560   $t||=$b-delete $hsh{'height'}   if defined $b and exists $hsh{'height'};
 561
 562   $r=$self->getwidth if not defined $r;
 563   $b=$self->getheight if not defined $b;
 564
 565   ($l,$r)=($r,$l) if $l>$r;
 566   ($t,$b)=($b,$t) if $t>$b;
 567
 568   if ($hsh{'width'}) {
 569     $l=int(0.5+($w-$hsh{'width'})/2);
 570     $r=$l+$hsh{'width'};
 571   } else {
 572     $hsh{'width'}=$r-$l;
 573   }
 574   if ($hsh{'height'}) {
 575     $b=int(0.5+($h-$hsh{'height'})/2);
 576     $t=$h+$hsh{'height'};
 577   } else {
 578     $hsh{'height'}=$b-$t;
 579   }
 580
 581 #    print "l=$l, r=$r, h=$hsh{'width'}\n";
 582 #    print "t=$t, b=$b, w=$hsh{'height'}\n";
 583
 584   my $dst=Imager->new(xsize=>$hsh{'width'}, ysize=>$hsh{'height'}, channels=>$self->getchannels());
 585
 586   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
 587   return $dst;
 588 }
 589
 590 # Sets an image to a certain size and channel number
 591 # if there was previously data in the image it is discarded
 592
 593 sub img_set {
 594   my $self=shift;
 595
 596   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
 597
 598   if (defined($self->{IMG})) {
 599     # let IIM_DESTROY destroy it, it's possible this image is
 600     # referenced from a virtual image (like masked)
 601     #i_img_destroy($self->{IMG});
 602     undef($self->{IMG});
 603   }
 604
 605   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
 606     $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
 607                                  $hsh{maxcolors} || 256);
 608   }
 609   elsif ($hsh{bits} eq 'double') {
 610     $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
 611   }
 612   elsif ($hsh{bits} == 16) {
 613     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
 614   }
 615   else {
 616     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
 617                                      $hsh{'channels'});
 618   }
 619 }
 620
 621 # created a masked version of the current image
 622 sub masked {
 623   my $self = shift;
 624
 625   $self or return undef;
 626   my %opts = (left    => 0,
 627               top     => 0,
 628               right   => $self->getwidth,
 629               bottom  => $self->getheight,
 630               @_);
 631   my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
 632
 633   my $result = Imager->new;
 634   $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left},
 635                                     $opts{top}, $opts{right} - $opts{left},
 636                                     $opts{bottom} - $opts{top});
 637   # keep references to the mask and base images so they don't
 638   # disappear on us
 639   $result->{DEPENDS} = [ $self->{IMG}, $mask ];
 640
 641   $result;
 642 }
 643
 644 # convert an RGB image into a paletted image
 645 sub to_paletted {
 646   my $self = shift;
 647   my $opts;
 648   if (@_ != 1 && !ref $_[0]) {
 649     $opts = { @_ };
 650   }
 651   else {
 652     $opts = shift;
 653   }
 654
 655   my $result = Imager->new;
 656   $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
 657
 658   #print "Type ", i_img_type($result->{IMG}), "\n";
 659
 660   $result->{IMG} or undef $result;
 661
 662   return $result;
 663 }
 664
 665 # convert a paletted (or any image) to an 8-bit/channel RGB images
 666 sub to_rgb8 {
 667   my $self = shift;
 668   my $result;
 669
 670   if ($self->{IMG}) {
 671     $result = Imager->new;
 672     $result->{IMG} = i_img_to_rgb($self->{IMG})
 673       or undef $result;
 674   }
 675
 676   return $result;
 677 }
 678
 679 sub addcolors {
 680   my $self = shift;
 681   my %opts = (colors=>[], @_);
 682
 683   @{$opts{colors}} or return undef;
 684
 685   $self->{IMG} and i_addcolors($self->{IMG}, @{$opts{colors}});
 686 }
 687
 688 sub setcolors {
 689   my $self = shift;
 690   my %opts = (start=>0, colors=>[], @_);
 691   @{$opts{colors}} or return undef;
 692
 693   $self->{IMG} and i_setcolors($self->{IMG}, $opts{start}, @{$opts{colors}});
 694 }
 695
 696 sub getcolors {
 697   my $self = shift;
 698   my %opts = @_;
 699   if (!exists $opts{start} && !exists $opts{count}) {
 700     # get them all
 701     $opts{start} = 0;
 702     $opts{count} = $self->colorcount;
 703   }
 704   elsif (!exists $opts{count}) {
 705     $opts{count} = 1;
 706   }
 707   elsif (!exists $opts{start}) {
 708     $opts{start} = 0;
 709   }
 710
 711   $self->{IMG} and
 712     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
 713 }
 714
 715 sub colorcount {
 716   i_colorcount($_[0]{IMG});
 717 }
 718
 719 sub maxcolors {
 720   i_maxcolors($_[0]{IMG});
 721 }
 722
 723 sub findcolor {
 724   my $self = shift;
 725   my %opts = @_;
 726   $opts{color} or return undef;
 727
 728   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
 729 }
 730
 731 sub bits {
 732   my $self = shift;
 733   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
 734   if ($bits && $bits == length(pack("d", 1)) * 8) {
 735     $bits = 'double';
 736   }
 737   $bits;
 738 }
 739
 740 sub type {
 741   my $self = shift;
 742   if ($self->{IMG}) {
 743     return i_img_type($self->{IMG}) ? "paletted" : "direct";
 744   }
 745 }
 746
 747 sub virtual {
 748   my $self = shift;
 749   $self->{IMG} and i_img_virtual($self->{IMG});
 750 }
 751
 752 sub tags {
 753   my ($self, %opts) = @_;
 754
 755   $self->{IMG} or return;
 756
 757   if (defined $opts{name}) {
 758     my @result;
 759     my $start = 0;
 760     my $found;
 761     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
 762       push @result, (i_tags_get($self->{IMG}, $found))[1];
 763       $start = $found+1;
 764     }
 765     return wantarray ? @result : $result[0];
 766   }
 767   elsif (defined $opts{code}) {
 768     my @result;
 769     my $start = 0;
 770     my $found;
 771     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
 772       push @result, (i_tags_get($self->{IMG}, $found))[1];
 773       $start = $found+1;
 774     }
 775     return @result;
 776   }
 777   else {
 778     if (wantarray) {
 779       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
 780     }
 781     else {
 782       return i_tags_count($self->{IMG});
 783     }
 784   }
 785 }
 786
 787 sub addtag {
 788   my $self = shift;
 789   my %opts = @_;
 790
 791   return -1 unless $self->{IMG};
 792   if ($opts{name}) {
 793     if (defined $opts{value}) {
 794       if ($opts{value} =~ /^\d+$/) {
 795         # add as a number
 796         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
 797       }
 798       else {
 799         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
 800       }
 801     }
 802     elsif (defined $opts{data}) {
 803       # force addition as a string
 804       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
 805     }
 806     else {
 807       $self->{ERRSTR} = "No value supplied";
 808       return undef;
 809     }
 810   }
 811   elsif ($opts{code}) {
 812     if (defined $opts{value}) {
 813       if ($opts{value} =~ /^\d+$/) {
 814         # add as a number
 815         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
 816       }
 817       else {
 818         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
 819       }
 820     }
 821     elsif (defined $opts{data}) {
 822       # force addition as a string
 823       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
 824     }
 825     else {
 826       $self->{ERRSTR} = "No value supplied";
 827       return undef;
 828     }
 829   }
 830   else {
 831     return undef;
 832   }
 833 }
 834
 835 sub deltag {
 836   my $self = shift;
 837   my %opts = @_;
 838
 839   return 0 unless $self->{IMG};
 840
 841   if (defined $opts{'index'}) {
 842     return i_tags_delete($self->{IMG}, $opts{'index'});
 843   }
 844   elsif (defined $opts{name}) {
 845     return i_tags_delbyname($self->{IMG}, $opts{name});
 846   }
 847   elsif (defined $opts{code}) {
 848     return i_tags_delbycode($self->{IMG}, $opts{code});
 849   }
 850   else {
 851     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
 852     return 0;
 853   }
 854 }
 855
 856 # Read an image from file
 857
 858 sub read {
 859   my $self = shift;
 860   my %input=@_;
 861   my ($fh, $fd, $IO);
 862
 863   if (defined($self->{IMG})) {
 864     # let IIM_DESTROY do the destruction, since the image may be
 865     # referenced from elsewhere
 866     #i_img_destroy($self->{IMG});
 867     undef($self->{IMG});
 868   }
 869
 870   if (!$input{fd} and !$input{file} and !$input{data}) {
 871     $self->{ERRSTR}='no file, fd or data parameter'; return undef;
 872   }
 873   if ($input{file}) {
 874     $fh = new IO::File($input{file},"r");
 875     if (!defined $fh) {
 876       $self->{ERRSTR}='Could not open file'; return undef;
 877     }
 878     binmode($fh);
 879     $fd = $fh->fileno();
 880   }
 881   if ($input{fd}) {
 882     $fd=$input{fd};
 883   }
 884
 885   # FIXME: Find the format here if not specified
 886   # yes the code isn't here yet - next week maybe?
 887   # Next week?  Are you high or something?  That comment
 888   # has been there for half a year dude.
 889   # Look, i just work here, ok?
 890
 891   if (!$input{'type'} and $input{file}) {
 892     $input{'type'}=$FORMATGUESS->($input{file});
 893   }
 894   if (!$formats{$input{'type'}}) {
 895     $self->{ERRSTR}='format not supported'; return undef;
 896   }
 897
 898   my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1, tga=>1, rgb=>1);
 899
 900   if ($iolready{$input{'type'}}) {
 901     # Setup data source
 902     $IO = defined $fd ? io_new_fd($fd) : io_new_buffer($input{data});
 903
 904     if ( $input{'type'} eq 'jpeg' ) {
 905       ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO );
 906       if ( !defined($self->{IMG}) ) {
 907         $self->{ERRSTR}='unable to read jpeg image'; return undef;
 908       }
 909       $self->{DEBUG} && print "loading a jpeg file\n";
 910       return $self;
 911     }
 912
 913     if ( $input{'type'} eq 'tiff' ) {
 914       $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
 915       if ( !defined($self->{IMG}) ) {
 916         $self->{ERRSTR}=$self->_error_as_msg(); return undef;
 917       }
 918       $self->{DEBUG} && print "loading a tiff file\n";
 919       return $self;
 920     }
 921
 922     if ( $input{'type'} eq 'pnm' ) {
 923       $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
 924       if ( !defined($self->{IMG}) ) {
 925         $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef;
 926       }
 927       $self->{DEBUG} && print "loading a pnm file\n";
 928       return $self;
 929     }
 930
 931     if ( $input{'type'} eq 'png' ) {
 932       $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
 933       if ( !defined($self->{IMG}) ) {
 934         $self->{ERRSTR}='unable to read png image';
 935         return undef;
 936       }
 937       $self->{DEBUG} && print "loading a png file\n";
 938     }
 939
 940     if ( $input{'type'} eq 'bmp' ) {
 941       $self->{IMG}=i_readbmp_wiol( $IO );
 942       if ( !defined($self->{IMG}) ) {
 943         $self->{ERRSTR}=$self->_error_as_msg();
 944         return undef;
 945       }
 946       $self->{DEBUG} && print "loading a bmp file\n";
 947     }
 948
 949     if ( $input{'type'} eq 'tga' ) {
 950       $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
 951       if ( !defined($self->{IMG}) ) {
 952         $self->{ERRSTR}=$self->_error_as_msg();
 953         return undef;
 954       }
 955       $self->{DEBUG} && print "loading a tga file\n";
 956     }
 957
 958     if ( $input{'type'} eq 'rgb' ) {
 959       $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
 960       if ( !defined($self->{IMG}) ) {
 961         $self->{ERRSTR}=$self->_error_as_msg();
 962         return undef;
 963       }
 964       $self->{DEBUG} && print "loading a tga file\n";
 965     }
 966
 967
 968     if ( $input{'type'} eq 'raw' ) {
 969       my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
 970
 971       if ( !($params{xsize} && $params{ysize}) ) {
 972         $self->{ERRSTR}='missing xsize or ysize parameter for raw';
 973         return undef;
 974       }
 975
 976       $self->{IMG} = i_readraw_wiol( $IO,
 977                                      $params{xsize},
 978                                      $params{ysize},
 979                                      $params{datachannels},
 980                                      $params{storechannels},
 981                                      $params{interleave});
 982       if ( !defined($self->{IMG}) ) {
 983         $self->{ERRSTR}='unable to read raw image';
 984         return undef;
 985       }
 986       $self->{DEBUG} && print "loading a raw file\n";
 987     }
 988
 989   } else {
 990
 991     # Old code for reference while changing the new stuff
 992
 993     if (!$input{'type'} and $input{file}) {
 994       $input{'type'}=$FORMATGUESS->($input{file});
 995     }
 996
 997     if (!$input{'type'}) {
 998       $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef;
 999     }
1000
1001     if (!$formats{$input{'type'}}) {
1002       $self->{ERRSTR}='format not supported';
1003       return undef;
1004     }
1005
1006     if ($input{file}) {
1007       $fh = new IO::File($input{file},"r");
1008       if (!defined $fh) {
1009         $self->{ERRSTR}='Could not open file';
1010         return undef;
1011       }
1012       binmode($fh);
1013       $fd = $fh->fileno();
1014     }
1015
1016     if ($input{fd}) {
1017       $fd=$input{fd};
1018     }
1019
1020     if ( $input{'type'} eq 'gif' ) {
1021       my $colors;
1022       if ($input{colors} && !ref($input{colors})) {
1023         # must be a reference to a scalar that accepts the colour map
1024         $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1025         return undef;
1026       }
1027       if (exists $input{data}) {
1028         if ($input{colors}) {
1029           ($self->{IMG}, $colors) = i_readgif_scalar($input{data});
1030         } else {
1031           $self->{IMG}=i_readgif_scalar($input{data});
1032         }
1033       } else {
1034         if ($input{colors}) {
1035           ($self->{IMG}, $colors) = i_readgif( $fd );
1036         } else {
1037           $self->{IMG} = i_readgif( $fd )
1038         }
1039       }
1040       if ($colors) {
1041         # we may or may not change i_readgif to return blessed objects...
1042         ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1043       }
1044       if ( !defined($self->{IMG}) ) {
1045         $self->{ERRSTR}= 'reading GIF:'._error_as_msg();
1046         return undef;
1047       }
1048       $self->{DEBUG} && print "loading a gif file\n";
1049     }
1050   }
1051   return $self;
1052 }
1053
1054 # Write an image to file
1055 sub write {
1056   my $self = shift;
1057   my %input=(jpegquality=>75,
1058              gifquant=>'mc',
1059              lmdither=>6.0,
1060              lmfixed=>[],
1061              idstring=>"",
1062              compress=>1,
1063              wierdpack=>0,
1064              fax_fine=>1, @_);
1065   my ($fh, $rc, $fd, $IO);
1066
1067   my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1, tga=>1 ); # this will be SO MUCH BETTER once they are all in there
1068
1069   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1070
1071   if (!$input{file} and !$input{'fd'} and !$input{'data'}) { $self->{ERRSTR}='file/fd/data parameter missing'; return undef; }
1072   if (!$input{'type'} and $input{file}) {
1073     $input{'type'}=$FORMATGUESS->($input{file});
1074   }
1075   if (!$input{'type'}) {
1076     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1077     return undef;
1078   }
1079
1080   if (!$formats{$input{'type'}}) { $self->{ERRSTR}='format not supported'; return undef; }
1081
1082   if (exists $input{'fd'}) {
1083     $fd=$input{'fd'};
1084   } elsif (exists $input{'data'}) {
1085     $IO = Imager::io_new_bufchain();
1086   } else {
1087     $fh = new IO::File($input{file},"w+");
1088     if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
1089     binmode($fh) or die;
1090     $fd = $fh->fileno();
1091   }
1092
1093   if ($iolready{$input{'type'}}) {
1094     if (defined $fd) {
1095       $IO = io_new_fd($fd);
1096     }
1097
1098     if ($input{'type'} eq 'tiff') {
1099       if (defined $input{class} && $input{class} eq 'fax') {
1100         if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1101           $self->{ERRSTR}='Could not write to buffer';
1102           return undef;
1103         }
1104       } else {
1105         if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1106           $self->{ERRSTR}='Could not write to buffer';
1107           return undef;
1108         }
1109       }
1110     } elsif ( $input{'type'} eq 'pnm' ) {
1111       if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1112         $self->{ERRSTR}='unable to write pnm image';
1113         return undef;
1114       }
1115       $self->{DEBUG} && print "writing a pnm file\n";
1116     } elsif ( $input{'type'} eq 'raw' ) {
1117       if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1118         $self->{ERRSTR}='unable to write raw image';
1119         return undef;
1120       }
1121       $self->{DEBUG} && print "writing a raw file\n";
1122     } elsif ( $input{'type'} eq 'png' ) {
1123       if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1124         $self->{ERRSTR}='unable to write png image';
1125         return undef;
1126       }
1127       $self->{DEBUG} && print "writing a png file\n";
1128     } elsif ( $input{'type'} eq 'jpeg' ) {
1129       if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1130         $self->{ERRSTR} = $self->_error_as_msg();
1131         return undef;
1132       }
1133       $self->{DEBUG} && print "writing a jpeg file\n";
1134     } elsif ( $input{'type'} eq 'bmp' ) {
1135       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1136         $self->{ERRSTR}='unable to write bmp image';
1137         return undef;
1138       }
1139       $self->{DEBUG} && print "writing a bmp file\n";
1140     } elsif ( $input{'type'} eq 'tga' ) {
1141
1142       if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1143         $self->{ERRSTR}=$self->_error_as_msg();
1144         return undef;
1145       }
1146       $self->{DEBUG} && print "writing a tga file\n";
1147     }
1148
1149     if (exists $input{'data'}) {
1150       my $data = io_slurp($IO);
1151       if (!$data) {
1152         $self->{ERRSTR}='Could not slurp from buffer';
1153         return undef;
1154       }
1155       ${$input{data}} = $data;
1156     }
1157     return $self;
1158   } else {
1159     if ( $input{'type'} eq 'gif' ) {
1160       if (not $input{gifplanes}) {
1161         my $gp;
1162         my $count=i_count_colors($self->{IMG}, 256);
1163         $gp=8 if $count == -1;
1164         $gp=1 if not $gp and $count <= 2;
1165         $gp=2 if not $gp and $count <= 4;
1166         $gp=3 if not $gp and $count <= 8;
1167         $gp=4 if not $gp and $count <= 16;
1168         $gp=5 if not $gp and $count <= 32;
1169         $gp=6 if not $gp and $count <= 64;
1170         $gp=7 if not $gp and $count <= 128;
1171         $input{gifplanes} = $gp || 8;
1172       }
1173
1174       if ($input{gifplanes}>8) {
1175         $input{gifplanes}=8;
1176       }
1177       if ($input{gifquant} eq 'gen' || $input{callback}) {
1178
1179
1180         if ($input{gifquant} eq 'lm') {
1181
1182           $input{make_colors} = 'addi';
1183           $input{translate} = 'perturb';
1184           $input{perturb} = $input{lmdither};
1185         } elsif ($input{gifquant} eq 'gen') {
1186           # just pass options through
1187         } else {
1188           $input{make_colors} = 'webmap'; # ignored
1189           $input{translate} = 'giflib';
1190         }
1191
1192         if ($input{callback}) {
1193           defined $input{maxbuffer} or $input{maxbuffer} = -1;
1194           $rc = i_writegif_callback($input{callback}, $input{maxbuffer},
1195                                     \%input, $self->{IMG});
1196         } else {
1197           $rc = i_writegif_gen($fd, \%input, $self->{IMG});
1198         }
1199
1200       } elsif ($input{gifquant} eq 'lm') {
1201         $rc=i_writegif($self->{IMG},$fd,$input{gifplanes},$input{lmdither},$input{lmfixed});
1202       } else {
1203         $rc=i_writegifmc($self->{IMG},$fd,$input{gifplanes});
1204       }
1205       if ( !defined($rc) ) {
1206         $self->{ERRSTR} = "Writing GIF file: "._error_as_msg(); return undef;
1207       }
1208       $self->{DEBUG} && print "writing a gif file\n";
1209
1210     }
1211   }
1212   return $self;
1213 }
1214
1215 sub write_multi {
1216   my ($class, $opts, @images) = @_;
1217
1218   if ($opts->{'type'} eq 'gif') {
1219     my $gif_delays = $opts->{gif_delays};
1220     local $opts->{gif_delays} = $gif_delays;
1221     unless (ref $opts->{gif_delays}) {
1222       # assume the caller wants the same delay for each frame
1223       $opts->{gif_delays} = [ ($gif_delays) x @images ];
1224     }
1225     # translate to ImgRaw
1226     if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1227       $ERRSTR = "Usage: Imager->write_multi({ options }, @images)";
1228       return 0;
1229     }
1230     my @work = map $_->{IMG}, @images;
1231     if ($opts->{callback}) {
1232       # Note: you may need to fix giflib for this one to work
1233       my $maxbuffer = $opts->{maxbuffer};
1234       defined $maxbuffer or $maxbuffer = -1; # max by default
1235       return i_writegif_callback($opts->{callback}, $maxbuffer,
1236                                  $opts, @work);
1237     }
1238     if ($opts->{fd}) {
1239       return i_writegif_gen($opts->{fd}, $opts, @work);
1240     }
1241     else {
1242       my $fh = IO::File->new($opts->{file}, "w+");
1243       unless ($fh) {
1244         $ERRSTR = "Error creating $opts->{file}: $!";
1245         return 0;
1246       }
1247       binmode($fh);
1248       return i_writegif_gen(fileno($fh), $opts, @work);
1249     }
1250   }
1251   else {
1252     $ERRSTR = "Sorry, write_multi doesn't support $opts->{'type'} yet";
1253     return 0;
1254   }
1255 }
1256
1257 # read multiple images from a file
1258 sub read_multi {
1259   my ($class, %opts) = @_;
1260
1261   if ($opts{file} && !exists $opts{'type'}) {
1262     # guess the type
1263     my $type = $FORMATGUESS->($opts{file});
1264     $opts{'type'} = $type;
1265   }
1266   unless ($opts{'type'}) {
1267     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1268     return;
1269   }
1270   my $fd;
1271   my $file;
1272   if ($opts{file}) {
1273     $file = IO::File->new($opts{file}, "r");
1274     unless ($file) {
1275       $ERRSTR = "Could not open file $opts{file}: $!";
1276       return;
1277     }
1278     binmode $file;
1279     $fd = fileno($file);
1280   }
1281   elsif ($opts{fh}) {
1282     $fd = fileno($opts{fh});
1283     unless ($fd) {
1284       $ERRSTR = "File handle specified with fh option not open";
1285       return;
1286     }
1287   }
1288   elsif ($opts{fd}) {
1289     $fd = $opts{fd};
1290   }
1291   elsif ($opts{callback} || $opts{data}) {
1292     # don't fail here
1293   }
1294   else {
1295     $ERRSTR = "You need to specify one of file, fd, fh, callback or data";
1296     return;
1297   }
1298
1299   if ($opts{'type'} eq 'gif') {
1300     my @imgs;
1301     if ($fd) {
1302       @imgs = i_readgif_multi($fd);
1303     }
1304     else {
1305       if (Imager::i_giflib_version() < 4.0) {
1306         $ERRSTR = "giflib3.x does not support callbacks";
1307         return;
1308       }
1309       if ($opts{callback}) {
1310         @imgs = i_readgif_multi_callback($opts{callback})
1311       }
1312       else {
1313         @imgs = i_readgif_multi_scalar($opts{data});
1314       }
1315     }
1316     if (@imgs) {
1317       return map {
1318         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1319       } @imgs;
1320     }
1321     else {
1322       $ERRSTR = _error_as_msg();
1323       return;
1324     }
1325   }
1326
1327   $ERRSTR = "Cannot read multiple images from $opts{'type'} files";
1328   return;
1329 }
1330
1331 # Destroy an Imager object
1332
1333 sub DESTROY {
1334   my $self=shift;
1335   #    delete $instances{$self};
1336   if (defined($self->{IMG})) {
1337     # the following is now handled by the XS DESTROY method for
1338     # Imager::ImgRaw object
1339     # Re-enabling this will break virtual images
1340     # tested for in t/t020masked.t
1341     # i_img_destroy($self->{IMG});
1342     undef($self->{IMG});
1343   } else {
1344 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1345   }
1346 }
1347
1348 # Perform an inplace filter of an image
1349 # that is the image will be overwritten with the data
1350
1351 sub filter {
1352   my $self=shift;
1353   my %input=@_;
1354   my %hsh;
1355   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1356
1357   if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1358
1359   if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
1360     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1361   }
1362
1363   if ($filters{$input{'type'}}{names}) {
1364     my $names = $filters{$input{'type'}}{names};
1365     for my $name (keys %$names) {
1366       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1367         $input{$name} = $names->{$name}{$input{$name}};
1368       }
1369     }
1370   }
1371   if (defined($filters{$input{'type'}}{defaults})) {
1372     %hsh=('image',$self->{IMG},%{$filters{$input{'type'}}{defaults}},%input);
1373   } else {
1374     %hsh=('image',$self->{IMG},%input);
1375   }
1376
1377   my @cs=@{$filters{$input{'type'}}{callseq}};
1378
1379   for(@cs) {
1380     if (!defined($hsh{$_})) {
1381       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1382     }
1383   }
1384
1385   &{$filters{$input{'type'}}{callsub}}(%hsh);
1386
1387   my @b=keys %hsh;
1388
1389   $self->{DEBUG} && print "callseq is: @cs\n";
1390   $self->{DEBUG} && print "matching callseq is: @b\n";
1391
1392   return $self;
1393 }
1394
1395 # Scale an image to requested size and return the scaled version
1396
1397 sub scale {
1398   my $self=shift;
1399   my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
1400   my $img = Imager->new();
1401   my $tmp = Imager->new();
1402
1403   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1404
1405   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
1406     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1407     if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1408     if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1409   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1410   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1411
1412   if ($opts{qtype} eq 'normal') {
1413     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1414     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1415     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1416     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1417     return $img;
1418   }
1419   if ($opts{'qtype'} eq 'preview') {
1420     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
1421     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1422     return $img;
1423   }
1424   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1425 }
1426
1427 # Scales only along the X axis
1428
1429 sub scaleX {
1430   my $self=shift;
1431   my %opts=(scalefactor=>0.5,@_);
1432
1433   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1434
1435   my $img = Imager->new();
1436
1437   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1438
1439   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1440   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1441
1442   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1443   return $img;
1444 }
1445
1446 # Scales only along the Y axis
1447
1448 sub scaleY {
1449   my $self=shift;
1450   my %opts=(scalefactor=>0.5,@_);
1451
1452   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1453
1454   my $img = Imager->new();
1455
1456   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1457
1458   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1459   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1460
1461   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1462   return $img;
1463 }
1464
1465
1466 # Transform returns a spatial transformation of the input image
1467 # this moves pixels to a new location in the returned image.
1468 # NOTE - should make a utility function to check transforms for
1469 # stack overruns
1470
1471 sub transform {
1472   my $self=shift;
1473   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1474   my %opts=@_;
1475   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1476
1477 #  print Dumper(\%opts);
1478 #  xopcopdes
1479
1480   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1481     if (!$I2P) {
1482       eval ("use Affix::Infix2Postfix;");
1483       print $@;
1484       if ( $@ ) {
1485         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
1486         return undef;
1487       }
1488       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1489                                              {op=>'-',trans=>'Sub'},
1490                                              {op=>'*',trans=>'Mult'},
1491                                              {op=>'/',trans=>'Div'},
1492                                              {op=>'-','type'=>'unary',trans=>'u-'},
1493                                              {op=>'**'},
1494                                              {op=>'func','type'=>'unary'}],
1495                                      'grouping'=>[qw( \( \) )],
1496                                      'func'=>[qw( sin cos )],
1497                                      'vars'=>[qw( x y )]
1498                                     );
1499     }
1500
1501     @xt=$I2P->translate($opts{'xexpr'});
1502     @yt=$I2P->translate($opts{'yexpr'});
1503
1504     $numre=$I2P->{'numre'};
1505     @pt=(0,0);
1506
1507     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1508     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1509     @{$opts{'parm'}}=@pt;
1510   }
1511
1512 #  print Dumper(\%opts);
1513
1514   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1515     $self->{ERRSTR}='transform: no xopcodes given.';
1516     return undef;
1517   }
1518
1519   @op=@{$opts{'xopcodes'}};
1520   for $iop (@op) {
1521     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1522       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1523       return undef;
1524     }
1525     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1526   }
1527
1528
1529 # yopcopdes
1530
1531   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1532     $self->{ERRSTR}='transform: no yopcodes given.';
1533     return undef;
1534   }
1535
1536   @op=@{$opts{'yopcodes'}};
1537   for $iop (@op) {
1538     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1539       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1540       return undef;
1541     }
1542     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1543   }
1544
1545 #parameters
1546
1547   if ( !exists $opts{'parm'}) {
1548     $self->{ERRSTR}='transform: no parameter arg given.';
1549     return undef;
1550   }
1551
1552 #  print Dumper(\@ropx);
1553 #  print Dumper(\@ropy);
1554 #  print Dumper(\@ropy);
1555
1556   my $img = Imager->new();
1557   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1558   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1559   return $img;
1560 }
1561
1562
1563 sub transform2 {
1564   my ($opts, @imgs) = @_;
1565
1566   require "Imager/Expr.pm";
1567
1568   $opts->{variables} = [ qw(x y) ];
1569   my ($width, $height) = @{$opts}{qw(width height)};
1570   if (@imgs) {
1571     $width ||= $imgs[0]->getwidth();
1572     $height ||= $imgs[0]->getheight();
1573     my $img_num = 1;
1574     for my $img (@imgs) {
1575       $opts->{constants}{"w$img_num"} = $img->getwidth();
1576       $opts->{constants}{"h$img_num"} = $img->getheight();
1577       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1578       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1579       ++$img_num;
1580     }
1581   }
1582   if ($width) {
1583     $opts->{constants}{w} = $width;
1584     $opts->{constants}{cx} = $width/2;
1585   }
1586   else {
1587     $Imager::ERRSTR = "No width supplied";
1588     return;
1589   }
1590   if ($height) {
1591     $opts->{constants}{h} = $height;
1592     $opts->{constants}{cy} = $height/2;
1593   }
1594   else {
1595     $Imager::ERRSTR = "No height supplied";
1596     return;
1597   }
1598   my $code = Imager::Expr->new($opts);
1599   if (!$code) {
1600     $Imager::ERRSTR = Imager::Expr::error();
1601     return;
1602   }
1603
1604   my $img = Imager->new();
1605   $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
1606                              $code->nregs(), $code->cregs(),
1607                              [ map { $_->{IMG} } @imgs ]);
1608   if (!defined $img->{IMG}) {
1609     $Imager::ERRSTR = Imager->_error_as_msg();
1610     return;
1611   }
1612
1613   return $img;
1614 }
1615
1616 sub rubthrough {
1617   my $self=shift;
1618   my %opts=(tx=>0,ty=>0,@_);
1619
1620   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1621   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1622
1623   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx},$opts{ty})) {
1624     $self->{ERRSTR} = $self->_error_as_msg();
1625     return undef;
1626   }
1627   return $self;
1628 }
1629
1630
1631 sub flip {
1632   my $self  = shift;
1633   my %opts  = @_;
1634   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
1635   my $dir;
1636   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
1637   $dir = $xlate{$opts{'dir'}};
1638   return $self if i_flipxy($self->{IMG}, $dir);
1639   return ();
1640 }
1641
1642 sub rotate {
1643   my $self = shift;
1644   my %opts = @_;
1645   if (defined $opts{right}) {
1646     my $degrees = $opts{right};
1647     if ($degrees < 0) {
1648       $degrees += 360 * int(((-$degrees)+360)/360);
1649     }
1650     $degrees = $degrees % 360;
1651     if ($degrees == 0) {
1652       return $self->copy();
1653     }
1654     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
1655       my $result = Imager->new();
1656       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
1657         return $result;
1658       }
1659       else {
1660         $self->{ERRSTR} = $self->_error_as_msg();
1661         return undef;
1662       }
1663     }
1664     else {
1665       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
1666       return undef;
1667     }
1668   }
1669   elsif (defined $opts{radians} || defined $opts{degrees}) {
1670     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
1671
1672     my $result = Imager->new;
1673     if ($result->{IMG} = i_rotate_exact($self->{IMG}, $amount)) {
1674       return $result;
1675     }
1676     else {
1677       $self->{ERRSTR} = $self->_error_as_msg();
1678       return undef;
1679     }
1680   }
1681   else {
1682     $self->{ERRSTR} = "Only the 'right' parameter is available";
1683     return undef;
1684   }
1685 }
1686
1687 sub matrix_transform {
1688   my $self = shift;
1689   my %opts = @_;
1690
1691   if ($opts{matrix}) {
1692     my $xsize = $opts{xsize} || $self->getwidth;
1693     my $ysize = $opts{ysize} || $self->getheight;
1694
1695     my $result = Imager->new;
1696     $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
1697                                         $opts{matrix})
1698       or return undef;
1699
1700     return $result;
1701   }
1702   else {
1703     $self->{ERRSTR} = "matrix parameter required";
1704     return undef;
1705   }
1706 }
1707
1708 # blame Leolo :)
1709 *yatf = \&matrix_transform;
1710
1711 # These two are supported for legacy code only
1712
1713 sub i_color_new {
1714   return Imager::Color->new(@_);
1715 }
1716
1717 sub i_color_set {
1718   return Imager::Color::set(@_);
1719 }
1720
1721 # Draws a box between the specified corner points.
1722 sub box {
1723   my $self=shift;
1724   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1725   my $dflcl=i_color_new(255,255,255,255);
1726   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1727
1728   if (exists $opts{'box'}) {
1729     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1730     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1731     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1732     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1733   }
1734
1735   if ($opts{filled}) {
1736     my $color = _color($opts{'color'});
1737     unless ($color) {
1738       $self->{ERRSTR} = $Imager::ERRSTR;
1739       return;
1740     }
1741     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1742                  $opts{ymax}, $color);
1743   }
1744   elsif ($opts{fill}) {
1745     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1746       # assume it's a hash ref
1747       require 'Imager/Fill.pm';
1748       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1749         $self->{ERRSTR} = $Imager::ERRSTR;
1750         return undef;
1751       }
1752     }
1753     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1754                 $opts{ymax},$opts{fill}{fill});
1755   }
1756   else {
1757     my $color = _color($opts{'color'});
1758     unless ($color) {
1759       $self->{ERRSTR} = $Imager::ERRSTR;
1760       return;
1761     }
1762     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
1763           $color);
1764   }
1765   return $self;
1766 }
1767
1768 # Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1769
1770 sub arc {
1771   my $self=shift;
1772   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1773   my $dflcl=i_color_new(255,255,255,255);
1774   my %opts=(color=>$dflcl,
1775             'r'=>min($self->getwidth(),$self->getheight())/3,
1776             'x'=>$self->getwidth()/2,
1777             'y'=>$self->getheight()/2,
1778             'd1'=>0, 'd2'=>361, @_);
1779   if ($opts{fill}) {
1780     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1781       # assume it's a hash ref
1782       require 'Imager/Fill.pm';
1783       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1784         $self->{ERRSTR} = $Imager::ERRSTR;
1785         return;
1786       }
1787     }
1788     i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
1789                 $opts{'d2'}, $opts{fill}{fill});
1790   }
1791   else {
1792     my $color = _color($opts{'color'});
1793     unless ($color) {
1794       $self->{ERRSTR} = $Imager::ERRSTR;
1795       return;
1796     }
1797     if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
1798       i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
1799                   $color);
1800     }
1801     else {
1802       if ($opts{'d1'} <= $opts{'d2'}) {
1803         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1804               $opts{'d1'}, $opts{'d2'}, $color);
1805       }
1806       else {
1807         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1808               $opts{'d1'}, 361,         $color);
1809         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
1810               0,           $opts{'d2'}, $color);
1811       }
1812     }
1813   }
1814
1815   return $self;
1816 }
1817
1818 # Draws a line from one point to (but not including) the destination point
1819
1820 sub line {
1821   my $self=shift;
1822   my $dflcl=i_color_new(0,0,0,0);
1823   my %opts=(color=>$dflcl,@_);
1824   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1825
1826   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
1827   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
1828
1829   my $color = _color($opts{'color'});
1830   unless ($color) {
1831     $self->{ERRSTR} = $Imager::ERRSTR;
1832     return;
1833   }
1834   $opts{antialias} = $opts{aa} if defined $opts{aa};
1835   if ($opts{antialias}) {
1836     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
1837               $color);
1838   } else {
1839     i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
1840            $color);
1841   }
1842   return $self;
1843 }
1844
1845 # Draws a line between an ordered set of points - It more or less just transforms this
1846 # into a list of lines.
1847
1848 sub polyline {
1849   my $self=shift;
1850   my ($pt,$ls,@points);
1851   my $dflcl=i_color_new(0,0,0,0);
1852   my %opts=(color=>$dflcl,@_);
1853
1854   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1855
1856   if (exists($opts{points})) { @points=@{$opts{points}}; }
1857   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
1858     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
1859     }
1860
1861 #  print Dumper(\@points);
1862
1863   my $color = _color($opts{'color'});
1864   unless ($color) {
1865     $self->{ERRSTR} = $Imager::ERRSTR;
1866     return;
1867   }
1868   $opts{antialias} = $opts{aa} if defined $opts{aa};
1869   if ($opts{antialias}) {
1870     for $pt(@points) {
1871       if (defined($ls)) {
1872         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
1873       }
1874       $ls=$pt;
1875     }
1876   } else {
1877     for $pt(@points) {
1878       if (defined($ls)) {
1879         i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
1880       }
1881       $ls=$pt;
1882     }
1883   }
1884   return $self;
1885 }
1886
1887 sub polygon {
1888   my $self = shift;
1889   my ($pt,$ls,@points);
1890   my $dflcl = i_color_new(0,0,0,0);
1891   my %opts = (color=>$dflcl, @_);
1892
1893   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1894
1895   if (exists($opts{points})) {
1896     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
1897     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
1898   }
1899
1900   if (!exists $opts{'x'} or !exists $opts{'y'})  {
1901     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
1902   }
1903
1904   if ($opts{'fill'}) {
1905     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
1906       # assume it's a hash ref
1907       require 'Imager/Fill.pm';
1908       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
1909         $self->{ERRSTR} = $Imager::ERRSTR;
1910         return undef;
1911       }
1912     }
1913     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
1914                     $opts{'fill'}{'fill'});
1915   }
1916   else {
1917     my $color = _color($opts{'color'});
1918     unless ($color) {
1919       $self->{ERRSTR} = $Imager::ERRSTR;
1920       return;
1921     }
1922     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
1923   }
1924
1925   return $self;
1926 }
1927
1928
1929 # this the multipoint bezier curve
1930 # this is here more for testing that actual usage since
1931 # this is not a good algorithm.  Usually the curve would be
1932 # broken into smaller segments and each done individually.
1933
1934 sub polybezier {
1935   my $self=shift;
1936   my ($pt,$ls,@points);
1937   my $dflcl=i_color_new(0,0,0,0);
1938   my %opts=(color=>$dflcl,@_);
1939
1940   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1941
1942   if (exists $opts{points}) {
1943     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
1944     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
1945   }
1946
1947   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
1948     $self->{ERRSTR}='Missing or invalid points.';
1949     return;
1950   }
1951
1952   my $color = _color($opts{'color'});
1953   unless ($color) {
1954     $self->{ERRSTR} = $Imager::ERRSTR;
1955     return;
1956   }
1957   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
1958   return $self;
1959 }
1960
1961 sub flood_fill {
1962   my $self = shift;
1963   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
1964
1965   unless (exists $opts{'x'} && exists $opts{'y'}) {
1966     $self->{ERRSTR} = "missing seed x and y parameters";
1967     return undef;
1968   }
1969
1970   if ($opts{fill}) {
1971     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1972       # assume it's a hash ref
1973       require 'Imager/Fill.pm';
1974       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1975         $self->{ERRSTR} = $Imager::ERRSTR;
1976         return;
1977       }
1978     }
1979     i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
1980   }
1981   else {
1982     my $color = _color($opts{'color'});
1983     unless ($color) {
1984       $self->{ERRSTR} = $Imager::ERRSTR;
1985       return;
1986     }
1987     i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
1988   }
1989
1990   $self;
1991 }
1992
1993 # make an identity matrix of the given size
1994 sub _identity {
1995   my ($size) = @_;
1996
1997   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
1998   for my $c (0 .. ($size-1)) {
1999     $matrix->[$c][$c] = 1;
2000   }
2001   return $matrix;
2002 }
2003
2004 # general function to convert an image
2005 sub convert {
2006   my ($self, %opts) = @_;
2007   my $matrix;
2008
2009   # the user can either specify a matrix or preset
2010   # the matrix overrides the preset
2011   if (!exists($opts{matrix})) {
2012     unless (exists($opts{preset})) {
2013       $self->{ERRSTR} = "convert() needs a matrix or preset";
2014       return;
2015     }
2016     else {
2017       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2018         # convert to greyscale, keeping the alpha channel if any
2019         if ($self->getchannels == 3) {
2020           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2021         }
2022         elsif ($self->getchannels == 4) {
2023           # preserve the alpha channel
2024           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2025                       [ 0,     0,     0,     1 ] ];
2026         }
2027         else {
2028           # an identity
2029           $matrix = _identity($self->getchannels);
2030         }
2031       }
2032       elsif ($opts{preset} eq 'noalpha') {
2033         # strip the alpha channel
2034         if ($self->getchannels == 2 or $self->getchannels == 4) {
2035           $matrix = _identity($self->getchannels);
2036           pop(@$matrix); # lose the alpha entry
2037         }
2038         else {
2039           $matrix = _identity($self->getchannels);
2040         }
2041       }
2042       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2043         # extract channel 0
2044         $matrix = [ [ 1 ] ];
2045       }
2046       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
2047         $matrix = [ [ 0, 1 ] ];
2048       }
2049       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
2050         $matrix = [ [ 0, 0, 1 ] ];
2051       }
2052       elsif ($opts{preset} eq 'alpha') {
2053         if ($self->getchannels == 2 or $self->getchannels == 4) {
2054           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
2055         }
2056         else {
2057           # the alpha is just 1 <shrug>
2058           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
2059         }
2060       }
2061       elsif ($opts{preset} eq 'rgb') {
2062         if ($self->getchannels == 1) {
2063           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
2064         }
2065         elsif ($self->getchannels == 2) {
2066           # preserve the alpha channel
2067           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
2068         }
2069         else {
2070           $matrix = _identity($self->getchannels);
2071         }
2072       }
2073       elsif ($opts{preset} eq 'addalpha') {
2074         if ($self->getchannels == 1) {
2075           $matrix = _identity(2);
2076         }
2077         elsif ($self->getchannels == 3) {
2078           $matrix = _identity(4);
2079         }
2080         else {
2081           $matrix = _identity($self->getchannels);
2082         }
2083       }
2084       else {
2085         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
2086         return undef;
2087       }
2088     }
2089   }
2090   else {
2091     $matrix = $opts{matrix};
2092   }
2093
2094   my $new = Imager->new();
2095   $new->{IMG} = i_img_new();
2096   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
2097     # most likely a bad matrix
2098     $self->{ERRSTR} = _error_as_msg();
2099     return undef;
2100   }
2101   return $new;
2102 }
2103
2104
2105 # general function to map an image through lookup tables
2106
2107 sub map {
2108   my ($self, %opts) = @_;
2109   my @chlist = qw( red green blue alpha );
2110
2111   if (!exists($opts{'maps'})) {
2112     # make maps from channel maps
2113     my $chnum;
2114     for $chnum (0..$#chlist) {
2115       if (exists $opts{$chlist[$chnum]}) {
2116         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
2117       } elsif (exists $opts{'all'}) {
2118         $opts{'maps'}[$chnum] = $opts{'all'};
2119       }
2120     }
2121   }
2122   if ($opts{'maps'} and $self->{IMG}) {
2123     i_map($self->{IMG}, $opts{'maps'} );
2124   }
2125   return $self;
2126 }
2127
2128 # destructive border - image is shrunk by one pixel all around
2129
2130 sub border {
2131   my ($self,%opts)=@_;
2132   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
2133   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
2134 }
2135
2136
2137 # Get the width of an image
2138
2139 sub getwidth {
2140   my $self = shift;
2141   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2142   return (i_img_info($self->{IMG}))[0];
2143 }
2144
2145 # Get the height of an image
2146
2147 sub getheight {
2148   my $self = shift;
2149   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2150   return (i_img_info($self->{IMG}))[1];
2151 }
2152
2153 # Get number of channels in an image
2154
2155 sub getchannels {
2156   my $self = shift;
2157   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2158   return i_img_getchannels($self->{IMG});
2159 }
2160
2161 # Get channel mask
2162
2163 sub getmask {
2164   my $self = shift;
2165   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2166   return i_img_getmask($self->{IMG});
2167 }
2168
2169 # Set channel mask
2170
2171 sub setmask {
2172   my $self = shift;
2173   my %opts = @_;
2174   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2175   i_img_setmask( $self->{IMG} , $opts{mask} );
2176 }
2177
2178 # Get number of colors in an image
2179
2180 sub getcolorcount {
2181   my $self=shift;
2182   my %opts=('maxcolors'=>2**30,@_);
2183   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2184   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2185   return ($rc==-1? undef : $rc);
2186 }
2187
2188 # draw string to an image
2189
2190 sub string {
2191   my $self = shift;
2192   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2193
2194   my %input=('x'=>0, 'y'=>0, @_);
2195   $input{string}||=$input{text};
2196
2197   unless(exists $input{string}) {
2198     $self->{ERRSTR}="missing required parameter 'string'";
2199     return;
2200   }
2201
2202   unless($input{font}) {
2203     $self->{ERRSTR}="missing required parameter 'font'";
2204     return;
2205   }
2206
2207   unless ($input{font}->draw(image=>$self, %input)) {
2208     $self->{ERRSTR} = $self->_error_as_msg();
2209     return;
2210   }
2211
2212   return $self;
2213 }
2214
2215 # Shortcuts that can be exported
2216
2217 sub newcolor { Imager::Color->new(@_); }
2218 sub newfont  { Imager::Font->new(@_); }
2219
2220 *NC=*newcolour=*newcolor;
2221 *NF=*newfont;
2222
2223 *open=\&read;
2224 *circle=\&arc;
2225
2226
2227 #### Utility routines
2228
2229 sub errstr {
2230   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2231 }
2232
2233 # Default guess for the type of an image from extension
2234
2235 sub def_guess_type {
2236   my $name=lc(shift);
2237   my $ext;
2238   $ext=($name =~ m/\.([^\.]+)$/)[0];
2239   return 'tiff' if ($ext =~ m/^tiff?$/);
2240   return 'jpeg' if ($ext =~ m/^jpe?g$/);
2241   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
2242   return 'png'  if ($ext eq "png");
2243   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
2244   return 'tga'  if ($ext eq "tga");
2245   return 'rgb'  if ($ext eq "rgb");
2246   return 'gif'  if ($ext eq "gif");
2247   return ();
2248 }
2249
2250 # get the minimum of a list
2251
2252 sub min {
2253   my $mx=shift;
2254   for(@_) { if ($_<$mx) { $mx=$_; }}
2255   return $mx;
2256 }
2257
2258 # get the maximum of a list
2259
2260 sub max {
2261   my $mx=shift;
2262   for(@_) { if ($_>$mx) { $mx=$_; }}
2263   return $mx;
2264 }
2265
2266 # string stuff for iptc headers
2267
2268 sub clean {
2269   my($str)=$_[0];
2270   $str = substr($str,3);
2271   $str =~ s/[\n\r]//g;
2272   $str =~ s/\s+/ /g;
2273   $str =~ s/^\s//;
2274   $str =~ s/\s$//;
2275   return $str;
2276 }
2277
2278 # A little hack to parse iptc headers.
2279
2280 sub parseiptc {
2281   my $self=shift;
2282   my(@sar,$item,@ar);
2283   my($caption,$photogr,$headln,$credit);
2284
2285   my $str=$self->{IPTCRAW};
2286
2287   #print $str;
2288
2289   @ar=split(/8BIM/,$str);
2290
2291   my $i=0;
2292   foreach (@ar) {
2293     if (/^\004\004/) {
2294       @sar=split(/\034\002/);
2295       foreach $item (@sar) {
2296         if ($item =~ m/^x/) {
2297           $caption=&clean($item);
2298           $i++;
2299         }
2300         if ($item =~ m/^P/) {
2301           $photogr=&clean($item);
2302           $i++;
2303         }
2304         if ($item =~ m/^i/) {
2305           $headln=&clean($item);
2306           $i++;
2307         }
2308         if ($item =~ m/^n/) {
2309           $credit=&clean($item);
2310           $i++;
2311         }
2312       }
2313     }
2314   }
2315   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
2316 }
2317
2318 # Autoload methods go after =cut, and are processed by the autosplit program.
2319
2320 1;
2321 __END__
2322 # Below is the stub of documentation for your module. You better edit it!
2323
2324 =head1 NAME
2325
2326 Imager - Perl extension for Generating 24 bit Images
2327
2328 =head1 SYNOPSIS
2329
2330   use Imager qw(init);
2331
2332   init();
2333   $img = Imager->new();
2334   $img->open(file=>'image.ppm',type=>'pnm')
2335     || print "failed: ",$img->{ERRSTR},"\n";
2336   $scaled=$img->scale(xpixels=>400,ypixels=>400);
2337   $scaled->write(file=>'sc_image.ppm',type=>'pnm')
2338     || print "failed: ",$scaled->{ERRSTR},"\n";
2339
2340 =head1 DESCRIPTION
2341
2342 Imager is a module for creating and altering images - It is not meant
2343 as a replacement or a competitor to ImageMagick or GD. Both are
2344 excellent packages and well supported.
2345
2346 =head2 API
2347
2348 Almost all functions take the parameters in the hash fashion.
2349 Example:
2350
2351   $img->open(file=>'lena.png',type=>'png');
2352
2353 or just:
2354
2355   $img->open(file=>'lena.png');
2356
2357 =head2 Basic concept
2358
2359 An Image object is created with C<$img = Imager-E<gt>new()> Should
2360 this fail for some reason an explanation can be found in
2361 C<$Imager::ERRSTR> usually error messages are stored in
2362 C<$img-E<gt>{ERRSTR}>, but since no object is created this is the only
2363 way to give back errors.  C<$Imager::ERRSTR> is also used to report
2364 all errors not directly associated with an image object. Examples:
2365
2366   $img=Imager->new(); # This is an empty image (size is 0 by 0)
2367   $img->open(file=>'lena.png',type=>'png'); # initializes from file
2368
2369 or if you want to create an empty image:
2370
2371   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
2372
2373 This example creates a completely black image of width 400 and
2374 height 300 and 4 channels.
2375
2376 If you have an existing image, use img_set() to change it's dimensions
2377 - this will destroy any existing image data:
2378
2379   $img->img_set(xsize=>500, ysize=>500, channels=>4);
2380
2381 To create paletted images, set the 'type' parameter to 'paletted':
2382
2383   $img = Imager->new(xsize=>200, ysize=>200, channels=>3, type=>'paletted');
2384
2385 which creates an image with a maxiumum of 256 colors, which you can
2386 change by supplying the C<maxcolors> parameter.
2387
2388 You can create a new paletted image from an existing image using the
2389 to_paletted() method:
2390
2391  $palimg = $img->to_paletted(\%opts)
2392
2393 where %opts contains the options specified under L<Quantization options>.
2394
2395 You can convert a paletted image (or any image) to an 8-bit/channel
2396 RGB image with:
2397
2398   $rgbimg = $img->to_rgb8;
2399
2400 Warning: if you draw on a paletted image with colors that aren't in
2401 the palette, the image will be internally converted to a normal image.
2402
2403 For improved color precision you can use the bits parameter to specify
2404 16 bit per channel:
2405
2406   $img = Imager->new(xsize=>200, ysize=>200, channels=>3, bits=>16);
2407
2408 or for even more precision:
2409
2410   $img = Imager->new(xsize=>200, ysize=>200, channels=>3, bits=>'double');
2411
2412 to get an image that uses a double for each channel.
2413
2414 Note that as of this writing all functions should work on images with
2415 more than 8-bits/channel, but many will only work at only
2416 8-bit/channel precision.
2417
2418 Currently only 8-bit, 16-bit, and double per channel image types are
2419 available, this may change later.
2420
2421 Color objects are created by calling the Imager::Color->new()
2422 method:
2423
2424   $color = Imager::Color->new($red, $green, $blue);
2425   $color = Imager::Color->new($red, $green, $blue, $alpha);
2426   $color = Imager::Color->new("#C0C0FF"); # html color specification
2427
2428 This object can then be passed to functions that require a color parameter.
2429
2430 Coordinates in Imager have the origin in the upper left corner.  The
2431 horizontal coordinate increases to the right and the vertical
2432 downwards.
2433
2434 =head2 Reading and writing images
2435
2436 C<$img-E<gt>read()> generally takes two parameters, 'file' and 'type'.
2437 If the type of the file can be determined from the suffix of the file
2438 it can be omitted.  Format dependant parameters are: For images of
2439 type 'raw' two extra parameters are needed 'xsize' and 'ysize', if the
2440 'channel' parameter is omitted for type 'raw' it is assumed to be 3.
2441 gif and png images might have a palette are converted to truecolor bit
2442 when read.  Alpha channel is preserved for png images irregardless of
2443 them being in RGB or gray colorspace.  Similarly grayscale jpegs are
2444 one channel images after reading them.  For jpeg images the iptc
2445 header information (stored in the APP13 header) is avaliable to some
2446 degree. You can get the raw header with C<$img-E<gt>{IPTCRAW}>, but
2447 you can also retrieve the most basic information with
2448 C<%hsh=$img-E<gt>parseiptc()> as always patches are welcome.  pnm has no
2449 extra options. Examples:
2450
2451   $img = Imager->new();
2452   $img->read(file=>"cover.jpg") or die $img->errstr; # gets type from name
2453
2454   $img = Imager->new();
2455   { local(*FH,$/); open(FH,"file.gif") or die $!; $a=<FH>; }
2456   $img->read(data=>$a,type=>'gif') or die $img->errstr;
2457
2458 The second example shows how to read an image from a scalar, this is
2459 usefull if your data originates from somewhere else than a filesystem
2460 such as a database over a DBI connection.
2461
2462 When writing to a tiff image file you can also specify the 'class'
2463 parameter, which can currently take a single value, "fax".  If class
2464 is set to fax then a tiff image which should be suitable for faxing
2465 will be written.  For the best results start with a grayscale image.
2466 By default the image is written at fine resolution you can override
2467 this by setting the "fax_fine" parameter to 0.
2468
2469 If you are reading from a gif image file, you can supply a 'colors'
2470 parameter which must be a reference to a scalar.  The referenced
2471 scalar will receive an array reference which contains the colors, each
2472 represented as an Imager::Color object.
2473
2474 If you already have an open file handle, for example a socket or a
2475 pipe, you can specify the 'fd' parameter instead of supplying a
2476 filename.  Please be aware that you need to use fileno() to retrieve
2477 the file descriptor for the file:
2478
2479   $img->read(fd=>fileno(FILE), type=>'gif') or die $img->errstr;
2480
2481 For writing using the 'fd' option you will probably want to set $| for
2482 that descriptor, since the writes to the file descriptor bypass Perl's
2483 (or the C libraries) buffering.  Setting $| should avoid out of order
2484 output.  For example a common idiom when writing a CGI script is:
2485
2486   # the $| _must_ come before you send the content-type
2487   $| = 1;
2488   print "Content-Type: image/jpeg\n\n";
2489   $img->write(fd=>fileno(STDOUT), type=>'jpeg') or die $img->errstr;
2490
2491 *Note that load() is now an alias for read but will be removed later*
2492
2493 C<$img-E<gt>write> has the same interface as C<read()>.  The earlier
2494 comments on C<read()> for autodetecting filetypes apply.  For jpegs
2495 quality can be adjusted via the 'jpegquality' parameter (0-100).  The
2496 number of colorplanes in gifs are set with 'gifplanes' and should be
2497 between 1 (2 color) and 8 (256 colors).  It is also possible to choose
2498 between two quantizing methods with the parameter 'gifquant'. If set
2499 to mc it uses the mediancut algorithm from either giflibrary. If set
2500 to lm it uses a local means algorithm. It is then possible to give
2501 some extra settings. lmdither is the dither deviation amount in pixels
2502 (manhattan distance).  lmfixed can be an array ref who holds an array
2503 of Imager::Color objects.  Note that the local means algorithm needs
2504 much more cpu time but also gives considerable better results than the
2505 median cut algorithm.
2506
2507 When storing targa images rle compression can be activated with the
2508 'compress' parameter, the 'idstring' parameter can be used to set the
2509 targa comment field and the 'wierdpack' option can be used to use the
2510 15 and 16 bit targa formats for rgb and rgba data.  The 15 bit format
2511 has 5 of each red, green and blue.  The 16 bit format in addition
2512 allows 1 bit of alpha.  The most significant bits are used for each
2513 channel.
2514
2515 Currently just for gif files, you can specify various options for the
2516 conversion from Imager's internal RGB format to the target's indexed
2517 file format.  If you set the gifquant option to 'gen', you can use the
2518 options specified under L<Quantization options>.
2519
2520 To see what Imager is compiled to support the following code snippet
2521 is sufficient:
2522
2523   use Imager;
2524   print "@{[keys %Imager::formats]}";
2525
2526 When reading raw images you need to supply the width and height of the
2527 image in the xsize and ysize options:
2528
2529   $img->read(file=>'foo.raw', xsize=>100, ysize=>100)
2530     or die "Cannot read raw image\n";
2531
2532 If your input file has more channels than you want, or (as is common),
2533 junk in the fourth channel, you can use the datachannels and
2534 storechannels options to control the number of channels in your input
2535 file and the resulting channels in your image.  For example, if your
2536 input image uses 32-bits per pixel with red, green, blue and junk
2537 values for each pixel you could do:
2538
2539   $img->read(file=>'foo.raw', xsize=>100, ysize=>100, datachannels=>4,
2540              storechannels=>3)
2541     or die "Cannot read raw image\n";
2542
2543 Normally the raw image is expected to have the value for channel 1
2544 immediately following channel 0 and channel 2 immediately following
2545 channel 1 for each pixel.  If your input image has all the channel 0
2546 values for the first line of the image, followed by all the channel 1
2547 values for the first line and so on, you can use the interleave option:
2548
2549   $img->read(file=>'foo.raw', xsize=100, ysize=>100, interleave=>1)
2550     or die "Cannot read raw image\n";
2551
2552 =head2 Multi-image files
2553
2554 Currently just for gif files, you can create files that contain more
2555 than one image.
2556
2557 To do this:
2558
2559   Imager->write_multi(\%opts, @images)
2560
2561 Where %opts describes 4 possible types of outputs:
2562
2563 =over 5
2564
2565 =item type
2566
2567 This is C<gif> for gif animations.
2568
2569 =item callback
2570
2571 A code reference which is called with a single parameter, the data to
2572 be written.  You can also specify $opts{maxbuffer} which is the
2573 maximum amount of data buffered.  Note that there can be larger writes
2574 than this if the file library writes larger blocks.  A smaller value
2575 maybe useful for writing to a socket for incremental display.
2576
2577 =item fd
2578
2579 The file descriptor to save the images to.
2580
2581 =item file
2582
2583 The name of the file to write to.
2584
2585 %opts may also include the keys from L<Gif options> and L<Quantization
2586 options>.
2587
2588 =back
2589
2590 You must also specify the file format using the 'type' option.
2591
2592 The current aim is to support other multiple image formats in the
2593 future, such as TIFF, and to support reading multiple images from a
2594 single file.
2595
2596 A simple example:
2597
2598     my @images;
2599     # ... code to put images in @images
2600     Imager->write_multi({type=>'gif',
2601                          file=>'anim.gif',
2602                          gif_delays=>[ (10) x @images ] },
2603                         @images)
2604     or die "Oh dear!";
2605
2606 You can read multi-image files (currently only GIF files) using the
2607 read_multi() method:
2608
2609   my @imgs = Imager->read_multi(file=>'foo.gif')
2610     or die "Cannot read images: ",Imager->errstr;
2611
2612 The possible parameters for read_multi() are:
2613
2614 =over
2615
2616 =item file
2617
2618 The name of the file to read in.
2619
2620 =item fh
2621
2622 A filehandle to read in.  This can be the name of a filehandle, but it
2623 will need the package name, no attempt is currently made to adjust
2624 this to the caller's package.
2625
2626 =item fd
2627
2628 The numeric file descriptor of an open file (or socket).
2629
2630 =item callback
2631
2632 A function to be called to read in data, eg. reading a blob from a
2633 database incrementally.
2634
2635 =item data
2636
2637 The data of the input file in memory.
2638
2639 =item type
2640
2641 The type of file.  If the file is parameter is given and provides
2642 enough information to guess the type, then this parameter is optional.
2643
2644 =back
2645
2646 Note: you cannot use the callback or data parameter with giflib
2647 versions before 4.0.
2648
2649 When reading from a GIF file with read_multi() the images are returned
2650 as paletted images.
2651
2652 =head2 Gif options
2653
2654 These options can be specified when calling write_multi() for gif
2655 files, when writing a single image with the gifquant option set to
2656 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
2657
2658 Note that some viewers will ignore some of these options
2659 (gif_user_input in particular).
2660
2661 =over 4
2662
2663 =item gif_each_palette
2664
2665 Each image in the gif file has it's own palette if this is non-zero.
2666 All but the first image has a local colour table (the first uses the
2667 global colour table.
2668
2669 =item interlace
2670
2671 The images are written interlaced if this is non-zero.
2672
2673 =item gif_delays
2674
2675 A reference to an array containing the delays between images, in 1/100
2676 seconds.
2677
2678 If you want the same delay for every frame you can simply set this to
2679 the delay in 1/100 seconds.
2680
2681 =item gif_user_input
2682
2683 A reference to an array contains user input flags.  If the given flag
2684 is non-zero the image viewer should wait for input before displaying
2685 the next image.
2686
2687 =item gif_disposal
2688
2689 A reference to an array of image disposal methods.  These define what
2690 should be done to the image before displaying the next one.  These are
2691 integers, where 0 means unspecified, 1 means the image should be left
2692 in place, 2 means restore to background colour and 3 means restore to
2693 the previous value.
2694
2695 =item gif_tran_color
2696
2697 A reference to an Imager::Color object, which is the colour to use for
2698 the palette entry used to represent transparency in the palette.  You
2699 need to set the transp option (see L<Quantization options>) for this
2700 value to be used.
2701
2702 =item gif_positions
2703
2704 A reference to an array of references to arrays which represent screen
2705 positions for each image.
2706
2707 =item gif_loop_count
2708
2709 If this is non-zero the Netscape loop extension block is generated,
2710 which makes the animation of the images repeat.
2711
2712 This is currently unimplemented due to some limitations in giflib.
2713
2714 =item gif_eliminate_unused
2715
2716 If this is true, when you write a paletted image any unused colors
2717 will be eliminated from its palette.  This is set by default.
2718
2719 =back
2720
2721 =head2 Quantization options
2722
2723 These options can be specified when calling write_multi() for gif
2724 files, when writing a single image with the gifquant option set to
2725 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
2726
2727 =over 4
2728
2729 =item colors
2730
2731 A arrayref of colors that are fixed.  Note that some color generators
2732 will ignore this.
2733
2734 =item transp
2735
2736 The type of transparency processing to perform for images with an
2737 alpha channel where the output format does not have a proper alpha
2738 channel (eg. gif).  This can be any of:
2739
2740 =over 4
2741
2742 =item none
2743
2744 No transparency processing is done. (default)
2745
2746 =item threshold
2747
2748 Pixels more transparent that tr_threshold are rendered as transparent.
2749
2750 =item errdiff
2751
2752 An error diffusion dither is done on the alpha channel.  Note that
2753 this is independent of the translation performed on the colour
2754 channels, so some combinations may cause undesired artifacts.
2755
2756 =item ordered
2757
2758 The ordered dither specified by tr_orddith is performed on the alpha
2759 channel.
2760
2761 =back
2762
2763 This will only be used if the image has an alpha channel, and if there
2764 is space in the palette for a transparency colour.
2765
2766 =item tr_threshold
2767
2768 The highest alpha value at which a pixel will be made transparent when
2769 transp is 'threshold'. (0-255, default 127)
2770
2771 =item tr_errdiff
2772
2773 The type of error diffusion to perform on the alpha channel when
2774 transp is 'errdiff'.  This can be any defined error diffusion type
2775 except for custom (see errdiff below).
2776
2777 =item tr_orddith
2778
2779 The type of ordered dither to perform on the alpha channel when transp
2780 is 'ordered'.  Possible values are:
2781
2782 =over 4
2783
2784 =item random
2785
2786 A semi-random map is used.  The map is the same each time.
2787
2788 =item dot8
2789
2790 8x8 dot dither.
2791
2792 =item dot4
2793
2794 4x4 dot dither
2795
2796 =item hline
2797
2798 horizontal line dither.
2799
2800 =item vline
2801
2802 vertical line dither.
2803
2804 =item "/line"
2805
2806 =item slashline
2807
2808 diagonal line dither
2809
2810 =item '\line'
2811
2812 =item backline
2813
2814 diagonal line dither
2815
2816 =item tiny
2817
2818 dot matrix dither (currently the default).  This is probably the best
2819 for displays (like web pages).
2820
2821 =item custom
2822
2823 A custom dither matrix is used - see tr_map
2824
2825 =back
2826
2827 =item tr_map
2828
2829 When tr_orddith is custom this defines an 8 x 8 matrix of integers
2830 representing the transparency threshold for pixels corresponding to
2831 each position.  This should be a 64 element array where the first 8
2832 entries correspond to the first row of the matrix.  Values should be
2833 betweern 0 and 255.
2834
2835 =item make_colors
2836
2837 Defines how the quantization engine will build the palette(s).
2838 Currently this is ignored if 'translate' is 'giflib', but that may
2839 change.  Possible values are:
2840
2841 =over 4
2842
2843 =item none
2844
2845 Only colors supplied in 'colors' are used.
2846
2847 =item webmap
2848
2849 The web color map is used (need url here.)
2850
2851 =item addi
2852
2853 The original code for generating the color map (Addi's code) is used.
2854
2855 =back
2856
2857 Other methods may be added in the future.
2858
2859 =item colors
2860
2861 A arrayref containing Imager::Color objects, which represents the
2862 starting set of colors to use in translating the images.  webmap will
2863 ignore this.  The final colors used are copied back into this array
2864 (which is expanded if necessary.)
2865
2866 =item max_colors
2867
2868 The maximum number of colors to use in the image.
2869
2870 =item translate
2871
2872 The method used to translate the RGB values in the source image into
2873 the colors selected by make_colors.  Note that make_colors is ignored
2874 whene translate is 'giflib'.
2875
2876 Possible values are:
2877
2878 =over 4
2879
2880 =item giflib
2881
2882 The giflib native quantization function is used.
2883
2884 =item closest
2885
2886 The closest color available is used.
2887
2888 =item perturb
2889
2890 The pixel color is modified by perturb, and the closest color is chosen.
2891
2892 =item errdiff
2893
2894 An error diffusion dither is performed.
2895
2896 =back
2897
2898 It's possible other transate values will be added.
2899
2900 =item errdiff
2901
2902 The type of error diffusion dither to perform.  These values (except
2903 for custom) can also be used in tr_errdif.
2904
2905 =over 4
2906
2907 =item floyd
2908
2909 Floyd-Steinberg dither
2910
2911 =item jarvis
2912
2913 Jarvis, Judice and Ninke dither
2914
2915 =item stucki
2916
2917 Stucki dither
2918
2919 =item custom
2920
2921 Custom.  If you use this you must also set errdiff_width,
2922 errdiff_height and errdiff_map.
2923
2924 =back
2925
2926 =item errdiff_width
2927
2928 =item errdiff_height
2929
2930 =item errdiff_orig
2931
2932 =item errdiff_map
2933
2934 When translate is 'errdiff' and errdiff is 'custom' these define a
2935 custom error diffusion map.  errdiff_width and errdiff_height define
2936 the size of the map in the arrayref in errdiff_map.  errdiff_orig is
2937 an integer which indicates the current pixel position in the top row
2938 of the map.
2939
2940 =item perturb
2941
2942 When translate is 'perturb' this is the magnitude of the random bias
2943 applied to each channel of the pixel before it is looked up in the
2944 color table.
2945
2946 =back
2947
2948 =head2 Obtaining/setting attributes of images
2949
2950 To get the size of an image in pixels the C<$img-E<gt>getwidth()> and
2951 C<$img-E<gt>getheight()> are used.
2952
2953 To get the number of channels in
2954 an image C<$img-E<gt>getchannels()> is used.  $img-E<gt>getmask() and
2955 $img-E<gt>setmask() are used to get/set the channel mask of the image.
2956
2957   $mask=$img->getmask();
2958   $img->setmask(mask=>1+2); # modify red and green only
2959   $img->setmask(mask=>8); # modify alpha only
2960   $img->setmask(mask=>$mask); # restore previous mask
2961
2962 The mask of an image describes which channels are updated when some
2963 operation is performed on an image.  Naturally it is not possible to
2964 apply masks to operations like scaling that alter the dimensions of
2965 images.
2966
2967 It is possible to have Imager find the number of colors in an image
2968 by using C<$img-E<gt>getcolorcount()>. It requires memory proportionally
2969 to the number of colors in the image so it is possible to have it
2970 stop sooner if you only need to know if there are more than a certain number
2971 of colors in the image.  If there are more colors than asked for
2972 the function return undef.  Examples:
2973
2974   if (!defined($img->getcolorcount(maxcolors=>512)) {
2975     print "Less than 512 colors in image\n";
2976   }
2977
2978 The bits() method retrieves the number of bits used to represent each
2979 channel in a pixel, 8 for a normal image, 16 for 16-bit image and
2980 'double' for a double/channel image.  The type() method returns either
2981 'direct' for truecolor images or 'paletted' for paletted images.  The
2982 virtual() method returns non-zero if the image contains no actual
2983 pixels, for example masked images.
2984
2985 =head2 Paletted Images
2986
2987 In general you can work with paletted images in the same way as RGB
2988 images, except that if you attempt to draw to a paletted image with a
2989 color that is not in the image's palette, the image will be converted
2990 to an RGB image.  This means that drawing on a paletted image with
2991 anti-aliasing enabled will almost certainly convert the image to RGB.
2992
2993 You can add colors to a paletted image with the addcolors() method:
2994
2995    my @colors = ( Imager::Color->new(255, 0, 0),
2996                   Imager::Color->new(0, 255, 0) );
2997    my $index = $img->addcolors(colors=>\@colors);
2998
2999 The return value is the index of the first color added, or undef if
3000 adding the colors would overflow the palette.
3001
3002 Once you have colors in the palette you can overwrite them with the
3003 setcolors() method:
3004
3005   $img->setcolors(start=>$start, colors=>\@colors);
3006
3007 Returns true on success.
3008
3009 To retrieve existing colors from the palette use the getcolors() method:
3010
3011   # get the whole palette
3012   my @colors = $img->getcolors();
3013   # get a single color
3014   my $color = $img->getcolors(start=>$index);
3015   # get a range of colors
3016   my @colors = $img->getcolors(start=>$index, count=>$count);
3017
3018 To quickly find a color in the palette use findcolor():
3019
3020   my $index = $img->findcolor(color=>$color);
3021
3022 which returns undef on failure, or the index of the color.
3023
3024 You can get the current palette size with $img->colorcount, and the
3025 maximum size of the palette with $img->maxcolors.
3026
3027 =head2 Drawing Methods
3028
3029 IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS
3030 DOCUMENTATION OF THIS SECTION OUT OF SYNC
3031
3032 It is possible to draw with graphics primitives onto images.  Such
3033 primitives include boxes, arcs, circles, polygons and lines.  A
3034 reference oriented list follows.
3035
3036 Box:
3037   $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1);
3038
3039 The above example calls the C<box> method for the image and the box
3040 covers the pixels with in the rectangle specified.  If C<filled> is
3041 ommited it is drawn as an outline.  If any of the edges of the box are
3042 ommited it will snap to the outer edge of the image in that direction.
3043 Also if a color is omitted a color with (255,255,255,255) is used
3044 instead.
3045
3046 Arc:
3047   $img->arc(color=>$red, r=20, x=>200, y=>100, d1=>10, d2=>20 );
3048
3049 This creates a filled red arc with a 'center' at (200, 100) and spans
3050 10 degrees and the slice has a radius of 20. SEE section on BUGS.
3051
3052 Circle:
3053   $img->circle(color=>$green, r=50, x=>200, y=>100);
3054
3055 This creates a green circle with its center at (200, 100) and has a
3056 radius of 20.
3057
3058 Line:
3059   $img->line(color=>$green, x1=>10, x2=>100,
3060                             y1=>20, y2=>50, aa=>1 );
3061
3062 That draws an antialiased line from (10,100) to (20,50).
3063
3064 The I<antialias> parameter is still available for backwards compatibility.
3065
3066 Polyline:
3067   $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
3068   $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], aa=>1);
3069
3070 Polyline is used to draw multilple lines between a series of points.
3071 The point set can either be specified as an arrayref to an array of
3072 array references (where each such array represents a point).  The
3073 other way is to specify two array references.
3074
3075 The I<antialias> parameter is still available for backwards compatibility.
3076
3077 Polygon:
3078   $img->polygon(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
3079   $img->polygon(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2]);
3080
3081 Polygon is used to draw a filled polygon.  Currently the polygon is
3082 always drawn antialiased, although that will change in the future.
3083 Like other antialiased drawing functions its coordinates can be
3084 specified with floating point values.
3085
3086 Flood Fill:
3087
3088 You can fill a region that all has the same color using the
3089 flood_fill() method, for example:
3090
3091   $img->flood_fill(x=>50, y=>50, color=>$color);
3092
3093 will fill all regions the same color connected to the point (50, 50).
3094
3095 The arc(), box(), polygon() and flood_fill() methods can take a
3096 C<fill> parameter which can either be an Imager::Fill object, or a
3097 reference to a hash containing the parameters used to create the fill:
3098
3099   $img->box(xmin=>10, ymin=>30, xmax=>150, ymax=>60,
3100             fill => { hatch=>'cross2' });
3101   use Imager::Fill;
3102   my $fill = Imager::Fill->new(hatch=>'stipple');
3103   $img->box(fill=>$fill);
3104
3105 Currently you can create opaque or transparent plain color fills,
3106 hatched fills, image based fills and fountain fills.  See
3107 L<Imager::Fill> for more information.
3108
3109 The C<color> parameter for any of the drawing methods can be an
3110 L<Imager::Color> object, a simple scalar that Imager::Color can
3111 understand, a hashref of parameters that Imager::Color->new
3112 understands, or an arrayref of red, green, blue values.
3113
3114 =head2 Text rendering
3115
3116 Text rendering is described in the Imager::Font manpage.
3117
3118 =head2 Image resizing
3119
3120 To scale an image so porportions are maintained use the
3121 C<$img-E<gt>scale()> method.  if you give either a xpixels or ypixels
3122 parameter they will determine the width or height respectively.  If
3123 both are given the one resulting in a larger image is used.  example:
3124 C<$img> is 700 pixels wide and 500 pixels tall.
3125
3126   $newimg = $img->scale(xpixels=>400); # 400x285
3127   $newimg = $img->scale(ypixels=>400); # 560x400
3128
3129   $newimg = $img->scale(xpixels=>400,ypixels=>400); # 560x400
3130   $newimg = $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285
3131
3132   $newimg = $img->scale(scalefactor=>0.25); 175x125
3133   $newimg = $img->scale(); # 350x250
3134
3135 if you want to create low quality previews of images you can pass
3136 C<qtype=E<gt>'preview'> to scale and it will use nearest neighbor
3137 sampling instead of filtering. It is much faster but also generates
3138 worse looking images - especially if the original has a lot of sharp
3139 variations and the scaled image is by more than 3-5 times smaller than
3140 the original.
3141
3142 If you need to scale images per axis it is best to do it simply by
3143 calling scaleX and scaleY.  You can pass either 'scalefactor' or
3144 'pixels' to both functions.
3145
3146 Another way to resize an image size is to crop it.  The parameters
3147 to crop are the edges of the area that you want in the returned image.
3148 If a parameter is omited a default is used instead.
3149
3150   $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100);
3151   $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90);
3152   $newimg = $img->crop(left=>50, right=>100); # top
3153
3154 You can also specify width and height parameters which will produce a
3155 new image cropped from the center of the input image, with the given
3156 width and height.
3157
3158   $newimg = $img->crop(width=>50, height=>50);
3159
3160 The width and height parameters take precedence over the left/right
3161 and top/bottom parameters respectively.
3162
3163 =head2 Copying images
3164
3165 To create a copy of an image use the C<copy()> method.  This is usefull
3166 if you want to keep an original after doing something that changes the image
3167 inplace like writing text.
3168
3169   $img=$orig->copy();
3170
3171 To copy an image to onto another image use the C<paste()> method.
3172
3173   $dest->paste(left=>40,top=>20,img=>$logo);
3174
3175 That copies the entire C<$logo> image onto the C<$dest> image so that the
3176 upper left corner of the C<$logo> image is at (40,20).
3177
3178
3179 =head2 Flipping images
3180
3181 An inplace horizontal or vertical flip is possible by calling the
3182 C<flip()> method.  If the original is to be preserved it's possible to
3183 make a copy first.  The only parameter it takes is the C<dir>
3184 parameter which can take the values C<h>, C<v>, C<vh> and C<hv>.
3185
3186   $img->flip(dir=>"h");       # horizontal flip
3187   $img->flip(dir=>"vh");      # vertical and horizontal flip
3188   $nimg = $img->copy->flip(dir=>"v"); # make a copy and flip it vertically
3189
3190 =head2 Rotating images
3191
3192 Use the rotate() method to rotate an image.  This method will return a
3193 new, rotated image.
3194
3195 To rotate by an exact amount in degrees or radians, use the 'degrees'
3196 or 'radians' parameter:
3197
3198   my $rot20 = $img->rotate(degrees=>20);
3199   my $rotpi4 = $img->rotate(radians=>3.14159265/4);
3200
3201 Exact image rotation uses the same underlying transformation engine as
3202 the matrix_transform() method.
3203
3204 To rotate in steps of 90 degrees, use the 'right' parameter:
3205
3206   my $rotated = $img->rotate(right=>270);
3207
3208 Rotations are clockwise for positive values.
3209
3210 =head2 Blending Images
3211
3212 To put an image or a part of an image directly
3213 into another it is best to call the C<paste()> method on the image you
3214 want to add to.
3215
3216   $img->paste(img=>$srcimage,left=>30,top=>50);
3217
3218 That will take paste C<$srcimage> into C<$img> with the upper
3219 left corner at (30,50).  If no values are given for C<left>
3220 or C<top> they will default to 0.
3221
3222 A more complicated way of blending images is where one image is
3223 put 'over' the other with a certain amount of opaqueness.  The
3224 method that does this is rubthrough.
3225
3226   $img->rubthrough(src=>$srcimage,tx=>30,ty=>50);
3227
3228 That will take the image C<$srcimage> and overlay it with the upper
3229 left corner at (30,50).  You can rub 2 or 4 channel images onto a 3
3230 channel image, or a 2 channel image onto a 1 channel image.  The last
3231 channel is used as an alpha channel.
3232
3233
3234 =head2 Filters
3235
3236 A special image method is the filter method. An example is:
3237
3238   $img->filter(type=>'autolevels');
3239
3240 This will call the autolevels filter.  Here is a list of the filters
3241 that are always avaliable in Imager.  This list can be obtained by
3242 running the C<filterlist.perl> script that comes with the module
3243 source.
3244
3245   Filter          Arguments
3246   autolevels      lsat(0.1) usat(0.1) skew(0)
3247   bumpmap         bump elevation(0) lightx lighty st(2)
3248   bumpmap_complex bump channel(0) tx(0) ty(0) Lx(0.2) Ly(0.4)
3249                   Lz(-1) cd(1.0) cs(40.0) n(1.3) Ia(0 0 0) Il(255 255 255)
3250                   Is(255 255 255)
3251   contrast        intensity
3252   conv            coef
3253   fountain        xa ya xb yb ftype(linear) repeat(none) combine(none)
3254                   super_sample(none) ssample_param(4) segments(see below)
3255   gaussian        stddev
3256   gradgen         xo yo colors dist
3257   hardinvert
3258   mosaic          size(20)
3259   noise           amount(3) subtype(0)
3260   postlevels      levels(10)
3261   radnoise        xo(100) yo(100) ascale(17.0) rscale(0.02)
3262   turbnoise       xo(0.0) yo(0.0) scale(10.0)
3263   unsharpmask     stddev(2.0) scale(1.0)
3264   watermark       wmark pixdiff(10) tx(0) ty(0)
3265
3266 The default values are in parenthesis.  All parameters must have some
3267 value but if a parameter has a default value it may be omitted when
3268 calling the filter function.
3269
3270 The filters are:
3271
3272 =over
3273
3274 =item autolevels
3275
3276 scales the value of each channel so that the values in the image will
3277 cover the whole possible range for the channel.  I<lsat> and I<usat>
3278 truncate the range by the specified fraction at the top and bottom of
3279 the range respectivly..
3280
3281 =item bumpmap
3282
3283 uses the channel I<elevation> image I<bump> as a bumpmap on your
3284 image, with the light at (I<lightx>, I<lightty>), with a shadow length
3285 of I<st>.
3286
3287 =item bumpmap_complex
3288
3289 uses the channel I<channel> image I<bump> as a bumpmap on your image.
3290 If Lz<0 the three L parameters are considered to be the direction of
3291 the light.  If Lz>0 the L parameters are considered to be the light
3292 position.  I<Ia> is the ambient colour, I<Il> is the light colour,
3293 I<Is> is the color of specular highlights.  I<cd> is the diffuse
3294 coefficient and I<cs> is the specular coefficient.  I<n> is the
3295 shininess of the surface.
3296
3297 =item contrast
3298
3299 scales each channel by I<intensity>.  Values of I<intensity> < 1.0
3300 will reduce the contrast.
3301
3302 =item conv
3303
3304 performs 2 1-dimensional convolutions on the image using the values
3305 from I<coef>.  I<coef> should be have an odd length.
3306
3307 =item fountain
3308
3309 renders a fountain fill, similar to the gradient tool in most paint
3310 software.  The default fill is a linear fill from opaque black to
3311 opaque white.  The points A(xa, ya) and B(xb, yb) control the way the
3312 fill is performed, depending on the ftype parameter:
3313
3314 =over
3315
3316 =item linear
3317
3318 the fill ramps from A through to B.
3319
3320 =item bilinear
3321
3322 the fill ramps in both directions from A, where AB defines the length
3323 of the gradient.
3324
3325 =item radial
3326
3327 A is the center of a circle, and B is a point on it's circumference.
3328 The fill ramps from the center out to the circumference.
3329
3330 =item radial_square
3331
3332 A is the center of a square and B is the center of one of it's sides.
3333 This can be used to rotate the square.  The fill ramps out to the
3334 edges of the square.
3335
3336 =item revolution
3337
3338 A is the centre of a circle and B is a point on it's circumference.  B
3339 marks the 0 and 360 point on the circle, with the fill ramping
3340 clockwise.
3341
3342 =item conical
3343
3344 A is the center of a circle and B is a point on it's circumference.  B
3345 marks the 0 and point on the circle, with the fill ramping in both
3346 directions to meet opposite.
3347
3348 =back
3349
3350 The I<repeat> option controls how the fill is repeated for some
3351 I<ftype>s after it leaves the AB range:
3352
3353 =over
3354
3355 =item none
3356
3357 no repeats, points outside of each range are treated as if they were
3358 on the extreme end of that range.
3359
3360 =item sawtooth
3361
3362 the fill simply repeats in the positive direction
3363
3364 =item triangle
3365
3366 the fill repeats in reverse and then forward and so on, in the
3367 positive direction
3368
3369 =item saw_both
3370
3371 the fill repeats in both the positive and negative directions (only
3372 meaningful for a linear fill).
3373
3374 =item tri_both
3375
3376 as for triangle, but in the negative direction too (only meaningful
3377 for a linear fill).
3378
3379 =back
3380
3381 By default the fill simply overwrites the whole image (unless you have
3382 parts of the range 0 through 1 that aren't covered by a segment), if
3383 any segments of your fill have any transparency, you can set the
3384 I<combine> option to 'normal' to have the fill combined with the
3385 existing pixels.  See the description of I<combine> in L<Imager/Fill>.
3386
3387 If your fill has sharp edges, for example between steps if you use
3388 repeat set to 'triangle', you may see some aliased or ragged edges.
3389 You can enable super-sampling which will take extra samples within the
3390 pixel in an attempt anti-alias the fill.
3391
3392 The possible values for the super_sample option are:
3393
3394 =over
3395
3396 =item none
3397
3398 no super-sampling is done
3399
3400 =item grid
3401
3402 a square grid of points are sampled.  The number of points sampled is
3403 the square of ceil(0.5 + sqrt(ssample_param)).
3404
3405 =item random
3406
3407 a random set of points within the pixel are sampled.  This looks
3408 pretty bad for low ssample_param values.
3409
3410 =item circle
3411
3412 the points on the radius of a circle within the pixel are sampled.
3413 This seems to produce the best results, but is fairly slow (for now).
3414
3415 =back
3416
3417 You can control the level of sampling by setting the ssample_param
3418 option.  This is roughly the number of points sampled, but depends on
3419 the type of sampling.
3420
3421 The segments option is an arrayref of segments.  You really should use
3422 the Imager::Fountain class to build your fountain fill.  Each segment
3423 is an array ref containing:
3424
3425 =over
3426
3427 =item start
3428
3429 a floating point number between 0 and 1, the start of the range of fill parameters covered by this segment.
3430
3431 =item middle
3432
3433 a floating point number between start and end which can be used to
3434 push the color range towards one end of the segment.
3435
3436 =item end
3437
3438 a floating point number between 0 and 1, the end of the range of fill
3439 parameters covered by this segment.  This should be greater than
3440 start.
3441
3442 =item c0
3443
3444 =item c1
3445
3446 The colors at each end of the segment.  These can be either
3447 Imager::Color or Imager::Color::Float objects.
3448
3449 =item segment type
3450
3451 The type of segment, this controls the way the fill parameter varies
3452 over the segment. 0 for linear, 1 for curved (unimplemented), 2 for
3453 sine, 3 for sphere increasing, 4 for sphere decreasing.
3454
3455 =item color type
3456
3457 The way the color varies within the segment, 0 for simple RGB, 1 for
3458 hue increasing and 2 for hue decreasing.
3459
3460 =back
3461
3462 Don't forgot to use Imager::Fountain instead of building your own.
3463 Really.  It even loads GIMP gradient files.
3464
3465 =item gaussian
3466
3467 performs a gaussian blur of the image, using I<stddev> as the standard
3468 deviation of the curve used to combine pixels, larger values give
3469 bigger blurs.  For a definition of Gaussian Blur, see:
3470
3471   http://www.maths.abdn.ac.uk/~igc/tch/mx4002/notes/node99.html
3472
3473 =item gradgen
3474
3475 renders a gradient, with the given I<colors> at the corresponding
3476 points (x,y) in I<xo> and I<yo>.  You can specify the way distance is
3477 measured for color blendeing by setting I<dist> to 0 for Euclidean, 1
3478 for Euclidean squared, and 2 for Manhattan distance.
3479
3480 =item hardinvert
3481
3482 inverts the image, black to white, white to black.  All channels are
3483 inverted, including the alpha channel if any.
3484
3485 =item mosaic
3486
3487 produces averaged tiles of the given I<size>.
3488
3489 =item noise
3490
3491 adds noise of the given I<amount> to the image.  If I<subtype> is
3492 zero, the noise is even to each channel, otherwise noise is added to
3493 each channel independently.
3494
3495 =item radnoise
3496
3497 renders radiant Perlin turbulent noise.  The centre of the noise is at
3498 (I<xo>, I<yo>), I<ascale> controls the angular scale of the noise ,
3499 and I<rscale> the radial scale, higher numbers give more detail.
3500
3501 =item postlevels
3502
3503 alters the image to have only I<levels> distinct level in each
3504 channel.
3505
3506 =item turbnoise
3507
3508 renders Perlin turbulent noise.  (I<xo>, I<yo>) controls the origin of
3509 the noise, and I<scale> the scale of the noise, with lower numbers
3510 giving more detail.
3511
3512 =item unsharpmask
3513
3514 performs an unsharp mask on the image.  This is the result of
3515 subtracting a gaussian blurred version of the image from the original.
3516 I<stddev> controls the stddev parameter of the gaussian blur.  Each
3517 output pixel is: in + I<scale> * (in - blurred).
3518
3519 =item watermark
3520
3521 applies I<wmark> as a watermark on the image with strength I<pixdiff>,
3522 with an origin at (I<tx>, I<ty>)
3523
3524 =back
3525
3526 A demonstration of most of the filters can be found at:
3527
3528   http://www.develop-help.com/imager/filters.html
3529
3530 (This is a slow link.)
3531
3532 =head2 Color transformations
3533
3534 You can use the convert method to transform the color space of an
3535 image using a matrix.  For ease of use some presets are provided.
3536
3537 The convert method can be used to:
3538
3539 =over 4
3540
3541 =item *
3542
3543 convert an RGB or RGBA image to grayscale.
3544
3545 =item *
3546
3547 convert a grayscale image to RGB.
3548
3549 =item *
3550
3551 extract a single channel from an image.
3552
3553 =item *
3554
3555 set a given channel to a particular value (or from another channel)
3556
3557 =back
3558
3559 The currently defined presets are:
3560
3561 =over
3562
3563 =item gray
3564
3565 =item grey
3566
3567 converts an RGBA image into a grayscale image with alpha channel, or
3568 an RGB image into a grayscale image without an alpha channel.
3569
3570 This weights the RGB channels at 22.2%, 70.7% and 7.1% respectively.
3571
3572 =item noalpha
3573
3574 removes the alpha channel from a 2 or 4 channel image.  An identity
3575 for other images.
3576
3577 =item red
3578
3579 =item channel0
3580
3581 extracts the first channel of the image into a single channel image
3582
3583 =item green
3584
3585 =item channel1
3586
3587 extracts the second channel of the image into a single channel image
3588
3589 =item blue
3590
3591 =item channel2
3592
3593 extracts the third channel of the image into a single channel image
3594
3595 =item alpha
3596
3597 extracts the alpha channel of the image into a single channel image.
3598
3599 If the image has 1 or 3 channels (assumed to be grayscale of RGB) then
3600 the resulting image will be all white.
3601
3602 =item rgb
3603
3604 converts a grayscale image to RGB, preserving the alpha channel if any
3605
3606 =item addalpha
3607
3608 adds an alpha channel to a grayscale or RGB image.  Preserves an
3609 existing alpha channel for a 2 or 4 channel image.
3610
3611 =back
3612
3613 For example, to convert an RGB image into a greyscale image:
3614
3615   $new = $img->convert(preset=>'grey'); # or gray
3616
3617 or to convert a grayscale image to an RGB image:
3618
3619   $new = $img->convert(preset=>'rgb');
3620
3621 The presets aren't necessary simple constants in the code, some are
3622 generated based on the number of channels in the input image.
3623
3624 If you want to perform some other colour transformation, you can use
3625 the 'matrix' parameter.
3626
3627 For each output pixel the following matrix multiplication is done:
3628
3629      channel[0]       [ [ $c00, $c01, ...  ]        inchannel[0]
3630    [     ...      ] =          ...              x [     ...        ]
3631      channel[n-1]       [ $cn0, ...,  $cnn ] ]      inchannel[max]
3632                                                           1
3633
3634 So if you want to swap the red and green channels on a 3 channel image:
3635
3636   $new = $img->convert(matrix=>[ [ 0, 1, 0 ],
3637                                  [ 1, 0, 0 ],
3638                                  [ 0, 0, 1 ] ]);
3639
3640 or to convert a 3 channel image to greyscale using equal weightings:
3641
3642   $new = $img->convert(matrix=>[ [ 0.333, 0.333, 0.334 ] ])
3643
3644 =head2 Color Mappings
3645
3646 You can use the map method to map the values of each channel of an
3647 image independently using a list of lookup tables.  It's important to
3648 realize that the modification is made inplace.  The function simply
3649 returns the input image again or undef on failure.
3650
3651 Each channel is mapped independently through a lookup table with 256
3652 entries.  The elements in the table should not be less than 0 and not
3653 greater than 255.  If they are out of the 0..255 range they are
3654 clamped to the range.  If a table does not contain 256 entries it is
3655 silently ignored.
3656
3657 Single channels can mapped by specifying their name and the mapping
3658 table.  The channel names are C<red>, C<green>, C<blue>, C<alpha>.
3659
3660   @map = map { int( $_/2 } 0..255;
3661   $img->map( red=>\@map );
3662
3663 It is also possible to specify a single map that is applied to all
3664 channels, alpha channel included.  For example this applies a gamma
3665 correction with a gamma of 1.4 to the input image.
3666
3667   $gamma = 1.4;
3668   @map = map { int( 0.5 + 255*($_/255)**$gamma ) } 0..255;
3669   $img->map(all=> \@map);
3670
3671 The C<all> map is used as a default channel, if no other map is
3672 specified for a channel then the C<all> map is used instead.  If we
3673 had not wanted to apply gamma to the alpha channel we would have used:
3674
3675   $img->map(all=> \@map, alpha=>[]);
3676
3677 Since C<[]> contains fewer than 256 element the gamma channel is
3678 unaffected.
3679
3680 It is also possible to simply specify an array of maps that are
3681 applied to the images in the rgba order.  For example to apply
3682 maps to the C<red> and C<blue> channels one would use:
3683
3684   $img->map(maps=>[\@redmap, [], \@bluemap]);
3685
3686
3687
3688 =head2 Transformations
3689
3690 Another special image method is transform.  It can be used to generate
3691 warps and rotations and such features.  It can be given the operations
3692 in postfix notation or the module Affix::Infix2Postfix can be used.
3693 Look in the test case t/t55trans.t for an example.
3694
3695 transform() needs expressions (or opcodes) that determine the source
3696 pixel for each target pixel.  Source expressions are infix expressions
3697 using any of the +, -, *, / or ** binary operators, the - unary
3698 operator, ( and ) for grouping and the sin() and cos() functions.  The
3699 target pixel is input as the variables x and y.
3700
3701 You specify the x and y expressions as xexpr and yexpr respectively.
3702 You can also specify opcodes directly, but that's magic deep enough
3703 that you can look at the source code.
3704
3705 You can still use the transform() function, but the transform2()
3706 function is just as fast and is more likely to be enhanced and
3707 maintained.
3708
3709 Later versions of Imager also support a transform2() class method
3710 which allows you perform a more general set of operations, rather than
3711 just specifying a spatial transformation as with the transform()
3712 method, you can also perform colour transformations, image synthesis
3713 and image combinations.
3714
3715 transform2() takes an reference to an options hash, and a list of
3716 images to operate one (this list may be empty):
3717
3718   my %opts;
3719   my @imgs;
3720   ...
3721   my $img = Imager::transform2(\%opts, @imgs)
3722       or die "transform2 failed: $Imager::ERRSTR";
3723
3724 The options hash may define a transformation function, and optionally:
3725
3726 =over 4
3727
3728 =item *
3729
3730 width - the width of the image in pixels.  If this isn't supplied the
3731 width of the first input image is used.  If there are no input images
3732 an error occurs.
3733
3734 =item *
3735
3736 height - the height of the image in pixels.  If this isn't supplied
3737 the height of the first input image is used.  If there are no input
3738 images an error occurs.
3739
3740 =item *
3741
3742 constants - a reference to hash of constants to define for the
3743 expression engine.  Some extra constants are defined by Imager
3744
3745 =back
3746
3747 The tranformation function is specified using either the expr or
3748 rpnexpr member of the options.
3749
3750 =over 4
3751
3752 =item Infix expressions
3753
3754 You can supply infix expressions to transform 2 with the expr keyword.
3755
3756 $opts{expr} = 'return getp1(w-x, h-y)'
3757
3758 The 'expression' supplied follows this general grammar:
3759
3760    ( identifier '=' expr ';' )* 'return' expr
3761
3762 This allows you to simplify your expressions using variables.
3763
3764 A more complex example might be:
3765
3766 $opts{expr} = 'pix = getp1(x,y); return if(value(pix)>0.8,pix*0.8,pix)'
3767
3768 Currently to use infix expressions you must have the Parse::RecDescent
3769 module installed (available from CPAN).  There is also what might be a
3770 significant delay the first time you run the infix expression parser
3771 due to the compilation of the expression grammar.
3772
3773 =item Postfix expressions
3774
3775 You can supply postfix or reverse-polish notation expressions to
3776 transform2() through the rpnexpr keyword.
3777
3778 The parser for rpnexpr emulates a stack machine, so operators will
3779 expect to see their parameters on top of the stack.  A stack machine
3780 isn't actually used during the image transformation itself.
3781
3782 You can store the value at the top of the stack in a variable called
3783 foo using !foo and retrieve that value again using @foo.  The !foo
3784 notation will pop the value from the stack.
3785
3786 An example equivalent to the infix expression above:
3787
3788  $opts{rpnexpr} = 'x y getp1 !pix @pix value 0.8 gt @pix 0.8 * @pix ifp'
3789
3790 =back
3791
3792 transform2() has a fairly rich range of operators.
3793
3794 =over 4
3795
3796 =item +, *, -, /, %, **
3797
3798 multiplication, addition, subtraction, division, remainder and
3799 exponentiation.  Multiplication, addition and subtraction can be used
3800 on colour values too - though you need to be careful - adding 2 white
3801 values together and multiplying by 0.5 will give you grey, not white.
3802
3803 Division by zero (or a small number) just results in a large number.
3804 Modulo zero (or a small number) results in zero.
3805
3806 =item sin(N), cos(N), atan2(y,x)
3807
3808 Some basic trig functions.  They work in radians, so you can't just
3809 use the hue values.
3810
3811 =item distance(x1, y1, x2, y2)
3812
3813 Find the distance between two points.  This is handy (along with
3814 atan2()) for producing circular effects.
3815
3816 =item sqrt(n)
3817
3818 Find the square root.  I haven't had much use for this since adding
3819 the distance() function.
3820
3821 =item abs(n)
3822
3823 Find the absolute value.
3824
3825 =item getp1(x,y), getp2(x,y), getp3(x, y)
3826
3827 Get the pixel at position (x,y) from the first, second or third image
3828 respectively.  I may add a getpn() function at some point, but this
3829 prevents static checking of the instructions against the number of
3830 images actually passed in.
3831
3832 =item value(c), hue(c), sat(c), hsv(h,s,v)
3833
3834 Separates a colour value into it's value (brightness), hue (colour)
3835 and saturation elements.  Use hsv() to put them back together (after
3836 suitable manipulation).
3837
3838 =item red(c), green(c), blue(c), rgb(r,g,b)
3839
3840 Separates a colour value into it's red, green and blue colours.  Use
3841 rgb(r,g,b) to put it back together.
3842
3843 =item int(n)
3844
3845 Convert a value to an integer.  Uses a C int cast, so it may break on
3846 large values.
3847
3848 =item if(cond,ntrue,nfalse), if(cond,ctrue,cfalse)
3849
3850 A simple (and inefficient) if function.
3851
3852 =item <=,<,==,>=,>,!=
3853
3854 Relational operators (typically used with if()).  Since we're working
3855 with floating point values the equalities are 'near equalities' - an
3856 epsilon value is used.
3857
3858 =item &&, ||, not(n)
3859
3860 Basic logical operators.
3861
3862 =back
3863
3864 A few examples:
3865
3866 =over 4
3867
3868 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat x y getp1 !pix @pix sat 0.7 gt @pat @pix ifp'
3869
3870 tiles a smaller version of the input image over itself where the
3871 colour has a saturation over 0.7.
3872
3873 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat y 360 / !rat x y getp1 1 @rat - pmult @pat @rat pmult padd'
3874
3875 tiles the input image over itself so that at the top of the image the
3876 full-size image is at full strength and at the bottom the tiling is
3877 most visible.
3878
3879 =item rpnexpr=>'x y getp1 !pix @pix value 0.96 gt @pix sat 0.1 lt and 128 128 255 rgb @pix ifp'
3880
3881 replace pixels that are white or almost white with a palish blue
3882
3883 =item rpnexpr=>'x 35 % 10 * y 45 % 8 * getp1 !pat x y getp1 !pix @pix sat 0.2 lt @pix value 0.9 gt and @pix @pat @pix value 2 / 0.5 + pmult ifp'
3884
3885 Tiles the input image overitself where the image isn't white or almost
3886 white.
3887
3888 =item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a2 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv'
3889
3890 Produces a spiral.
3891
3892 =item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv'
3893
3894 A spiral built on top of a colour wheel.
3895
3896 =back
3897
3898 For details on expression parsing see L<Imager::Expr>.  For details on
3899 the virtual machine used to transform the images, see
3900 L<Imager::regmach.pod>.
3901
3902 =head2 Matrix Transformations
3903
3904 Rather than having to write code in a little language, you can use a
3905 matrix to perform transformations, using the matrix_transform()
3906 method:
3907
3908   my $im2 = $im->matrix_transform(matrix=>[ -1, 0, $im->getwidth-1,
3909                                             0,  1, 0,
3910                                             0,  0, 1 ]);
3911
3912 By default the output image will be the same size as the input image,
3913 but you can supply the xsize and ysize parameters to change the size.
3914
3915 Rather than building matrices by hand you can use the Imager::Matrix2d
3916 module to build the matrices.  This class has methods to allow you to
3917 scale, shear, rotate, translate and reflect, and you can combine these
3918 with an overloaded multiplication operator.
3919
3920 WARNING: the matrix you provide in the matrix operator transforms the
3921 co-ordinates within the B<destination> image to the co-ordinates
3922 within the I<source> image.  This can be confusing.
3923
3924 Since Imager has 3 different fairly general ways of transforming an
3925 image spatially, this method also has a yatf() alias.  Yet Another
3926 Transformation Function.
3927
3928 =head2 Masked Images
3929
3930 Masked images let you control which pixels are modified in an
3931 underlying image.  Where the first channel is completely black in the
3932 mask image, writes to the underlying image are ignored.
3933
3934 For example, given a base image called $img:
3935
3936   my $mask = Imager->new(xsize=>$img->getwidth, ysize=>getheight,
3937                          channels=>1);
3938   # ... draw something on the mask
3939   my $maskedimg = $img->masked(mask=>$mask);
3940
3941 You can specifiy the region of the underlying image that is masked
3942 using the left, top, right and bottom options.
3943
3944 If you just want a subset of the image, without masking, just specify
3945 the region without specifying a mask.
3946
3947 =head2 Plugins
3948
3949 It is possible to add filters to the module without recompiling the
3950 module itself.  This is done by using DSOs (Dynamic shared object)
3951 avaliable on most systems.  This way you can maintain our own filters
3952 and not have to get me to add it, or worse patch every new version of
3953 the Module.  Modules can be loaded AND UNLOADED at runtime.  This
3954 means that you can have a server/daemon thingy that can do something
3955 like:
3956
3957   load_plugin("dynfilt/dyntest.so")  || die "unable to load plugin\n";
3958   %hsh=(a=>35,b=>200,type=>lin_stretch);
3959   $img->filter(%hsh);
3960   unload_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
3961   $img->write(type=>'pnm',file=>'testout/t60.jpg')
3962     || die "error in write()\n";
3963
3964 Someone decides that the filter is not working as it should -
3965 dyntest.c modified and recompiled.
3966
3967   load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
3968   $img->filter(%hsh);
3969
3970 An example plugin comes with the module - Please send feedback to
3971 addi@umich.edu if you test this.
3972
3973 Note: This seems to test ok on the following systems:
3974 Linux, Solaris, HPUX, OpenBSD, FreeBSD, TRU64/OSF1, AIX.
3975 If you test this on other systems please let me know.
3976
3977 =head2 Tags
3978
3979 Image tags contain meta-data about the image, ie. information not
3980 stored as pixels of the image.
3981
3982 At the perl level each tag has a name or code and a value, which is an
3983 integer or an arbitrary string.  An image can contain more than one
3984 tag with the same name or code.
3985
3986 You can retrieve tags from an image using the tags() method, you can
3987 get all of the tags in an image, as a list of array references, with
3988 the code or name of the tag followed by the value of the tag:
3989
3990   my @alltags = $img->tags;
3991
3992 or you can get all tags that have a given name:
3993
3994   my @namedtags = $img->tags(name=>$name);
3995
3996 or a given code:
3997
3998   my @tags = $img->tags(code=>$code);
3999
4000 You can add tags using the addtag() method, either by name:
4001
4002   my $index = $img->addtag(name=>$name, value=>$value);
4003
4004 or by code:
4005
4006   my $index = $img->addtag(code=>$code, value=>$value);
4007
4008 You can remove tags with the deltag() method, either by index:
4009
4010   $img->deltag(index=>$index);
4011
4012 or by name:
4013
4014   $img->deltag(name=>$name);
4015
4016 or by code:
4017
4018   $img->deltag(code=>$code);
4019
4020 In each case deltag() returns the number of tags deleted.
4021
4022 When you read a GIF image using read_multi(), each image can include
4023 the following tags:
4024
4025 =over
4026
4027 =item gif_left
4028
4029 the offset of the image from the left of the "screen" ("Image Left
4030 Position")
4031
4032 =item gif_top
4033
4034 the offset of the image from the top of the "screen" ("Image Top Position")
4035
4036 =item gif_interlace
4037
4038 non-zero if the image was interlaced ("Interlace Flag")
4039
4040 =item gif_screen_width
4041
4042 =item gif_screen_height
4043
4044 the size of the logical screen ("Logical Screen Width",
4045 "Logical Screen Height")
4046
4047 =item gif_local_map
4048
4049 Non-zero if this image had a local color map.
4050
4051 =item gif_background
4052
4053 The index in the global colormap of the logical screen's background
4054 color.  This is only set if the current image uses the global
4055 colormap.
4056
4057 =item gif_trans_index
4058
4059 The index of the color in the colormap used for transparency.  If the
4060 image has a transparency then it is returned as a 4 channel image with
4061 the alpha set to zero in this palette entry. ("Transparent Color Index")
4062
4063 =item gif_delay
4064
4065 The delay until the next frame is displayed, in 1/100 of a second.
4066 ("Delay Time").
4067
4068 =item gif_user_input
4069
4070 whether or not a user input is expected before continuing (view dependent)
4071 ("User Input Flag").
4072
4073 =item gif_disposal
4074
4075 how the next frame is displayed ("Disposal Method")
4076
4077 =item gif_loop
4078
4079 the number of loops from the Netscape Loop extension.  This may be zero.
4080
4081 =item gif_comment
4082
4083 the first block of the first gif comment before each image.
4084
4085 =back
4086
4087 Where applicable, the ("name") is the name of that field from the GIF89
4088 standard.
4089
4090 The following tags are set in a TIFF image when read, and can be set
4091 to control output:
4092
4093 =over
4094
4095 =item tiff_resolutionunit
4096
4097 The value of the ResolutionUnit tag.  This is ignored on writing if
4098 the i_aspect_only tag is non-zero.
4099
4100 =item tiff_documentname
4101
4102 =item tiff_imagedescription
4103
4104 =item tiff_make
4105
4106 =item tiff_model
4107
4108 =item tiff_pagename
4109
4110 =item tiff_software
4111
4112 =item tiff_datetime
4113
4114 =item tiff_artist
4115
4116 =item tiff_hostcomputer
4117
4118 Various strings describing the image.  tiff_datetime must be formatted
4119 as "YYYY:MM:DD HH:MM:SS".  These correspond directly to the mixed case
4120 names in the TIFF specification.  These are set in images read from a
4121 TIFF and save when writing a TIFF image.
4122
4123 =back
4124
4125 The following tags are set when a Windows BMP file is read:
4126
4127 =over
4128
4129 =item bmp_compression
4130
4131 The type of compression, if any.
4132
4133 =item bmp_important_colors
4134
4135 The number of important colors as defined by the writer of the image.
4136
4137 =back
4138
4139 Some standard tags will be implemented as time goes by:
4140
4141 =over
4142
4143 =item i_xres
4144
4145 =item i_yres
4146
4147 The spatial resolution of the image in pixels per inch.  If the image
4148 format uses a different scale, eg. pixels per meter, then this value
4149 is converted.  A floating point number stored as a string.
4150
4151 =item i_aspect_only
4152
4153 If this is non-zero then the values in i_xres and i_yres are treated
4154 as a ratio only.  If the image format does not support aspect ratios
4155 then this is scaled so the smaller value is 72dpi.
4156
4157 =item i_incomplete
4158
4159 If this tag is present then the whole image could not be read.  This
4160 isn't implemented for all images yet.
4161
4162 =back
4163
4164 =head1 BUGS
4165
4166 box, arc, circle do not support antialiasing yet.  arc, is only filled
4167 as of yet.  Some routines do not return $self where they should.  This
4168 affects code like this, C<$img-E<gt>box()-E<gt>arc()> where an object
4169 is expected.
4170
4171 When saving Gif images the program does NOT try to shave of extra
4172 colors if it is possible.  If you specify 128 colors and there are
4173 only 2 colors used - it will have a 128 colortable anyway.
4174
4175 =head1 AUTHOR
4176
4177 Arnar M. Hrafnkelsson, addi@umich.edu, and recently lots of assistance
4178 from Tony Cook.  See the README for a complete list.
4179
4180 =head1 SEE ALSO
4181
4182 perl(1), Imager::Color(3), Imager::Font(3), Imager::Matrix2d(3),
4183 Affix::Infix2Postfix(3), Parse::RecDescent(3)
4184 http://www.eecs.umich.edu/~addi/perl/Imager/
4185
4186 =cut