]> git.imager.perl.org - imager.git/blobdiff - Imager.pm
don't attempt to save the palette if we failed to read the image
[imager.git] / Imager.pm
index f6e0ab844476b1a9ff5d1f83fe15c2fc81aa3795..b6131c9633b15c666f75158478b919c78cb0b7ad 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -155,7 +155,7 @@ my %attempted_to_load;
 BEGIN {
   require Exporter;
   @ISA = qw(Exporter);
-  $VERSION = '0.51_01';
+  $VERSION = '0.59';
   eval {
     require XSLoader;
     XSLoader::load(Imager => $VERSION);
@@ -552,6 +552,15 @@ sub _color {
   return $result;
 }
 
+sub _valid_image {
+  my ($self) = @_;
+
+  $self->{IMG} and return 1;
+
+  $self->_set_error('empty input image');
+
+  return;
+}
 
 #
 # Methods to be called on objects.
@@ -745,7 +754,10 @@ sub crop {
     $self->_set_error("resulting image would have no content");
     return;
   }
-
+  if( $r < $l or $b < $t ) {
+    $self->_set_error("attempting to crop outside of the image");
+    return;
+  }
   my $dst = $self->_sametype(xsize=>$r-$l, ysize=>$b-$t);
 
   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
@@ -875,7 +887,7 @@ sub to_rgb8 {
 
   unless (defined wantarray) {
     my @caller = caller;
-    warn "to_rgb8() called in void context - to_rgb8() returns the cropped image at $caller[1] line $caller[2]\n";
+    warn "to_rgb8() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n";
     return;
   }
 
@@ -888,6 +900,26 @@ sub to_rgb8 {
   return $result;
 }
 
+# convert a paletted (or any image) to an 8-bit/channel RGB images
+sub to_rgb16 {
+  my $self = shift;
+  my $result;
+
+  unless (defined wantarray) {
+    my @caller = caller;
+    warn "to_rgb16() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n";
+    return;
+  }
+
+  if ($self->{IMG}) {
+    $result = Imager->new;
+    $result->{IMG} = i_img_to_rgb16($self->{IMG})
+      or undef $result;
+  }
+
+  return $result;
+}
+
 sub addcolors {
   my $self = shift;
   my %opts = (colors=>[], @_);
@@ -1114,9 +1146,9 @@ sub settag {
 sub _get_reader_io {
   my ($self, $input) = @_;
 
-       if ($input->{io}) {
-               return $input->{io}, undef;
-       }
+  if ($input->{io}) {
+    return $input->{io}, undef;
+  }
   elsif ($input->{fd}) {
     return io_new_fd($input->{fd});
   }
@@ -1165,7 +1197,10 @@ sub _get_reader_io {
 sub _get_writer_io {
   my ($self, $input, $type) = @_;
 
-  if ($input->{fd}) {
+  if ($input->{io}) {
+    return $input->{io};
+  }
+  elsif ($input->{fd}) {
     return io_new_fd($input->{fd});
   }
   elsif ($input->{fh}) {
@@ -1257,11 +1292,13 @@ sub read {
     return $self;
   }
 
+  my $allow_incomplete = $input{allow_incomplete};
+  defined $allow_incomplete or $allow_incomplete = 0;
+
   if ( $input{'type'} eq 'tiff' ) {
     my $page = $input{'page'};
     defined $page or $page = 0;
-    # Fixme, check if that length parameter is ever needed
-    $self->{IMG}=i_readtiff_wiol( $IO, -1, $page ); 
+    $self->{IMG}=i_readtiff_wiol( $IO, $allow_incomplete, $page ); 
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
     }
@@ -1270,7 +1307,7 @@ sub read {
   }
 
   if ( $input{'type'} eq 'pnm' ) {
-    $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
+    $self->{IMG}=i_readpnm_wiol( $IO, $allow_incomplete );
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); 
       return undef;
@@ -1289,7 +1326,7 @@ sub read {
   }
 
   if ( $input{'type'} eq 'bmp' ) {
-    $self->{IMG}=i_readbmp_wiol( $IO );
+    $self->{IMG}=i_readbmp_wiol( $IO, $allow_incomplete );
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg();
       return undef;
@@ -1319,7 +1356,7 @@ sub read {
       my $page = $input{'page'};
       defined $page or $page = 0;
       $self->{IMG} = i_readgif_single_wiol( $IO, $page );
-      if ($input{colors}) {
+      if ($self->{IMG} && $input{colors}) {
        ${ $input{colors} } =
          [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ];
       }
@@ -1663,7 +1700,7 @@ sub write {
       $self->_set_opts(\%input, "bmp_", $self)
         or return undef;
       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
-        $self->{ERRSTR}='unable to write bmp image';
+       $self->{ERRSTR} = $self->_error_as_msg;
         return undef;
       }
       $self->{DEBUG} && print "writing a bmp file\n";
@@ -1781,8 +1818,15 @@ sub write_multi {
       }
     }
     else {
-      $ERRSTR = "Sorry, write_multi doesn't support $type yet";
-      return 0;
+      if (@images == 1) {
+       unless ($images[0]->write(%$opts, io => $IO, type => $type)) {
+         return 1;
+       }
+      }
+      else {
+       $ERRSTR = "Sorry, write_multi doesn't support $type yet";
+       return 0;
+      }
     }
   }
 
@@ -1850,6 +1894,12 @@ sub read_multi {
       return;
     }
   }
+  else {
+    my $img = Imager->new;
+    if ($img->read(%opts, io => $IO, type => $type)) {
+      return ( $img );
+    }
+  }
 
   $ERRSTR = "Cannot read multiple images from $type files";
   return;
@@ -1954,11 +2004,10 @@ sub register_filter {
 
 sub scale {
   my $self=shift;
-  my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
+  my %opts=('type'=>'max',qtype=>'normal',@_);
   my $img = Imager->new();
   my $tmp = Imager->new();
-
-  my $scalefactor = $opts{scalefactor};
+  my ($x_scale, $y_scale);
 
   unless (defined wantarray) {
     my @caller = caller;
@@ -1971,45 +2020,67 @@ sub scale {
     return undef;
   }
 
+  if ($opts{'xscalefactor'} && $opts{'yscalefactor'}) {
+    $x_scale = $opts{'xscalefactor'};
+    $y_scale = $opts{'yscalefactor'};
+  }
+  elsif ($opts{'xscalefactor'}) {
+    $x_scale = $opts{'xscalefactor'};
+    $y_scale = $opts{'scalefactor'} || $x_scale;
+  }
+  elsif ($opts{'yscalefactor'}) {
+    $y_scale = $opts{'yscalefactor'};
+    $x_scale = $opts{'scalefactor'} || $y_scale;
+  }
+  else {
+    $x_scale = $y_scale = $opts{'scalefactor'} || 0.5;
+  }
+
   # work out the scaling
   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
     my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() , 
                        $opts{ypixels} / $self->getheight() );
     if ($opts{'type'} eq 'min') { 
-      $scalefactor = _min($xpix,$ypix); 
+      $x_scale = $y_scale = _min($xpix,$ypix); 
     }
     elsif ($opts{'type'} eq 'max') {
-      $scalefactor = _max($xpix,$ypix);
+      $x_scale = $y_scale = _max($xpix,$ypix);
+    }
+    elsif ($opts{'type'} eq 'nonprop' || $opts{'type'} eq 'non-proportional') {
+      $x_scale = $xpix;
+      $y_scale = $ypix;
     }
     else {
       $self->_set_error('invalid value for type parameter');
       return undef;
     }
   } elsif ($opts{xpixels}) { 
-    $scalefactor = $opts{xpixels} / $self->getwidth();
+    $x_scale = $y_scale = $opts{xpixels} / $self->getwidth();
   }
   elsif ($opts{ypixels}) { 
-    $scalefactor = $opts{ypixels}/$self->getheight();
+    $x_scale = $y_scale = $opts{ypixels}/$self->getheight();
   }
   elsif ($opts{constrain} && ref $opts{constrain}
         && $opts{constrain}->can('constrain')) {
     # we've been passed an Image::Math::Constrain object or something
     # that looks like one
+    my $scalefactor;
     (undef, undef, $scalefactor)
       = $opts{constrain}->constrain($self->getwidth, $self->getheight);
     unless ($scalefactor) {
       $self->_set_error('constrain method failed on constrain parameter');
       return undef;
     }
+    $x_scale = $y_scale = $scalefactor;
   }
 
   if ($opts{qtype} eq 'normal') {
-    $tmp->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
+    $tmp->{IMG} = i_scaleaxis($self->{IMG}, $x_scale, 0);
     if ( !defined($tmp->{IMG}) ) { 
       $self->{ERRSTR} = 'unable to scale image';
       return undef;
     }
-    $img->{IMG}=i_scaleaxis($tmp->{IMG}, $scalefactor, 1);
+    $img->{IMG}=i_scaleaxis($tmp->{IMG}, $y_scale, 1);
     if ( !defined($img->{IMG}) ) { 
       $self->{ERRSTR}='unable to scale image'; 
       return undef;
@@ -2018,13 +2089,25 @@ sub scale {
     return $img;
   }
   elsif ($opts{'qtype'} eq 'preview') {
-    $img->{IMG} = i_scale_nn($self->{IMG}, $scalefactor, $scalefactor); 
+    $img->{IMG} = i_scale_nn($self->{IMG}, $x_scale, $y_scale); 
     if ( !defined($img->{IMG}) ) { 
       $self->{ERRSTR}='unable to scale image'; 
       return undef;
     }
     return $img;
   }
+  elsif ($opts{'qtype'} eq 'mixing') {
+    my $new_width = int(0.5 + $self->getwidth * $x_scale);
+    my $new_height = int(0.5 + $self->getheight * $y_scale);
+    $new_width >= 1 or $new_width = 1;
+    $new_height >= 1 or $new_height = 1;
+    $img->{IMG} = i_scale_mixing($self->{IMG}, $new_width, $new_height);
+    unless ($img->{IMG}) {
+      $self->_set_error(Imager->_error_as_meg);
+      return;
+    }
+    return $img;
+  }
   else {
     $self->_set_error('invalid value for qtype parameter');
     return undef;
@@ -2766,25 +2849,32 @@ sub setpixel {
   if (ref $x && ref $y) {
     unless (@$x == @$y) {
       $self->{ERRSTR} = 'length of x and y mismatch';
-      return undef;
+      return;
     }
+    my $set = 0;
     if ($color->isa('Imager::Color')) {
       for my $i (0..$#{$opts{'x'}}) {
-        i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
+        i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color)
+         or ++$set;
       }
     }
     else {
       for my $i (0..$#{$opts{'x'}}) {
-        i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
+        i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color)
+         or ++$set;
       }
     }
+    $set or return;
+    return $set;
   }
   else {
     if ($color->isa('Imager::Color')) {
-      i_ppix($self->{IMG}, $x, $y, $color);
+      i_ppix($self->{IMG}, $x, $y, $color)
+       and return;
     }
     else {
-      i_ppixf($self->{IMG}, $x, $y, $color);
+      i_ppixf($self->{IMG}, $x, $y, $color)
+       and return;
     }
   }
 
@@ -2837,6 +2927,8 @@ sub getscanline {
   my $self = shift;
   my %opts = ( type => '8bit', x=>0, @_);
 
+  $self->_valid_image or return;
+
   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
 
   unless (defined $opts{'y'}) {
@@ -2846,11 +2938,19 @@ sub getscanline {
 
   if ($opts{type} eq '8bit') {
     return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
-                 $opts{y});
+                 $opts{'y'});
   }
   elsif ($opts{type} eq 'float') {
     return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
-                 $opts{y});
+                 $opts{'y'});
+  }
+  elsif ($opts{type} eq 'index') {
+    unless (i_img_type($self->{IMG})) {
+      $self->_set_error("type => index only valid on paletted images");
+      return;
+    }
+    return i_gpal($self->{IMG}, $opts{x}, $opts{x} + $opts{width},
+                  $opts{'y'});
   }
   else {
     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
@@ -2862,6 +2962,8 @@ sub setscanline {
   my $self = shift;
   my %opts = ( x=>0, @_);
 
+  $self->_valid_image or return;
+
   unless (defined $opts{'y'}) {
     $self->_set_error("missing y parameter");
     return;
@@ -2903,6 +3005,14 @@ sub setscanline {
       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
     }
   }
+  elsif ($opts{type} eq 'index') {
+    if (ref $opts{pixels}) {
+      return i_ppal($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
+    }
+    else {
+      return i_ppal_p($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
+    }
+  }
   else {
     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
     return;
@@ -3176,7 +3286,7 @@ sub string {
   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 
   my %input=('x'=>0, 'y'=>0, @_);
-  $input{string}||=$input{text};
+  defined($input{string}) or $input{string} = $input{text};
 
   unless(defined $input{string}) {
     $self->{ERRSTR}="missing required parameter 'string'";
@@ -3447,7 +3557,7 @@ render text and more.
 
 =item *
 
-Imager - This document - Synopsis Example, Table of Contents and
+Imager - This document - Synopsis, Example, Table of Contents and
 Overview.
 
 =item *
@@ -3551,14 +3661,32 @@ or if you want to create an empty image:
 This example creates a completely black image of width 400 and height
 300 and 4 channels.
 
-When an operation fails which can be directly associated with an image
-the error message is stored can be retrieved with
-C<$img-E<gt>errstr()>.
+=head1 ERROR HANDLING
+
+In general a method will return false when it fails, if it does use the errstr() method to find out why:
+
+=over
+
+=item errstr
+
+Returns the last error message in that context.
+
+If the last error you received was from calling an object method, such
+as read, call errstr() as an object method to find out why:
+
+  my $image = Imager->new;
+  $image->read(file => 'somefile.gif')
+     or die $image->errstr;
 
-In cases where no image object is associated with an operation
-C<$Imager::ERRSTR> is used to report errors not directly associated
-with an image object.  You can also call C<Imager->errstr> to get this
-value.
+If it was a class method then call errstr() as a class method:
+
+  my @imgs = Imager->read_multi(file => 'somefile.gif')
+    or die Imager->errstr;
+
+Note that in some cases object methods are implemented in terms of
+class methods so a failing object method may set both.
+
+=back
 
 The C<Imager-E<gt>new> method is described in detail in
 L<Imager::ImageTypes>.
@@ -3571,10 +3699,10 @@ addcolors() -  L<Imager::ImageTypes/addcolors>
 
 addtag() -  L<Imager::ImageTypes/addtag> - add image tags
 
-arc() - L<Imager::Draw/arc>
-
 align_string() - L<Imager::Draw/align_string>
 
+arc() - L<Imager::Draw/arc>
+
 bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
 image
 
@@ -3591,6 +3719,8 @@ copy() - L<Imager::Transformations/copy>
 
 crop() - L<Imager::Transformations/crop> - extract part of an image
 
+def_guess_type() - L<Imager::Files/def_guess_type>
+
 deltag() -  L<Imager::ImageTypes/deltag> - delete image tags
 
 difference() - L<Imager::Filters/"Image Difference">
@@ -3617,6 +3747,8 @@ get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
 
 getheight() - L<Imager::ImageTypes/getwidth>
 
+getmask() - L<Imager::ImageTypes/getmask>
+
 getpixel() - L<Imager::Draw/getpixel>
 
 getsamples() - L<Imager::Draw/getsamples>
@@ -3627,8 +3759,12 @@ getwidth() - L<Imager::ImageTypes/getwidth>
 
 img_set() - L<Imager::ImageTypes/img_set>
 
+init() - L<Imager::ImageTypes/init>
+
 line() - L<Imager::Draw/line>
 
+load_plugin() - L<Imager::Filters/load_plugin>
+
 map() - L<Imager::Transformations/"Color Mappings"> - remap color
 channel values
 
@@ -3638,8 +3774,18 @@ matrix_transform() - L<Imager::Engines/matrix_transform>
 
 maxcolors() - L<Imager::ImageTypes/maxcolors>
 
+NC() - L<Imager::Handy/NC>
+
 new() - L<Imager::ImageTypes/new>
 
+newcolor() - L<Imager::Handy/newcolor>
+
+newcolour() - L<Imager::Handy/newcolour>
+
+newfont() - L<Imager::Handy/newfont>
+
+NF() - L<Imager::Handy/NF>
+
 open() - L<Imager::Files> - an alias for read()
 
 parseiptc() - L<Imager::Files/parseiptc> - parse IPTC data from a JPEG
@@ -3656,6 +3802,12 @@ read() - L<Imager::Files> - read a single image from an image file
 read_multi() - L<Imager::Files> - read multiple images from an image
 file
 
+register_filter() - L<Imager::Filters/register_filter>
+
+register_reader() - L<Imager::Filters/register_reader>
+
+register_writer() - L<Imager::Filters/register_writer>
+
 rotate() - L<Imager::Transformations/rotate>
 
 rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
@@ -3670,20 +3822,24 @@ scaleY() - L<Imager::Transformations/scaleY>
 setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
 a paletted image
 
+set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
+
+setmask() - L<Imager::ImageTypes/setmask>
+
 setpixel() - L<Imager::Draw/setpixel>
 
 setscanline() - L<Imager::Draw/setscanline>
 
 settag() - L<Imager::ImageTypes/settag>
 
-set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
-
 string() - L<Imager::Draw/string> - draw text on an image
 
 tags() -  L<Imager::ImageTypes/tags> - fetch image tags
 
 to_paletted() -  L<Imager::ImageTypes/to_paletted>
 
+to_rgb16() - L<Imager::ImageTypes/to_rgb16>
+
 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
 
 transform() - L<Imager::Engines/"transform">
@@ -3692,6 +3848,8 @@ transform2() - L<Imager::Engines/"transform2">
 
 type() -  L<Imager::ImageTypes/type> - type of image (direct vs paletted)
 
+unload_plugin() - L<Imager::Filters/unload_plugin>
+
 virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
 data
 
@@ -3732,13 +3890,14 @@ cropping - L<Imager::Transformations/crop>
 
 C<diff> images - L<Imager::Filter/"Image Difference">
 
-dpi - L<Imager::ImageTypes/i_xres>
+dpi - L<Imager::ImageTypes/i_xres>, 
+L<Imager::Cookbook/"Image spatial resolution">
 
 drawing boxes - L<Imager::Draw/box>
 
 drawing lines - L<Imager::Draw/line>
 
-drawing text - L<Imager::Font/string>, L<Imager::Font/align>
+drawing text - L<Imager::Draw/string>, L<Imager::Draw/align_string>
 
 error message - L<"Basic Overview">
 
@@ -3756,8 +3915,8 @@ flood fill - L<Imager::Draw/flood_fill>
 
 fonts - L<Imager::Font>
 
-fonts, drawing with - L<Imager::Font/string>, L<Imager::Font/align>,
-L<Imager::Font::Wrap>
+fonts, drawing with - L<Imager::Draw/string>,
+L<Imager::Draw/align_string>, L<Imager::Font::Wrap>
 
 fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
 
@@ -3875,14 +4034,47 @@ Please remember to include the versions of Imager, perl, supporting
 libraries, and any relevant code.  If you have specific images that
 cause the problems, please include those too.
 
-=head1 BUGS
+If you don't want to publish your email address on a mailing list you
+can use CPAN::Forum:
 
-Bugs are listed individually for relevant pod pages.
+  http://www.cpanforum.com/dist/Imager
+
+You will need to register to post.
+
+=head1 CONTRIBUTING TO IMAGER
+
+=head2 Feedback
+
+I like feedback.
+
+If you like or dislike Imager, you can add a public review of Imager
+at CPAN Ratings:
+
+  http://cpanratings.perl.org/dist/Imager
+
+This requires a Bitcard Account (http://www.bitcard.org).
+
+You can also send email to the maintainer below.
+
+If you send me a bug report via email, it will be copied to RT.
+
+=head2 Patches
+
+I accept patches, preferably against the main branch in subversion.
+You should include an explanation of the reason for why the patch is
+needed or useful.
+
+Your patch should include regression tests where possible, otherwise
+it will be delayed until I get a chance to write them.
 
 =head1 AUTHOR
 
-Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
-others. See the README for a complete list.
+Tony Cook <tony@imager.perl.org> is the current maintainer for Imager.
+
+Arnar M. Hrafnkelsson is the original author of Imager.
+
+Many others have contributed to Imager, please see the README for a
+complete list.
 
 =head1 SEE ALSO