Imager.pm

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