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