- the parameters to crop() weren't handled correctly in most

          cases other than supplying left,top,right,bottom.
        - clarified the documentation for crop() providing more detail
          and more examples
        - the edges of the cropped area are now cropped against the
          edges of the source image
        - cropping to zero width/height is treated as an error (no
          image is returned and $src->errstr has a message)
          Resolves https://rt.cpan.org/Ticket/Display.html?id=7581
        - built 0.43_01 for testing

diff --git a/Changes b/Changes
index dd8af93395f44b9799dd77018ecde6a0c8b439dc..8c26ad1e7b05898797139f994dbac6912c44b63a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -739,14 +739,14 @@ Revision history for Perl extension Imager.
        - document the constants that transform2() defines
        - skip the right number of tests when FT2 isn't available
        - This version pushed to CPAN because of skip problem in FT2 test.
        - document the constants that transform2() defines
        - skip the right number of tests when FT2 isn't available
        - This version pushed to CPAN because of skip problem in FT2 test.

+
+0.43_01 Fri 8 Oct 2004

        - only call FT_Get_Postscript_Name() on FT 2.0.6 and later
        - put the IM_LIBPATH and IM_INCPATH values first in the search
          path so the builder gets their local versions if desired rather
          than the system versions they might be trying to avoid
        - document the exp() and log() transform2() functions
        - document the constants normally set by transform2().
        - only call FT_Get_Postscript_Name() on FT 2.0.6 and later
        - put the IM_LIBPATH and IM_INCPATH values first in the search
          path so the builder gets their local versions if desired rather
          than the system versions they might be trying to avoid
        - document the exp() and log() transform2() functions
        - document the constants normally set by transform2().

-
-0.44

        - refer the user to appropriate documents in the example in 
          Imager.pm
        - change the list of documents in Imager.pm to move the document 
        - refer the user to appropriate documents in the example in 
          Imager.pm
        - change the list of documents in Imager.pm to move the document 


@@ -833,6 +833,16 @@ Revision history for Perl extension Imager.
         - the image resulting from a crop is now the same type as the
           source image (paletted vs direct, bits/sample)
           Resolves https://rt.cpan.org/Ticket/Display.html?id=7578
         - the image resulting from a crop is now the same type as the
           source image (paletted vs direct, bits/sample)
           Resolves https://rt.cpan.org/Ticket/Display.html?id=7578

+        - the parameters to crop() weren't handled correctly in most 
+          cases other than supplying left,top,right,bottom.
+        - clarified the documentation for crop() providing more detail
+          and more examples
+        - the edges of the cropped area are now cropped against the 
+          edges of the source image
+        - cropping to zero width/height is treated as an error (no
+          image is returned and $src->errstr has a message)
+          Resolves https://rt.cpan.org/Ticket/Display.html?id=7581
+        - built 0.43_01 for testing

 
 =================================================================
 
 
 =================================================================
 

diff --git a/Imager.pm b/Imager.pm
index d8df816ab423609ef050f1bee86c7d7c1afae890..34a6e9aab9819ea81cfe72e1afc127b3cdb8b990 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -147,7 +147,7 @@ BEGIN {
   require Exporter;
   require DynaLoader;
 
   require Exporter;
   require DynaLoader;
 

-  $VERSION = '0.43';
+  $VERSION = '0.43_01';

   @ISA = qw(Exporter DynaLoader);
   bootstrap Imager $VERSION;
 }
   @ISA = qw(Exporter DynaLoader);
   bootstrap Imager $VERSION;
 }


@@ -573,41 +573,77 @@ sub paste {
 sub crop {
   my $self=shift;
   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 sub crop {
   my $self=shift;
   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }

-  my %hsh=(left=>0,right=>$self->getwidth(),top=>0,bottom=>$self->getheight(),@_);

 
 

-  my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
-                               @hsh{qw(left right bottom top)});
-  $l=0 if not defined $l;
-  $t=0 if not defined $t;
+  
+  my %hsh=@_;

 
 

-  $r||=$l+delete $hsh{'width'}    if defined $l and exists $hsh{'width'};
-  $b||=$t+delete $hsh{'height'}   if defined $t and exists $hsh{'height'};
-  $l||=$r-delete $hsh{'width'}    if defined $r and exists $hsh{'width'};
-  $t||=$b-delete $hsh{'height'}   if defined $b and exists $hsh{'height'};
+  my ($w, $h, $l, $r, $b, $t) =
+    @hsh{qw(width height left right bottom top)};

 
 

-  $r=$self->getwidth if not defined $r;
-  $b=$self->getheight if not defined $b;
+  # work through the various possibilities
+  if (defined $l) {
+    if (defined $w) {
+      $r = $l + $w;
+    }
+    elsif (!defined $r) {
+      $r = $self->getwidth;
+    }
+  }
+  elsif (defined $r) {
+    if (defined $w) {
+      $l = $r - $w;
+    }
+    else {
+      $l = 0;
+    }
+  }
+  elsif (defined $w) {
+    $l = int(0.5+($self->getwidth()-$w)/2);
+    $r = $l + $w;
+  }
+  else {
+    $l = 0;
+    $r = $self->getwidth;
+  }
+  if (defined $t) {
+    if (defined $h) {
+      $b = $t + $h;
+    }
+    elsif (!defined $b) {
+      $b = $self->getheight;
+    }
+  }
+  elsif (defined $b) {
+    if (defined $h) {
+      $t = $b - $h;
+    }
+    else {
+      $t = 0;
+    }
+  }
+  elsif (defined $h) {
+    $t=int(0.5+($self->getheight()-$h)/2);
+    $b=$t+$h;
+  }
+  else {
+    $t = 0;
+    $b = $self->getheight;
+  }

 
   ($l,$r)=($r,$l) if $l>$r;
   ($t,$b)=($b,$t) if $t>$b;
 
 
   ($l,$r)=($r,$l) if $l>$r;
   ($t,$b)=($b,$t) if $t>$b;
 

-  if ($hsh{'width'}) {
-    $l=int(0.5+($w-$hsh{'width'})/2);
-    $r=$l+$hsh{'width'};
-  } else {
-    $hsh{'width'}=$r-$l;
-  }
-  if ($hsh{'height'}) {
-    $b=int(0.5+($h-$hsh{'height'})/2);
-    $t=$h+$hsh{'height'};
-  } else {
-    $hsh{'height'}=$b-$t;
-  }
+  $l < 0 and $l = 0;
+  $r > $self->getwidth and $r = $self->getwidth;
+  $t < 0 and $t = 0;
+  $b > $self->getheight and $b = $self->getheight;

 
 

-#    print "l=$l, r=$r, h=$hsh{'width'}\n";
-#    print "t=$t, b=$b, w=$hsh{'height'}\n";
+  if ($l == $r || $t == $b) {
+    $self->_set_error("resulting image would have no content");
+    return;
+  }

 
 

-  my $dst = $self->_sametype(xsize=>$hsh{width}, ysize=>$hsh{height});
+  my $dst = $self->_sametype(xsize=>$r-$l, ysize=>$b-$t);

 
   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
   return $dst;
 
   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
   return $dst;

diff --git a/image.c b/image.c
index 86aa3f63eb2c8bbf3c9579ed93cde1e5f35260db..4f7d93eb4a626f74bcd7e8548ac8c64338f02bbb 100644 (file)
--- a/image.c
+++ b/image.c
@@ -2069,14 +2069,7 @@ int i_free_gen_write_data(i_gen_write_data *info, int flush)
 /*
 =item i_test_format_probe(io_glue *data, int length)
 
 /*
 =item i_test_format_probe(io_glue *data, int length)
 

-Cleans up the write buffer.
-
-Will flush any left-over data if I<flush> is non-zero.
-
-Returns non-zero if flush is zero or if info->cb() returns non-zero.
-
-Return zero only if flush is non-zero and info->cb() returns zero.
-ie. if it fails.
+Check the beginning of the supplied file for a 'magic number'

 
 =cut
 */
 
 =cut
 */

diff --git a/lib/Imager/Transformations.pod b/lib/Imager/Transformations.pod
index 767d33def22e7962789cd26cef3cf09a6f01967b..0867179c1f9887f273121bc2e648b9f7d85f7656 100644 (file)
--- a/lib/Imager/Transformations.pod
+++ b/lib/Imager/Transformations.pod
@@ -110,10 +110,18 @@ crop are the edges of the area that you want in the returned image,
 where the right and bottom edges are non-inclusive.  If a parameter is
 omitted a default is used instead.
 
 where the right and bottom edges are non-inclusive.  If a parameter is
 omitted a default is used instead.
 

-  # the first two produce the same image
+  # these produce the same image

   $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100); 
   $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90);
   $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100); 
   $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90);

-  $newimg = $img->crop(left=>50, right=>100); # top 
+  $newimg = $img->crop(right=>100, bottom=>100, width=>50, height=>90);
+
+  # and the following produce the same image
+  $newimg = $img->crop(left=>50, right=>100);
+  $newimg = $img->crop(left=>50, right=>100, top=>0, 
+                       bottom=>$img->getheight);
+
+  # grab the top left corner of the image
+  $newimg = $img->crop(right=>50, bottom=>50);

 
 You can also specify width and height parameters which will produce a
 new image cropped from the center of the input image, with the given
 
 You can also specify width and height parameters which will produce a
 new image cropped from the center of the input image, with the given


@@ -121,8 +129,21 @@ width and height.
 
   $newimg = $img->crop(width=>50, height=>50);
 
 
   $newimg = $img->crop(width=>50, height=>50);
 

-The width and height parameters take precedence over the left/right
-and top/bottom parameters respectively.
+If you supply C<left>, C<width> and C<right> values, the C<right>
+value will be ignored.  If you supply C<top>, C<height> and C<bottom>
+values, the C<bottom> value will be ignored.
+
+The edges of the cropped area default to the edges of the source
+image, for example:
+
+  # a vertical bar from the middle from top to bottom
+  $newimg = $img->crop(width=>50);
+
+  # the right half
+  $newimg = $img->crop(left=>$img->getwidth() / 2);
+
+If the resulting image would have zero width or height then crop()
+returns false and $img->errstr is an appropriate error message.

 
 =item rotate
 
 
 =item rotate
 

diff --git a/t/t65crop.t b/t/t65crop.t
index 40d32c1a3f842a4fb1935703427c38d36ed561a5..3413655fb6cad88298b74b425791337b89e4b8f9 100644 (file)
--- a/t/t65crop.t
+++ b/t/t65crop.t
@@ -3,7 +3,7 @@ use strict;
 require "t/testtools.pl";
 use Imager;
 
 require "t/testtools.pl";
 use Imager;
 

-print "1..10\n";
+print "1..58\n";

 
 #$Imager::DEBUG=1;
 
 
 #$Imager::DEBUG=1;
 


@@ -40,3 +40,118 @@ else {
   my $out = $src->crop(left=>10, right=>40, top=>10, bottom=>40);
   isx($out->type, 'paletted', 'check output type');
 }
   my $out = $src->crop(left=>10, right=>40, top=>10, bottom=>40);
   isx($out->type, 'paletted', 'check output type');
 }

+
+{ # https://rt.cpan.org/Ticket/Display.html?id=7581
+  # crop() documentation says width/height takes precedence, but is unclear
+  # from looking at the existing code, setting width/height will go from
+  # the left of the image, even if left/top are provided, despite the
+  # sample in the docs
+  # Let's make sure that things happen as documented
+  my $src = test_oo_img();
+  # make sure we get what we want
+  isx($src->getwidth, 150, "src width");
+  isx($src->getheight, 150, "src height");
+
+  # the test data is: 
+  #  - description
+  #  - hash ref containing args to crop()
+  #  - expected left, top, right, bottom values
+  # we call crop using the given arguments then call it using the 
+  # hopefully stable left/top/right/bottom/arguments
+  # this is kind of lame, but I don't want to include a rewritten
+  # crop in this file
+  my @tests = 
+    (
+     [ 
+      "basic",
+      { left=>10, top=>10, right=>70, bottom=>80 },
+      10, 10, 70, 80,
+     ],
+     [
+      "middle",
+      { width=>50, height=>50 },
+      50, 50, 100, 100,
+     ],
+     [
+      "lefttop",
+      { left=>20, width=>70, top=>30, height=>90 },
+      20, 30, 90, 120,
+     ],
+     [
+      "bottomright",
+      { right=>140, width=>50, bottom=>130, height=>60 },
+      90, 70, 140, 130,
+     ],
+     [
+      "acrossmiddle",
+      { top=>40, bottom=>110 },
+      0, 40, 150, 110,
+     ],
+     [
+      "downmiddle",
+      { left=>40, right=>110 },
+      40, 0, 110, 150,
+     ],
+     [
+      "rightside",
+      { left=>80, },
+      80, 0, 150, 150,
+     ],
+     [
+      "leftside",
+      { right=>40 },
+      0, 0, 40, 150,
+     ],
+     [
+      "topside",
+      { bottom=>40, },
+      0, 0, 150, 40,
+     ],
+     [
+      "bottomside",
+      { top=>90 },
+      0, 90, 150, 150,
+     ],
+     [
+      "overright",
+      { left=>100, right=>200 },
+      100, 0, 150, 150,
+     ],
+     [
+      "overtop",
+      { bottom=>50, height=>70 },
+      0, 0, 150, 50,
+     ],
+     [
+      "overleft",
+      { right=>30, width=>60 },
+      0, 0, 30, 150,
+     ],
+     [ 
+      "overbottom",
+      { top=>120, height=>60 },
+      0, 120, 150, 150,
+     ],
+    );
+  for my $test (@tests) {
+    my ($desc, $args, $left, $top, $right, $bottom) = @$test;
+    my $out = $src->crop(%$args);
+    okx($out, "got output for $desc");
+    my $cmp = $src->crop(left=>$left, top=>$top, right=>$right, bottom=>$bottom);
+    okx($cmp, "got cmp for $desc");
+    # make sure they're the same
+    my $diff = Imager::i_img_diff($out->{IMG}, $cmp->{IMG});
+    isx($diff, 0, "difference should be 0 for $desc");
+  }
+}
+{ # https://rt.cpan.org/Ticket/Display.html?id=7581
+  # previously we didn't check that the result had some pixels
+  # make sure we do
+  my $src = test_oo_img();
+  okx(!$src->crop(left=>50, right=>50), "nothing across");
+  matchx($src->errstr, qr/resulting image would have no content/,
+        "and message");
+  okx(!$src->crop(top=>60, bottom=>60), "nothing down");
+  matchx($src->errstr, qr/resulting image would have no content/,
+        "and message");
+}

diff --git a/t/testtools.pl b/t/testtools.pl
index e3082478a791c4793570f22083c95ce0eca40aca..9821c1a55d38885abfa518529829c0d6e60e3a6b 100644 (file)
--- a/t/testtools.pl
+++ b/t/testtools.pl
@@ -20,6 +20,14 @@ sub test_img {
   $img;
 }
 
   $img;
 }
 

+sub test_oo_img {
+  my $raw = test_img();
+  my $img = Imager->new;
+  $img->{IMG} = $raw;
+
+  $img;
+}
+

 sub skipn {
   my ($testnum, $count, $why) = @_;
   
 sub skipn {
   my ($testnum, $count, $why) = @_;