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