r67476 - in /branches/upstream/libimager-perl/current: ./ JPEG/ lib/Imager/ lib/Imager/Color/ samples/ t/ testimg/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Tue Jan 18 16:38:08 UTC 2011
Author: periapt-guest
Date: Tue Jan 18 16:37:49 2011
New Revision: 67476
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=67476
Log:
[svn-upgrade] new version libimager-perl (0.80+dfsg)
Added:
branches/upstream/libimager-perl/current/testimg/gradbad.ggr
branches/upstream/libimager-perl/current/testimg/gradbad2.ggr
Modified:
branches/upstream/libimager-perl/current/Changes
branches/upstream/libimager-perl/current/Imager.pm
branches/upstream/libimager-perl/current/Imager.xs
branches/upstream/libimager-perl/current/JPEG/imexif.c
branches/upstream/libimager-perl/current/MANIFEST
branches/upstream/libimager-perl/current/META.yml
branches/upstream/libimager-perl/current/Makefile.PL
branches/upstream/libimager-perl/current/hlines.c
branches/upstream/libimager-perl/current/image.c
branches/upstream/libimager-perl/current/lib/Imager/Color/Float.pm
branches/upstream/libimager-perl/current/lib/Imager/Draw.pod
branches/upstream/libimager-perl/current/lib/Imager/Filters.pod
branches/upstream/libimager-perl/current/lib/Imager/Font.pm
branches/upstream/libimager-perl/current/lib/Imager/Fountain.pm
branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod
branches/upstream/libimager-perl/current/lib/Imager/Transformations.pod
branches/upstream/libimager-perl/current/lib/Imager/Tutorial.pod
branches/upstream/libimager-perl/current/samples/align-string.pl
branches/upstream/libimager-perl/current/samples/anaglyph.pl
branches/upstream/libimager-perl/current/samples/border.pl
branches/upstream/libimager-perl/current/samples/interleave.pl
branches/upstream/libimager-perl/current/samples/replace_color.pl
branches/upstream/libimager-perl/current/samples/samp-image.cgi
branches/upstream/libimager-perl/current/samples/samp-scale.cgi
branches/upstream/libimager-perl/current/samples/samp-tags.cgi
branches/upstream/libimager-perl/current/samples/slant_text.pl
branches/upstream/libimager-perl/current/samples/tk-photo.pl
branches/upstream/libimager-perl/current/t/t020masked.t
branches/upstream/libimager-perl/current/t/t15color.t
branches/upstream/libimager-perl/current/t/t40scale.t
branches/upstream/libimager-perl/current/t/t61filters.t
Modified: branches/upstream/libimager-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/Changes?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/Changes (original)
+++ branches/upstream/libimager-perl/current/Changes Tue Jan 18 16:37:49 2011
@@ -1,6 +1,29 @@
Imager release history. Older releases can be found in Changes.old
-Imager 0.79 - unreleased
+Imager 0.80 - 17 Jan 2011
+===========
+
+ - added coverage tests for Imager::Fountain and Imager::Color::Float
+
+ - Imager is now maintained in git
+ http://git.imager.perl.org/imager.git
+ git://git.imager.perl.org/imager.git
+
+Bug fixes:
+
+ - images with an translucent alpha channel were not scaled correctly
+ by the default (qtype=normal) scaling method.
+ https://rt.cpan.org/Public/Bug/Display.html?id=63922
+
+ - Imager::Color::Float now translates "#FFFFFF" to white instead of
+ just a little darker.
+
+ - make the default color map build algorithm "mediancut". This
+ changes the default color map builder for writing GIFs back to what
+ it was in 0.77, reverting a performance regression.
+ https://rt.cpan.org/Ticket/Display.html?id=64785
+
+Imager 0.79 - 10 Dec 2010
===========
- add Imager::Test to the POD coverage tests and document the missing
Modified: branches/upstream/libimager-perl/current/Imager.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/Imager.pm?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/Imager.pm (original)
+++ branches/upstream/libimager-perl/current/Imager.pm Tue Jan 18 16:37:49 2011
@@ -155,7 +155,7 @@
BEGIN {
require Exporter;
@ISA = qw(Exporter);
- $VERSION = '0.79';
+ $VERSION = '0.80';
eval {
require XSLoader;
XSLoader::load(Imager => $VERSION);
@@ -4036,7 +4036,7 @@
my $format;
# see Imager::Files for information on the read() method
- my $im = Imager->new(file=>$file)
+ my $img = Imager->new(file=>$file)
or die Imager->errstr();
$file =~ s/\.[^.]*$//;
Modified: branches/upstream/libimager-perl/current/Imager.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/Imager.xs?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/Imager.xs (original)
+++ branches/upstream/libimager-perl/current/Imager.xs Tue Jan 18 16:37:49 2011
@@ -641,7 +641,7 @@
}
}
}
- quant->make_colors = mc_addi;
+ quant->make_colors = mc_median_cut;
sv = hv_fetch(hv, "make_colors", 11, 0);
if (sv && *sv && (str = SvPV(*sv, len))) {
quant->make_colors =
Modified: branches/upstream/libimager-perl/current/JPEG/imexif.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/JPEG/imexif.c?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/JPEG/imexif.c (original)
+++ branches/upstream/libimager-perl/current/JPEG/imexif.c Tue Jan 18 16:37:49 2011
@@ -1580,7 +1580,7 @@
=head1 REVISION
-$Revision: 1814 $
-
-=cut
-*/
+$Revision$
+
+=cut
+*/
Modified: branches/upstream/libimager-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/MANIFEST?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/MANIFEST (original)
+++ branches/upstream/libimager-perl/current/MANIFEST Tue Jan 18 16:37:49 2011
@@ -362,6 +362,8 @@
testimg/comp8.bmp Compressed 8-bit/pixel BMP
testimg/filltest.ppm Test for flood fills
testimg/gimpgrad A GIMP gradient file
+testimg/gradbad.ggr A bad GIMP gradient file (bad seg count)
+testimg/gradbad2.ggr A bad GIMP gradient file (bad segment)
testimg/imager.pbm Test bi-level
testimg/junk.ppm
testimg/longid.tga Test TGA with a long id string
Modified: branches/upstream/libimager-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/META.yml?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/META.yml (original)
+++ branches/upstream/libimager-perl/current/META.yml Tue Jan 18 16:37:49 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Imager
-version: 0.79
+version: 0.80
abstract: Perl extension for Generating 24 bit Images
author:
- Tony Cook <tony at imager.perl.org>, Arnar M. Hrafnkelsson
@@ -18,9 +18,9 @@
web: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Imager
homepage: http://imager.perl.org/
repository:
- type: svn
- url: http://imager.perl.org/svn/trunk/Imager
- web: http://imager.perl.org/svnweb/public/browse/trunk/Imager
+ type: git
+ url: git://git.imager.perl.org/imager.git
+ web: http://git.imager.perl.org/imager.git
no_index:
directory:
- t
Modified: branches/upstream/libimager-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/Makefile.PL?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/Makefile.PL (original)
+++ branches/upstream/libimager-perl/current/Makefile.PL Tue Jan 18 16:37:49 2011
@@ -219,9 +219,9 @@
homepage => "http://imager.perl.org/",
repository =>
{
- url => "http://imager.perl.org/svn/trunk/Imager",
- web => "http://imager.perl.org/svnweb/public/browse/trunk/Imager",
- type => "svn",
+ url => "git://git.imager.perl.org/imager.git",
+ web => "http://git.imager.perl.org/imager.git",
+ type => "git",
},
bugtracker =>
{
Modified: branches/upstream/libimager-perl/current/hlines.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/hlines.c?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/hlines.c (original)
+++ branches/upstream/libimager-perl/current/hlines.c Tue Jan 18 16:37:49 2011
@@ -357,7 +357,7 @@
=head1 REVISION
-$Revision: 1431 $
-
-=cut
-*/
+$Revision$
+
+=cut
+*/
Modified: branches/upstream/libimager-perl/current/image.c
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/image.c?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/image.c (original)
+++ branches/upstream/libimager-perl/current/image.c Tue Jan 18 16:37:49 2011
@@ -747,10 +747,11 @@
short psave;
i_color val,val1,val2;
i_img *new_img;
+ int has_alpha = i_img_has_alpha(im);
+ int color_chans = i_img_color_channels(im);
i_clear_error();
mm_log((1,"i_scaleaxis(im %p,Value %.2f,Axis %d)\n",im,Value,Axis));
-
if (Axis == XAXIS) {
hsize = (int)(0.5 + im->xsize * Value);
@@ -823,15 +824,46 @@
i_gpix(im, Mx, i, &val1);
i_gpix(im, mx, i, &val2);
-
- for (k=0; k<im->channels; k++) {
- PictureValue[k] += l1[l] * val1.channel[k];
- PictureValue[k] += l0[lMax-l-1] * val2.channel[k];
+
+ if (has_alpha) {
+ i_sample_t alpha1 = val1.channel[color_chans];
+ i_sample_t alpha2 = val2.channel[color_chans];
+ for (k=0; k < color_chans; k++) {
+ PictureValue[k] += l1[l] * val1.channel[k] * alpha1 / 255;
+ PictureValue[k] += l0[lMax-l-1] * val2.channel[k] * alpha2 / 255;
+ }
+ PictureValue[color_chans] += l1[l] * val1.channel[color_chans];
+ PictureValue[color_chans] += l0[lMax-l-1] * val2.channel[color_chans];
+ }
+ else {
+ for (k=0; k<im->channels; k++) {
+ PictureValue[k] += l1[l] * val1.channel[k];
+ PictureValue[k] += l0[lMax-l-1] * val2.channel[k];
+ }
}
}
- for(k=0;k<im->channels;k++) {
- psave = (short)(0.5+(PictureValue[k] / LanczosWidthFactor));
- val.channel[k]=minmax(0,255,psave);
+
+ if (has_alpha) {
+ float fa = PictureValue[color_chans] / LanczosWidthFactor;
+ int alpha = minmax(0, 255, fa+0.5);
+ if (alpha) {
+ for (k = 0; k < color_chans; ++k) {
+ psave = (short)(0.5+(PictureValue[k] / LanczosWidthFactor * 255 / fa));
+ val.channel[k]=minmax(0,255,psave);
+ }
+ val.channel[color_chans] = alpha;
+ }
+ else {
+ /* zero alpha, so the pixel has no color */
+ for (k = 0; k < im->channels; ++k)
+ val.channel[k] = 0;
+ }
+ }
+ else {
+ for(k=0;k<im->channels;k++) {
+ psave = (short)(0.5+(PictureValue[k] / LanczosWidthFactor));
+ val.channel[k]=minmax(0,255,psave);
+ }
}
i_ppix(new_img, j, i, &val);
}
@@ -848,14 +880,43 @@
i_gpix(im, i, Mx, &val1);
i_gpix(im, i, mx, &val2);
- for (k=0; k<im->channels; k++) {
- PictureValue[k] += l1[l] * val1.channel[k];
- PictureValue[k] += l0[lMax-l-1] * val2.channel[k];
+ if (has_alpha) {
+ i_sample_t alpha1 = val1.channel[color_chans];
+ i_sample_t alpha2 = val2.channel[color_chans];
+ for (k=0; k < color_chans; k++) {
+ PictureValue[k] += l1[l] * val1.channel[k] * alpha1 / 255;
+ PictureValue[k] += l0[lMax-l-1] * val2.channel[k] * alpha2 / 255;
+ }
+ PictureValue[color_chans] += l1[l] * val1.channel[color_chans];
+ PictureValue[color_chans] += l0[lMax-l-1] * val2.channel[color_chans];
+ }
+ else {
+ for (k=0; k<im->channels; k++) {
+ PictureValue[k] += l1[l] * val1.channel[k];
+ PictureValue[k] += l0[lMax-l-1] * val2.channel[k];
+ }
}
}
- for (k=0; k<im->channels; k++) {
- psave = (short)(0.5+(PictureValue[k] / LanczosWidthFactor));
- val.channel[k] = minmax(0, 255, psave);
+ if (has_alpha) {
+ float fa = PictureValue[color_chans] / LanczosWidthFactor;
+ int alpha = minmax(0, 255, fa+0.5);
+ if (alpha) {
+ for (k = 0; k < color_chans; ++k) {
+ psave = (short)(0.5+(PictureValue[k] / LanczosWidthFactor * 255 / fa));
+ val.channel[k]=minmax(0,255,psave);
+ }
+ val.channel[color_chans] = alpha;
+ }
+ else {
+ for (k = 0; k < im->channels; ++k)
+ val.channel[k] = 0;
+ }
+ }
+ else {
+ for(k=0;k<im->channels;k++) {
+ psave = (short)(0.5+(PictureValue[k] / LanczosWidthFactor));
+ val.channel[k]=minmax(0,255,psave);
+ }
}
i_ppix(new_img, i, j, &val);
}
Modified: branches/upstream/libimager-perl/current/lib/Imager/Color/Float.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Color/Float.pm?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Color/Float.pm (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Color/Float.pm Tue Jan 18 16:37:49 2011
@@ -16,10 +16,10 @@
return (@_ ) if @_ == 4;
if ($_[0] =~
/^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) {
- return (hex($1)/255.99,hex($2)/255.99,hex($3)/255.99,hex($4)/255.99);
+ return (hex($1)/255,hex($2)/255,hex($3)/255,hex($4)/255);
}
if ($_[0] =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) {
- return (hex($1)/255.99,hex($2)/255.99,hex($3)/255.99,1);
+ return (hex($1)/255,hex($2)/255,hex($3)/255,1);
}
return ();
}
Modified: branches/upstream/libimager-perl/current/lib/Imager/Draw.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Draw.pod?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Draw.pod (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Draw.pod Tue Jan 18 16:37:49 2011
@@ -1194,6 +1194,6 @@
=head1 REVISION
-$Revision: 1850 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/lib/Imager/Filters.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Filters.pod?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Filters.pod (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Filters.pod Tue Jan 18 16:37:49 2011
@@ -727,6 +727,6 @@
=head1 REVISION
-$Revision: 1767 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/lib/Imager/Font.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Font.pm?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Font.pm (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Font.pm Tue Jan 18 16:37:49 2011
@@ -1057,7 +1057,7 @@
=head1 REVISION
-$Revision: 1908 $
+$Revision$
=head1 SEE ALSO
Modified: branches/upstream/libimager-perl/current/lib/Imager/Fountain.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Fountain.pm?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Fountain.pm (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Fountain.pm Tue Jan 18 16:37:49 2011
@@ -62,7 +62,7 @@
return $class->_load_gimp_gradient($fh, $opts{gimp}, $name_ref);
}
else {
- warn "$class::read: Nothing to do!";
+ warn "${class}::read: Nothing to do!";
return;
}
}
Modified: branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/ImageTypes.pod Tue Jan 18 16:37:49 2011
@@ -1149,7 +1149,7 @@
=head1 REVISION
-$Revision: 1917 $
+$Revision$
=head1 AUTHORS
Modified: branches/upstream/libimager-perl/current/lib/Imager/Transformations.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Transformations.pod?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Transformations.pod (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Transformations.pod Tue Jan 18 16:37:49 2011
@@ -967,6 +967,6 @@
=head1 REVISION
-$Revision: 1907 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/lib/Imager/Tutorial.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/lib/Imager/Tutorial.pod?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/lib/Imager/Tutorial.pod (original)
+++ branches/upstream/libimager-perl/current/lib/Imager/Tutorial.pod Tue Jan 18 16:37:49 2011
@@ -177,6 +177,6 @@
=head1 REVISION
-$Revision: 1724 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/samples/align-string.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/align-string.pl?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/align-string.pl (original)
+++ branches/upstream/libimager-perl/current/samples/align-string.pl Tue Jan 18 16:37:49 2011
@@ -89,7 +89,7 @@
=head1 REVISION
-$Revision: 1724 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/samples/anaglyph.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/anaglyph.pl?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/anaglyph.pl (original)
+++ branches/upstream/libimager-perl/current/samples/anaglyph.pl Tue Jan 18 16:37:49 2011
@@ -153,6 +153,6 @@
=head1 REVISION
-$Revision: 1902 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/samples/border.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/border.pl?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/border.pl (original)
+++ branches/upstream/libimager-perl/current/samples/border.pl Tue Jan 18 16:37:49 2011
@@ -201,6 +201,6 @@
=head1 REVISION
-$Revision: 819 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/samples/interleave.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/interleave.pl?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/interleave.pl (original)
+++ branches/upstream/libimager-perl/current/samples/interleave.pl Tue Jan 18 16:37:49 2011
@@ -130,6 +130,6 @@
=head1 REVISION
-$Revision: 1724 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/samples/replace_color.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/replace_color.pl?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/replace_color.pl (original)
+++ branches/upstream/libimager-perl/current/samples/replace_color.pl Tue Jan 18 16:37:49 2011
@@ -100,7 +100,7 @@
=head1 REVISION
-$Revision: 816 $
+$Revision$
=head1 AUTHOR
Modified: branches/upstream/libimager-perl/current/samples/samp-image.cgi
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/samp-image.cgi?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/samp-image.cgi (original)
+++ branches/upstream/libimager-perl/current/samples/samp-image.cgi Tue Jan 18 16:37:49 2011
@@ -58,7 +58,7 @@
=head1 REVISION
-$Revision: 725 $
+$Revision$
=head1 AUTHOR
Modified: branches/upstream/libimager-perl/current/samples/samp-scale.cgi
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/samp-scale.cgi?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/samp-scale.cgi (original)
+++ branches/upstream/libimager-perl/current/samples/samp-scale.cgi Tue Jan 18 16:37:49 2011
@@ -82,7 +82,7 @@
=head1 REVISION
-$Revision: 729 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/samples/samp-tags.cgi
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/samp-tags.cgi?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/samp-tags.cgi (original)
+++ branches/upstream/libimager-perl/current/samples/samp-tags.cgi Tue Jan 18 16:37:49 2011
@@ -72,7 +72,7 @@
=head1 REVISION
-$Revision: 729 $
+$Revision$
=cut
Modified: branches/upstream/libimager-perl/current/samples/slant_text.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/slant_text.pl?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/slant_text.pl (original)
+++ branches/upstream/libimager-perl/current/samples/slant_text.pl Tue Jan 18 16:37:49 2011
@@ -209,7 +209,7 @@
=head1 REVISION
-$Revision: 1724 $
+$Revision$
=head1 SEE ALSO
Modified: branches/upstream/libimager-perl/current/samples/tk-photo.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/samples/tk-photo.pl?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/samples/tk-photo.pl (original)
+++ branches/upstream/libimager-perl/current/samples/tk-photo.pl Tue Jan 18 16:37:49 2011
@@ -60,7 +60,7 @@
=head1 REVISION
-$Revision: 1724 $
+$Revision$
=head1 AUTHOR
Modified: branches/upstream/libimager-perl/current/t/t020masked.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/t/t020masked.t?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/t/t020masked.t (original)
+++ branches/upstream/libimager-perl/current/t/t020masked.t Tue Jan 18 16:37:49 2011
@@ -1,11 +1,8 @@
#!perl -w
-
-BEGIN { $| = 1; print "1..35\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use strict;
+use Test::More tests => 34;
use Imager qw(:all :handy);
-#use Data::Dumper;
-$loaded = 1;
-print "ok 1\n";
+use Imager::Test qw(is_color3);
init_log("testout/t020masked.log", 1);
my $base_rgb = Imager::ImgRaw::new(100, 100, 3);
@@ -22,44 +19,38 @@
# first a simple subset image
my $s_rgb = Imager::i_img_masked_new($base_rgb, undef, 25, 25, 50, 50);
-print Imager::i_img_getchannels($s_rgb) == 3
- ? "ok 2\n" : "not ok 2 # 1 channel image channel count mismatch\n";
-print Imager::i_img_getmask($s_rgb) & 1
- ? "ok 3\n" : "not ok 3 # 1 channel image bad mask\n";
-print Imager::i_img_virtual($s_rgb) == 0
- ? "not ok 4 # 1 channel image thinks it isn't virtual\n" : "ok 4\n";
-print Imager::i_img_bits($s_rgb) == 8
- ? "ok 5\n" : "not ok 5 # 1 channel image has bits != 8\n";
-print Imager::i_img_type($s_rgb) == 0 # direct
- ? "ok 6\n" : "not ok 6 # 1 channel image isn't direct\n";
+is(Imager::i_img_getchannels($s_rgb), 3,
+ "1 channel image channel count match");
+ok(Imager::i_img_getmask($s_rgb) & 1,
+ "1 channel image mask");
+ok(Imager::i_img_virtual($s_rgb),
+ "1 channel image thinks it isn't virtual");
+is(Imager::i_img_bits($s_rgb), 8,
+ "1 channel image has bits == 8");
+is(Imager::i_img_type($s_rgb), 0, # direct
+ "1 channel image is direct");
my @ginfo = i_img_info($s_rgb);
-print $ginfo[0] == 50
- ? "ok 7\n" : "not ok 7 # image width incorrect\n";
-print $ginfo[1] == 50
- ? "ok 8\n" : "not ok 8 # image height incorrect\n";
+is($ginfo[0], 50, "check width");
+is($ginfo[1], 50, "check height");
# sample some pixels through the subset
my $c = Imager::i_get_pixel($s_rgb, 0, 0);
-color_cmp($c, $green) == 0 or print "not ";
-print "ok 9\n";
+is_color3($c, 0, 255, 0, "check (0,0)");
$c = Imager::i_get_pixel($s_rgb, 49, 49);
# (25+49)%3 = 2
-color_cmp($c, $blue) == 0 or print "not ";
-print "ok 10\n";
+is_color3($c, 0, 0, 255, "check (49,49)");
# try writing to it
for my $y (0..49) {
Imager::i_plin($s_rgb, 0, $y, ($cols[$y % 3]) x 50);
}
-print "ok 11\n";
+pass("managed to write to it");
# and checking the target image
$c = Imager::i_get_pixel($base_rgb, 25, 25);
-color_cmp($c, $red) == 0 or print "not ";
-print "ok 12\n";
+is_color3($c, 255, 0, 0, "check (25,25)");
$c = Imager::i_get_pixel($base_rgb, 29, 29);
-color_cmp($c, $green) == 0 or print "not ";
-print "ok 13\n";
+is_color3($c, 0, 255, 0, "check (29,29)");
undef $s_rgb;
@@ -77,8 +68,7 @@
Imager::i_plin($mask, 20, $y, ($white) x 8);
}
my $m_rgb = Imager::i_img_masked_new($base_rgb, $mask, 25, 25, 50, 50);
-$m_rgb or print "not ";
-print "ok 14\n";
+ok($m_rgb, "make masked with mask");
for my $y (0..49) {
Imager::i_plin($m_rgb, 0, $y, ($green) x 50);
}
@@ -102,31 +92,29 @@
);
my $test_num = 15;
for my $test (@color_tests) {
- color_test($test_num++, $base_rgb, @$test);
+ my ($x, $y, $testc) = @$test;
+ my ($r, $g, $b) = $testc->rgba;
+ my $c = Imager::i_get_pixel($base_rgb, $x, $y);
+ is_color3($c, $r, $g, $b, "at ($x, $y)");
}
{
# tests for the OO versions, fairly simple, since the basic functionality
# is covered by the low-level interface tests
- my $base = Imager->new(xsize=>100, ysize=>100)
- or print "not ";
- print "ok 30\n";
+ my $base = Imager->new(xsize=>100, ysize=>100);
+ ok($base, "make base OO image");
$base->box(color=>$blue, filled=>1); # fill it all
my $mask = Imager->new(xsize=>80, ysize=>80, channels=>1);
$mask->box(color=>$white, filled=>1, xmin=>5, xmax=>75, ymin=>5, ymax=>75);
- my $m_img = $base->masked(mask=>$mask, left=>5, top=>5)
- or print "not ";
- print "ok 31\n";
- $m_img->getwidth == 80 or print "not ";
- print "ok 32\n";
+ my $m_img = $base->masked(mask=>$mask, left=>5, top=>5);
+ ok($m_img, "make masked OO image");
+ is($m_img->getwidth, 80, "check width");
$m_img->box(color=>$green, filled=>1);
- color_cmp(Imager::i_get_pixel($m_img->{IMG}, 0, 0), $blue) == 0
- or print "not ";
- print "ok 33\n";
- color_cmp(Imager::i_get_pixel($m_img->{IMG}, 5, 5), $green) == 0
- or print "not ";
- print "ok 34\n";
+ my $c = $m_img->getpixel(x=>0, y=>0);
+ is_color3($c, 0, 0, 255, "check (0,0)");
+ $c = $m_img->getpixel(x => 5, y => 5);
+ is_color3($c, 0, 255, 0, "check (5,5)");
# older versions destroyed the Imager::ImgRaw object manually in
# Imager::DESTROY rather than letting Imager::ImgRaw::DESTROY
@@ -137,23 +125,5 @@
undef $mask;
undef $base;
$m_img->box(color=>$blue, filled=>1);
- print "ok 35\n";
+ pass("didn't crash unreffing base or mask for masked image");
}
-
-sub color_test {
- my ($num, $im, $x, $y, $expected) = @_;
- my $c = Imager::i_get_pixel($im, $x, $y);
- color_cmp($c, $expected) == 0 or print "not ";
- print "ok $num # $x, $y\n";
-}
-
-sub color_cmp {
- my ($l, $r) = @_;
- my @l = $l->rgba;
- my @r = $r->rgba;
- # print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n";
- return $l[0] <=> $r[0]
- || $l[1] <=> $r[1]
- || $l[2] <=> $r[2];
-}
-
Modified: branches/upstream/libimager-perl/current/t/t15color.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/t/t15color.t?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/t/t15color.t (original)
+++ branches/upstream/libimager-perl/current/t/t15color.t Tue Jan 18 16:37:49 2011
@@ -7,9 +7,10 @@
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
-use Test::More tests => 47;
-
-BEGIN { use_ok('Imager'); };
+use Test::More tests => 55;
+
+use Imager;
+use Imager::Test qw(is_fcolor4);
init_log("testout/t15color.log",1);
@@ -126,7 +127,35 @@
is(@warnings, 0, "Should be no warnings")
or do { print "# $_" for @warnings };
}
-
+
+{
+ # float color from hex triple
+ my $f3white = Imager::Color::Float->new("#FFFFFF");
+ is_fcolor4($f3white, 1.0, 1.0, 1.0, 1.0, "check color #FFFFFF");
+ my $f3black = Imager::Color::Float->new("#000000");
+ is_fcolor4($f3black, 0, 0, 0, 1.0, "check color #000000");
+ my $f3grey = Imager::Color::Float->new("#808080");
+ is_fcolor4($f3grey, 0x80/0xff, 0x80/0xff, 0x80/0xff, 1.0, "check color #808080");
+
+ my $f4white = Imager::Color::Float->new("#FFFFFF80");
+ is_fcolor4($f4white, 1.0, 1.0, 1.0, 0x80/0xff, "check color #FFFFFF80");
+}
+
+{
+ # fail to make a color
+ ok(!Imager::Color::Float->new("-unknown-"), "try to make float color -unknown-");
+}
+
+{
+ # set after creation
+ my $c = Imager::Color::Float->new(0, 0, 0);
+ is_fcolor4($c, 0, 0, 0, 1.0, "check simple init of float color");
+ ok($c->set(1.0, 0.5, 0.25, 1.0), "set() the color");
+ is_fcolor4($c, 1.0, 0.5, 0.25, 1.0, "check after set");
+
+ ok(!$c->set("-unknown-"), "set to unknown");
+}
+
sub test_col {
my ($c, $r, $g, $b, $a) = @_;
unless ($c) {
Modified: branches/upstream/libimager-perl/current/t/t40scale.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/t/t40scale.t?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/t/t40scale.t (original)
+++ branches/upstream/libimager-perl/current/t/t40scale.t Tue Jan 18 16:37:49 2011
@@ -1,9 +1,9 @@
#!perl -w
use strict;
-use Test::More tests => 230;
+use Test::More tests => 232;
BEGIN { use_ok(Imager=>':all') }
-use Imager::Test qw(is_image is_color4);
+use Imager::Test qw(is_image is_color4 is_image_similar);
Imager::init('log'=>'testout/t40scale.log');
my $img=Imager->new();
@@ -180,7 +180,7 @@
pixels => 144);
}
-{ # check proper alpha handling
+{ # check proper alpha handling for mixing
my $im = Imager->new(xsize => 40, ysize => 40, channels => 4);
$im->box(filled => 1, color => 'C0C0C0');
my $rot = $im->rotate(degrees => -4)
@@ -191,7 +191,24 @@
$out->box(filled => 1, color => 'C0C0C0');
my $cmp = $out->copy;
$out->rubthrough(src => $sc);
- is_image($out, $cmp, "check we get the right image after scaling");
+ is_image($out, $cmp, "check we get the right image after scaling (mixing)");
+
+ # we now set alpha=0 pixels to zero on scaling
+ is_color4($sc->getpixel('x' => 39, 'y' => 39), 0, 0, 0, 0,
+ "check we set alpha=0 pixels to zero on scaling");
+}
+
+{ # check proper alpha handling for default scaling
+ my $im = Imager->new(xsize => 40, ysize => 40, channels => 4);
+ $im->box(filled => 1, color => 'C0C0C0');
+ my $rot = $im->rotate(degrees => -4)
+ or die;
+ my $sc = $rot->scale(qtype => "normal", xpixels => 40);
+ my $out = Imager->new(xsize => $sc->getwidth, ysize => $sc->getheight);
+ $out->box(filled => 1, color => 'C0C0C0');
+ my $cmp = $out->copy;
+ $out->rubthrough(src => $sc);
+ is_image_similar($out, $cmp, 100, "check we get the right image after scaling (normal)");
# we now set alpha=0 pixels to zero on scaling
is_color4($sc->getpixel('x' => 39, 'y' => 39), 0, 0, 0, 0,
Modified: branches/upstream/libimager-perl/current/t/t61filters.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/t/t61filters.t?rev=67476&op=diff
==============================================================================
--- branches/upstream/libimager-perl/current/t/t61filters.t (original)
+++ branches/upstream/libimager-perl/current/t/t61filters.t Tue Jan 18 16:37:49 2011
@@ -1,7 +1,7 @@
#!perl -w
use strict;
use Imager qw(:handy);
-use Test::More tests => 91;
+use Test::More tests => 113;
Imager::init_log("testout/t61filters.log", 1);
use Imager::Test qw(is_image_similar test_image is_image is_color4 is_fcolor4);
# meant for testing the filters themselves
@@ -139,6 +139,48 @@
segments=>$f3, super_sample=>'grid',
ftype=>'radial_square', combine=>'color' },
'testout/t61_fount_gimp.ppm');
+{ # test new fountain with no parameters
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn .= "@_" };
+ my $f4 = Imager::Fountain->read();
+ ok(!$f4, "read with no parameters does nothing");
+ like($warn, qr/Nothing to do!/, "check the warning");
+}
+{ # test with missing file
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn .= "@_" };
+ my $f = Imager::Fountain->read(gimp => "no-such-file");
+ ok(!$f, "try to read a fountain defintion that doesn't exist");
+ is($warn, "", "should be no warning");
+ like(Imager->errstr, qr/^Cannot open no-such-file: /, "check message");
+}
+SKIP:
+{
+ my $fh = IO::File->new("testimg/gimpgrad", "r");
+ ok($fh, "opened gradient")
+ or skip "Couldn't open gradient: $!", 1;
+ my $f = Imager::Fountain->read(gimp => $fh);
+ ok($f, "read gradient from file handle");
+}
+{
+ # not a gradient
+ my $f = Imager::Fountain->read(gimp => "t/t61filters.t");
+ ok(!$f, "fail to read non-gradient");
+ is(Imager->errstr, "t/t61filters.t is not a GIMP gradient file",
+ "check error message");
+}
+{ # an invalid gradient file
+ my $f = Imager::Fountain->read(gimp => "testimg/gradbad.ggr");
+ ok(!$f, "fail to read bad gradient (bad seg count)");
+ is(Imager->errstr, "testimg/gradbad.ggr is missing the segment count",
+ "check error message");
+}
+{ # an invalid gradient file
+ my $f = Imager::Fountain->read(gimp => "testimg/gradbad2.ggr");
+ ok(!$f, "fail to read bad gradient (bad segment)");
+ is(Imager->errstr, "Bad segment definition",
+ "check error message");
+}
test($imbase, { type=>'unsharpmask', stddev=>2.0 },
'testout/t61_unsharp.ppm');
test($imbase, {type=>'conv', coef=>[ -1, 3, -1, ], },
@@ -229,6 +271,40 @@
xa=>0, ya=>30, xb=>49, yb=>30),
"fountain with invalid color name");
cmp_ok($im->errstr, '=~', 'No color named', "check error message");
+}
+
+{
+ # test simple gradient creation
+ my @colors = map Imager::Color->new($_), qw/white blue red/;
+ my $s = Imager::Fountain->simple(positions => [ 0, 0.3, 1.0 ],
+ colors => \@colors);
+ ok($s, "made simple gradient");
+ my $start = $s->[0];
+ is($start->[0], 0, "check start of first correct");
+ is_color4($start->[3], 255, 255, 255, 255, "check color at start");
+}
+{
+ # simple gradient error modes
+ {
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn .= "@_" };
+ my $s = Imager::Fountain->simple();
+ ok(!$s, "no parameters to simple()");
+ like($warn, qr/Nothing to do/);
+ }
+ {
+ my $s = Imager::Fountain->simple(positions => [ 0, 1 ],
+ colors => [ NC(0, 0, 0) ]);
+ ok(!$s, "mismatch of positions and colors fails");
+ is(Imager->errstr, "positions and colors must be the same size",
+ "check message");
+ }
+ {
+ my $s = Imager::Fountain->simple(positions => [ 0 ],
+ colors => [ NC(0, 0, 0) ]);
+ ok(!$s, "not enough positions");
+ is(Imager->errstr, "not enough segments");
+ }
}
{
Added: branches/upstream/libimager-perl/current/testimg/gradbad.ggr
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/testimg/gradbad.ggr?rev=67476&op=file
==============================================================================
--- branches/upstream/libimager-perl/current/testimg/gradbad.ggr (added)
+++ branches/upstream/libimager-perl/current/testimg/gradbad.ggr Tue Jan 18 16:37:49 2011
@@ -1,0 +1,3 @@
+GIMP Gradient
+xxx
+We fail to load this as a gradient
Added: branches/upstream/libimager-perl/current/testimg/gradbad2.ggr
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libimager-perl/current/testimg/gradbad2.ggr?rev=67476&op=file
==============================================================================
--- branches/upstream/libimager-perl/current/testimg/gradbad2.ggr (added)
+++ branches/upstream/libimager-perl/current/testimg/gradbad2.ggr Tue Jan 18 16:37:49 2011
@@ -1,0 +1,4 @@
+GIMP Gradient
+1
+1 2 3 4 5 6 7 8 9 10
+Another invalid file
More information about the Pkg-perl-cvs-commits
mailing list