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