]> git.imager.perl.org - imager.git/blobdiff - Imager.pm
fix an unsigned comparison when converting character code to a glyph index with a...
[imager.git] / Imager.pm
index 1008f60e85f784be8e0057778ab465c03413d9b4..82948f2bc14ac015319cba435e15e5042eea0110 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -144,7 +144,7 @@ BEGIN {
   if ($ex_version < 5.57) {
     @ISA = qw(Exporter);
   }
-  $VERSION = '0.98';
+  $VERSION = '1.008';
   require XSLoader;
   XSLoader::load(Imager => $VERSION);
 }
@@ -204,12 +204,18 @@ BEGIN {
      callsub => sub { my %hsh=@_; i_hardinvertall($hsh{image}); }
     };
 
-  $filters{autolevels} ={
+  $filters{autolevels_skew} ={
                         callseq => ['image','lsat','usat','skew'],
                         defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
                         callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
                        };
 
+  $filters{autolevels} ={
+                        callseq => ['image','lsat','usat'],
+                        defaults => { lsat=>0.1,usat=>0.1 },
+                        callsub => sub { my %hsh=@_; i_autolevels_mono($hsh{image},$hsh{lsat},$hsh{usat}); }
+                       };
+
   $filters{turbnoise} ={
                        callseq => ['image'],
                        defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
@@ -631,6 +637,9 @@ sub _combine {
 sub _valid_image {
   my ($self, $method) = @_;
 
+  ref $self
+    or return Imager->_set_error("$method needs an image object");
+
   $self->{IMG} && Scalar::Util::blessed($self->{IMG}) and return 1;
 
   my $msg = $self->{IMG} ? "images do not cross threads" : "empty input image";
@@ -665,18 +674,13 @@ sub new {
   $self->{ERRSTR}=undef; #
   $self->{DEBUG}=$DEBUG;
   $self->{DEBUG} and print "Initialized Imager\n";
-  if (defined $hsh{xsize} || defined $hsh{ysize}) { 
-    unless ($self->img_set(%hsh)) {
-      $Imager::ERRSTR = $self->{ERRSTR};
-      return;
-    }
-  }
-  elsif (defined $hsh{file} || 
-        defined $hsh{fh} ||
-        defined $hsh{fd} ||
-        defined $hsh{callback} ||
-        defined $hsh{readcb} ||
-        defined $hsh{data}) {
+  if (defined $hsh{file} ||
+      defined $hsh{fh} ||
+      defined $hsh{fd} ||
+      defined $hsh{callback} ||
+      defined $hsh{readcb} ||
+      defined $hsh{data} ||
+      defined $hsh{io}) {
     # allow $img = Imager->new(file => $filename)
     my %extras;
     
@@ -690,6 +694,16 @@ sub new {
       return;
     }
   }
+  elsif (defined $hsh{xsize} || defined $hsh{ysize}) {
+    unless ($self->img_set(%hsh)) {
+      $Imager::ERRSTR = $self->{ERRSTR};
+      return;
+    }
+  }
+  elsif (%hsh) {
+    Imager->_set_error("new: supply xsize and ysize or a file access parameter or no parameters");
+    return;
+  }
 
   return $self;
 }
@@ -905,16 +919,29 @@ sub _sametype {
 # Sets an image to a certain size and channel number
 # if there was previously data in the image it is discarded
 
+my %model_channels =
+  (
+   gray => 1,
+   graya => 2,
+   rgb => 3,
+   rgba => 4,
+  );
+
 sub img_set {
   my $self=shift;
 
   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
 
-  if (defined($self->{IMG})) {
-    # let IIM_DESTROY destroy it, it's possible this image is
-    # referenced from a virtual image (like masked)
-    #i_img_destroy($self->{IMG});
-    undef($self->{IMG});
+  undef($self->{IMG});
+
+  if ($hsh{model}) {
+    if (my $channels = $model_channels{$hsh{model}}) {
+      $hsh{channels} = $channels;
+    }
+    else {
+      $self->_set_error("new: unknown value for model '$hsh{model}'");
+      return;
+    }
   }
 
   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
@@ -933,7 +960,7 @@ sub img_set {
   }
 
   unless ($self->{IMG}) {
-    $self->{ERRSTR} = Imager->_error_as_msg();
+    $self->_set_error(Imager->_error_as_msg());
     return;
   }
 
@@ -1015,7 +1042,12 @@ sub make_palette {
     ++$index;
   }
 
-  return i_img_make_palette($quant, map $_->{IMG}, @images);
+  my @cols = i_img_make_palette($quant, map $_->{IMG}, @images);
+  unless (@cols) {
+      Imager->_set_error(Imager->_error_as_msg);
+      return;
+  }
+  return @cols;
 }
 
 # convert a paletted (or any image) to an 8-bit/channel RGB image
@@ -1644,6 +1676,8 @@ sub _load_file {
   else {
     local $SIG{__DIE__};
     my $loaded = eval {
+      local @INC = @INC;
+      pop @INC if $INC[-1] eq '.';
       ++$attempted_to_load{$file};
       require $file;
       return 1;
@@ -1923,6 +1957,10 @@ sub write_multi {
   # translate to ImgRaw
   my $index = 1;
   for my $img (@images) {
+    unless (ref $img && Scalar::Util::blessed($img) && $img->isa("Imager")) {
+      $class->_set_error("write_multi: image $index is not an Imager image object");
+      return;
+    }
     unless ($img->_valid_image("write_multi")) {
       $class->_set_error($img->errstr . " (image $index)");
       return;
@@ -2374,8 +2412,12 @@ sub transform {
 
   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
     if (!$I2P) {
-      eval ("use Affix::Infix2Postfix;");
-      print $@;
+      {
+       local @INC = @INC;
+       pop @INC if $INC[-1] eq '.';
+       eval ("use Affix::Infix2Postfix;");
+      }
+
       if ( $@ ) {
        $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.'; 
        return undef;
@@ -2888,8 +2930,14 @@ sub arc {
          return;
        }
       }
-      i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
-                    $opts{'d2'}, $opts{fill}{fill});
+      if ($opts{d1} == 0 && $opts{d2} == 361) {
+       i_circle_aa_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
+                        $opts{fill}{fill});
+      }
+      else {
+       i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
+                      $opts{'d2'}, $opts{fill}{fill});
+      }
     }
     elsif ($opts{filled}) {
       my $color = _color($opts{'color'});
@@ -3052,6 +3100,8 @@ sub polygon {
     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
   }
 
+  my $mode = _first($opts{mode}, 0);
+
   if ($opts{'fill'}) {
     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
       # assume it's a hash ref
@@ -3061,21 +3111,86 @@ sub polygon {
         return undef;
       }
     }
-    i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, 
-                    $opts{'fill'}{'fill'});
+    unless (i_poly_aa_cfill_m($self->{IMG}, $opts{'x'}, $opts{'y'},
+                             $mode, $opts{'fill'}{'fill'})) {
+      return $self->_set_error($self->_error_as_msg);
+    }
   }
   else {
     my $color = _color($opts{'color'});
     unless ($color) { 
       $self->{ERRSTR} = $Imager::ERRSTR; 
-      return; 
+      return;
+    }
+    unless (i_poly_aa_m($self->{IMG}, $opts{'x'}, $opts{'y'}, $mode, $color)) {
+      return $self->_set_error($self->_error_as_msg);
     }
-    i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
   }
 
   return $self;
 }
 
+sub polypolygon {
+  my ($self, %opts) = @_;
+
+  $self->_valid_image("polypolygon")
+    or return;
+
+  my $points = $opts{points};
+  $points
+    or return $self->_set_error("polypolygon: missing required points");
+
+  my $mode = _first($opts{mode}, "evenodd");
+
+  if ($opts{filled}) {
+    my $color = _color(_first($opts{color}, [ 0, 0, 0, 0 ]))
+      or return $self->_set_error($Imager::ERRSTR);
+
+    i_poly_poly_aa($self->{IMG}, $points, $mode, $color)
+      or return $self->_set_error($self->_error_as_msg);
+  }
+  elsif ($opts{fill}) {
+    my $fill = $opts{fill};
+    $self->_valid_fill($fill, "polypolygon")
+      or return;
+
+    i_poly_poly_aa_cfill($self->{IMG}, $points, $mode, $fill->{fill})
+      or return $self->_set_error($self->_error_as_msg);
+  }
+  else {
+    my $color = _color(_first($opts{color}, [ 0, 0, 0, 255 ]))
+      or return $self->_set_error($Imager::ERRSTR);
+
+    my $rimg = $self->{IMG};
+
+    if (_first($opts{aa}, 1)) {
+      for my $poly (@$points) {
+       my $xp = $poly->[0];
+       my $yp = $poly->[1];
+       for my $i (0 .. $#$xp - 1) {
+         i_line_aa($rimg, $xp->[$i], $yp->[$i], $xp->[$i+1], $yp->[$i+1],
+                   $color, 0);
+       }
+       i_line_aa($rimg, $xp->[$#$xp], $yp->[$#$yp], $xp->[0], $yp->[0],
+                 $color, 0);
+      }
+    }
+    else {
+      for my $poly (@$points) {
+       my $xp = $poly->[0];
+       my $yp = $poly->[1];
+       for my $i (0 .. $#$xp - 1) {
+         i_line($rimg, $xp->[$i], $yp->[$i], $xp->[$i+1], $yp->[$i+1],
+                $color, 0);
+       }
+       i_line($rimg, $xp->[$#$xp], $yp->[$#$yp], $xp->[0], $yp->[0],
+              $color, 0);
+      }
+    }
+  }
+
+  return $self;
+}
 
 # this the multipoint bezier curve
 # this is here more for testing that actual usage since
@@ -3826,6 +3941,37 @@ sub getchannels {
   return i_img_getchannels($self->{IMG});
 }
 
+my @model_names = qw(unknown gray graya rgb rgba);
+
+sub colormodel {
+  my ($self, %opts) = @_;
+
+  $self->_valid_image("colormodel")
+    or return;
+
+  my $model = i_img_color_model($self->{IMG});
+
+  return $opts{numeric} ? $model : $model_names[$model];
+}
+
+sub colorchannels {
+  my ($self) = @_;
+
+  $self->_valid_image("colorchannels")
+    or return;
+
+  return i_img_color_channels($self->{IMG});
+}
+
+sub alphachannel {
+  my ($self) = @_;
+
+  $self->_valid_image("alphachannel")
+    or return;
+
+  return scalar(i_img_alpha_channel($self->{IMG}));
+}
+
 # Get channel mask
 
 sub getmask {
@@ -4081,7 +4227,7 @@ sub _set_error {
 
 # Default guess for the type of an image from extension
 
-my @simple_types = qw(png tga gif raw ico cur xpm mng jng ilbm pcx psd eps);
+my @simple_types = qw(png tga gif raw ico cur xpm mng jng ilbm pcx psd eps webp xwd xpm dng ras);
 
 my %ext_types =
   (
@@ -4116,6 +4262,15 @@ sub def_guess_type {
   return $type;
 }
 
+sub add_type_extensions {
+  my ($class, $type, @exts) = @_;
+
+  for my $ext (@exts) {
+    exists $ext_types{lc $ext} or $ext_types{lc $ext} = lc $type;
+  }
+  1;
+}
+
 sub combines {
   return @combine_types;
 }
@@ -4190,7 +4345,8 @@ sub parseiptc {
 }
 
 sub Inline {
-  my ($lang) = @_;
+  # Inline added a new argument at the beginning
+  my $lang = $_[-1];
 
   $lang eq 'C'
     or die "Only C language supported";
@@ -4209,6 +4365,8 @@ sub preload {
   # - something for Module::ScanDeps to analyze
   # https://rt.cpan.org/Ticket/Display.html?id=6566
   local $@;
+  local @INC = @INC;
+  pop @INC if $INC[-1] eq '.';
   eval { require Imager::File::GIF };
   eval { require Imager::File::JPEG };
   eval { require Imager::File::PNG };
@@ -4218,6 +4376,9 @@ sub preload {
   eval { require Imager::Font::W32 };
   eval { require Imager::Font::FT2 };
   eval { require Imager::Font::T1 };
+  eval { require Imager::Color::Table };
+
+  1;
 }
 
 package Imager::IO;
@@ -4589,9 +4750,16 @@ paletted image
 
 addtag() -  L<Imager::ImageTypes/addtag()> - add image tags
 
+add_type_extensions() -
+L<Imager::Files/add_type_extensions($type, $ext, ...)> - add extensions for
+new image file types.
+
 align_string() - L<Imager::Draw/align_string()> - draw text aligned on a
 point
 
+alphachannel() - L<Imager::ImageTypes/alphachannel()> - return the
+channel index of the alpha channel (if any).
+
 arc() - L<Imager::Draw/arc()> - draw a filled arc
 
 bits() - L<Imager::ImageTypes/bits()> - number of bits per sample for the
@@ -4606,9 +4774,15 @@ circle() - L<Imager::Draw/circle()> - draw a filled circle
 close_log() - L<Imager::ImageTypes/close_log()> - close the Imager
 debugging log.
 
+colorchannels() - L<Imager::ImageTypes/colorchannels()> - the number
+of channels used for color.
+
 colorcount() - L<Imager::ImageTypes/colorcount()> - the number of
 colors in an image's palette (paletted images only)
 
+colormodel() - L<Imager::ImageTypes/colorcount()> - how color is
+represented.
+
 combine() - L<Imager::Transformations/combine()> - combine channels
 from one or more images.
 
@@ -4740,6 +4914,8 @@ polygon() - L<Imager::Draw/polygon()>
 
 polyline() - L<Imager::Draw/polyline()>
 
+polypolygon() - L<Imager::Draw/polypolygon()>
+
 preload() - L<Imager::Files/preload()>
 
 read() - L<Imager::Files/read()> - read a single image from an image file