Imager.pm

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