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 $warn_obsolete);
   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                 i_poly_aa_cfill
  48
  49                 i_copyto
  50                 i_rubthru
  51                 i_scaleaxis
  52                 i_scale_nn
  53                 i_haar
  54                 i_count_colors
  55
  56                 i_gaussian
  57                 i_conv
  58
  59                 i_convert
  60                 i_map
  61
  62                 i_img_diff
  63
  64                 i_init_fonts
  65                 i_t1_new
  66                 i_t1_destroy
  67                 i_t1_set_aa
  68                 i_t1_cp
  69                 i_t1_text
  70                 i_t1_bbox
  71
  72                 i_tt_set_aa
  73                 i_tt_cp
  74                 i_tt_text
  75                 i_tt_bbox
  76
  77                 i_readjpeg_wiol
  78                 i_writejpeg_wiol
  79
  80                 i_readtiff_wiol
  81                 i_writetiff_wiol
  82                 i_writetiff_wiol_faxable
  83
  84                 i_readpng_wiol
  85                 i_writepng_wiol
  86
  87                 i_readgif
  88                 i_readgif_wiol
  89                 i_readgif_callback
  90                 i_writegif
  91                 i_writegifmc
  92                 i_writegif_gen
  93                 i_writegif_callback
  94
  95                 i_readpnm_wiol
  96                 i_writeppm_wiol
  97
  98                 i_readraw_wiol
  99                 i_writeraw_wiol
 100
 101                 i_contrast
 102                 i_hardinvert
 103                 i_noise
 104                 i_bumpmap
 105                 i_postlevels
 106                 i_mosaic
 107                 i_watermark
 108
 109                 malloc_state
 110
 111                 list_formats
 112
 113                 i_gifquant
 114
 115                 newfont
 116                 newcolor
 117                 newcolour
 118                 NC
 119                 NF
 120 );
 121
 122 @EXPORT=qw(
 123            init_log
 124            i_list_formats
 125            i_has_format
 126            malloc_state
 127            i_color_new
 128
 129            i_img_empty
 130            i_img_empty_ch
 131           );
 132
 133 %EXPORT_TAGS=
 134   (handy => [qw(
 135                 newfont
 136                 newcolor
 137                 NF
 138                 NC
 139                )],
 140    all => [@EXPORT_OK],
 141    default => [qw(
 142                   load_plugin
 143                   unload_plugin
 144                  )]);
 145
 146 BEGIN {
 147   require Exporter;
 148   require DynaLoader;
 149
 150   $VERSION = '0.41';
 151   @ISA = qw(Exporter DynaLoader);
 152   bootstrap Imager $VERSION;
 153 }
 154
 155 BEGIN {
 156   i_init_fonts(); # Initialize font engines
 157   Imager::Font::__init();
 158   for(i_list_formats()) { $formats{$_}++; }
 159
 160   if ($formats{'t1'}) {
 161     i_t1_set_aa(1);
 162   }
 163
 164   if (!$formats{'t1'} and !$formats{'tt'}
 165       && !$formats{'ft2'} && !$formats{'w32'}) {
 166     $fontstate='no font support';
 167   }
 168
 169   %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
 170
 171   $DEBUG=0;
 172
 173   # the members of the subhashes under %filters are:
 174   #  callseq - a list of the parameters to the underlying filter in the
 175   #            order they are passed
 176   #  callsub - a code ref that takes a named parameter list and calls the
 177   #            underlying filter
 178   #  defaults - a hash of default values
 179   #  names - defines names for value of given parameters so if the names
 180   #          field is foo=> { bar=>1 }, and the user supplies "bar" as the
 181   #          foo parameter, the filter will receive 1 for the foo
 182   #          parameter
 183   $filters{contrast}={
 184                       callseq => ['image','intensity'],
 185                       callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); }
 186                      };
 187
 188   $filters{noise} ={
 189                     callseq => ['image', 'amount', 'subtype'],
 190                     defaults => { amount=>3,subtype=>0 },
 191                     callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
 192                    };
 193
 194   $filters{hardinvert} ={
 195                          callseq => ['image'],
 196                          defaults => { },
 197                          callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
 198                         };
 199
 200   $filters{autolevels} ={
 201                          callseq => ['image','lsat','usat','skew'],
 202                          defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
 203                          callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
 204                         };
 205
 206   $filters{turbnoise} ={
 207                         callseq => ['image'],
 208                         defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
 209                         callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
 210                        };
 211
 212   $filters{radnoise} ={
 213                        callseq => ['image'],
 214                        defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
 215                        callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
 216                       };
 217
 218   $filters{conv} ={
 219                        callseq => ['image', 'coef'],
 220                        defaults => { },
 221                        callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
 222                       };
 223
 224   $filters{gradgen} ={
 225                        callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 226                        defaults => { },
 227                        callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 228                       };
 229
 230   $filters{nearest_color} ={
 231                             callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 232                             defaults => { },
 233                             callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 234                            };
 235   $filters{gaussian} = {
 236                         callseq => [ 'image', 'stddev' ],
 237                         defaults => { },
 238                         callsub => sub { my %hsh = @_; i_gaussian($hsh{image}, $hsh{stddev}); },
 239                        };
 240   $filters{mosaic} =
 241     {
 242      callseq => [ qw(image size) ],
 243      defaults => { size => 20 },
 244      callsub => sub { my %hsh = @_; i_mosaic($hsh{image}, $hsh{size}) },
 245     };
 246   $filters{bumpmap} =
 247     {
 248      callseq => [ qw(image bump elevation lightx lighty st) ],
 249      defaults => { elevation=>0, st=> 2 },
 250      callsub => sub {
 251        my %hsh = @_;
 252        i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation},
 253                  $hsh{lightx}, $hsh{lighty}, $hsh{st});
 254      },
 255     };
 256   $filters{bumpmap_complex} =
 257     {
 258      callseq => [ qw(image bump channel tx ty Lx Ly Lz cd cs n Ia Il Is) ],
 259      defaults => {
 260                   channel => 0,
 261                   tx => 0,
 262                   ty => 0,
 263                   Lx => 0.2,
 264                   Ly => 0.4,
 265                   Lz => -1.0,
 266                   cd => 1.0,
 267                   cs => 40,
 268                   n => 1.3,
 269                   Ia => Imager::Color->new(rgb=>[0,0,0]),
 270                   Il => Imager::Color->new(rgb=>[255,255,255]),
 271                   Is => Imager::Color->new(rgb=>[255,255,255]),
 272                  },
 273      callsub => sub {
 274        my %hsh = @_;
 275        i_bumpmap_complex($hsh{image}, $hsh{bump}{IMG}, $hsh{channel},
 276                  $hsh{tx}, $hsh{ty}, $hsh{Lx}, $hsh{Ly}, $hsh{Lz},
 277                  $hsh{cd}, $hsh{cs}, $hsh{n}, $hsh{Ia}, $hsh{Il},
 278                  $hsh{Is});
 279      },
 280     };
 281   $filters{postlevels} =
 282     {
 283      callseq  => [ qw(image levels) ],
 284      defaults => { levels => 10 },
 285      callsub  => sub { my %hsh = @_; i_postlevels($hsh{image}, $hsh{levels}); },
 286     };
 287   $filters{watermark} =
 288     {
 289      callseq  => [ qw(image wmark tx ty pixdiff) ],
 290      defaults => { pixdiff=>10, tx=>0, ty=>0 },
 291      callsub  =>
 292      sub {
 293        my %hsh = @_;
 294        i_watermark($hsh{image}, $hsh{wmark}{IMG}, $hsh{tx}, $hsh{ty},
 295                    $hsh{pixdiff});
 296      },
 297     };
 298   $filters{fountain} =
 299     {
 300      callseq  => [ qw(image xa ya xb yb ftype repeat combine super_sample ssample_param segments) ],
 301      names    => {
 302                   ftype => { linear         => 0,
 303                              bilinear       => 1,
 304                              radial         => 2,
 305                              radial_square  => 3,
 306                              revolution     => 4,
 307                              conical        => 5 },
 308                   repeat => { none      => 0,
 309                               sawtooth  => 1,
 310                               triangle  => 2,
 311                               saw_both  => 3,
 312                               tri_both  => 4,
 313                             },
 314                   super_sample => {
 315                                    none    => 0,
 316                                    grid    => 1,
 317                                    random  => 2,
 318                                    circle  => 3,
 319                                   },
 320                   combine => {
 321                               none      => 0,
 322                               normal    => 1,
 323                               multiply  => 2, mult => 2,
 324                               dissolve  => 3,
 325                               add       => 4,
 326                               subtract  => 5, 'sub' => 5,
 327                               diff      => 6,
 328                               lighten   => 7,
 329                               darken    => 8,
 330                               hue       => 9,
 331                               sat       => 10,
 332                               value     => 11,
 333                               color     => 12,
 334                              },
 335                  },
 336      defaults => { ftype => 0, repeat => 0, combine => 0,
 337                    super_sample => 0, ssample_param => 4,
 338                    segments=>[
 339                               [ 0, 0.5, 1,
 340                                 Imager::Color->new(0,0,0),
 341                                 Imager::Color->new(255, 255, 255),
 342                                 0, 0,
 343                               ],
 344                              ],
 345                  },
 346      callsub  =>
 347      sub {
 348        my %hsh = @_;
 349        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
 350                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
 351                   $hsh{ssample_param}, $hsh{segments});
 352      },
 353     };
 354   $filters{unsharpmask} =
 355     {
 356      callseq => [ qw(image stddev scale) ],
 357      defaults => { stddev=>2.0, scale=>1.0 },
 358      callsub =>
 359      sub {
 360        my %hsh = @_;
 361        i_unsharp_mask($hsh{image}, $hsh{stddev}, $hsh{scale});
 362      },
 363     };
 364
 365   $FORMATGUESS=\&def_guess_type;
 366
 367   $warn_obsolete = 1;
 368 }
 369
 370 #
 371 # Non methods
 372 #
 373
 374 # initlize Imager
 375 # NOTE: this might be moved to an import override later on
 376
 377 #sub import {
 378 #  my $pack = shift;
 379 #  (look through @_ for special tags, process, and remove them);
 380 #  use Data::Dumper;
 381 #  print Dumper($pack);
 382 #  print Dumper(@_);
 383 #}
 384
 385 sub init_log {
 386         m_init_log($_[0],$_[1]);
 387         log_entry("Imager $VERSION starting\n", 1);
 388 }
 389
 390
 391 sub init {
 392   my %parms=(loglevel=>1,@_);
 393   if ($parms{'log'}) {
 394     init_log($parms{'log'},$parms{'loglevel'});
 395   }
 396
 397   if (exists $parms{'warn_obsolete'}) {
 398     $warn_obsolete = $parms{'warn_obsolete'};
 399   }
 400
 401 #    if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
 402 #    if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
 403 #       i_init_fonts();
 404 #       $fontstate='ok';
 405 #    }
 406   if (exists $parms{'t1log'}) {
 407     i_init_fonts($parms{'t1log'});
 408   }
 409 }
 410
 411 END {
 412   if ($DEBUG) {
 413     print "shutdown code\n";
 414     #   for(keys %instances) { $instances{$_}->DESTROY(); }
 415     malloc_state(); # how do decide if this should be used? -- store something from the import
 416     print "Imager exiting\n";
 417   }
 418 }
 419
 420 # Load a filter plugin
 421
 422 sub load_plugin {
 423   my ($filename)=@_;
 424   my $i;
 425   my ($DSO_handle,$str)=DSO_open($filename);
 426   if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
 427   my %funcs=DSO_funclist($DSO_handle);
 428   if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf("  %2d: %s\n",$i++,$_); } }
 429   $i=0;
 430   for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
 431
 432   $DSOs{$filename}=[$DSO_handle,\%funcs];
 433
 434   for(keys %funcs) {
 435     my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
 436     $DEBUG && print "eval string:\n",$evstr,"\n";
 437     eval $evstr;
 438     print $@ if $@;
 439   }
 440   return 1;
 441 }
 442
 443 # Unload a plugin
 444
 445 sub unload_plugin {
 446   my ($filename)=@_;
 447
 448   if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
 449   my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
 450   for(keys %{$funcref}) {
 451     delete $filters{$_};
 452     $DEBUG && print "unloading: $_\n";
 453   }
 454   my $rc=DSO_close($DSO_handle);
 455   if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
 456   return 1;
 457 }
 458
 459 # take the results of i_error() and make a message out of it
 460 sub _error_as_msg {
 461   return join(": ", map $_->[0], i_errors());
 462 }
 463
 464 # this function tries to DWIM for color parameters
 465 #  color objects are used as is
 466 #  simple scalars are simply treated as single parameters to Imager::Color->new
 467 #  hashrefs are treated as named argument lists to Imager::Color->new
 468 #  arrayrefs are treated as list arguments to Imager::Color->new iff any
 469 #    parameter is > 1
 470 #  other arrayrefs are treated as list arguments to Imager::Color::Float
 471
 472 sub _color {
 473   my $arg = shift;
 474   # perl 5.6.0 seems to do weird things to $arg if we don't make an
 475   # explicitly stringified copy
 476   # I vaguely remember a bug on this on p5p, but couldn't find it
 477   # through bugs.perl.org (I had trouble getting it to find any bugs)
 478   my $copy = $arg . "";
 479   my $result;
 480
 481   if (ref $arg) {
 482     if (UNIVERSAL::isa($arg, "Imager::Color")
 483         || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
 484       $result = $arg;
 485     }
 486     else {
 487       if ($copy =~ /^HASH\(/) {
 488         $result = Imager::Color->new(%$arg);
 489       }
 490       elsif ($copy =~ /^ARRAY\(/) {
 491         if (grep $_ > 1, @$arg) {
 492           $result = Imager::Color->new(@$arg);
 493         }
 494         else {
 495           $result = Imager::Color::Float->new(@$arg);
 496         }
 497       }
 498       else {
 499         $Imager::ERRSTR = "Not a color";
 500       }
 501     }
 502   }
 503   else {
 504     # assume Imager::Color::new knows how to handle it
 505     $result = Imager::Color->new($arg);
 506   }
 507
 508   return $result;
 509 }
 510
 511
 512 #
 513 # Methods to be called on objects.
 514 #
 515
 516 # Create a new Imager object takes very few parameters.
 517 # usually you call this method and then call open from
 518 # the resulting object
 519
 520 sub new {
 521   my $class = shift;
 522   my $self ={};
 523   my %hsh=@_;
 524   bless $self,$class;
 525   $self->{IMG}=undef;    # Just to indicate what exists
 526   $self->{ERRSTR}=undef; #
 527   $self->{DEBUG}=$DEBUG;
 528   $self->{DEBUG} && print "Initialized Imager\n";
 529   if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
 530   return $self;
 531 }
 532
 533 # Copy an entire image with no changes
 534 # - if an image has magic the copy of it will not be magical
 535
 536 sub copy {
 537   my $self = shift;
 538   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 539
 540   my $newcopy=Imager->new();
 541   $newcopy->{IMG}=i_img_new();
 542   i_copy($newcopy->{IMG},$self->{IMG});
 543   return $newcopy;
 544 }
 545
 546 # Paste a region
 547
 548 sub paste {
 549   my $self = shift;
 550   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 551   my %input=(left=>0, top=>0, @_);
 552   unless($input{img}) {
 553     $self->{ERRSTR}="no source image";
 554     return;
 555   }
 556   $input{left}=0 if $input{left} <= 0;
 557   $input{top}=0 if $input{top} <= 0;
 558   my $src=$input{img};
 559   my($r,$b)=i_img_info($src->{IMG});
 560
 561   i_copyto($self->{IMG}, $src->{IMG},
 562            0,0, $r, $b, $input{left}, $input{top});
 563   return $self;  # What should go here??
 564 }
 565
 566 # Crop an image - i.e. return a new image that is smaller
 567
 568 sub crop {
 569   my $self=shift;
 570   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 571   my %hsh=(left=>0,right=>0,top=>0,bottom=>0,@_);
 572
 573   my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
 574                                 @hsh{qw(left right bottom top)});
 575   $l=0 if not defined $l;
 576   $t=0 if not defined $t;
 577
 578   $r||=$l+delete $hsh{'width'}    if defined $l and exists $hsh{'width'};
 579   $b||=$t+delete $hsh{'height'}   if defined $t and exists $hsh{'height'};
 580   $l||=$r-delete $hsh{'width'}    if defined $r and exists $hsh{'width'};
 581   $t||=$b-delete $hsh{'height'}   if defined $b and exists $hsh{'height'};
 582
 583   $r=$self->getwidth if not defined $r;
 584   $b=$self->getheight if not defined $b;
 585
 586   ($l,$r)=($r,$l) if $l>$r;
 587   ($t,$b)=($b,$t) if $t>$b;
 588
 589   if ($hsh{'width'}) {
 590     $l=int(0.5+($w-$hsh{'width'})/2);
 591     $r=$l+$hsh{'width'};
 592   } else {
 593     $hsh{'width'}=$r-$l;
 594   }
 595   if ($hsh{'height'}) {
 596     $b=int(0.5+($h-$hsh{'height'})/2);
 597     $t=$h+$hsh{'height'};
 598   } else {
 599     $hsh{'height'}=$b-$t;
 600   }
 601
 602 #    print "l=$l, r=$r, h=$hsh{'width'}\n";
 603 #    print "t=$t, b=$b, w=$hsh{'height'}\n";
 604
 605   my $dst=Imager->new(xsize=>$hsh{'width'}, ysize=>$hsh{'height'}, channels=>$self->getchannels());
 606
 607   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
 608   return $dst;
 609 }
 610
 611 # Sets an image to a certain size and channel number
 612 # if there was previously data in the image it is discarded
 613
 614 sub img_set {
 615   my $self=shift;
 616
 617   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
 618
 619   if (defined($self->{IMG})) {
 620     # let IIM_DESTROY destroy it, it's possible this image is
 621     # referenced from a virtual image (like masked)
 622     #i_img_destroy($self->{IMG});
 623     undef($self->{IMG});
 624   }
 625
 626   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
 627     $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
 628                                  $hsh{maxcolors} || 256);
 629   }
 630   elsif ($hsh{bits} eq 'double') {
 631     $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
 632   }
 633   elsif ($hsh{bits} == 16) {
 634     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
 635   }
 636   else {
 637     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
 638                                      $hsh{'channels'});
 639   }
 640 }
 641
 642 # created a masked version of the current image
 643 sub masked {
 644   my $self = shift;
 645
 646   $self or return undef;
 647   my %opts = (left    => 0,
 648               top     => 0,
 649               right   => $self->getwidth,
 650               bottom  => $self->getheight,
 651               @_);
 652   my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
 653
 654   my $result = Imager->new;
 655   $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left},
 656                                     $opts{top}, $opts{right} - $opts{left},
 657                                     $opts{bottom} - $opts{top});
 658   # keep references to the mask and base images so they don't
 659   # disappear on us
 660   $result->{DEPENDS} = [ $self->{IMG}, $mask ];
 661
 662   $result;
 663 }
 664
 665 # convert an RGB image into a paletted image
 666 sub to_paletted {
 667   my $self = shift;
 668   my $opts;
 669   if (@_ != 1 && !ref $_[0]) {
 670     $opts = { @_ };
 671   }
 672   else {
 673     $opts = shift;
 674   }
 675
 676   my $result = Imager->new;
 677   $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
 678
 679   #print "Type ", i_img_type($result->{IMG}), "\n";
 680
 681   $result->{IMG} or undef $result;
 682
 683   return $result;
 684 }
 685
 686 # convert a paletted (or any image) to an 8-bit/channel RGB images
 687 sub to_rgb8 {
 688   my $self = shift;
 689   my $result;
 690
 691   if ($self->{IMG}) {
 692     $result = Imager->new;
 693     $result->{IMG} = i_img_to_rgb($self->{IMG})
 694       or undef $result;
 695   }
 696
 697   return $result;
 698 }
 699
 700 sub addcolors {
 701   my $self = shift;
 702   my %opts = (colors=>[], @_);
 703
 704   @{$opts{colors}} or return undef;
 705
 706   $self->{IMG} and i_addcolors($self->{IMG}, @{$opts{colors}});
 707 }
 708
 709 sub setcolors {
 710   my $self = shift;
 711   my %opts = (start=>0, colors=>[], @_);
 712   @{$opts{colors}} or return undef;
 713
 714   $self->{IMG} and i_setcolors($self->{IMG}, $opts{start}, @{$opts{colors}});
 715 }
 716
 717 sub getcolors {
 718   my $self = shift;
 719   my %opts = @_;
 720   if (!exists $opts{start} && !exists $opts{count}) {
 721     # get them all
 722     $opts{start} = 0;
 723     $opts{count} = $self->colorcount;
 724   }
 725   elsif (!exists $opts{count}) {
 726     $opts{count} = 1;
 727   }
 728   elsif (!exists $opts{start}) {
 729     $opts{start} = 0;
 730   }
 731
 732   $self->{IMG} and
 733     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
 734 }
 735
 736 sub colorcount {
 737   i_colorcount($_[0]{IMG});
 738 }
 739
 740 sub maxcolors {
 741   i_maxcolors($_[0]{IMG});
 742 }
 743
 744 sub findcolor {
 745   my $self = shift;
 746   my %opts = @_;
 747   $opts{color} or return undef;
 748
 749   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
 750 }
 751
 752 sub bits {
 753   my $self = shift;
 754   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
 755   if ($bits && $bits == length(pack("d", 1)) * 8) {
 756     $bits = 'double';
 757   }
 758   $bits;
 759 }
 760
 761 sub type {
 762   my $self = shift;
 763   if ($self->{IMG}) {
 764     return i_img_type($self->{IMG}) ? "paletted" : "direct";
 765   }
 766 }
 767
 768 sub virtual {
 769   my $self = shift;
 770   $self->{IMG} and i_img_virtual($self->{IMG});
 771 }
 772
 773 sub tags {
 774   my ($self, %opts) = @_;
 775
 776   $self->{IMG} or return;
 777
 778   if (defined $opts{name}) {
 779     my @result;
 780     my $start = 0;
 781     my $found;
 782     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
 783       push @result, (i_tags_get($self->{IMG}, $found))[1];
 784       $start = $found+1;
 785     }
 786     return wantarray ? @result : $result[0];
 787   }
 788   elsif (defined $opts{code}) {
 789     my @result;
 790     my $start = 0;
 791     my $found;
 792     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
 793       push @result, (i_tags_get($self->{IMG}, $found))[1];
 794       $start = $found+1;
 795     }
 796     return @result;
 797   }
 798   else {
 799     if (wantarray) {
 800       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
 801     }
 802     else {
 803       return i_tags_count($self->{IMG});
 804     }
 805   }
 806 }
 807
 808 sub addtag {
 809   my $self = shift;
 810   my %opts = @_;
 811
 812   return -1 unless $self->{IMG};
 813   if ($opts{name}) {
 814     if (defined $opts{value}) {
 815       if ($opts{value} =~ /^\d+$/) {
 816         # add as a number
 817         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
 818       }
 819       else {
 820         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
 821       }
 822     }
 823     elsif (defined $opts{data}) {
 824       # force addition as a string
 825       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
 826     }
 827     else {
 828       $self->{ERRSTR} = "No value supplied";
 829       return undef;
 830     }
 831   }
 832   elsif ($opts{code}) {
 833     if (defined $opts{value}) {
 834       if ($opts{value} =~ /^\d+$/) {
 835         # add as a number
 836         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
 837       }
 838       else {
 839         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
 840       }
 841     }
 842     elsif (defined $opts{data}) {
 843       # force addition as a string
 844       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
 845     }
 846     else {
 847       $self->{ERRSTR} = "No value supplied";
 848       return undef;
 849     }
 850   }
 851   else {
 852     return undef;
 853   }
 854 }
 855
 856 sub deltag {
 857   my $self = shift;
 858   my %opts = @_;
 859
 860   return 0 unless $self->{IMG};
 861
 862   if (defined $opts{'index'}) {
 863     return i_tags_delete($self->{IMG}, $opts{'index'});
 864   }
 865   elsif (defined $opts{name}) {
 866     return i_tags_delbyname($self->{IMG}, $opts{name});
 867   }
 868   elsif (defined $opts{code}) {
 869     return i_tags_delbycode($self->{IMG}, $opts{code});
 870   }
 871   else {
 872     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
 873     return 0;
 874   }
 875 }
 876
 877 sub settag {
 878   my ($self, %opts) = @_;
 879
 880   if ($opts{name}) {
 881     $self->deltag(name=>$opts{name});
 882     return $self->addtag(name=>$opts{name}, value=>$opts{value});
 883   }
 884   elsif (defined $opts{code}) {
 885     $self->deltag(code=>$opts{code});
 886     return $self->addtag(code=>$opts{code}, value=>$opts{value});
 887   }
 888   else {
 889     return undef;
 890   }
 891 }
 892
 893 my @needseekcb = qw/tiff/;
 894 my %needseekcb = map { $_, $_ } @needseekcb;
 895
 896
 897 sub _get_reader_io {
 898   my ($self, $input, $type) = @_;
 899
 900   if ($input->{fd}) {
 901     return io_new_fd($input->{fd});
 902   }
 903   elsif ($input->{fh}) {
 904     my $fd = fileno($input->{fh});
 905     unless ($fd) {
 906       $self->_set_error("Handle in fh option not opened");
 907       return;
 908     }
 909     return io_new_fd($fd);
 910   }
 911   elsif ($input->{file}) {
 912     my $file = IO::File->new($input->{file}, "r");
 913     unless ($file) {
 914       $self->_set_error("Could not open $input->{file}: $!");
 915       return;
 916     }
 917     binmode $file;
 918     return (io_new_fd(fileno($file)), $file);
 919   }
 920   elsif ($input->{data}) {
 921     return io_new_buffer($input->{data});
 922   }
 923   elsif ($input->{callback} || $input->{readcb}) {
 924     if ($needseekcb{$type} && !$input->{seekcb}) {
 925       $self->_set_error("Format $type needs a seekcb parameter");
 926     }
 927     if ($input->{maxbuffer}) {
 928       return io_new_cb($input->{writecb},
 929                        $input->{callback} || $input->{readcb},
 930                        $input->{seekcb}, $input->{closecb},
 931                        $input->{maxbuffer});
 932     }
 933     else {
 934       return io_new_cb($input->{writecb},
 935                        $input->{callback} || $input->{readcb},
 936                        $input->{seekcb}, $input->{closecb});
 937     }
 938   }
 939   else {
 940     $self->_set_error("file/fd/fh/data/callback parameter missing");
 941     return;
 942   }
 943 }
 944
 945 sub _get_writer_io {
 946   my ($self, $input, $type) = @_;
 947
 948   if ($input->{fd}) {
 949     return io_new_fd($input->{fd});
 950   }
 951   elsif ($input->{fh}) {
 952     my $fd = fileno($input->{fh});
 953     unless ($fd) {
 954       $self->_set_error("Handle in fh option not opened");
 955       return;
 956     }
 957     # flush it
 958     my $oldfh = select($input->{fh});
 959     # flush anything that's buffered, and make sure anything else is flushed
 960     $| = 1;
 961     select($oldfh);
 962     return io_new_fd($fd);
 963   }
 964   elsif ($input->{file}) {
 965     my $fh = new IO::File($input->{file},"w+");
 966     unless ($fh) {
 967       $self->_set_error("Could not open file $input->{file}: $!");
 968       return;
 969     }
 970     binmode($fh) or die;
 971     return (io_new_fd(fileno($fh)), $fh);
 972   }
 973   elsif ($input->{data}) {
 974     return io_new_bufchain();
 975   }
 976   elsif ($input->{callback} || $input->{writecb}) {
 977     if ($input->{maxbuffer}) {
 978       return io_new_cb($input->{callback} || $input->{writecb},
 979                        $input->{readcb},
 980                        $input->{seekcb}, $input->{closecb},
 981                        $input->{maxbuffer});
 982     }
 983     else {
 984       return io_new_cb($input->{callback} || $input->{writecb},
 985                        $input->{readcb},
 986                        $input->{seekcb}, $input->{closecb});
 987     }
 988   }
 989   else {
 990     $self->_set_error("file/fd/fh/data/callback parameter missing");
 991     return;
 992   }
 993 }
 994
 995 # Read an image from file
 996
 997 sub read {
 998   my $self = shift;
 999   my %input=@_;
1000
1001   if (defined($self->{IMG})) {
1002     # let IIM_DESTROY do the destruction, since the image may be
1003     # referenced from elsewhere
1004     #i_img_destroy($self->{IMG});
1005     undef($self->{IMG});
1006   }
1007
1008   # FIXME: Find the format here if not specified
1009   # yes the code isn't here yet - next week maybe?
1010   # Next week?  Are you high or something?  That comment
1011   # has been there for half a year dude.
1012   # Look, i just work here, ok?
1013
1014   if (!$input{'type'} and $input{file}) {
1015     $input{'type'}=$FORMATGUESS->($input{file});
1016   }
1017   unless ($input{'type'}) {
1018     $self->_set_error('type parameter missing and not possible to guess from extension');
1019     return undef;
1020   }
1021   if (!$formats{$input{'type'}}) {
1022     $self->{ERRSTR}='format not supported'; return undef;
1023   }
1024
1025   my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1, tga=>1, rgb=>1, gif=>1);
1026
1027   if ($iolready{$input{'type'}}) {
1028     # Setup data source
1029     my ($IO, $fh) = $self->_get_reader_io(\%input, $input{'type'})
1030       or return;
1031
1032     if ( $input{'type'} eq 'jpeg' ) {
1033       ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO );
1034       if ( !defined($self->{IMG}) ) {
1035         $self->{ERRSTR}='unable to read jpeg image'; return undef;
1036       }
1037       $self->{DEBUG} && print "loading a jpeg file\n";
1038       return $self;
1039     }
1040
1041     if ( $input{'type'} eq 'tiff' ) {
1042       $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1043       if ( !defined($self->{IMG}) ) {
1044         $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1045       }
1046       $self->{DEBUG} && print "loading a tiff file\n";
1047       return $self;
1048     }
1049
1050     if ( $input{'type'} eq 'pnm' ) {
1051       $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1052       if ( !defined($self->{IMG}) ) {
1053         $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef;
1054       }
1055       $self->{DEBUG} && print "loading a pnm file\n";
1056       return $self;
1057     }
1058
1059     if ( $input{'type'} eq 'png' ) {
1060       $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1061       if ( !defined($self->{IMG}) ) {
1062         $self->{ERRSTR}='unable to read png image';
1063         return undef;
1064       }
1065       $self->{DEBUG} && print "loading a png file\n";
1066     }
1067
1068     if ( $input{'type'} eq 'bmp' ) {
1069       $self->{IMG}=i_readbmp_wiol( $IO );
1070       if ( !defined($self->{IMG}) ) {
1071         $self->{ERRSTR}=$self->_error_as_msg();
1072         return undef;
1073       }
1074       $self->{DEBUG} && print "loading a bmp file\n";
1075     }
1076
1077     if ( $input{'type'} eq 'gif' ) {
1078       if ($input{colors} && !ref($input{colors})) {
1079         # must be a reference to a scalar that accepts the colour map
1080         $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1081         return undef;
1082       }
1083       if ($input{colors}) {
1084         my $colors;
1085         ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
1086         if ($colors) {
1087           ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1088         }
1089       }
1090       else {
1091         $self->{IMG} =i_readgif_wiol( $IO );
1092       }
1093       if ( !defined($self->{IMG}) ) {
1094         $self->{ERRSTR}=$self->_error_as_msg();
1095         return undef;
1096       }
1097       $self->{DEBUG} && print "loading a gif file\n";
1098     }
1099
1100     if ( $input{'type'} eq 'tga' ) {
1101       $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1102       if ( !defined($self->{IMG}) ) {
1103         $self->{ERRSTR}=$self->_error_as_msg();
1104         return undef;
1105       }
1106       $self->{DEBUG} && print "loading a tga file\n";
1107     }
1108
1109     if ( $input{'type'} eq 'rgb' ) {
1110       $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1111       if ( !defined($self->{IMG}) ) {
1112         $self->{ERRSTR}=$self->_error_as_msg();
1113         return undef;
1114       }
1115       $self->{DEBUG} && print "loading a tga file\n";
1116     }
1117
1118
1119     if ( $input{'type'} eq 'raw' ) {
1120       my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
1121
1122       if ( !($params{xsize} && $params{ysize}) ) {
1123         $self->{ERRSTR}='missing xsize or ysize parameter for raw';
1124         return undef;
1125       }
1126
1127       $self->{IMG} = i_readraw_wiol( $IO,
1128                                      $params{xsize},
1129                                      $params{ysize},
1130                                      $params{datachannels},
1131                                      $params{storechannels},
1132                                      $params{interleave});
1133       if ( !defined($self->{IMG}) ) {
1134         $self->{ERRSTR}='unable to read raw image';
1135         return undef;
1136       }
1137       $self->{DEBUG} && print "loading a raw file\n";
1138     }
1139
1140   } else {
1141
1142     # Old code for reference while changing the new stuff
1143
1144     if (!$input{'type'} and $input{file}) {
1145       $input{'type'}=$FORMATGUESS->($input{file});
1146     }
1147
1148     if (!$input{'type'}) {
1149       $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef;
1150     }
1151
1152     if (!$formats{$input{'type'}}) {
1153       $self->{ERRSTR}='format not supported';
1154       return undef;
1155     }
1156
1157     my ($fh, $fd);
1158     if ($input{file}) {
1159       $fh = new IO::File($input{file},"r");
1160       if (!defined $fh) {
1161         $self->{ERRSTR}='Could not open file';
1162         return undef;
1163       }
1164       binmode($fh);
1165       $fd = $fh->fileno();
1166     }
1167
1168     if ($input{fd}) {
1169       $fd=$input{fd};
1170     }
1171
1172     if ( $input{'type'} eq 'gif' ) {
1173       my $colors;
1174       if ($input{colors} && !ref($input{colors})) {
1175         # must be a reference to a scalar that accepts the colour map
1176         $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1177         return undef;
1178       }
1179       if (exists $input{data}) {
1180         if ($input{colors}) {
1181           ($self->{IMG}, $colors) = i_readgif_scalar($input{data});
1182         } else {
1183           $self->{IMG}=i_readgif_scalar($input{data});
1184         }
1185       } else {
1186         if ($input{colors}) {
1187           ($self->{IMG}, $colors) = i_readgif( $fd );
1188         } else {
1189           $self->{IMG} = i_readgif( $fd )
1190         }
1191       }
1192       if ($colors) {
1193         # we may or may not change i_readgif to return blessed objects...
1194         ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1195       }
1196       if ( !defined($self->{IMG}) ) {
1197         $self->{ERRSTR}= 'reading GIF:'._error_as_msg();
1198         return undef;
1199       }
1200       $self->{DEBUG} && print "loading a gif file\n";
1201     }
1202   }
1203   return $self;
1204 }
1205
1206 sub _fix_gif_positions {
1207   my ($opts, $opt, $msg, @imgs) = @_;
1208
1209   my $positions = $opts->{'gif_positions'};
1210   my $index = 0;
1211   for my $pos (@$positions) {
1212     my ($x, $y) = @$pos;
1213     my $img = $imgs[$index++];
1214     $img->settag(name=>'gif_left', value=>$x);
1215     $img->settag(name=>'gif_top', value=>$y) if defined $y;
1216   }
1217   $$msg .= "replaced with the gif_left and gif_top tags";
1218 }
1219
1220 my %obsolete_opts =
1221   (
1222    gif_each_palette=>'gif_local_map',
1223    interlace       => 'gif_interlace',
1224    gif_delays => 'gif_delay',
1225    gif_positions => \&_fix_gif_positions,
1226    gif_loop_count => 'gif_loop',
1227   );
1228
1229 sub _set_opts {
1230   my ($self, $opts, $prefix, @imgs) = @_;
1231
1232   for my $opt (keys %$opts) {
1233     my $tagname = $opt;
1234     if ($obsolete_opts{$opt}) {
1235       my $new = $obsolete_opts{$opt};
1236       my $msg = "Obsolete option $opt ";
1237       if (ref $new) {
1238         $new->($opts, $opt, \$msg, @imgs);
1239       }
1240       else {
1241         $msg .= "replaced with the $new tag ";
1242         $tagname = $new;
1243       }
1244       $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1];
1245       warn $msg if $warn_obsolete && $^W;
1246     }
1247     next unless $tagname =~ /^\Q$prefix/;
1248     my $value = $opts->{$opt};
1249     if (ref $value) {
1250       if (UNIVERSAL::isa($value, "Imager::Color")) {
1251         my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1252         for my $img (@imgs) {
1253           $img->settag(name=>$tagname, value=>$tag);
1254         }
1255       }
1256       elsif (ref($value) eq 'ARRAY') {
1257         for my $i (0..$#$value) {
1258           my $val = $value->[$i];
1259           if (ref $val) {
1260             if (UNIVERSAL::isa($val, "Imager::Color")) {
1261               my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1262               $i < @imgs and
1263                 $imgs[$i]->settag(name=>$tagname, value=>$tag);
1264             }
1265             else {
1266               $self->_set_error("Unknown reference type " . ref($value) .
1267                                 " supplied in array for $opt");
1268               return;
1269             }
1270           }
1271           else {
1272             $i < @imgs
1273               and $imgs[$i]->settag(name=>$tagname, value=>$val);
1274           }
1275         }
1276       }
1277       else {
1278         $self->_set_error("Unknown reference type " . ref($value) .
1279                           " supplied for $opt");
1280         return;
1281       }
1282     }
1283     else {
1284       # set it as a tag for every image
1285       for my $img (@imgs) {
1286         $img->settag(name=>$tagname, value=>$value);
1287       }
1288     }
1289   }
1290
1291   return 1;
1292 }
1293
1294 # Write an image to file
1295 sub write {
1296   my $self = shift;
1297   my %input=(jpegquality=>75,
1298              gifquant=>'mc',
1299              lmdither=>6.0,
1300              lmfixed=>[],
1301              idstring=>"",
1302              compress=>1,
1303              wierdpack=>0,
1304              fax_fine=>1, @_);
1305   my $rc;
1306
1307   $self->_set_opts(\%input, "i_", $self)
1308     or return undef;
1309
1310   my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1, tga=>1,
1311                  gif=>1 ); # this will be SO MUCH BETTER once they are all in there
1312
1313   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1314
1315   if (!$input{'type'} and $input{file}) {
1316     $input{'type'}=$FORMATGUESS->($input{file});
1317   }
1318   if (!$input{'type'}) {
1319     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1320     return undef;
1321   }
1322
1323   if (!$formats{$input{'type'}}) { $self->{ERRSTR}='format not supported'; return undef; }
1324
1325   my ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1326     or return undef;
1327
1328   # this conditional is probably obsolete
1329   if ($iolready{$input{'type'}}) {
1330
1331     if ($input{'type'} eq 'tiff') {
1332       $self->_set_opts(\%input, "tiff_", $self)
1333         or return undef;
1334       $self->_set_opts(\%input, "exif_", $self)
1335         or return undef;
1336
1337       if (defined $input{class} && $input{class} eq 'fax') {
1338         if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1339           $self->{ERRSTR}='Could not write to buffer';
1340           return undef;
1341         }
1342       } else {
1343         if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1344           $self->{ERRSTR}='Could not write to buffer';
1345           return undef;
1346         }
1347       }
1348     } elsif ( $input{'type'} eq 'pnm' ) {
1349       $self->_set_opts(\%input, "pnm_", $self)
1350         or return undef;
1351       if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1352         $self->{ERRSTR}='unable to write pnm image';
1353         return undef;
1354       }
1355       $self->{DEBUG} && print "writing a pnm file\n";
1356     } elsif ( $input{'type'} eq 'raw' ) {
1357       $self->_set_opts(\%input, "raw_", $self)
1358         or return undef;
1359       if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1360         $self->{ERRSTR}='unable to write raw image';
1361         return undef;
1362       }
1363       $self->{DEBUG} && print "writing a raw file\n";
1364     } elsif ( $input{'type'} eq 'png' ) {
1365       $self->_set_opts(\%input, "png_", $self)
1366         or return undef;
1367       if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1368         $self->{ERRSTR}='unable to write png image';
1369         return undef;
1370       }
1371       $self->{DEBUG} && print "writing a png file\n";
1372     } elsif ( $input{'type'} eq 'jpeg' ) {
1373       $self->_set_opts(\%input, "jpeg_", $self)
1374         or return undef;
1375       $self->_set_opts(\%input, "exif_", $self)
1376         or return undef;
1377       if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1378         $self->{ERRSTR} = $self->_error_as_msg();
1379         return undef;
1380       }
1381       $self->{DEBUG} && print "writing a jpeg file\n";
1382     } elsif ( $input{'type'} eq 'bmp' ) {
1383       $self->_set_opts(\%input, "bmp_", $self)
1384         or return undef;
1385       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1386         $self->{ERRSTR}='unable to write bmp image';
1387         return undef;
1388       }
1389       $self->{DEBUG} && print "writing a bmp file\n";
1390     } elsif ( $input{'type'} eq 'tga' ) {
1391       $self->_set_opts(\%input, "tga_", $self)
1392         or return undef;
1393
1394       if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1395         $self->{ERRSTR}=$self->_error_as_msg();
1396         return undef;
1397       }
1398       $self->{DEBUG} && print "writing a tga file\n";
1399     } elsif ( $input{'type'} eq 'gif' ) {
1400       $self->_set_opts(\%input, "gif_", $self)
1401         or return undef;
1402       # compatibility with the old interfaces
1403       if ($input{gifquant} eq 'lm') {
1404         $input{make_colors} = 'addi';
1405         $input{translate} = 'perturb';
1406         $input{perturb} = $input{lmdither};
1407       } elsif ($input{gifquant} eq 'gen') {
1408         # just pass options through
1409       } else {
1410         $input{make_colors} = 'webmap'; # ignored
1411         $input{translate} = 'giflib';
1412       }
1413       $rc = i_writegif_wiol($IO, \%input, $self->{IMG});
1414     }
1415
1416     if (exists $input{'data'}) {
1417       my $data = io_slurp($IO);
1418       if (!$data) {
1419         $self->{ERRSTR}='Could not slurp from buffer';
1420         return undef;
1421       }
1422       ${$input{data}} = $data;
1423     }
1424     return $self;
1425   }
1426
1427   return $self;
1428 }
1429
1430 sub write_multi {
1431   my ($class, $opts, @images) = @_;
1432
1433   if (!$opts->{'type'} && $opts->{'file'}) {
1434     $opts->{'type'} = $FORMATGUESS->($opts->{'file'});
1435   }
1436   unless ($opts->{'type'}) {
1437     $class->_set_error('type parameter missing and not possible to guess from extension');
1438     return;
1439   }
1440   # translate to ImgRaw
1441   if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1442     $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
1443     return 0;
1444   }
1445   $class->_set_opts($opts, "i_", @images)
1446     or return;
1447   my @work = map $_->{IMG}, @images;
1448   my ($IO, $file) = $class->_get_writer_io($opts, $opts->{'type'})
1449     or return undef;
1450   if ($opts->{'type'} eq 'gif') {
1451     $class->_set_opts($opts, "gif_", @images)
1452       or return;
1453     my $gif_delays = $opts->{gif_delays};
1454     local $opts->{gif_delays} = $gif_delays;
1455     if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
1456       # assume the caller wants the same delay for each frame
1457       $opts->{gif_delays} = [ ($gif_delays) x @images ];
1458     }
1459     my $res = i_writegif_wiol($IO, $opts, @work);
1460     $res or $class->_set_error($class->_error_as_msg());
1461     return $res;
1462   }
1463   elsif ($opts->{'type'} eq 'tiff') {
1464     $class->_set_opts($opts, "tiff_", @images)
1465       or return;
1466     $class->_set_opts($opts, "exif_", @images)
1467       or return;
1468     my $res;
1469     $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
1470     if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
1471       $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
1472     }
1473     else {
1474       $res = i_writetiff_multi_wiol($IO, @work);
1475     }
1476     $res or $class->_set_error($class->_error_as_msg());
1477     return $res;
1478   }
1479   else {
1480     $ERRSTR = "Sorry, write_multi doesn't support $opts->{'type'} yet";
1481     return 0;
1482   }
1483 }
1484
1485 # read multiple images from a file
1486 sub read_multi {
1487   my ($class, %opts) = @_;
1488
1489   if ($opts{file} && !exists $opts{'type'}) {
1490     # guess the type
1491     my $type = $FORMATGUESS->($opts{file});
1492     $opts{'type'} = $type;
1493   }
1494   unless ($opts{'type'}) {
1495     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1496     return;
1497   }
1498
1499   my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
1500     or return;
1501   if ($opts{'type'} eq 'gif') {
1502     my @imgs;
1503     @imgs = i_readgif_multi_wiol($IO);
1504     if (@imgs) {
1505       return map {
1506         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1507       } @imgs;
1508     }
1509     else {
1510       $ERRSTR = _error_as_msg();
1511       return;
1512     }
1513   }
1514   elsif ($opts{'type'} eq 'tiff') {
1515     my @imgs = i_readtiff_multi_wiol($IO, -1);
1516     if (@imgs) {
1517       return map {
1518         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1519       } @imgs;
1520     }
1521     else {
1522       $ERRSTR = _error_as_msg();
1523       return;
1524     }
1525   }
1526
1527   $ERRSTR = "Cannot read multiple images from $opts{'type'} files";
1528   return;
1529 }
1530
1531 # Destroy an Imager object
1532
1533 sub DESTROY {
1534   my $self=shift;
1535   #    delete $instances{$self};
1536   if (defined($self->{IMG})) {
1537     # the following is now handled by the XS DESTROY method for
1538     # Imager::ImgRaw object
1539     # Re-enabling this will break virtual images
1540     # tested for in t/t020masked.t
1541     # i_img_destroy($self->{IMG});
1542     undef($self->{IMG});
1543   } else {
1544 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1545   }
1546 }
1547
1548 # Perform an inplace filter of an image
1549 # that is the image will be overwritten with the data
1550
1551 sub filter {
1552   my $self=shift;
1553   my %input=@_;
1554   my %hsh;
1555   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1556
1557   if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1558
1559   if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
1560     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1561   }
1562
1563   if ($filters{$input{'type'}}{names}) {
1564     my $names = $filters{$input{'type'}}{names};
1565     for my $name (keys %$names) {
1566       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1567         $input{$name} = $names->{$name}{$input{$name}};
1568       }
1569     }
1570   }
1571   if (defined($filters{$input{'type'}}{defaults})) {
1572     %hsh=('image',$self->{IMG},%{$filters{$input{'type'}}{defaults}},%input);
1573   } else {
1574     %hsh=('image',$self->{IMG},%input);
1575   }
1576
1577   my @cs=@{$filters{$input{'type'}}{callseq}};
1578
1579   for(@cs) {
1580     if (!defined($hsh{$_})) {
1581       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1582     }
1583   }
1584
1585   &{$filters{$input{'type'}}{callsub}}(%hsh);
1586
1587   my @b=keys %hsh;
1588
1589   $self->{DEBUG} && print "callseq is: @cs\n";
1590   $self->{DEBUG} && print "matching callseq is: @b\n";
1591
1592   return $self;
1593 }
1594
1595 # Scale an image to requested size and return the scaled version
1596
1597 sub scale {
1598   my $self=shift;
1599   my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
1600   my $img = Imager->new();
1601   my $tmp = Imager->new();
1602
1603   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1604
1605   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
1606     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1607     if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1608     if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1609   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1610   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1611
1612   if ($opts{qtype} eq 'normal') {
1613     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1614     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1615     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1616     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1617     return $img;
1618   }
1619   if ($opts{'qtype'} eq 'preview') {
1620     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
1621     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1622     return $img;
1623   }
1624   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1625 }
1626
1627 # Scales only along the X axis
1628
1629 sub scaleX {
1630   my $self=shift;
1631   my %opts=(scalefactor=>0.5,@_);
1632
1633   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1634
1635   my $img = Imager->new();
1636
1637   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1638
1639   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1640   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1641
1642   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1643   return $img;
1644 }
1645
1646 # Scales only along the Y axis
1647
1648 sub scaleY {
1649   my $self=shift;
1650   my %opts=(scalefactor=>0.5,@_);
1651
1652   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1653
1654   my $img = Imager->new();
1655
1656   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1657
1658   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1659   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1660
1661   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1662   return $img;
1663 }
1664
1665
1666 # Transform returns a spatial transformation of the input image
1667 # this moves pixels to a new location in the returned image.
1668 # NOTE - should make a utility function to check transforms for
1669 # stack overruns
1670
1671 sub transform {
1672   my $self=shift;
1673   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1674   my %opts=@_;
1675   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1676
1677 #  print Dumper(\%opts);
1678 #  xopcopdes
1679
1680   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1681     if (!$I2P) {
1682       eval ("use Affix::Infix2Postfix;");
1683       print $@;
1684       if ( $@ ) {
1685         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
1686         return undef;
1687       }
1688       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1689                                              {op=>'-',trans=>'Sub'},
1690                                              {op=>'*',trans=>'Mult'},
1691                                              {op=>'/',trans=>'Div'},
1692                                              {op=>'-','type'=>'unary',trans=>'u-'},
1693                                              {op=>'**'},
1694                                              {op=>'func','type'=>'unary'}],
1695                                      'grouping'=>[qw( \( \) )],
1696                                      'func'=>[qw( sin cos )],
1697                                      'vars'=>[qw( x y )]
1698                                     );
1699     }
1700
1701     @xt=$I2P->translate($opts{'xexpr'});
1702     @yt=$I2P->translate($opts{'yexpr'});
1703
1704     $numre=$I2P->{'numre'};
1705     @pt=(0,0);
1706
1707     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1708     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1709     @{$opts{'parm'}}=@pt;
1710   }
1711
1712 #  print Dumper(\%opts);
1713
1714   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1715     $self->{ERRSTR}='transform: no xopcodes given.';
1716     return undef;
1717   }
1718
1719   @op=@{$opts{'xopcodes'}};
1720   for $iop (@op) {
1721     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1722       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1723       return undef;
1724     }
1725     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1726   }
1727
1728
1729 # yopcopdes
1730
1731   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1732     $self->{ERRSTR}='transform: no yopcodes given.';
1733     return undef;
1734   }
1735
1736   @op=@{$opts{'yopcodes'}};
1737   for $iop (@op) {
1738     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1739       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1740       return undef;
1741     }
1742     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1743   }
1744
1745 #parameters
1746
1747   if ( !exists $opts{'parm'}) {
1748     $self->{ERRSTR}='transform: no parameter arg given.';
1749     return undef;
1750   }
1751
1752 #  print Dumper(\@ropx);
1753 #  print Dumper(\@ropy);
1754 #  print Dumper(\@ropy);
1755
1756   my $img = Imager->new();
1757   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1758   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1759   return $img;
1760 }
1761
1762
1763 sub transform2 {
1764   my ($opts, @imgs) = @_;
1765
1766   require "Imager/Expr.pm";
1767
1768   $opts->{variables} = [ qw(x y) ];
1769   my ($width, $height) = @{$opts}{qw(width height)};
1770   if (@imgs) {
1771     $width ||= $imgs[0]->getwidth();
1772     $height ||= $imgs[0]->getheight();
1773     my $img_num = 1;
1774     for my $img (@imgs) {
1775       $opts->{constants}{"w$img_num"} = $img->getwidth();
1776       $opts->{constants}{"h$img_num"} = $img->getheight();
1777       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1778       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1779       ++$img_num;
1780     }
1781   }
1782   if ($width) {
1783     $opts->{constants}{w} = $width;
1784     $opts->{constants}{cx} = $width/2;
1785   }
1786   else {
1787     $Imager::ERRSTR = "No width supplied";
1788     return;
1789   }
1790   if ($height) {
1791     $opts->{constants}{h} = $height;
1792     $opts->{constants}{cy} = $height/2;
1793   }
1794   else {
1795     $Imager::ERRSTR = "No height supplied";
1796     return;
1797   }
1798   my $code = Imager::Expr->new($opts);
1799   if (!$code) {
1800     $Imager::ERRSTR = Imager::Expr::error();
1801     return;
1802   }
1803
1804   my $img = Imager->new();
1805   $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
1806                              $code->nregs(), $code->cregs(),
1807                              [ map { $_->{IMG} } @imgs ]);
1808   if (!defined $img->{IMG}) {
1809     $Imager::ERRSTR = Imager->_error_as_msg();
1810     return;
1811   }
1812
1813   return $img;
1814 }
1815
1816 sub rubthrough {
1817   my $self=shift;
1818   my %opts=(tx=>0,ty=>0,@_);
1819
1820   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1821   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1822
1823   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx},$opts{ty})) {
1824     $self->{ERRSTR} = $self->_error_as_msg();
1825     return undef;
1826   }
1827   return $self;
1828 }
1829
1830
1831 sub flip {
1832   my $self  = shift;
1833   my %opts  = @_;
1834   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
1835   my $dir;
1836   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
1837   $dir = $xlate{$opts{'dir'}};
1838   return $self if i_flipxy($self->{IMG}, $dir);
1839   return ();
1840 }
1841
1842 sub rotate {
1843   my $self = shift;
1844   my %opts = @_;
1845   if (defined $opts{right}) {
1846     my $degrees = $opts{right};
1847     if ($degrees < 0) {
1848       $degrees += 360 * int(((-$degrees)+360)/360);
1849     }
1850     $degrees = $degrees % 360;
1851     if ($degrees == 0) {
1852       return $self->copy();
1853     }
1854     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
1855       my $result = Imager->new();
1856       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
1857         return $result;
1858       }
1859       else {
1860         $self->{ERRSTR} = $self->_error_as_msg();
1861         return undef;
1862       }
1863     }
1864     else {
1865       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
1866       return undef;
1867     }
1868   }
1869   elsif (defined $opts{radians} || defined $opts{degrees}) {
1870     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
1871
1872     my $result = Imager->new;
1873     if ($result->{IMG} = i_rotate_exact($self->{IMG}, $amount)) {
1874       return $result;
1875     }
1876     else {
1877       $self->{ERRSTR} = $self->_error_as_msg();
1878       return undef;
1879     }
1880   }
1881   else {
1882     $self->{ERRSTR} = "Only the 'right' parameter is available";
1883     return undef;
1884   }
1885 }
1886
1887 sub matrix_transform {
1888   my $self = shift;
1889   my %opts = @_;
1890
1891   if ($opts{matrix}) {
1892     my $xsize = $opts{xsize} || $self->getwidth;
1893     my $ysize = $opts{ysize} || $self->getheight;
1894
1895     my $result = Imager->new;
1896     $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
1897                                         $opts{matrix})
1898       or return undef;
1899
1900     return $result;
1901   }
1902   else {
1903     $self->{ERRSTR} = "matrix parameter required";
1904     return undef;
1905   }
1906 }
1907
1908 # blame Leolo :)
1909 *yatf = \&matrix_transform;
1910
1911 # These two are supported for legacy code only
1912
1913 sub i_color_new {
1914   return Imager::Color->new(@_);
1915 }
1916
1917 sub i_color_set {
1918   return Imager::Color::set(@_);
1919 }
1920
1921 # Draws a box between the specified corner points.
1922 sub box {
1923   my $self=shift;
1924   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1925   my $dflcl=i_color_new(255,255,255,255);
1926   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1927
1928   if (exists $opts{'box'}) {
1929     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1930     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1931     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1932     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1933   }
1934
1935   if ($opts{filled}) {
1936     my $color = _color($opts{'color'});
1937     unless ($color) {
1938       $self->{ERRSTR} = $Imager::ERRSTR;
1939       return;
1940     }
1941     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1942                  $opts{ymax}, $color);
1943   }
1944   elsif ($opts{fill}) {
1945     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1946       # assume it's a hash ref
1947       require 'Imager/Fill.pm';
1948       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1949         $self->{ERRSTR} = $Imager::ERRSTR;
1950         return undef;
1951       }
1952     }
1953     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1954                 $opts{ymax},$opts{fill}{fill});
1955   }
1956   else {
1957     my $color = _color($opts{'color'});
1958     unless ($color) {
1959       $self->{ERRSTR} = $Imager::ERRSTR;
1960       return;
1961     }
1962     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
1963           $color);
1964   }
1965   return $self;
1966 }
1967
1968 # Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1969
1970 sub arc {
1971   my $self=shift;
1972   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1973   my $dflcl=i_color_new(255,255,255,255);
1974   my %opts=(color=>$dflcl,
1975             'r'=>min($self->getwidth(),$self->getheight())/3,
1976             'x'=>$self->getwidth()/2,
1977             'y'=>$self->getheight()/2,
1978             'd1'=>0, 'd2'=>361, @_);
1979   if ($opts{fill}) {
1980     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1981       # assume it's a hash ref
1982       require 'Imager/Fill.pm';
1983       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1984         $self->{ERRSTR} = $Imager::ERRSTR;
1985         return;
1986       }
1987     }
1988     i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
1989                 $opts{'d2'}, $opts{fill}{fill});
1990   }
1991   else {
1992     my $color = _color($opts{'color'});
1993     unless ($color) {
1994       $self->{ERRSTR} = $Imager::ERRSTR;
1995       return;
1996     }
1997     if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
1998       i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
1999                   $color);
2000     }
2001     else {
2002       if ($opts{'d1'} <= $opts{'d2'}) {
2003         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2004               $opts{'d1'}, $opts{'d2'}, $color);
2005       }
2006       else {
2007         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2008               $opts{'d1'}, 361,         $color);
2009         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2010               0,           $opts{'d2'}, $color);
2011       }
2012     }
2013   }
2014
2015   return $self;
2016 }
2017
2018 # Draws a line from one point to (but not including) the destination point
2019
2020 sub line {
2021   my $self=shift;
2022   my $dflcl=i_color_new(0,0,0,0);
2023   my %opts=(color=>$dflcl,@_);
2024   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2025
2026   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2027   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2028
2029   my $color = _color($opts{'color'});
2030   unless ($color) {
2031     $self->{ERRSTR} = $Imager::ERRSTR;
2032     return;
2033   }
2034   $opts{antialias} = $opts{aa} if defined $opts{aa};
2035   if ($opts{antialias}) {
2036     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2037               $color);
2038   } else {
2039     i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2040            $color);
2041   }
2042   return $self;
2043 }
2044
2045 # Draws a line between an ordered set of points - It more or less just transforms this
2046 # into a list of lines.
2047
2048 sub polyline {
2049   my $self=shift;
2050   my ($pt,$ls,@points);
2051   my $dflcl=i_color_new(0,0,0,0);
2052   my %opts=(color=>$dflcl,@_);
2053
2054   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2055
2056   if (exists($opts{points})) { @points=@{$opts{points}}; }
2057   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2058     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2059     }
2060
2061 #  print Dumper(\@points);
2062
2063   my $color = _color($opts{'color'});
2064   unless ($color) {
2065     $self->{ERRSTR} = $Imager::ERRSTR;
2066     return;
2067   }
2068   $opts{antialias} = $opts{aa} if defined $opts{aa};
2069   if ($opts{antialias}) {
2070     for $pt(@points) {
2071       if (defined($ls)) {
2072         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
2073       }
2074       $ls=$pt;
2075     }
2076   } else {
2077     for $pt(@points) {
2078       if (defined($ls)) {
2079         i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
2080       }
2081       $ls=$pt;
2082     }
2083   }
2084   return $self;
2085 }
2086
2087 sub polygon {
2088   my $self = shift;
2089   my ($pt,$ls,@points);
2090   my $dflcl = i_color_new(0,0,0,0);
2091   my %opts = (color=>$dflcl, @_);
2092
2093   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2094
2095   if (exists($opts{points})) {
2096     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2097     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2098   }
2099
2100   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2101     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2102   }
2103
2104   if ($opts{'fill'}) {
2105     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2106       # assume it's a hash ref
2107       require 'Imager/Fill.pm';
2108       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2109         $self->{ERRSTR} = $Imager::ERRSTR;
2110         return undef;
2111       }
2112     }
2113     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2114                     $opts{'fill'}{'fill'});
2115   }
2116   else {
2117     my $color = _color($opts{'color'});
2118     unless ($color) {
2119       $self->{ERRSTR} = $Imager::ERRSTR;
2120       return;
2121     }
2122     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2123   }
2124
2125   return $self;
2126 }
2127
2128
2129 # this the multipoint bezier curve
2130 # this is here more for testing that actual usage since
2131 # this is not a good algorithm.  Usually the curve would be
2132 # broken into smaller segments and each done individually.
2133
2134 sub polybezier {
2135   my $self=shift;
2136   my ($pt,$ls,@points);
2137   my $dflcl=i_color_new(0,0,0,0);
2138   my %opts=(color=>$dflcl,@_);
2139
2140   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2141
2142   if (exists $opts{points}) {
2143     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2144     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2145   }
2146
2147   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2148     $self->{ERRSTR}='Missing or invalid points.';
2149     return;
2150   }
2151
2152   my $color = _color($opts{'color'});
2153   unless ($color) {
2154     $self->{ERRSTR} = $Imager::ERRSTR;
2155     return;
2156   }
2157   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2158   return $self;
2159 }
2160
2161 sub flood_fill {
2162   my $self = shift;
2163   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2164
2165   unless (exists $opts{'x'} && exists $opts{'y'}) {
2166     $self->{ERRSTR} = "missing seed x and y parameters";
2167     return undef;
2168   }
2169
2170   if ($opts{fill}) {
2171     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2172       # assume it's a hash ref
2173       require 'Imager/Fill.pm';
2174       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2175         $self->{ERRSTR} = $Imager::ERRSTR;
2176         return;
2177       }
2178     }
2179     i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2180   }
2181   else {
2182     my $color = _color($opts{'color'});
2183     unless ($color) {
2184       $self->{ERRSTR} = $Imager::ERRSTR;
2185       return;
2186     }
2187     i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2188   }
2189
2190   $self;
2191 }
2192
2193 sub setpixel {
2194   my $self = shift;
2195
2196   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2197
2198   unless (exists $opts{'x'} && exists $opts{'y'}) {
2199     $self->{ERRSTR} = 'missing x and y parameters';
2200     return undef;
2201   }
2202
2203   my $x = $opts{'x'};
2204   my $y = $opts{'y'};
2205   my $color = _color($opts{color})
2206     or return undef;
2207   if (ref $x && ref $y) {
2208     unless (@$x == @$y) {
2209       $self->{ERRSTR} = 'length of x and y mismatch';
2210       return undef;
2211     }
2212     if ($color->isa('Imager::Color')) {
2213       for my $i (0..$#{$opts{'x'}}) {
2214         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2215       }
2216     }
2217     else {
2218       for my $i (0..$#{$opts{'x'}}) {
2219         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2220       }
2221     }
2222   }
2223   else {
2224     if ($color->isa('Imager::Color')) {
2225       i_ppix($self->{IMG}, $x, $y, $color);
2226     }
2227     else {
2228       i_ppixf($self->{IMG}, $x, $y, $color);
2229     }
2230   }
2231
2232   $self;
2233 }
2234
2235 sub getpixel {
2236   my $self = shift;
2237
2238   my %opts = ( "type"=>'8bit', @_);
2239
2240   unless (exists $opts{'x'} && exists $opts{'y'}) {
2241     $self->{ERRSTR} = 'missing x and y parameters';
2242     return undef;
2243   }
2244
2245   my $x = $opts{'x'};
2246   my $y = $opts{'y'};
2247   if (ref $x && ref $y) {
2248     unless (@$x == @$y) {
2249       $self->{ERRSTR} = 'length of x and y mismatch';
2250       return undef;
2251     }
2252     my @result;
2253     if ($opts{"type"} eq '8bit') {
2254       for my $i (0..$#{$opts{'x'}}) {
2255         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2256       }
2257     }
2258     else {
2259       for my $i (0..$#{$opts{'x'}}) {
2260         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2261       }
2262     }
2263     return wantarray ? @result : \@result;
2264   }
2265   else {
2266     if ($opts{"type"} eq '8bit') {
2267       return i_get_pixel($self->{IMG}, $x, $y);
2268     }
2269     else {
2270       return i_gpixf($self->{IMG}, $x, $y);
2271     }
2272   }
2273
2274   $self;
2275 }
2276
2277 # make an identity matrix of the given size
2278 sub _identity {
2279   my ($size) = @_;
2280
2281   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
2282   for my $c (0 .. ($size-1)) {
2283     $matrix->[$c][$c] = 1;
2284   }
2285   return $matrix;
2286 }
2287
2288 # general function to convert an image
2289 sub convert {
2290   my ($self, %opts) = @_;
2291   my $matrix;
2292
2293   # the user can either specify a matrix or preset
2294   # the matrix overrides the preset
2295   if (!exists($opts{matrix})) {
2296     unless (exists($opts{preset})) {
2297       $self->{ERRSTR} = "convert() needs a matrix or preset";
2298       return;
2299     }
2300     else {
2301       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2302         # convert to greyscale, keeping the alpha channel if any
2303         if ($self->getchannels == 3) {
2304           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2305         }
2306         elsif ($self->getchannels == 4) {
2307           # preserve the alpha channel
2308           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2309                       [ 0,     0,     0,     1 ] ];
2310         }
2311         else {
2312           # an identity
2313           $matrix = _identity($self->getchannels);
2314         }
2315       }
2316       elsif ($opts{preset} eq 'noalpha') {
2317         # strip the alpha channel
2318         if ($self->getchannels == 2 or $self->getchannels == 4) {
2319           $matrix = _identity($self->getchannels);
2320           pop(@$matrix); # lose the alpha entry
2321         }
2322         else {
2323           $matrix = _identity($self->getchannels);
2324         }
2325       }
2326       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2327         # extract channel 0
2328         $matrix = [ [ 1 ] ];
2329       }
2330       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
2331         $matrix = [ [ 0, 1 ] ];
2332       }
2333       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
2334         $matrix = [ [ 0, 0, 1 ] ];
2335       }
2336       elsif ($opts{preset} eq 'alpha') {
2337         if ($self->getchannels == 2 or $self->getchannels == 4) {
2338           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
2339         }
2340         else {
2341           # the alpha is just 1 <shrug>
2342           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
2343         }
2344       }
2345       elsif ($opts{preset} eq 'rgb') {
2346         if ($self->getchannels == 1) {
2347           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
2348         }
2349         elsif ($self->getchannels == 2) {
2350           # preserve the alpha channel
2351           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
2352         }
2353         else {
2354           $matrix = _identity($self->getchannels);
2355         }
2356       }
2357       elsif ($opts{preset} eq 'addalpha') {
2358         if ($self->getchannels == 1) {
2359           $matrix = _identity(2);
2360         }
2361         elsif ($self->getchannels == 3) {
2362           $matrix = _identity(4);
2363         }
2364         else {
2365           $matrix = _identity($self->getchannels);
2366         }
2367       }
2368       else {
2369         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
2370         return undef;
2371       }
2372     }
2373   }
2374   else {
2375     $matrix = $opts{matrix};
2376   }
2377
2378   my $new = Imager->new();
2379   $new->{IMG} = i_img_new();
2380   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
2381     # most likely a bad matrix
2382     $self->{ERRSTR} = _error_as_msg();
2383     return undef;
2384   }
2385   return $new;
2386 }
2387
2388
2389 # general function to map an image through lookup tables
2390
2391 sub map {
2392   my ($self, %opts) = @_;
2393   my @chlist = qw( red green blue alpha );
2394
2395   if (!exists($opts{'maps'})) {
2396     # make maps from channel maps
2397     my $chnum;
2398     for $chnum (0..$#chlist) {
2399       if (exists $opts{$chlist[$chnum]}) {
2400         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
2401       } elsif (exists $opts{'all'}) {
2402         $opts{'maps'}[$chnum] = $opts{'all'};
2403       }
2404     }
2405   }
2406   if ($opts{'maps'} and $self->{IMG}) {
2407     i_map($self->{IMG}, $opts{'maps'} );
2408   }
2409   return $self;
2410 }
2411
2412 sub difference {
2413   my ($self, %opts) = @_;
2414
2415   defined $opts{mindist} or $opts{mindist} = 0;
2416
2417   defined $opts{other}
2418     or return $self->_set_error("No 'other' parameter supplied");
2419   defined $opts{other}{IMG}
2420     or return $self->_set_error("No image data in 'other' image");
2421
2422   $self->{IMG}
2423     or return $self->_set_error("No image data");
2424
2425   my $result = Imager->new;
2426   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
2427                                 $opts{mindist})
2428     or return $self->_set_error($self->_error_as_msg());
2429
2430   return $result;
2431 }
2432
2433 # destructive border - image is shrunk by one pixel all around
2434
2435 sub border {
2436   my ($self,%opts)=@_;
2437   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
2438   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
2439 }
2440
2441
2442 # Get the width of an image
2443
2444 sub getwidth {
2445   my $self = shift;
2446   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2447   return (i_img_info($self->{IMG}))[0];
2448 }
2449
2450 # Get the height of an image
2451
2452 sub getheight {
2453   my $self = shift;
2454   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2455   return (i_img_info($self->{IMG}))[1];
2456 }
2457
2458 # Get number of channels in an image
2459
2460 sub getchannels {
2461   my $self = shift;
2462   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2463   return i_img_getchannels($self->{IMG});
2464 }
2465
2466 # Get channel mask
2467
2468 sub getmask {
2469   my $self = shift;
2470   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2471   return i_img_getmask($self->{IMG});
2472 }
2473
2474 # Set channel mask
2475
2476 sub setmask {
2477   my $self = shift;
2478   my %opts = @_;
2479   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2480   i_img_setmask( $self->{IMG} , $opts{mask} );
2481 }
2482
2483 # Get number of colors in an image
2484
2485 sub getcolorcount {
2486   my $self=shift;
2487   my %opts=('maxcolors'=>2**30,@_);
2488   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2489   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2490   return ($rc==-1? undef : $rc);
2491 }
2492
2493 # draw string to an image
2494
2495 sub string {
2496   my $self = shift;
2497   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2498
2499   my %input=('x'=>0, 'y'=>0, @_);
2500   $input{string}||=$input{text};
2501
2502   unless(exists $input{string}) {
2503     $self->{ERRSTR}="missing required parameter 'string'";
2504     return;
2505   }
2506
2507   unless($input{font}) {
2508     $self->{ERRSTR}="missing required parameter 'font'";
2509     return;
2510   }
2511
2512   unless ($input{font}->draw(image=>$self, %input)) {
2513     $self->{ERRSTR} = $self->_error_as_msg();
2514     return;
2515   }
2516
2517   return $self;
2518 }
2519
2520 # Shortcuts that can be exported
2521
2522 sub newcolor { Imager::Color->new(@_); }
2523 sub newfont  { Imager::Font->new(@_); }
2524
2525 *NC=*newcolour=*newcolor;
2526 *NF=*newfont;
2527
2528 *open=\&read;
2529 *circle=\&arc;
2530
2531
2532 #### Utility routines
2533
2534 sub errstr {
2535   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2536 }
2537
2538 sub _set_error {
2539   my ($self, $msg) = @_;
2540
2541   if (ref $self) {
2542     $self->{ERRSTR} = $msg;
2543   }
2544   else {
2545     $ERRSTR = $msg;
2546   }
2547   return;
2548 }
2549
2550 # Default guess for the type of an image from extension
2551
2552 sub def_guess_type {
2553   my $name=lc(shift);
2554   my $ext;
2555   $ext=($name =~ m/\.([^\.]+)$/)[0];
2556   return 'tiff' if ($ext =~ m/^tiff?$/);
2557   return 'jpeg' if ($ext =~ m/^jpe?g$/);
2558   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
2559   return 'png'  if ($ext eq "png");
2560   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
2561   return 'tga'  if ($ext eq "tga");
2562   return 'rgb'  if ($ext eq "rgb");
2563   return 'gif'  if ($ext eq "gif");
2564   return 'raw'  if ($ext eq "raw");
2565   return ();
2566 }
2567
2568 # get the minimum of a list
2569
2570 sub min {
2571   my $mx=shift;
2572   for(@_) { if ($_<$mx) { $mx=$_; }}
2573   return $mx;
2574 }
2575
2576 # get the maximum of a list
2577
2578 sub max {
2579   my $mx=shift;
2580   for(@_) { if ($_>$mx) { $mx=$_; }}
2581   return $mx;
2582 }
2583
2584 # string stuff for iptc headers
2585
2586 sub clean {
2587   my($str)=$_[0];
2588   $str = substr($str,3);
2589   $str =~ s/[\n\r]//g;
2590   $str =~ s/\s+/ /g;
2591   $str =~ s/^\s//;
2592   $str =~ s/\s$//;
2593   return $str;
2594 }
2595
2596 # A little hack to parse iptc headers.
2597
2598 sub parseiptc {
2599   my $self=shift;
2600   my(@sar,$item,@ar);
2601   my($caption,$photogr,$headln,$credit);
2602
2603   my $str=$self->{IPTCRAW};
2604
2605   #print $str;
2606
2607   @ar=split(/8BIM/,$str);
2608
2609   my $i=0;
2610   foreach (@ar) {
2611     if (/^\004\004/) {
2612       @sar=split(/\034\002/);
2613       foreach $item (@sar) {
2614         if ($item =~ m/^x/) {
2615           $caption=&clean($item);
2616           $i++;
2617         }
2618         if ($item =~ m/^P/) {
2619           $photogr=&clean($item);
2620           $i++;
2621         }
2622         if ($item =~ m/^i/) {
2623           $headln=&clean($item);
2624           $i++;
2625         }
2626         if ($item =~ m/^n/) {
2627           $credit=&clean($item);
2628           $i++;
2629         }
2630       }
2631     }
2632   }
2633   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
2634 }
2635
2636 # Autoload methods go after =cut, and are processed by the autosplit program.
2637
2638 1;
2639 __END__
2640 # Below is the stub of documentation for your module. You better edit it!
2641
2642 =head1 NAME
2643
2644 Imager - Perl extension for Generating 24 bit Images
2645
2646 =head1 SYNOPSIS
2647
2648   # Thumbnail example
2649
2650   #!/usr/bin/perl -w
2651   use strict;
2652   use Imager;
2653
2654   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
2655   my $file = shift;
2656
2657   my $format;
2658
2659   my $img = Imager->new();
2660   $img->open(file=>$file) or die $img->errstr();
2661
2662   $file =~ s/\.[^.]*$//;
2663
2664   # Create smaller version
2665   my $thumb = $img->scale(scalefactor=>.3);
2666
2667   # Autostretch individual channels
2668   $thumb->filter(type=>'autolevels');
2669
2670   # try to save in one of these formats
2671   SAVE:
2672
2673   for $format ( qw( png gif jpg tiff ppm ) ) {
2674     # Check if given format is supported
2675     if ($Imager::formats{$format}) {
2676       $file.="_low.$format";
2677       print "Storing image as: $file\n";
2678       $thumb->write(file=>$file) or
2679         die $thumb->errstr;
2680       last SAVE;
2681     }
2682   }
2683
2684
2685
2686
2687 =head1 DESCRIPTION
2688
2689 Imager is a module for creating and altering images.  It can read and
2690 write various image formats, draw primitive shapes like lines,and
2691 polygons, blend multiple images together in various ways, scale, crop,
2692 render text and more.
2693
2694 =head2 Overview of documentation
2695
2696 =over
2697
2698 =item Imager
2699
2700 This document - Synopsis Example, Table of Contents and Overview.
2701
2702 =item Imager::ImageTypes
2703
2704 Direct type/virtual images, RGB(A)/paletted images, 8/16/double
2705 bits/channel, color maps, channel masks, image tags, color
2706 quantization.
2707
2708 =item Imager::Files
2709
2710 IO interaction, reading/writing images, format specific tags.
2711
2712 =item Imager::Draw
2713
2714 Drawing Primitives, lines, boxes, circles, arcs, flood fill.
2715
2716 =item Imager::Color
2717
2718 Color specification.
2719
2720 =item Imager::Fill
2721
2722 Fill pattern specification.
2723
2724 =item Imager::Font
2725
2726 General font rendering, bounding boxes and font metrics.
2727
2728 =item Imager::Transformations
2729
2730 Copying, scaling, cropping, flipping, blending, pasting, convert and
2731 map.
2732
2733 =item Imager::Engines
2734
2735 Programmable transformations through C<transform()>, C<transform2()>
2736 and C<matrix_transform()>.
2737
2738 =item Imager::Filters
2739
2740 Filters, sharpen, blur, noise, convolve etc. and filter plugins.
2741
2742 =item Imager::Expr
2743
2744 Expressions for evaluation engine used by transform2().
2745
2746 =item Imager::Matrix2d
2747
2748 Helper class for affine transformations.
2749
2750 =item Imager::Fountain
2751
2752 Helper for making gradient profiles.
2753
2754 =back
2755
2756
2757
2758 =head2 Basic Overview
2759
2760 An Image object is created with C<$img = Imager-E<gt>new()>.
2761 Examples:
2762
2763   $img=Imager->new();                         # create empty image
2764   $img->open(file=>'lena.png',type=>'png') or # read image from file
2765      die $img->errstr();                      # give an explanation
2766                                               # if something failed
2767
2768 or if you want to create an empty image:
2769
2770   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
2771
2772 This example creates a completely black image of width 400 and height
2773 300 and 4 channels.
2774
2775 When an operation fails which can be directly associated with an image
2776 the error message is stored can be retrieved with
2777 C<$img-E<gt>errstr()>.
2778
2779 In cases where no image object is associated with an operation
2780 C<$Imager::ERRSTR> is used to report errors not directly associated
2781 with an image object.
2782
2783 =head1 SUPPORT
2784
2785 You can ask for help, report bugs or express your undying love for
2786 Imager on the Imager-devel mailing list.
2787
2788 To subscribe send a message with C<subscribe> in the body to:
2789
2790    imager-devel+request@molar.is
2791
2792 or use the form at:
2793
2794    http://www.molar.is/en/lists/imager-devel/
2795    (annonymous is temporarily off due to spam)
2796
2797 where you can also find the mailing list archive.
2798
2799 If you're into IRC, you can typically find the developers in #Imager
2800 on irc.rhizomatic.net.  As with any IRC channel, the participants
2801 could be occupied or asleep, so please be patient.
2802
2803 =head1 BUGS
2804
2805 Bugs are listed individually for relevant pod pages.
2806
2807 =head1 AUTHOR
2808
2809 Arnar M. Hrafnkelsson (addi@imager.perl.org) and Tony Cook
2810 (tony@imager.perl.org) See the README for a complete list.
2811
2812 =head1 SEE ALSO
2813
2814 perl(1), Imager::ImageTypes(3), Imager::Files(3), Imager::Draw(3),
2815 Imager::Color(3), Imager::Fill(3), Imager::Font(3),
2816 Imager::Transformations(3), Imager::Engines(3), Imager::Filters(3),
2817 Imager::Expr(3), Imager::Matrix2d(3), Imager::Fountain(3)
2818
2819 Affix::Infix2Postfix(3), Parse::RecDescent(3)
2820 http://www.eecs.umich.edu/~addi/perl/Imager/
2821
2822 =cut
2823
2824
2825
2826