Imager.pm

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