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