]> git.imager.perl.org - imager.git/blobdiff - Imager.pm
- check that the result of fileno($fh) is defined rather than simply
[imager.git] / Imager.pm
index 36bd47dbbae8f874ada8e12126b24ed614c76679..446bd22c6306c33e331184ac0b1b763467889308 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -117,6 +117,7 @@ use Imager::Font;
                newcolour
                NC
                NF
+                NCF
 );
 
 @EXPORT=qw(
@@ -136,6 +137,7 @@ use Imager::Font;
                newcolor
                NF
                NC
+                NCF
               )],
    all => [@EXPORT_OK],
    default => [qw(
@@ -152,10 +154,26 @@ my %writers;
 # modules we attempted to autoload
 my %attempted_to_load;
 
+# library keys that are image file formats
+my %file_formats = map { $_ => 1 } qw/tiff pnm gif png jpeg raw bmp tga/;
+
+# image pixel combine types
+my @combine_types = 
+  qw/none normal multiply dissolve add subtract diff lighten darken
+     hue saturation value color/;
+my %combine_types;
+@combine_types{@combine_types} = 0 .. $#combine_types;
+$combine_types{mult} = $combine_types{multiply};
+$combine_types{'sub'}  = $combine_types{subtract};
+$combine_types{sat}  = $combine_types{saturation};
+
+# this will be used to store global defaults at some point
+my %defaults;
+
 BEGIN {
   require Exporter;
   @ISA = qw(Exporter);
-  $VERSION = '0.60';
+  $VERSION = '0.63';
   eval {
     require XSLoader;
     XSLoader::load(Imager => $VERSION);
@@ -168,14 +186,9 @@ BEGIN {
 }
 
 BEGIN {
-  i_init_fonts(); # Initialize font engines
   Imager::Font::__init();
   for(i_list_formats()) { $formats{$_}++; }
 
-  if ($formats{'t1'}) {
-    i_t1_set_aa(1);
-  }
-
   if (!$formats{'t1'} and !$formats{'tt'} 
       && !$formats{'ft2'} && !$formats{'w32'}) {
     $fontstate='no font support';
@@ -423,13 +436,19 @@ BEGIN {
 # initlize Imager
 # NOTE: this might be moved to an import override later on
 
-#sub import {
-#  my $pack = shift;
-#  (look through @_ for special tags, process, and remove them);   
-#  use Data::Dumper;
-#  print Dumper($pack);
-#  print Dumper(@_);
-#}
+sub import {
+  my $i = 1;
+  while ($i < @_) {
+    if ($_[$i] eq '-log-stderr') {
+      init_log(undef, 4);
+      splice(@_, $i, 1);
+    }
+    else {
+      ++$i;
+    }
+  }
+  goto &Exporter::import;
+}
 
 sub init_log {
   i_init_log($_[0],$_[1]);
@@ -552,6 +571,22 @@ sub _color {
   return $result;
 }
 
+sub _combine {
+  my ($self, $combine, $default) = @_;
+
+  if (!defined $combine && ref $self) {
+    $combine = $self->{combine};
+  }
+  defined $combine or $combine = $defaults{combine};
+  defined $combine or $combine = $default;
+
+  if (exists $combine_types{$combine}) {
+    $combine = $combine_types{$combine};
+  }
+  
+  return $combine;
+}
+
 sub _valid_image {
   my ($self) = @_;
 
@@ -1022,6 +1057,14 @@ sub virtual {
   $self->{IMG} and i_img_virtual($self->{IMG});
 }
 
+sub is_bilevel {
+  my ($self) = @_;
+
+  $self->{IMG} or return;
+
+  return i_img_is_monochrome($self->{IMG});
+}
+
 sub tags {
   my ($self, %opts) = @_;
 
@@ -1154,7 +1197,7 @@ sub _get_reader_io {
   }
   elsif ($input->{fh}) {
     my $fd = fileno($input->{fh});
-    unless ($fd) {
+    unless (defined $fd) {
       $self->_set_error("Handle in fh option not opened");
       return;
     }
@@ -1205,7 +1248,7 @@ sub _get_writer_io {
   }
   elsif ($input->{fh}) {
     my $fd = fileno($input->{fh});
-    unless ($fd) {
+    unless (defined $fd) {
       $self->_set_error("Handle in fh option not opened");
       return;
     }
@@ -1278,7 +1321,8 @@ sub read {
   }
 
   unless ($formats{$input{'type'}}) {
-    $self->_set_error("format '$input{'type'}' not supported");
+    my $read_types = join ', ', sort Imager->read_types();
+    $self->_set_error("format '$input{'type'}' not supported - formats $read_types available for reading");
     return;
   }
 
@@ -1446,6 +1490,30 @@ sub register_writer {
   return 1;
 }
 
+sub read_types {
+  my %types =
+    (
+     map { $_ => 1 }
+     keys %readers,
+     grep($file_formats{$_}, keys %formats),
+     qw(ico sgi), # formats not handled directly, but supplied with Imager
+    );
+
+  return keys %types;
+}
+
+sub write_types {
+  my %types =
+    (
+     map { $_ => 1 }
+     keys %writers,
+     grep($file_formats{$_}, keys %formats),
+     qw(ico sgi), # formats not handled directly, but supplied with Imager
+    );
+
+  return keys %types;
+}
+
 # probes for an Imager::File::whatever module
 sub _reader_autoload {
   my $type = shift;
@@ -1525,6 +1593,9 @@ my %obsolete_opts =
    gif_loop_count => 'gif_loop',
   );
 
+# options that should be converted to colors
+my %color_opts = map { $_ => 1 } qw/i_background/;
+
 sub _set_opts {
   my ($self, $opts, $prefix, @imgs) = @_;
 
@@ -1545,6 +1616,13 @@ sub _set_opts {
     }
     next unless $tagname =~ /^\Q$prefix/;
     my $value = $opts->{$opt};
+    if ($color_opts{$opt}) {
+      $value = _color($value);
+      unless ($value) {
+       $self->_set_error($Imager::ERRSTR);
+       return;
+      }
+    }
     if (ref $value) {
       if (UNIVERSAL::isa($value, "Imager::Color")) {
         my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
@@ -1628,7 +1706,8 @@ sub write {
   }
   else {
     if (!$formats{$input{'type'}}) { 
-      $self->{ERRSTR}='format not supported'; 
+      my $write_types = join ', ', sort Imager->write_types();
+      $self->_set_error("format '$input{'type'}' not supported - formats $write_types available for writing");
       return undef;
     }
     
@@ -1768,7 +1847,8 @@ sub write_multi {
   }
   else {
     if (!$formats{$type}) { 
-      $class->_set_error("format $type not supported"); 
+      my $write_types = join ', ', sort Imager->write_types();
+      $class->_set_error("format '$type' not supported - formats $write_types available for writing");
       return undef;
     }
     
@@ -1889,9 +1969,9 @@ sub read_multi {
     if ($img->read(%opts, io => $IO, type => $type)) {
       return ( $img );
     }
+    Imager->_set_error($img->errstr);
   }
 
-  $ERRSTR = "Cannot read multiple images from $type files";
   return;
 }
 
@@ -1990,24 +2070,31 @@ sub register_filter {
   return 1;
 }
 
-# Scale an image to requested size and return the scaled version
+sub scale_calculate {
+  my $self = shift;
 
-sub scale {
-  my $self=shift;
-  my %opts=('type'=>'max',qtype=>'normal',@_);
-  my $img = Imager->new();
-  my $tmp = Imager->new();
-  my ($x_scale, $y_scale);
+  my %opts = ('type'=>'max', @_);
 
-  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;
+  # none of these should be references
+  for my $name (qw/xpixels ypixels xscalefactor yscalefactor width height/) {
+    if (defined $opts{$name} && ref $opts{$name}) {
+      $self->_set_error("scale_calculate: $name parameter cannot be a reference");
+      return;
+    }
   }
 
-  unless ($self->{IMG}) { 
-    $self->_set_error('empty input image'); 
-    return undef;
+  my ($x_scale, $y_scale);
+  my $width = $opts{width};
+  my $height = $opts{height};
+  if (ref $self) {
+    defined $width or $width = $self->getwidth;
+    defined $height or $height = $self->getheight;
+  }
+  else {
+    unless (defined $width && defined $height) {
+      $self->_set_error("scale_calculate: width and height parameters must be supplied when called as a class method");
+      return;
+    }
   }
 
   if ($opts{'xscalefactor'} && $opts{'yscalefactor'}) {
@@ -2028,8 +2115,8 @@ sub scale {
 
   # work out the scaling
   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
-    my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() , 
-                       $opts{ypixels} / $self->getheight() );
+    my ($xpix, $ypix)=( $opts{xpixels} / $width , 
+                       $opts{ypixels} / $height );
     if ($opts{'type'} eq 'min') { 
       $x_scale = $y_scale = _min($xpix,$ypix); 
     }
@@ -2042,13 +2129,13 @@ sub scale {
     }
     else {
       $self->_set_error('invalid value for type parameter');
-      return undef;
+      return;
     }
   } elsif ($opts{xpixels}) { 
-    $x_scale = $y_scale = $opts{xpixels} / $self->getwidth();
+    $x_scale = $y_scale = $opts{xpixels} / $width;
   }
   elsif ($opts{ypixels}) { 
-    $x_scale = $y_scale = $opts{ypixels}/$self->getheight();
+    $x_scale = $y_scale = $opts{ypixels}/$height;
   }
   elsif ($opts{constrain} && ref $opts{constrain}
         && $opts{constrain}->can('constrain')) {
@@ -2059,20 +2146,52 @@ sub scale {
       = $opts{constrain}->constrain($self->getwidth, $self->getheight);
     unless ($scalefactor) {
       $self->_set_error('constrain method failed on constrain parameter');
-      return undef;
+      return;
     }
     $x_scale = $y_scale = $scalefactor;
   }
 
+  my $new_width = int($x_scale * $width + 0.5);
+  $new_width > 0 or $new_width = 1;
+  my $new_height = int($y_scale * $height + 0.5);
+  $new_height > 0 or $new_height = 1;
+
+  return ($x_scale, $y_scale, $new_width, $new_height);
+  
+}
+
+# Scale an image to requested size and return the scaled version
+
+sub scale {
+  my $self=shift;
+  my %opts = (qtype=>'normal' ,@_);
+  my $img = Imager->new();
+  my $tmp = Imager->new();
+
+  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->_set_error('empty input image'); 
+    return undef;
+  }
+
+  my ($x_scale, $y_scale, $new_width, $new_height) = 
+    $self->scale_calculate(%opts)
+      or return;
+
   if ($opts{qtype} eq 'normal') {
     $tmp->{IMG} = i_scaleaxis($self->{IMG}, $x_scale, 0);
     if ( !defined($tmp->{IMG}) ) { 
-      $self->{ERRSTR} = 'unable to scale image';
+      $self->{ERRSTR} = 'unable to scale image: ' . $self->_error_as_msg;
       return undef;
     }
     $img->{IMG}=i_scaleaxis($tmp->{IMG}, $y_scale, 1);
     if ( !defined($img->{IMG}) ) { 
-      $self->{ERRSTR}='unable to scale image'
+      $self->{ERRSTR}='unable to scale image: ' . $self->_error_as_msg
       return undef;
     }
 
@@ -2087,13 +2206,9 @@ sub scale {
     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);
+      $self->_set_error(Imager->_error_as_msg);
       return;
     }
     return $img;
@@ -2337,7 +2452,7 @@ sub transform2 {
 
 sub rubthrough {
   my $self=shift;
-  my %opts=(tx => 0,ty => 0, @_);
+  my %opts= @_;
 
   unless ($self->{IMG}) { 
     $self->{ERRSTR}='empty input image'; 
@@ -2354,15 +2469,108 @@ sub rubthrough {
           src_maxy => $opts{src}->getheight(),
           %opts);
 
-  unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
+  my $tx = $opts{tx};
+  defined $tx or $tx = $opts{left};
+  defined $tx or $tx = 0;
+
+  my $ty = $opts{ty};
+  defined $ty or $ty = $opts{top};
+  defined $ty or $ty = 0;
+
+  unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $tx, $ty,
                     $opts{src_minx}, $opts{src_miny}, 
                     $opts{src_maxx}, $opts{src_maxy})) {
     $self->_set_error($self->_error_as_msg());
     return undef;
   }
+
   return $self;
 }
 
+sub compose {
+  my $self = shift;
+  my %opts =
+    ( 
+     opacity => 1.0,
+     mask_left => 0,
+     mask_top => 0,
+     @_
+    );
+
+  unless ($self->{IMG}) {
+    $self->_set_error("compose: empty input image");
+    return;
+  }
+
+  unless ($opts{src}) {
+    $self->_set_error("compose: src parameter missing");
+    return;
+  }
+  
+  unless ($opts{src}{IMG}) {
+    $self->_set_error("compose: src parameter empty image");
+    return;
+  }
+  my $src = $opts{src};
+
+  my $left = $opts{left};
+  defined $left or $left = $opts{tx};
+  defined $left or $left = 0;
+
+  my $top = $opts{top};
+  defined $top or $top = $opts{ty};
+  defined $top or $top = 0;
+
+  my $src_left = $opts{src_left};
+  defined $src_left or $src_left = $opts{src_minx};
+  defined $src_left or $src_left = 0;
+
+  my $src_top = $opts{src_top};
+  defined $src_top or $src_top = $opts{src_miny};
+  defined $src_top or $src_top = 0;
+
+  my $width = $opts{width};
+  if (!defined $width && defined $opts{src_maxx}) {
+    $width = $opts{src_maxx} - $src_left;
+  }
+  defined $width or $width = $src->getwidth() - $src_left;
+
+  my $height = $opts{height};
+  if (!defined $height && defined $opts{src_maxy}) {
+    $height = $opts{src_maxy} - $src_top;
+  }
+  defined $height or $height = $src->getheight() - $src_top;
+
+  my $combine = $self->_combine($opts{combine}, 'normal');
+
+  if ($opts{mask}) {
+    unless ($opts{mask}{IMG}) {
+      $self->_set_error("compose: mask parameter empty image");
+      return;
+    }
+
+    my $mask_left = $opts{mask_left};
+    defined $mask_left or $mask_left = $opts{mask_minx};
+    defined $mask_left or $mask_left = 0;
+    
+    my $mask_top = $opts{mask_top};
+    defined $mask_top or $mask_top = $opts{mask_miny};
+    defined $mask_top or $mask_top = 0;
+
+    i_compose_mask($self->{IMG}, $src->{IMG}, $opts{mask}{IMG}, 
+                  $left, $top, $src_left, $src_top,
+                  $mask_left, $mask_top, $width, $height, 
+                  $combine, $opts{opacity})
+      or return;
+  }
+  else {
+    i_compose($self->{IMG}, $src->{IMG}, $left, $top, $src_left, $src_top,
+             $width, $height, $combine, $opts{opacity})
+      or return;
+  }
+
+  return $self;
+}
 
 sub flip {
   my $self  = shift;
@@ -3011,7 +3219,7 @@ sub setscanline {
 
 sub getsamples {
   my $self = shift;
-  my %opts = ( type => '8bit', x=>0, @_);
+  my %opts = ( type => '8bit', x=>0, offset => 0, @_);
 
   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
 
@@ -3024,18 +3232,103 @@ sub getsamples {
     $opts{channels} = [ 0 .. $self->getchannels()-1 ];
   }
 
-  if ($opts{type} eq '8bit') {
-    return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
-                  $opts{y}, @{$opts{channels}});
-  }
-  elsif ($opts{type} eq 'float') {
-    return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
-                   $opts{y}, @{$opts{channels}});
+  if ($opts{target}) {
+    my $target = $opts{target};
+    my $offset = $opts{offset};
+    if ($opts{type} eq '8bit') {
+      my @samples = i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
+                           $opts{y}, @{$opts{channels}})
+       or return;
+      @{$target}{$offset .. $offset + @samples - 1} = @samples;
+      return scalar(@samples);
+    }
+    elsif ($opts{type} eq 'float') {
+      my @samples = i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
+                            $opts{y}, @{$opts{channels}});
+      @{$target}{$offset .. $offset + @samples - 1} = @samples;
+      return scalar(@samples);
+    }
+    elsif ($opts{type} =~ /^(\d+)bit$/) {
+      my $bits = $1;
+
+      my @data;
+      my $count = i_gsamp_bits($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, 
+                              $opts{y}, $bits, $target, 
+                              $offset, @{$opts{channels}});
+      unless (defined $count) {
+       $self->_set_error(Imager->_error_as_msg);
+       return;
+      }
+
+      return $count;
+    }
+    else {
+      $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
+      return;
+    }
   }
   else {
-    $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
+    if ($opts{type} eq '8bit') {
+      return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
+                    $opts{y}, @{$opts{channels}});
+    }
+    elsif ($opts{type} eq 'float') {
+      return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
+                     $opts{y}, @{$opts{channels}});
+    }
+    elsif ($opts{type} =~ /^(\d+)bit$/) {
+      my $bits = $1;
+
+      my @data;
+      i_gsamp_bits($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, 
+                  $opts{y}, $bits, \@data, 0, @{$opts{channels}})
+       or return;
+      return @data;
+    }
+    else {
+      $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
+      return;
+    }
+  }
+}
+
+sub setsamples {
+  my $self = shift;
+  my %opts = ( x => 0, offset => 0, @_ );
+
+  unless ($self->{IMG}) {
+    $self->_set_error('setsamples: empty input image');
+    return;
+  }
+
+  unless(defined $opts{data} && ref $opts{data}) {
+    $self->_set_error('setsamples: data parameter missing or invalid');
+    return;
+  }
+
+  unless ($opts{channels}) {
+    $opts{channels} = [ 0 .. $self->getchannels()-1 ];
+  }
+
+  unless ($opts{type} && $opts{type} =~ /^(\d+)bit$/) {
+    $self->_set_error('setsamples: type parameter missing or invalid');
     return;
   }
+  my $bits = $1;
+
+  unless (defined $opts{width}) {
+    $opts{width} = $self->getwidth() - $opts{x};
+  }
+
+  my $count = i_psamp_bits($self->{IMG}, $opts{x}, $opts{y}, $bits,
+                          $opts{channels}, $opts{data}, $opts{offset}, 
+                          $opts{width});
+  unless (defined $count) {
+    $self->_set_error(Imager->_error_as_msg);
+    return;
+  }
+
+  return $count;
 }
 
 # make an identity matrix of the given size
@@ -3416,6 +3709,7 @@ sub get_file_limits {
 
 sub newcolor { Imager::Color->new(@_); }
 sub newfont  { Imager::Font->new(@_); }
+sub NCF { Imager::Color::Float->new(@_) }
 
 *NC=*newcolour=*newcolor;
 *NF=*newfont;
@@ -3461,6 +3755,10 @@ sub def_guess_type {
   return ();
 }
 
+sub combines {
+  return @combine_types;
+}
+
 # get the minimum of a list
 
 sub _min {
@@ -3708,7 +4006,8 @@ This example creates a completely black image of width 400 and height
 
 =head1 ERROR HANDLING
 
-In general a method will return false when it fails, if it does use the errstr() method to find out why:
+In general a method will return false when it fails, if it does use
+the errstr() method to find out why:
 
 =over
 
@@ -3757,6 +4056,10 @@ circle() - L<Imager::Draw/circle>
 
 colorcount() - L<Imager::Draw/colorcount>
 
+combines() - L<Imager::Draw/combines>
+
+compose() - L<Imager::Transformations/compose>
+
 convert() - L<Imager::Transformations/"Color transformations"> -
 transform the color space
 
@@ -3810,6 +4113,8 @@ img_set() - L<Imager::ImageTypes/img_set>
 
 init() - L<Imager::ImageTypes/init>
 
+is_bilevel() - L<Imager::ImageTypes/is_bilevel>
+
 line() - L<Imager::Draw/line>
 
 load_plugin() - L<Imager::Filters/load_plugin>
@@ -3825,6 +4130,8 @@ maxcolors() - L<Imager::ImageTypes/maxcolors>
 
 NC() - L<Imager::Handy/NC>
 
+NCF() - L<Imager::Handy/NCF>
+
 new() - L<Imager::ImageTypes/new>
 
 newcolor() - L<Imager::Handy/newcolor>
@@ -3851,6 +4158,9 @@ read() - L<Imager::Files> - read a single image from an image file
 read_multi() - L<Imager::Files> - read multiple images from an image
 file
 
+read_types() - L<Imager::Files/read_types> - list image types Imager
+can read.
+
 register_filter() - L<Imager::Filters/register_filter>
 
 register_reader() - L<Imager::Filters/register_reader>
@@ -3864,6 +4174,8 @@ image and use the alpha channel
 
 scale() - L<Imager::Transformations/scale>
 
+scale_calculate() - L<Imager::Transformations/scale_calculate>
+
 scaleX() - L<Imager::Transformations/scaleX>
 
 scaleY() - L<Imager::Transformations/scaleY>
@@ -3877,6 +4189,8 @@ setmask() - L<Imager::ImageTypes/setmask>
 
 setpixel() - L<Imager::Draw/setpixel>
 
+setsamples() - L<Imager::Draw/setsamples>
+
 setscanline() - L<Imager::Draw/setscanline>
 
 settag() - L<Imager::ImageTypes/settag>
@@ -3907,9 +4221,12 @@ write() - L<Imager::Files> - write an image to a file
 write_multi() - L<Imager::Files> - write multiple image to an image
 file.
 
+write_types() - L<Imager::Files/read_types> - list image types Imager
+can write.
+
 =head1 CONCEPT INDEX
 
-animated GIF - L<Imager::File/"Writing an animated GIF">
+animated GIF - L<Imager::Files/"Writing an animated GIF">
 
 aspect ratio - L<Imager::ImageTypes/i_xres>,
 L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>