]> git.imager.perl.org - imager.git/blobdiff - Imager.pm
i_init_tt() has only been used internally to font.c, make it static
[imager.git] / Imager.pm
index d03638be3dc93f2e3e1d2063995962ef155e419e..e097fe8284aeca55f88268ddfc1be5e7dbb1fbf0 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -148,16 +148,9 @@ BEGIN {
   if ($ex_version < 5.57) {
     @ISA = qw(Exporter);
   }
   if ($ex_version < 5.57) {
     @ISA = qw(Exporter);
   }
-  $VERSION = '0.87';
-  eval {
-    require XSLoader;
-    XSLoader::load(Imager => $VERSION);
-    1;
-  } or do {
-    require DynaLoader;
-    push @ISA, 'DynaLoader';
-    bootstrap Imager $VERSION;
-  }
+  $VERSION = '0.91';
+  require XSLoader;
+  XSLoader::load(Imager => $VERSION);
 }
 
 my %formats_low;
 }
 
 my %formats_low;
@@ -629,11 +622,13 @@ sub _combine {
 }
 
 sub _valid_image {
 }
 
 sub _valid_image {
-  my ($self) = @_;
+  my ($self, $method) = @_;
 
   $self->{IMG} and return 1;
 
 
   $self->{IMG} and return 1;
 
-  $self->_set_error('empty input image');
+  my $msg = 'empty input image';
+  $msg = "$method: $msg" if $method;
+  $self->_set_error($msg);
 
   return;
 }
 
   return;
 }
@@ -918,8 +913,8 @@ sub img_set {
     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
   }
   else {
     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
   }
   else {
-    $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
-                                     $hsh{'channels'});
+    $self->{IMG}= i_img_8_new($hsh{'xsize'}, $hsh{'ysize'},
+                             $hsh{'channels'});
   }
 
   unless ($self->{IMG}) {
   }
 
   unless ($self->{IMG}) {
@@ -1610,10 +1605,11 @@ sub _load_file {
       return 1;
     }
     else {
       return 1;
     }
     else {
-      my $work = $@ || "Unknown error loading $file";
+      my $work = $@ || "Unknown error";
       chomp $work;
       $work =~ s/\n?Compilation failed in require at .*Imager\.pm line .*\z//m;
       $work =~ s/\n/\\n/g;
       chomp $work;
       $work =~ s/\n?Compilation failed in require at .*Imager\.pm line .*\z//m;
       $work =~ s/\n/\\n/g;
+      $work =~ s/\s*\.?\z/ loading $file/;
       $file_load_errors{$file} = $work;
       $$error = $work;
       return 0;
       $file_load_errors{$file} = $work;
       $$error = $work;
       return 0;
@@ -2636,7 +2632,7 @@ sub rotate {
     }
   }
   elsif (defined $opts{radians} || defined $opts{degrees}) {
     }
   }
   elsif (defined $opts{radians} || defined $opts{degrees}) {
-    my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
+    my $amount = $opts{radians} || $opts{degrees} * 3.14159265358979 / 180;
 
     my $back = $opts{back};
     my $result = Imager->new;
 
     my $back = $opts{back};
     my $result = Imager->new;
@@ -3117,6 +3113,9 @@ sub flood_fill {
 sub setpixel {
   my ($self, %opts) = @_;
 
 sub setpixel {
   my ($self, %opts) = @_;
 
+  $self->_valid_image("setpixel")
+    or return;
+
   my $color = $opts{color};
   unless (defined $color) {
     $color = $self->{fg};
   my $color = $opts{color};
   unless (defined $color) {
     $color = $self->{fg};
@@ -3124,36 +3123,53 @@ sub setpixel {
   }
 
   unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) {
   }
 
   unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) {
-    $color = _color($color)
-      or return undef;
+    unless ($color = _color($color, 'setpixel')) {
+      $self->_set_error("setpixel: " . Imager->errstr);
+      return;
+    }
   }
 
   unless (exists $opts{'x'} && exists $opts{'y'}) {
   }
 
   unless (exists $opts{'x'} && exists $opts{'y'}) {
-    $self->{ERRSTR} = 'missing x and y parameters';
-    return undef;
+    $self->_set_error('setpixel: missing x or y parameter');
+    return;
   }
 
   my $x = $opts{'x'};
   my $y = $opts{'y'};
   }
 
   my $x = $opts{'x'};
   my $y = $opts{'y'};
-  if (ref $x && ref $y) {
-    unless (@$x == @$y) {
-      $self->{ERRSTR} = 'length of x and y mismatch';
+  if (ref $x || ref $y) {
+    $x = ref $x ? $x : [ $x ];
+    $y = ref $y ? $y : [ $y ];
+    unless (@$x) {
+      $self->_set_error("setpixel: x is a reference to an empty array");
       return;
     }
       return;
     }
+    unless (@$y) {
+      $self->_set_error("setpixel: y is a reference to an empty array");
+      return;
+    }
+
+    # make both the same length, replicating the last element
+    if (@$x < @$y) {
+      $x = [ @$x, ($x->[-1]) x (@$y - @$x) ];
+    }
+    elsif (@$y < @$x) {
+      $y = [ @$y, ($y->[-1]) x (@$x - @$y) ];
+    }
+
     my $set = 0;
     if ($color->isa('Imager::Color')) {
     my $set = 0;
     if ($color->isa('Imager::Color')) {
-      for my $i (0..$#{$opts{'x'}}) {
+      for my $i (0..$#$x) {
         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color)
          or ++$set;
       }
     }
     else {
         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color)
          or ++$set;
       }
     }
     else {
-      for my $i (0..$#{$opts{'x'}}) {
+      for my $i (0..$#$x) {
         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color)
          or ++$set;
       }
     }
         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color)
          or ++$set;
       }
     }
-    $set or return;
+
     return $set;
   }
   else {
     return $set;
   }
   else {
@@ -3167,7 +3183,7 @@ sub setpixel {
     }
   }
 
     }
   }
 
-  $self;
+  return $self;
 }
 
 sub getpixel {
 }
 
 sub getpixel {
@@ -3175,41 +3191,66 @@ sub getpixel {
 
   my %opts = ( "type"=>'8bit', @_);
 
 
   my %opts = ( "type"=>'8bit', @_);
 
+  $self->_valid_image("getpixel")
+    or return;
+
   unless (exists $opts{'x'} && exists $opts{'y'}) {
   unless (exists $opts{'x'} && exists $opts{'y'}) {
-    $self->{ERRSTR} = 'missing x and y parameters';
-    return undef;
+    $self->_set_error('getpixel: missing x or y parameter');
+    return;
   }
 
   my $x = $opts{'x'};
   my $y = $opts{'y'};
   }
 
   my $x = $opts{'x'};
   my $y = $opts{'y'};
-  if (ref $x && ref $y) {
-    unless (@$x == @$y) {
-      $self->{ERRSTR} = 'length of x and y mismatch';
-      return undef;
+  my $type = $opts{'type'};
+  if (ref $x || ref $y) {
+    $x = ref $x ? $x : [ $x ];
+    $y = ref $y ? $y : [ $y ];
+    unless (@$x) {
+      $self->_set_error("getpixel: x is a reference to an empty array");
+      return;
+    }
+    unless (@$y) {
+      $self->_set_error("getpixel: y is a reference to an empty array");
+      return;
+    }
+
+    # make both the same length, replicating the last element
+    if (@$x < @$y) {
+      $x = [ @$x, ($x->[-1]) x (@$y - @$x) ];
     }
     }
+    elsif (@$y < @$x) {
+      $y = [ @$y, ($y->[-1]) x (@$x - @$y) ];
+    }
+
     my @result;
     my @result;
-    if ($opts{"type"} eq '8bit') {
-      for my $i (0..$#{$opts{'x'}}) {
+    if ($type eq '8bit') {
+      for my $i (0..$#$x) {
         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
       }
     }
         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
       }
     }
-    else {
-      for my $i (0..$#{$opts{'x'}}) {
+    elsif ($type eq 'float' || $type eq 'double') {
+      for my $i (0..$#$x) {
         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
       }
     }
         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
       }
     }
+    else {
+      $self->_set_error("getpixel: type must be '8bit' or 'float'");
+      return;
+    }
     return wantarray ? @result : \@result;
   }
   else {
     return wantarray ? @result : \@result;
   }
   else {
-    if ($opts{"type"} eq '8bit') {
+    if ($type eq '8bit') {
       return i_get_pixel($self->{IMG}, $x, $y);
     }
       return i_get_pixel($self->{IMG}, $x, $y);
     }
-    else {
+    elsif ($type eq 'float' || $type eq 'double') {
       return i_gpixf($self->{IMG}, $x, $y);
     }
       return i_gpixf($self->{IMG}, $x, $y);
     }
+    else {
+      $self->_set_error("getpixel: type must be '8bit' or 'float'");
+      return;
+    }
   }
   }
-
-  $self;
 }
 
 sub getscanline {
 }
 
 sub getscanline {
@@ -3388,24 +3429,44 @@ sub setsamples {
     return;
   }
 
     return;
   }
 
-  unless(defined $opts{data} && ref $opts{data}) {
-    $self->_set_error('setsamples: data parameter missing or invalid');
+  my $data = $opts{data};
+  unless(defined $data) {
+    $self->_set_error('setsamples: data parameter missing');
     return;
   }
 
     return;
   }
 
-  unless ($opts{type} && $opts{type} =~ /^(\d+)bit$/) {
-    $self->_set_error('setsamples: type parameter missing or invalid');
-    return;
+  my $type = $opts{type};
+  defined $type or $type = '8bit';
+
+  my $width = defined $opts{width} ? $opts{width}
+    : $self->getwidth() - $opts{x};
+
+  my $count;
+  if ($type eq '8bit') {
+    $count = i_psamp($self->{IMG}, $opts{x}, $opts{y}, $opts{channels},
+                    $data, $opts{offset}, $width);
+  }
+  elsif ($type eq 'float') {
+    $count = i_psampf($self->{IMG}, $opts{x}, $opts{y}, $opts{channels},
+                     $data, $opts{offset}, $width);
   }
   }
-  my $bits = $1;
+  elsif ($type =~ /^([0-9]+)bit$/) {
+    my $bits = $1;
+
+    unless (ref $data) {
+      $self->_set_error("setsamples: data must be an array ref for type not 8bit or float");
+      return;
+    }
 
 
-  unless (defined $opts{width}) {
-    $opts{width} = $self->getwidth() - $opts{x};
+    $count = i_psamp_bits($self->{IMG}, $opts{x}, $opts{y}, $bits,
+                         $opts{channels}, $data, $opts{offset}, 
+                         $width);
+  }
+  else {
+    $self->_set_error('setsamples: type parameter invalid');
+    return;
   }
 
   }
 
-  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;
   unless (defined $count) {
     $self->_set_error(Imager->_error_as_msg);
     return;
@@ -3839,6 +3900,41 @@ sub get_file_limits {
   i_get_image_file_limits();
 }
 
   i_get_image_file_limits();
 }
 
+my @check_args = qw(width height channels sample_size);
+
+sub check_file_limits {
+  my $class = shift;
+
+  my %opts =
+    (
+     channels => 3,
+     sample_size => 1,
+     @_,
+    );
+
+  if ($opts{sample_size} && $opts{sample_size} eq 'float') {
+    $opts{sample_size} = length(pack("d", 0));
+  }
+
+  for my $name (@check_args) {
+    unless (defined $opts{$name}) {
+      $class->_set_error("check_file_limits: $name must be defined");
+      return;
+    }
+    unless ($opts{$name} == int($opts{$name})) {
+      $class->_set_error("check_file_limits: $name must be a positive integer");
+      return;
+    }
+  }
+
+  my $result = i_int_check_image_file_limits(@opts{@check_args});
+  unless ($result) {
+    $class->_set_error($class->_error_as_msg());
+  }
+
+  return $result;
+}
+
 # Shortcuts that can be exported
 
 sub newcolor { Imager::Color->new(@_); }
 # Shortcuts that can be exported
 
 sub newcolor { Imager::Color->new(@_); }
@@ -4268,6 +4364,10 @@ L<Imager::Inline> - using Imager's C API from Inline::C
 
 L<Imager::ExtUtils> - tools to get access to Imager's C API.
 
 
 L<Imager::ExtUtils> - tools to get access to Imager's C API.
 
+=item *
+
+L<Imager::Security> - brief security notes.
+
 =back
 
 =head2 Basic Overview
 =back
 
 =head2 Basic Overview
@@ -4337,6 +4437,8 @@ image
 
 box() - L<Imager::Draw/box()> - draw a filled or outline box.
 
 
 box() - L<Imager::Draw/box()> - draw a filled or outline box.
 
+check_file_limits() - L<Imager::Files/check_file_limits()>
+
 circle() - L<Imager::Draw/circle()> - draw a filled circle
 
 close_log() - L<Imager::ImageTypes/close_log()> - close the Imager
 circle() - L<Imager::Draw/circle()> - draw a filled circle
 
 close_log() - L<Imager::ImageTypes/close_log()> - close the Imager
@@ -4396,7 +4498,7 @@ getcolorusage() - L<Imager::ImageTypes/getcolorusage()>
 
 getcolorusagehash() - L<Imager::ImageTypes/getcolorusagehash()>
 
 
 getcolorusagehash() - L<Imager::ImageTypes/getcolorusagehash()>
 
-get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
+get_file_limits() - L<Imager::Files/get_file_limits()>
 
 getheight() - L<Imager::ImageTypes/getheight()> - height of the image in
 pixels
 
 getheight() - L<Imager::ImageTypes/getheight()> - height of the image in
 pixels
@@ -4437,7 +4539,7 @@ log.
 make_palette() - L<Imager::ImageTypes/make_palette()> - produce a
 color palette from one or more input images.
 
 make_palette() - L<Imager::ImageTypes/make_palette()> - produce a
 color palette from one or more input images.
 
-map() - L<Imager::Transformations/"Color Mappings"> - remap color
+map() - L<Imager::Transformations/map()> - remap color
 channel values
 
 masked() -  L<Imager::ImageTypes/masked()> - make a masked image
 channel values
 
 masked() -  L<Imager::ImageTypes/masked()> - make a masked image
@@ -4460,7 +4562,7 @@ newfont() - L<Imager::Handy/newfont()>
 
 NF() - L<Imager::Handy/NF()>
 
 
 NF() - L<Imager::Handy/NF()>
 
-open() - L<Imager::Files> - an alias for read()
+open() - L<Imager::Files/read()> - an alias for read()
 
 open_log() - L<Imager::ImageTypes/open_log()> - open the debug log.
 
 
 open_log() - L<Imager::ImageTypes/open_log()> - open the debug log.
 
@@ -4508,7 +4610,7 @@ scaleY() - L<Imager::Transformations/scaleY()>
 setcolors() - L<Imager::ImageTypes/setcolors()> - set palette colors
 in a paletted image
 
 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">
+set_file_limits() - L<Imager::Files/set_file_limits()>
 
 setmask() - L<Imager::ImageTypes/setmask()>
 
 
 setmask() - L<Imager::ImageTypes/setmask()>
 
@@ -4687,6 +4789,8 @@ saving an image - L<Imager::Files>
 
 scaling - L<Imager::Transformations/scale()>
 
 
 scaling - L<Imager::Transformations/scale()>
 
+security - L<Imager::Security>
+
 SGI files - L<Imager::Files/"SGI (RGB, BW)">
 
 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
 SGI files - L<Imager::Files/"SGI (RGB, BW)">
 
 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>