- bump to 0.48

[imager.git] / Imager.pm

diff --git a/Imager.pm b/Imager.pm
index fe0a874d2f617203b8b54a6554187ad0b09f6263..0f684aec57cbbb8c4922daedfa246c0d27a3851e 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -146,7 +146,7 @@ use Imager::Font;
 BEGIN {
   require Exporter;
   @ISA = qw(Exporter);
 BEGIN {
   require Exporter;
   @ISA = qw(Exporter);

-  $VERSION = '0.47';
+  $VERSION = '0.48';

   eval {
     require XSLoader;
     XSLoader::load(Imager => $VERSION);
   eval {
     require XSLoader;
     XSLoader::load(Imager => $VERSION);


@@ -241,11 +241,26 @@ BEGIN {
      }
     };
 
      }
     };
 

-  $filters{nearest_color} ={
-                           callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
-                           defaults => { },
-                           callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
-                          };
+  $filters{nearest_color} =
+    {
+     callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
+     defaults => { },
+     callsub => 
+     sub { 
+       my %hsh=@_; 
+       # make sure the segments are specified with colors
+       my @colors;
+       for my $color (@{$hsh{colors}}) {
+         my $new_color = _color($color) 
+           or die $Imager::ERRSTR."\n";
+         push @colors, $new_color;
+       }
+
+       i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, \@colors, 
+                       $hsh{dist})
+         or die Imager->_error_as_msg() . "\n";
+     },
+    };

   $filters{gaussian} = {
                         callseq => [ 'image', 'stddev' ],
                         defaults => { },
   $filters{gaussian} = {
                         callseq => [ 'image', 'stddev' ],
                         defaults => { },


@@ -372,7 +387,8 @@ BEGIN {
 
        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
 
        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},

-                  $hsh{ssample_param}, \@segments);
+                  $hsh{ssample_param}, \@segments)
+         or die Imager->_error_as_msg() . "\n";

      },
     };
   $filters{unsharpmask} =
      },
     };
   $filters{unsharpmask} =


@@ -1217,7 +1233,8 @@ sub read {
   if ( $input{'type'} eq 'pnm' ) {
     $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
     if ( !defined($self->{IMG}) ) {
   if ( $input{'type'} eq 'pnm' ) {
     $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
     if ( !defined($self->{IMG}) ) {

-      $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef;
+      $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); 
+      return undef;

     }
     $self->{DEBUG} && print "loading a pnm file\n";
     return $self;
     }
     $self->{DEBUG} && print "loading a pnm file\n";
     return $self;


@@ -1310,7 +1327,7 @@ sub read {
                                   $params{storechannels},
                                   $params{interleave});
     if ( !defined($self->{IMG}) ) {
                                   $params{storechannels},
                                   $params{interleave});
     if ( !defined($self->{IMG}) ) {

-      $self->{ERRSTR}='unable to read raw image';
+      $self->{ERRSTR}=$self->_error_as_msg();

       return undef;
     }
     $self->{DEBUG} && print "loading a raw file\n";
       return undef;
     }
     $self->{DEBUG} && print "loading a raw file\n";


@@ -1446,12 +1463,12 @@ sub write {
 
     if (defined $input{class} && $input{class} eq 'fax') {
       if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
 
     if (defined $input{class} && $input{class} eq 'fax') {
       if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {

-       $self->{ERRSTR}='Could not write to buffer';
+       $self->{ERRSTR} = $self->_error_as_msg();

        return undef;
       }
     } else {
       if (!i_writetiff_wiol($self->{IMG}, $IO)) {
        return undef;
       }
     } else {
       if (!i_writetiff_wiol($self->{IMG}, $IO)) {

-       $self->{ERRSTR}='Could not write to buffer';
+       $self->{ERRSTR} = $self->_error_as_msg();

        return undef;
       }
     }
        return undef;
       }
     }


@@ -1459,7 +1476,7 @@ sub write {
     $self->_set_opts(\%input, "pnm_", $self)
       or return undef;
     if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
     $self->_set_opts(\%input, "pnm_", $self)
       or return undef;
     if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {

-      $self->{ERRSTR}='unable to write pnm image';
+      $self->{ERRSTR} = $self->_error_as_msg();

       return undef;
     }
     $self->{DEBUG} && print "writing a pnm file\n";
       return undef;
     }
     $self->{DEBUG} && print "writing a pnm file\n";


@@ -1467,7 +1484,7 @@ sub write {
     $self->_set_opts(\%input, "raw_", $self)
       or return undef;
     if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
     $self->_set_opts(\%input, "raw_", $self)
       or return undef;
     if ( !i_writeraw_wiol($self->{IMG},$IO) ) {

-      $self->{ERRSTR}='unable to write raw image';
+      $self->{ERRSTR} = $self->_error_as_msg();

       return undef;
     }
     $self->{DEBUG} && print "writing a raw file\n";
       return undef;
     }
     $self->{DEBUG} && print "writing a raw file\n";


@@ -1679,9 +1696,14 @@ sub filter {
     }
   }
   if (defined($filters{$input{'type'}}{defaults})) {
     }
   }
   if (defined($filters{$input{'type'}}{defaults})) {

-    %hsh=('image',$self->{IMG},%{$filters{$input{'type'}}{defaults}},%input);
+    %hsh=( image => $self->{IMG},
+           imager => $self,
+           %{$filters{$input{'type'}}{defaults}},
+           %input );

   } else {
   } else {

-    %hsh=('image',$self->{IMG},%input);
+    %hsh=( image => $self->{IMG},
+           imager => $self,
+           %input );

   }
 
   my @cs=@{$filters{$input{'type'}}{callseq}};
   }
 
   my @cs=@{$filters{$input{'type'}}{callseq}};


@@ -1736,41 +1758,84 @@ sub scale {
   my $img = Imager->new();
   my $tmp = Imager->new();
 
   my $img = Imager->new();
   my $tmp = Imager->new();
 

+  my $scalefactor = $opts{scalefactor};
+

   unless (defined wantarray) {
     my @caller = caller;
     warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
     return;
   }
 
   unless (defined wantarray) {
     my @caller = caller;
     warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
     return;
   }
 

-  unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+  unless ($self->{IMG}) { 
+    $self->_set_error('empty input image'); 
+    return undef;
+  }

 
 

+  # work out the scaling

   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
   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') { $opts{scalefactor}=min($xpix,$ypix); }
-    if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
-  } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
-  elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
+    my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() , 
+                       $opts{ypixels} / $self->getheight() );
+    if ($opts{'type'} eq 'min') { 
+      $scalefactor = min($xpix,$ypix); 
+    }
+    elsif ($opts{'type'} eq 'max') {
+      $scalefactor = max($xpix,$ypix);
+    }
+    else {
+      $self->_set_error('invalid value for type parameter');
+      return undef;
+    }
+  } elsif ($opts{xpixels}) { 
+    $scalefactor = $opts{xpixels} / $self->getwidth();
+  }
+  elsif ($opts{ypixels}) { 
+    $scalefactor = $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
+    (undef, undef, $scalefactor)
+      = $opts{constrain}->constrain($self->getwidth, $self->getheight);
+    unless ($scalefactor) {
+      $self->_set_error('constrain method failed on constrain parameter');
+      return undef;
+    }
+  }

 
   if ($opts{qtype} eq 'normal') {
 
   if ($opts{qtype} eq 'normal') {

-    $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
-    if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
-    $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
-    if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
+    $tmp->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
+    if ( !defined($tmp->{IMG}) ) { 
+      $self->{ERRSTR} = 'unable to scale image';
+      return undef;
+    }
+    $img->{IMG}=i_scaleaxis($tmp->{IMG}, $scalefactor, 1);
+    if ( !defined($img->{IMG}) ) { 
+      $self->{ERRSTR}='unable to scale image'; 
+      return undef;
+    }
+

     return $img;
   }
     return $img;
   }

-  if ($opts{'qtype'} eq 'preview') {
-    $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'}); 
-    if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
+  elsif ($opts{'qtype'} eq 'preview') {
+    $img->{IMG} = i_scale_nn($self->{IMG}, $scalefactor, $scalefactor); 
+    if ( !defined($img->{IMG}) ) { 
+      $self->{ERRSTR}='unable to scale image'; 
+      return undef;
+    }

     return $img;
   }
     return $img;
   }

-  $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
+  else {
+    $self->_set_error('invalid value for qtype parameter');
+    return undef;
+  }

 }
 
 # Scales only along the X axis
 
 sub scaleX {
 }
 
 # Scales only along the X axis
 
 sub scaleX {

-  my $self=shift;
-  my %opts=(scalefactor=>0.5,@_);
+  my $self = shift;
+  my %opts = ( scalefactor=>0.5, @_ );

 
   unless (defined wantarray) {
     my @caller = caller;
 
   unless (defined wantarray) {
     my @caller = caller;


@@ -1778,24 +1843,39 @@ sub scaleX {
     return;
   }
 
     return;
   }
 

-  unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+  unless ($self->{IMG}) { 
+    $self->{ERRSTR} = 'empty input image';
+    return undef;
+  }

 
   my $img = Imager->new();
 
 
   my $img = Imager->new();
 

-  if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
+  my $scalefactor = $opts{scalefactor};

 
 

-  unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
-  $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
+  if ($opts{pixels}) { 
+    $scalefactor = $opts{pixels} / $self->getwidth();
+  }
+
+  unless ($self->{IMG}) { 
+    $self->{ERRSTR}='empty input image'; 
+    return undef;
+  }
+
+  $img->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
+
+  if ( !defined($img->{IMG}) ) { 
+    $self->{ERRSTR} = 'unable to scale image'; 
+    return undef;
+  }

 
 

-  if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }

   return $img;
 }
 
 # Scales only along the Y axis
 
 sub scaleY {
   return $img;
 }
 
 # Scales only along the Y axis
 
 sub scaleY {

-  my $self=shift;
-  my %opts=(scalefactor=>0.5,@_);
+  my $self = shift;
+  my %opts = ( scalefactor => 0.5, @_ );

 
   unless (defined wantarray) {
     my @caller = caller;
 
   unless (defined wantarray) {
     my @caller = caller;


@@ -1807,16 +1887,26 @@ sub scaleY {
 
   my $img = Imager->new();
 
 
   my $img = Imager->new();
 

-  if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
+  my $scalefactor = $opts{scalefactor};

 
 

-  unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
-  $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
+  if ($opts{pixels}) { 
+    $scalefactor = $opts{pixels} / $self->getheight();
+  }
+
+  unless ($self->{IMG}) { 
+    $self->{ERRSTR} = 'empty input image'; 
+    return undef;
+  }
+  $img->{IMG}=i_scaleaxis($self->{IMG}, $scalefactor, 1);
+
+  if ( !defined($img->{IMG}) ) {
+    $self->{ERRSTR} = 'unable to scale image';
+    return undef;
+  }

 
 

-  if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }

   return $img;
 }
 
   return $img;
 }
 

-

 # Transform returns a spatial transformation of the input image
 # this moves pixels to a new location in the returned image.
 # NOTE - should make a utility function to check transforms for
 # Transform returns a spatial transformation of the input image
 # this moves pixels to a new location in the returned image.
 # NOTE - should make a utility function to check transforms for


@@ -1976,8 +2066,14 @@ sub rubthrough {
   my $self=shift;
   my %opts=(tx => 0,ty => 0, @_);
 
   my $self=shift;
   my %opts=(tx => 0,ty => 0, @_);
 

-  unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
-  unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
+  unless ($self->{IMG}) { 
+    $self->{ERRSTR}='empty input image'; 
+    return undef;
+  }
+  unless ($opts{src} && $opts{src}->{IMG}) {
+    $self->{ERRSTR}='empty input image for src'; 
+    return undef;
+  }

 
   %opts = (src_minx => 0,
           src_miny => 0,
 
   %opts = (src_minx => 0,
           src_miny => 0,


@@ -1986,8 +2082,9 @@ sub rubthrough {
           %opts);
 
   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
           %opts);
 
   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},

-         $opts{src_minx}, $opts{src_miny}, $opts{src_maxx}, $opts{src_maxy})) {
-    $self->{ERRSTR} = $self->_error_as_msg();
+                    $opts{src_minx}, $opts{src_miny}, 
+                    $opts{src_maxx}, $opts{src_maxy})) {
+    $self->_set_error($self->_error_as_msg());

     return undef;
   }
   return $self;
     return undef;
   }
   return $self;


@@ -2042,9 +2139,16 @@ sub rotate {
   elsif (defined $opts{radians} || defined $opts{degrees}) {
     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
 
   elsif (defined $opts{radians} || defined $opts{degrees}) {
     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
 

+    my $back = $opts{back};

     my $result = Imager->new;
     my $result = Imager->new;

-    if ($opts{back}) {
-      $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $opts{back});
+    if ($back) {
+      $back = _color($back);
+      unless ($back) {
+        $self->_set_error(Imager->errstr);
+        return undef;
+      }
+
+      $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $back);

     }
     else {
       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);
     }
     else {
       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);


@@ -3285,7 +3389,7 @@ channel values
 
 masked() -  L<Imager::ImageTypes/masked> - make a masked image
 
 
 masked() -  L<Imager::ImageTypes/masked> - make a masked image
 

-matrix_transform() - L<Imager::Engines/"Matrix Transformations">
+matrix_transform() - L<Imager::Engines/matrix_transform>

 
 maxcolors() - L<Imager::ImageTypes/maxcolors>
 
 
 maxcolors() - L<Imager::ImageTypes/maxcolors>
 


@@ -3311,8 +3415,6 @@ image and use the alpha channel
 
 scale() - L<Imager::Transformations/scale>
 
 
 scale() - L<Imager::Transformations/scale>
 

-setscanline() - L<Imager::Draw/setscanline>
-

 scaleX() - L<Imager::Transformations/scaleX>
 
 scaleY() - L<Imager::Transformations/scaleY>
 scaleX() - L<Imager::Transformations/scaleX>
 
 scaleY() - L<Imager::Transformations/scaleY>


@@ -3322,6 +3424,10 @@ a paletted image
 
 setpixel() - L<Imager::Draw/setpixel>
 
 
 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
 set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
 
 string() - L<Imager::Draw/string> - draw text on an image