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