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