r47315 - in /trunk/libimager-perl: Changes Imager.pm Imager.xs META.yml Makefile.PL conv.im debian/changelog debian/control fills.c imager.h lib/Imager/Fill.pm lib/Imager/Filters.pod lib/Imager/Test.pm t/t20fill.t t/t61filters.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Mon Nov 16 18:24:28 UTC 2009
Author: jawnsy-guest
Date: Mon Nov 16 18:24:21 2009
New Revision: 47315
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47315
Log:
* New upstream release
* Add myself to Uploaders and Copyright
* Drop perl version dependency
* Rewrite control description
Modified:
trunk/libimager-perl/Changes
trunk/libimager-perl/Imager.pm
trunk/libimager-perl/Imager.xs
trunk/libimager-perl/META.yml
trunk/libimager-perl/Makefile.PL
trunk/libimager-perl/conv.im
trunk/libimager-perl/debian/changelog
trunk/libimager-perl/debian/control
trunk/libimager-perl/fills.c
trunk/libimager-perl/imager.h
trunk/libimager-perl/lib/Imager/Fill.pm
trunk/libimager-perl/lib/Imager/Filters.pod
trunk/libimager-perl/lib/Imager/Test.pm
trunk/libimager-perl/t/t20fill.t
trunk/libimager-perl/t/t61filters.t
Modified: trunk/libimager-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/Changes?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/Changes (original)
+++ trunk/libimager-perl/Changes Mon Nov 16 18:24:21 2009
@@ -1,4 +1,20 @@
Imager release history. Older releases can be found in Changes.old
+
+Imager 0.71 - 16 Nov 2009
+===========
+
+ - add the opacity fill type - an adaptor that modifies the opacity of
+ another fill.
+
+Bug fixes:
+
+ - the conv filter now enforces that the sum of the coefficients is
+ non-zero. Also, rather than skipping pixels off the edge off the
+ edge of the image, the closest edge pixel is used. Previously
+ dividing by the zero sum of coefficients could cause invalid
+ results or runtime exceptions.
+ Thanks to David Cantrell's Alpha-NetBSD CPAN test box for revealing
+ this bug.
Imager 0.70 - 21 Sep 2009
===========
Modified: trunk/libimager-perl/Imager.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/Imager.pm?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/Imager.pm (original)
+++ trunk/libimager-perl/Imager.pm Mon Nov 16 18:24:21 2009
@@ -173,7 +173,7 @@
BEGIN {
require Exporter;
@ISA = qw(Exporter);
- $VERSION = '0.70';
+ $VERSION = '0.71';
eval {
require XSLoader;
XSLoader::load(Imager => $VERSION);
@@ -243,11 +243,17 @@
callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
};
- $filters{conv} ={
- callseq => ['image', 'coef'],
- defaults => { },
- callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
- };
+ $filters{conv} =
+ {
+ callseq => ['image', 'coef'],
+ defaults => { },
+ callsub =>
+ sub {
+ my %hsh=@_;
+ i_conv($hsh{image},$hsh{coef})
+ or die Imager->_error_as_msg() . "\n";
+ }
+ };
$filters{gradgen} =
{
Modified: trunk/libimager-perl/Imager.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/Imager.xs?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/Imager.xs (original)
+++ trunk/libimager-perl/Imager.xs Mon Nov 16 18:24:21 2009
@@ -1756,27 +1756,26 @@
float stdev
double scale
-void
-i_conv(im,pcoef)
- Imager::ImgRaw im
- PREINIT:
- float* coeff;
- int len;
- AV* av;
- SV* sv1;
- int i;
- PPCODE:
- if (!SvROK(ST(1))) croak("Imager: Parameter 1 must be a reference to an array\n");
- if (SvTYPE(SvRV(ST(1))) != SVt_PVAV) croak("Imager: Parameter 1 must be a reference to an array\n");
- av=(AV*)SvRV(ST(1));
- len=av_len(av)+1;
- coeff=mymalloc( len*sizeof(float) );
- for(i=0;i<len;i++) {
- sv1=(*(av_fetch(av,i,0)));
- coeff[i]=(float)SvNV(sv1);
- }
- i_conv(im,coeff,len);
- myfree(coeff);
+int
+i_conv(im,coef)
+ Imager::ImgRaw im
+ AV *coef
+ PREINIT:
+ double* c_coef;
+ int len;
+ SV* sv1;
+ int i;
+ CODE:
+ len = av_len(coef) + 1;
+ c_coef=mymalloc( len * sizeof(double) );
+ for(i = 0; i < len; i++) {
+ sv1 = (*(av_fetch(coef, i, 0)));
+ c_coef[i] = (double)SvNV(sv1);
+ }
+ RETVAL = i_conv(im, c_coef, len);
+ myfree(c_coef);
+ OUTPUT:
+ RETVAL
Imager::ImgRaw
i_convert(src, avmain)
@@ -3380,6 +3379,11 @@
OUTPUT:
RETVAL
+Imager::FillHandle
+i_new_fill_opacity(other_fill, alpha_mult)
+ Imager::FillHandle other_fill
+ double alpha_mult
+
void
i_errors()
PREINIT:
Modified: trunk/libimager-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/META.yml?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/META.yml (original)
+++ trunk/libimager-perl/META.yml Mon Nov 16 18:24:21 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Imager
-version: 0.70
+version: 0.71
abstract: Perl extension for Generating 24 bit Images
author:
- Tony Cook <tony at imager.perl.org>, Arnar M. Hrafnkelsson
Modified: trunk/libimager-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/Makefile.PL?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/Makefile.PL (original)
+++ trunk/libimager-perl/Makefile.PL Mon Nov 16 18:24:21 2009
@@ -944,6 +944,12 @@
Add to the include search path
--libpath dir
Add to the library search path
+ --coverage
+ Build for coverage testing.
+ --assert
+ Build with assertions active.
+ --noexif
+ Disable EXIF parsing.
EOS
exit 1;
Modified: trunk/libimager-perl/conv.im
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/conv.im?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/conv.im (original)
+++ trunk/libimager-perl/conv.im Mon Nov 16 18:24:21 2009
@@ -1,4 +1,5 @@
#include "imager.h"
+#include "imageri.h"
/*
General convolution for 2d decoupled filters
@@ -11,72 +12,87 @@
(since the filter is even);
*/
-void
-i_conv(i_img *im,const float *coeff,int len) {
- int i,l,c,ch,center;
+int
+i_conv(i_img *im, const double *coeff,int len) {
+ int xo, yo; /* output pixel co-ordinate */
+ int c, ch, center;
double pc;
- double res[11];
+ double res[MAXCHANNELS];
i_img *timg;
mm_log((1,"i_conv(im %p, coeff %p, len %d)\n",im,coeff,len));
+ i_clear_error();
+ center=(len-1)/2;
+
+ pc = 0;
+ for (c = 0; c < len; ++c)
+ pc += coeff[c];
+
+ if (pc == 0) {
+ i_push_error(0, "sum of coefficients is zero");
+ return 0;
+ }
+
timg = i_sametype(im, im->xsize, im->ysize);
-
- center=(len-1)/2;
#code im->bits <= 8
IM_COLOR rcolor;
/* don't move the calculation of pc up here, it depends on which pixels
are readable */
- for(l=0;l<im->ysize;l++) {
- for(i=0;i<im->xsize;i++) {
- pc=0.0;
- for(ch=0;ch<im->channels;ch++)
- res[ch]=0;
- for(c=0;c<len;c++)
- if (IM_GPIX(im,i+c-center,l,&rcolor)!=-1) {
- for(ch=0;ch<im->channels;ch++)
- res[ch] += (rcolor.channel[ch])*coeff[c];
- pc+=coeff[c];
+ for(yo = 0; yo < im->ysize; yo++) {
+ for(xo = 0; xo < im->xsize; xo++) {
+ for(ch = 0;ch < im->channels; ch++)
+ res[ch] = 0;
+ for(c = 0;c < len; c++) {
+ int xi = xo + c - center;
+ if (xi < 0)
+ xi = 0;
+ else if (xi >= im->xsize)
+ xi = im->xsize - 1;
+
+ if (IM_GPIX(im, xi, yo, &rcolor)!=-1) {
+ for(ch = 0; ch < im->channels; ch++)
+ res[ch] += (rcolor.channel[ch]) *coeff[c];
}
- for(ch=0;ch<im->channels;ch++) {
- double temp = res[ch]/pc;
+ }
+ im_assert(pc != 0);
+ for(ch = 0; ch < im->channels; ch++) {
+ double temp = res[ch] / pc;
rcolor.channel[ch] =
temp < 0 ? 0 : temp > IM_SAMPLE_MAX ? IM_SAMPLE_MAX : (IM_SAMPLE_T)temp;
}
- IM_PPIX(timg,i,l,&rcolor);
+ IM_PPIX(timg, xo, yo, &rcolor);
}
}
- for(l=0;l<im->xsize;l++) {
- for(i=0;i<im->ysize;i++) {
- pc=0.0;
- for(ch=0;ch<im->channels;ch++) res[ch]=0;
- for(c=0;c<len;c++) {
- if (IM_GPIX(timg,l,i+c-center,&rcolor)!=-1) {
- for(ch=0;ch<im->channels;ch++)
- res[ch] += (rcolor.channel[ch])*coeff[c];
- pc+=coeff[c];
+ for(xo = 0; xo < im->xsize; xo++) {
+ for(yo = 0;yo < im->ysize; yo++) {
+ for(ch = 0; ch < im->channels; ch++)
+ res[ch] = 0;
+ for(c = 0; c < len; c++) {
+ int yi = yo + c - center;
+ if (yi < 0)
+ yi = 0;
+ else if (yi >= im->ysize)
+ yi = im->ysize - 1;
+ if (IM_GPIX(timg, xo, yi, &rcolor) != -1) {
+ for(ch = 0;ch < im->channels; ch++)
+ res[ch] += (rcolor.channel[ch]) * coeff[c];
}
}
- for(ch=0;ch<im->channels;ch++) {
- double temp = res[ch]/pc;
- rcolor.channel[ch]=
+ im_assert(pc != 0);
+ for(ch = 0;ch < im->channels; ch++) {
+ double temp = res[ch] / pc;
+ rcolor.channel[ch] =
temp < 0 ? 0 : temp > IM_SAMPLE_MAX ? IM_SAMPLE_MAX : (IM_SAMPLE_T)temp;
}
- IM_PPIX(im,l,i,&rcolor);
+ IM_PPIX(im, xo, yo,&rcolor);
}
}
#/code
i_img_destroy(timg);
+
+ return 1;
}
-
-
-
-
-
-
-
-
-
Modified: trunk/libimager-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/debian/changelog?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/debian/changelog (original)
+++ trunk/libimager-perl/debian/changelog Mon Nov 16 18:24:21 2009
@@ -1,3 +1,12 @@
+libimager-perl (0.71-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ * Add myself to Uploaders and Copyright
+ * Drop perl version dependency
+ * Rewrite control description
+
+ -- Jonathan Yu <jawnsy at cpan.org> Mon, 16 Nov 2009 09:51:10 -0500
+
libimager-perl (0.70-1) unstable; urgency=low
[ Krzysztof Krzyżaniak (eloy) ]
Modified: trunk/libimager-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/debian/control?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/debian/control (original)
+++ trunk/libimager-perl/debian/control Mon Nov 16 18:24:21 2009
@@ -1,13 +1,13 @@
Source: libimager-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7), perl (>= 5.8.0-7), libgif-dev,
+Build-Depends: perl, debhelper (>= 7), libgif-dev,
libtiff4-dev, libpng12-dev, libjpeg62-dev, libfreetype6-dev, libt1-dev,
libtest-pod-perl, libtest-pod-coverage-perl, libinline-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Jay Bonci <jaybonci at debian.org>, Esteban Manchado Velázque
- <zoso at debian.org>, Gunnar Wolf <gwolf at debian.org>,
- Damyan Ivanov <dmn at debian.org>,
+Uploaders: Jay Bonci <jaybonci at debian.org>,
+ Esteban Manchado Velázque <zoso at debian.org>, Gunnar Wolf <gwolf at debian.org>,
+ Damyan Ivanov <dmn at debian.org>, Jonathan Yu <jawnsy at cpan.org>
gregor herrmann <gregoa at debian.org>, Rene Mayorga <rmayorga at debian.org.sv>,
Krzysztof Krzyżaniak (eloy) <eloy at debian.org>
Standards-Version: 3.8.3
@@ -18,11 +18,10 @@
Package: libimager-perl
Architecture: any
Depends: ${misc:Depends}, ${perl:Depends}, ${shlibs:Depends}
-Description: Perl extension for Generating 24 bit Images
- Imager is a module for creating and altering images. It can read and
- write various image formats, draw primitive shapes like lines,and
- polygons, blend multiple images together in various ways, scale, crop,
- render text and more.
+Description: Perl extension for generating 24-bit images
+ Imager is a module for creating and altering images. It can read and write
+ various image formats, draw primitive shapes like lines and polygons, blend
+ multiple images together in various ways, scale, crop, render text and more.
.
- Imager also has convenience functions for things like RGB<->HSV color
- space conversion.
+ Imager also has convenience functions for things like color space conversion
+ (convert RGB to HSV and back).
Modified: trunk/libimager-perl/fills.c
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/fills.c?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/fills.c (original)
+++ trunk/libimager-perl/fills.c Mon Nov 16 18:24:21 2009
@@ -17,6 +17,7 @@
fill = i_new_fill_hatchf(&fc1, &fc2, combine, hatch, cust_hash, dx, dy);
fill = i_new_fill_hatch(&c1, &c2, combine, hatch, cust_hash, dx, dy);
fill = i_new_fill_image(im, matrix, xoff, yoff, combine);
+ fill = i_new_fill_opacity(fill, alpha_mult);
i_fill_destroy(fill);
=head1 DESCRIPTION
@@ -528,6 +529,38 @@
return &fill->base;
}
+static void fill_opacity(i_fill_t *fill, int x, int y, int width, int channels,
+ i_color *data);
+static void fill_opacityf(i_fill_t *fill, int x, int y, int width, int channels,
+ i_fcolor *data);
+
+struct i_fill_opacity_t {
+ i_fill_t base;
+ i_fill_t *other_fill;
+ double alpha_mult;
+};
+
+static struct i_fill_opacity_t
+opacity_fill_proto =
+ {
+ fill_opacity,
+ fill_opacityf,
+ NULL
+ };
+
+i_fill_t *
+i_new_fill_opacity(i_fill_t *base_fill, double alpha_mult) {
+ struct i_fill_opacity_t *fill = mymalloc(sizeof(*fill));
+ *fill = opacity_fill_proto;
+
+ fill->base.combine = base_fill->combine;
+ fill->base.combinef = base_fill->combinef;
+
+ fill->other_fill = base_fill;
+ fill->alpha_mult = alpha_mult;
+
+ return &fill->base;
+}
#define T_SOLID_FILL(fill) ((i_fill_solid_t *)(fill))
@@ -901,6 +934,45 @@
i_adapt_fcolors(want_channels, f->src->channels, data, width);
}
+static void
+fill_opacity(i_fill_t *fill, int x, int y, int width, int channels,
+ i_color *data) {
+ struct i_fill_opacity_t *f = (struct i_fill_opacity_t *)fill;
+ int alpha_chan = channels-1; /* channels is always 2 or 4 */
+ i_color *datap = data;
+
+ (f->other_fill->f_fill_with_color)(f->other_fill, x, y, width, channels, data);
+ while (width--) {
+ double new_alpha = datap->channel[alpha_chan] * f->alpha_mult;
+ if (new_alpha < 0)
+ datap->channel[alpha_chan] = 0;
+ else if (new_alpha > 255)
+ datap->channel[alpha_chan] = 255;
+ else datap->channel[alpha_chan] = (int)(new_alpha + 0.5);
+
+ ++datap;
+ }
+}
+static void
+fill_opacityf(i_fill_t *fill, int x, int y, int width, int channels,
+ i_fcolor *data) {
+ struct i_fill_opacity_t *f = (struct i_fill_alpha_t *)fill;
+ int alpha_chan = channels-1; /* channels is always 2 or 4 */
+ i_fcolor *datap = data;
+
+ (f->other_fill->f_fill_with_fcolor)(f->other_fill, x, y, width, channels, data);
+
+ while (width--) {
+ double new_alpha = datap->channel[alpha_chan] * f->alpha_mult;
+ if (new_alpha < 0)
+ datap->channel[alpha_chan] = 0;
+ else if (new_alpha > 1.0)
+ datap->channel[alpha_chan] = 1.0;
+ else datap->channel[alpha_chan] = new_alpha;
+
+ ++datap;
+ }
+}
/*
=back
Modified: trunk/libimager-perl/imager.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/imager.h?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/imager.h (original)
+++ trunk/libimager-perl/imager.h Mon Nov 16 18:24:21 2009
@@ -155,6 +155,7 @@
const unsigned char *cust_hatch, int dx, int dy);
extern i_fill_t *
i_new_fill_image(i_img *im, const double *matrix, int xoff, int yoff, int combine);
+extern i_fill_t *i_new_fill_opacity(i_fill_t *, double alpha_mult);
extern void i_fill_destroy(i_fill_t *fill);
float i_gpix_pch(i_img *im,int x,int y,int ch);
@@ -205,7 +206,7 @@
/* image processing functions */
int i_gaussian (i_img *im, double stdev);
-void i_conv (i_img *im,const float *coeff,int len);
+int i_conv (i_img *im,const double *coeff,int len);
void i_unsharp_mask(i_img *im, double stddev, double scale);
/* colour manipulation */
Modified: trunk/libimager-perl/lib/Imager/Fill.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/lib/Imager/Fill.pm?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/lib/Imager/Fill.pm (original)
+++ trunk/libimager-perl/lib/Imager/Fill.pm Mon Nov 16 18:24:21 2009
@@ -125,6 +125,35 @@
$hsh{yoff}, $hsh{combine});
$self->{DEPS} = [ $hsh{image}{IMG} ];
}
+ elsif (defined $hsh{type} && $hsh{type} eq "opacity") {
+ my $other_fill = delete $hsh{other};
+ unless (defined $other_fill) {
+ Imager->_set_error("'other' parameter required to create opacity fill");
+ return;
+ }
+ unless (ref $other_fill &&
+ eval { $other_fill->isa("Imager::Fill") }) {
+ # try to auto convert to a fill object
+ if (ref $other_fill && $other_fill =~ /HASH/) {
+ $other_fill = Imager::Fill->new(%$other_fill)
+ or return;
+ }
+ else {
+ undef $other_fill;
+ }
+ unless ($other_fill) {
+ Imager->_set_error("'other' parameter must be an Imager::Fill object to create an opacity fill");
+ return;
+ }
+ }
+
+ my $raw_fill = $other_fill->{fill};
+ my $opacity = delete $hsh{opacity};
+ defined $opacity or $opacity = 0.5; # some sort of default
+ $self->{fill} =
+ Imager::i_new_fill_opacity($raw_fill, $opacity);
+ $self->{DEPS} = [ $other_fill ]; # keep reference to old fill and its deps
+ }
else {
$Imager::ERRSTR = "No fill type specified";
warn "No fill type!";
@@ -158,6 +187,8 @@
dx=>$dx, dy=>$dy);
my $fill3 = Imager::Fill->new(fountain=>$type, ...);
my $fill4 = Imager::Fill->new(image=>$img, ...);
+ my $fill5 = Imager::Fill->new(type => "opacity", other => $fill,
+ opacity => ...);
=head1 DESCRIPTION
@@ -341,6 +372,36 @@
The matrix parameter will significantly slow down the fill.
+=head2 Opacity modification fill
+
+ my $fill = Imager::Fill->new(type => "opacity",
+ other => $fill, opacity => 0.25);
+
+This can be used to make a fill that is a more translucent or opaque
+version of an existing fill. This is intended for use where you
+receive a fill object as a parameter and need to change the opacity.
+
+Parameters:
+
+=over
+
+=item *
+
+type => "opacity" - Required
+
+=item *
+
+other - the fill to produce a modified version of. This must be an
+Imager::Fill object. Required.
+
+=item *
+
+opacity - multiplier for the source fill opacity. Default: 0.5.
+
+=back
+
+The source fill's combine mode is used.
+
=head1 OTHER METHODS
=over
Modified: trunk/libimager-perl/lib/Imager/Filters.pod
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/lib/Imager/Filters.pod?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/lib/Imager/Filters.pod (original)
+++ trunk/libimager-perl/lib/Imager/Filters.pod Mon Nov 16 18:24:21 2009
@@ -196,6 +196,10 @@
# blur
$img->filter(type=>"conv", coef=>[ 1, 2, 1 ])
+ or die $img->errstr;
+
+ # error
+ $img->filter(type=>"conv", coef=>[ -0.5, 1, -0.5 ])
or die $img->errstr;
=item fountain
@@ -694,6 +698,6 @@
=head1 REVISION
-$Revision: 1330 $
+$Revision: 1643 $
=cut
Modified: trunk/libimager-perl/lib/Imager/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/lib/Imager/Test.pm?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/lib/Imager/Test.pm (original)
+++ trunk/libimager-perl/lib/Imager/Test.pm Mon Nov 16 18:24:21 2009
@@ -127,10 +127,10 @@
&& $ca == $alpha, $comment)) {
$builder->diag(<<END_DIAG);
Color mismatch:
- Red: $red vs $cr
-Green: $green vs $cg
- Blue: $blue vs $cb
-Alpha: $alpha vs $ca
+ Red: $cr vs $red
+Green: $cg vs $green
+ Blue: $cb vs $blue
+Alpha: $ca vs $alpha
END_DIAG
return;
}
@@ -168,10 +168,10 @@
&& abs($ca - $alpha) <= $mindiff, $comment)) {
$builder->diag(<<END_DIAG);
Color mismatch:
- Red: $red vs $cr
-Green: $green vs $cg
- Blue: $blue vs $cb
-Alpha: $alpha vs $ca
+ Red: $cr vs $red
+Green: $cg vs $green
+ Blue: $cb vs $blue
+Alpha: $ca vs $alpha
END_DIAG
return;
}
Modified: trunk/libimager-perl/t/t20fill.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/t/t20fill.t?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/t/t20fill.t (original)
+++ trunk/libimager-perl/t/t20fill.t Mon Nov 16 18:24:21 2009
@@ -1,11 +1,11 @@
#!perl -w
use strict;
-use Test::More tests => 129;
+use Test::More tests => 148;
use Imager ':handy';
use Imager::Fill;
use Imager::Color::Float;
-use Imager::Test qw(is_image);
+use Imager::Test qw(is_image is_color4 is_fcolor4);
use Config;
Imager::init_log("testout/t20fill.log", 1);
@@ -466,6 +466,121 @@
}
}
+{ # alpha modifying fills
+ { # 8-bit/sample
+ my $base_img = Imager->new(xsize => 4, ysize => 2, channels => 4);
+ $base_img->setscanline
+ (
+ x => 0,
+ y => 0,
+ pixels =>
+ [
+ map Imager::Color->new($_),
+ qw/FF000020 00FF0080 00008040 FFFF00FF/,
+ ],
+ );
+ $base_img->setscanline
+ (
+ x => 0,
+ y => 1,
+ pixels =>
+ [
+ map Imager::Color->new($_),
+ qw/FFFF00FF FF000000 00FF0080 00008040/
+ ]
+ );
+ my $base_fill = Imager::Fill->new
+ (
+ image => $base_img,
+ combine => "normal",
+ );
+ ok($base_fill, "make the base image fill");
+ my $fill50 = Imager::Fill->new(type => "opacity", opacity => 0.5, other => $base_fill)
+ or print "# ", Imager->errstr, "\n";
+ ok($fill50, "make 50% alpha translation fill");
+ my $out = Imager->new(xsize => 10, ysize => 10, channels => 4);
+ $out->box(fill => $fill50);
+ is_color4($out->getpixel(x => 0, y => 0),
+ 255, 0, 0, 16, "check alpha output");
+ is_color4($out->getpixel(x => 2, y => 1),
+ 0, 255, 0, 64, "check alpha output");
+ $out->box(filled => 1, color => "000000");
+ is_color4($out->getpixel(x => 0, y => 0),
+ 0, 0, 0, 255, "check after clear");
+ $out->box(fill => $fill50);
+ is_color4($out->getpixel(x => 4, y => 2),
+ 16, 0, 0, 255, "check drawn against background");
+ is_color4($out->getpixel(x => 6, y => 3),
+ 0, 64, 0, 255, "check drawn against background");
+ }
+ { # double/sample
+ use Imager::Color::Float;
+ my $base_img = Imager->new(xsize => 4, ysize => 2, channels => 4, bits => "double");
+ $base_img->setscanline
+ (
+ x => 0,
+ y => 0,
+ pixels =>
+ [
+ map Imager::Color::Float->new(@$_),
+ [ 1, 0, 0, 0.125 ],
+ [ 0, 1, 0, 0.5 ],
+ [ 0, 0, 0.5, 0.25 ],
+ [ 1, 1, 0, 1 ],
+ ],
+ );
+ $base_img->setscanline
+ (
+ x => 0,
+ y => 1,
+ pixels =>
+ [
+ map Imager::Color::Float->new(@$_),
+ [ 1, 1, 0, 1 ],
+ [ 1, 0, 0, 0 ],
+ [ 0, 1, 0, 0.5 ],
+ [ 0, 0, 0.5, 0.25 ],
+ ]
+ );
+ my $base_fill = Imager::Fill->new
+ (
+ image => $base_img,
+ combine => "normal",
+ );
+ ok($base_fill, "make the base image fill");
+ my $fill50 = Imager::Fill->new(type => "opacity", opacity => 0.5, other => $base_fill)
+ or print "# ", Imager->errstr, "\n";
+ ok($fill50, "make 50% alpha translation fill");
+ my $out = Imager->new(xsize => 10, ysize => 10, channels => 4, bits => "double");
+ $out->box(fill => $fill50);
+ is_fcolor4($out->getpixel(x => 0, y => 0, type => "float"),
+ 1, 0, 0, 0.0625, "check alpha output at 0,0");
+ is_fcolor4($out->getpixel(x => 2, y => 1, type => "float"),
+ 0, 1, 0, 0.25, "check alpha output at 2,1");
+ $out->box(filled => 1, color => "000000");
+ is_fcolor4($out->getpixel(x => 0, y => 0, type => "float"),
+ 0, 0, 0, 1, "check after clear");
+ $out->box(fill => $fill50);
+ is_fcolor4($out->getpixel(x => 4, y => 2, type => "float"),
+ 0.0625, 0, 0, 1, "check drawn against background at 4,2");
+ is_fcolor4($out->getpixel(x => 6, y => 3, type => "float"),
+ 0, 0.25, 0, 1, "check drawn against background at 6,3");
+ }
+ ok(!Imager::Fill->new(type => "opacity"),
+ "should fail to make an opacity fill with no other fill object");
+ is(Imager->errstr, "'other' parameter required to create opacity fill",
+ "check error message");
+ ok(!Imager::Fill->new(type => "opacity", other => "xx"),
+ "should fail to make an opacity fill with a bad other parameter");
+ is(Imager->errstr, "'other' parameter must be an Imager::Fill object to create an opacity fill",
+ "check error message");
+
+ # check auto conversion of hashes
+ ok(Imager::Fill->new(type => "opacity", other => { solid => "FF0000" }),
+ "check we auto-create fills")
+ or print "# ", Imager->errstr, "\n";
+}
+
sub color_close {
my ($c1, $c2) = @_;
Modified: trunk/libimager-perl/t/t61filters.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libimager-perl/t/t61filters.t?rev=47315&op=diff
==============================================================================
--- trunk/libimager-perl/t/t61filters.t (original)
+++ trunk/libimager-perl/t/t61filters.t Mon Nov 16 18:24:21 2009
@@ -1,7 +1,7 @@
#!perl -w
use strict;
use Imager qw(:handy);
-use Test::More tests => 73;
+use Test::More tests => 79;
Imager::init_log("testout/t61filters.log", 1);
use Imager::Test qw(is_image_similar test_image is_image);
# meant for testing the filters themselves
@@ -17,8 +17,31 @@
'testout/t61_contrast.ppm');
# this one's kind of cool
-test($imbase, {type=>'conv', coef=>[ -0.5, 1, -0.5, ], },
- 'testout/t61_conv.ppm');
+test($imbase, {type=>'conv', coef=>[ 0.3, 1, 0.3, ], },
+ 'testout/t61_conv_blur.ppm');
+
+{
+ my $work8 = $imbase->copy;
+ ok(!$work8->filter(type => "conv", coef => "ABC"),
+ "coef not an array");
+}
+{
+ my $work8 = $imbase->copy;
+ ok(!$work8->filter(type => "conv", coef => [ -1, 2, -1 ]),
+ "should fail if sum of coef is 0");
+ is($work8->errstr, "sum of coefficients is zero", "check message");
+}
+
+{
+ my $work8 = $imbase->copy;
+ my $work16 = $imbase->to_rgb16;
+ my $coef = [ -0.2, 1, -0.2 ];
+ ok($work8->filter(type => "conv", coef => $coef),
+ "filter 8 bit image");
+ ok($work16->filter(type => "conv", , coef => $coef),
+ "filter 16 bit image");
+ is_image_similar($work8, $work16, 80000, "8 and 16 bit conv match");
+}
{
my $gauss = test($imbase, {type=>'gaussian', stddev=>5 },
@@ -292,6 +315,7 @@
or print "# ",$copy->errstr,"\n";
}
else {
+ diag($copy->errstr);
SKIP:
{
skip("couldn't filter", 1);
More information about the Pkg-perl-cvs-commits
mailing list