Imager.pm

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