r35120 - in /trunk/libgd-svg-perl: Changes META.yml SVG.pm debian/changelog debian/control debian/copyright
plessy at users.alioth.debian.org
plessy at users.alioth.debian.org
Sun May 10 16:27:33 UTC 2009
Author: plessy
Date: Sun May 10 16:27:28 2009
New Revision: 35120
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=35120
Log:
New upstream version.
- Can now embed pixmap information inside an SVG (Lincoln Stein)
- Improvements to alpha support (Lincoln Stein)
- Ghost methods for more complete mapping to GD (Jason Stajich)
* Incremented Standards-Version in debian/control to reflect the
conformance with Policy 3.8.1 (no changes needed).
* Updated debian/copyright to a lighter version of the
machine-readable format.
Modified:
trunk/libgd-svg-perl/Changes
trunk/libgd-svg-perl/META.yml
trunk/libgd-svg-perl/SVG.pm
trunk/libgd-svg-perl/debian/changelog
trunk/libgd-svg-perl/debian/control
trunk/libgd-svg-perl/debian/copyright
Modified: trunk/libgd-svg-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgd-svg-perl/Changes?rev=35120&op=diff
==============================================================================
--- trunk/libgd-svg-perl/Changes (original)
+++ trunk/libgd-svg-perl/Changes Sun May 10 16:27:28 2009
@@ -1,7 +1,9 @@
Revision history for Perl extension GD::SVG.
-0.32 Wed Oct 01 12:19:22 MDT 2008
- - Added width and height accessors
+0.33 Sun May 10 04:14:12 MDT 2009
+ - Can now embed pixmap information inside an SVG (Lincoln Stein)
+ - Improvements to alpha support (Lincoln Stein)
+ - Ghost methods for more complete mapping to GD (Jason Stajich)
0.31 Thu Aug 14 08:16:37 MDT 2008
- removed GD version requirement
Modified: trunk/libgd-svg-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgd-svg-perl/META.yml?rev=35120&op=diff
==============================================================================
--- trunk/libgd-svg-perl/META.yml (original)
+++ trunk/libgd-svg-perl/META.yml Sun May 10 16:27:28 2009
@@ -1,15 +1,21 @@
--- #YAML:1.0
-name: GD-SVG
-version: 0.32
-abstract: Seamlessly enable SVG output from scripts written using GD
-license: ~
-author:
+name: GD-SVG
+version: 0.33
+abstract: Seamlessly enable SVG output from scripts written using GD
+author:
- Todd Harris <harris at cshl.org>
-generated_by: ExtUtils::MakeMaker version 6.44
-distribution_type: module
-requires:
- GD: 0
- SVG: 0
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ GD: 0
+ SVG: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.46
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: trunk/libgd-svg-perl/SVG.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgd-svg-perl/SVG.pm?rev=35120&op=diff
==============================================================================
--- trunk/libgd-svg-perl/SVG.pm (original)
+++ trunk/libgd-svg-perl/SVG.pm Sun May 10 16:27:28 2009
@@ -7,8 +7,8 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
require Exporter;
-$VERSION = '0.32';
-# $Id: SVG.pm,v 1.12 2008/08/14 14:21:07 todd Exp $
+$VERSION = '0.33';
+# $Id: SVG.pm,v 1.16 2009/05/10 14:07:17 todd Exp $
# Conditional support for side-by-side raster generation. Off for now.
# Methods that support this are commented out multiple times (ie ######)
@@ -326,10 +326,11 @@
# As with GD, colorAllocate returns integers...
# This could easily rely on GD itself to generate the indices
sub colorAllocate {
- my ($self,$r,$g,$b) = @_;
- $r ||= 0;
- $g ||= 0;
- $b ||= 0;
+ my ($self,$r,$g,$b,$alpha) = @_;
+ $r ||= 0;
+ $g ||= 0;
+ $b ||= 0;
+ $alpha ||= 0;
###GD###my $newindex = $self->{gd}->colorAllocate($r,$g,$b);
@@ -337,7 +338,7 @@
# colorDeallocate removes keys.
# Instead use the colors_added array.
my $new_index = (defined $self->{colors_added}) ? scalar @{$self->{colors_added}} : 0;
- $self->{colors}->{$new_index} = [$r,$g,$b];
+ $self->{colors}->{$new_index} = [$r,$g,$b,$alpha];
# Keep a list of colors in the order that they are added
# This is used as a kludge for setBrush
@@ -346,9 +347,9 @@
}
sub colorAllocateAlpha {
- my ($self,$r,$g,$b,$alpha) = @_;
- ###GD###$self->{gd}->colorAllocateAlpha($r,$g,$b,$alpha);
- $self->_error('colorAllocateAlpha');
+ my $self = shift;
+ ###GD###$self->{gd}->colorAllocateAlpha($r,$g,$b,$alpha);
+ $self->colorAllocate(@_);
}
sub colorDeallocate {
@@ -844,90 +845,98 @@
# Taking a stab at implementing the copy() methods
# Should be relatively easy to implement clone() from this
sub copy {
- my ($self,$source,$dstx,$dsty,$srcx,$srcy,$width,$height) = @_;
-
- my $topx = $srcx;
- my $topy = $srcy;
- my $bottomx = $srcx + $width; # arithmetic right here?
- my $bottomy = $srcy + $height;
-
- # Fetch all elements of the source image
- my @elements = $source->img->getElements;
- foreach my $element (@elements) {
- my $att = $element->getAttributes();
- # Points|rectangles|text, circles|ellipses, lines
- my $x = $att->{x} || $att->{cx} || $att->{x1};
- my $y = $att->{y} || $att->{cy} || $att->{y1};
-
- # Use the first point for polygons
- unless ($x && $y) {
- my @points = split(/\s/,$att->{points});
- if (@points) {
- ($x,$y) = split(',',$points[0]);
- }
+ my $self = shift;
+ my ($source,$dstx,$dsty,$srcx,$srcy,$width,$height) = @_;
+
+ # special case -- if we have been asked to copy a
+ # GD::Image into us, then we embed an image with the
+ # data:url
+ if ($source->isa('GD::Image') || $source->isa('GD::Simple')) {
+ return $self->_copy_image(@_);
}
- # Paths
- unless ($x && $y) {
- my @d = split(/\s/,$att->{d});
- if (@d) {
- ($x,$y) = split(',',$d[0]);
- $x =~ s/^M//; # Remove the style directive
- }
+ my $topx = $srcx;
+ my $topy = $srcy;
+ my $bottomx = $srcx + $width; # arithmetic right here?
+ my $bottomy = $srcy + $height;
+
+ # Fetch all elements of the source image
+ my @elements = $source->img->getElements;
+ foreach my $element (@elements) {
+ my $att = $element->getAttributes();
+ # Points|rectangles|text, circles|ellipses, lines
+ my $x = $att->{x} || $att->{cx} || $att->{x1};
+ my $y = $att->{y} || $att->{cy} || $att->{y1};
+
+ # Use the first point for polygons
+ unless ($x && $y) {
+ my @points = split(/\s/,$att->{points});
+ if (@points) {
+ ($x,$y) = split(',',$points[0]);
+ }
+ }
+
+ # Paths
+ unless ($x && $y) {
+ my @d = split(/\s/,$att->{d});
+ if (@d) {
+ ($x,$y) = split(',',$d[0]);
+ $x =~ s/^M//; # Remove the style directive
+ }
+ }
+
+ # Are the starting coords within the bounds of the desired rectangle?
+ # We will simplistically assume that the entire glyph fits inside
+ # the rectangle which may not be true.
+ if (($x >= $topx && $y >= $topy) &&
+ ($x <= $bottomx && $y <= $bottomy)) {
+ my $type = $element->getType;
+ # warn "$type $x $y $bottomx $bottomy $topx $topy";
+
+ # Transform the coordinates as necessary,
+ # calculating the offsets relative to the
+ # original bounding rectangle in the source image
+
+ # Text or rectangles
+ if ($type eq 'text' || $type eq 'rect') {
+ my ($newx,$newy) = _transform_coords($topx,$topy,$x,$y,$dstx,$dsty);
+ $element->setAttribute('x',$newx);
+ $element->setAttribute('y',$newy);
+ # Circles or ellipses
+ } elsif ($type eq 'circle' || $type eq 'ellipse') {
+ my ($newx,$newy) = _transform_coords($topx,$topy,$x,$y,$dstx,$dsty);
+ $element->setAttribute('cx',$newx);
+ $element->setAttribute('cy',$newy);
+ # Lines
+ } elsif ($type eq 'line') {
+ my ($newx1,$newy1) = _transform_coords($topx,$topy,$x,$y,$dstx,$dsty);
+ my ($newx2,$newy2) = _transform_coords($topx,$topy,$att->{x2},$element->{y2},$dstx,$dsty);
+ $element->setAttribute('x1',$newx1);
+ $element->setAttribute('y1',$newy1);
+ $element->setAttribute('x2',$newx2);
+ $element->setAttribute('y2',$newy2);
+ # Polygons
+ } elsif ($type eq 'polygon') {
+ my @points = split(/\s/,$att->{points});
+ my @transformed;
+ foreach (@points) {
+ ($x,$y) = split(',',$_);
+ my ($newx,$newy) = _transform_coords($topx,$topy,$x,$y,$dstx,$dsty);
+ push (@transformed,"$newx,$newy");
+ }
+ my $transformed = join(" ", at transformed);
+ $element->setAttribute('points',$transformed);
+ # Paths
+ } elsif ($type eq 'path') {
+
+ }
+
+ # Create new elements for the destination image
+ # via the generic SVG::Element::tag method
+ my %attributes = $element->getAttributes;
+ $self->img->tag($type,%attributes);
+ }
}
-
- # Are the starting coords within the bounds of the desired rectangle?
- # We will simplistically assume that the entire glyph fits inside
- # the rectangle which may not be true.
- if (($x >= $topx && $y >= $topy) &&
- ($x <= $bottomx && $y <= $bottomy)) {
- my $type = $element->getType;
- # warn "$type $x $y $bottomx $bottomy $topx $topy";
-
- # Transform the coordinates as necessary,
- # calculating the offsets relative to the
- # original bounding rectangle in the source image
-
- # Text or rectangles
- if ($type eq 'text' || $type eq 'rect') {
- my ($newx,$newy) = _transform_coords($topx,$topy,$x,$y,$dstx,$dsty);
- $element->setAttribute('x',$newx);
- $element->setAttribute('y',$newy);
- # Circles or ellipses
- } elsif ($type eq 'circle' || $type eq 'ellipse') {
- my ($newx,$newy) = _transform_coords($topx,$topy,$x,$y,$dstx,$dsty);
- $element->setAttribute('cx',$newx);
- $element->setAttribute('cy',$newy);
- # Lines
- } elsif ($type eq 'line') {
- my ($newx1,$newy1) = _transform_coords($topx,$topy,$x,$y,$dstx,$dsty);
- my ($newx2,$newy2) = _transform_coords($topx,$topy,$att->{x2},$element->{y2},$dstx,$dsty);
- $element->setAttribute('x1',$newx1);
- $element->setAttribute('y1',$newy1);
- $element->setAttribute('x2',$newx2);
- $element->setAttribute('y2',$newy2);
- # Polygons
- } elsif ($type eq 'polygon') {
- my @points = split(/\s/,$att->{points});
- my @transformed;
- foreach (@points) {
- ($x,$y) = split(',',$_);
- my ($newx,$newy) = _transform_coords($topx,$topy,$x,$y,$dstx,$dsty);
- push (@transformed,"$newx,$newy");
- }
- my $transformed = join(" ", at transformed);
- $element->setAttribute('points',$transformed);
- # Paths
- } elsif ($type eq 'path') {
-
- }
-
- # Create new elements for the destination image
- # via the generic SVG::Element::tag method
- my %attributes = $element->getAttributes;
- $self->img->tag($type,%attributes);
- }
- }
}
# Used internally by the copy method
@@ -941,6 +950,33 @@
my $newy = $dsty + $yoffset;
return ($newx,$newy);
}
+
+sub _copy_image {
+ my $self = shift;
+ my ($source,$dstx,$dsty,$srcx,$srcy,$width,$height) = @_;
+
+ eval "use MIME::Base64; 1"
+ or croak "The MIME::Base64 module is required to copy a GD::Image into a GD::SVG: $@";
+
+ my $subimage = GD::Image->new($width,$height); # will be loaded
+ $subimage->copy($source->isa('GD::Simple') ? $source->gd : $source,
+ 0,0,
+ $srcx,$srcy,
+ $width,$height);
+
+ my $data = encode_base64($subimage->png);
+ my ($img,$id) = $self->_prep($dstx,$dsty);
+ my $result =
+ $img->image('x' => $dstx,
+ 'y' => $dsty,
+ width => $width,
+ height => $height,
+ id => $id,
+ 'xlink:href' => "data:image/png;base64,$data");
+ $self->_reset;
+ return $result;
+}
+
@@ -999,6 +1035,15 @@
# Replicating the TrueType handling
#sub GD::Image::stringFT { shift->_error('stringFT'); }
+sub stringFT {
+ return;
+}
+
+# not implemented
+sub useFontConfig {
+ return 0;
+}
+
##################################################
# Alpha Channels
@@ -1017,9 +1062,6 @@
my $height = $self->{height};
return($width,$height);
}
-
-sub width { (shift->getBounds)[0] }
-sub height { (shift->getBounds)[1] }
sub isTrueColor { shift->_error('isTrueColor'); }
sub compare { shift->_error('compare'); }
@@ -1050,12 +1092,17 @@
my $fill_opacity = ($fill) ? '1.0' : 0;
$fill = defined $fill ? $self->_get_color($fill) : 'none';
- $stroke_opacity ||= '1.0';
- my %style = ('stroke' => $self->_get_color($color),
+ if ((my $color_opacity = $self->_get_opacity($color)) > 0) {
+ $stroke_opacity = (127-$color_opacity)/127;
+ } else {
+ $stroke_opacity ||= '1.0';
+ }
+ my %style = ('stroke' => $self->_get_color($color),
'stroke-opacity' => $stroke_opacity,
'stroke-width' => $thickness,
'fill' => $fill,
- 'fill-opacity' => $fill_opacity);
+ 'fill-opacity' => $stroke_opacity,
+ );
my $dasharray = $self->{dasharray};
if ($self->{dasharray}) {
$style{'stroke-dasharray'} = @{$self->{dasharray}};
@@ -1070,9 +1117,18 @@
confess "somebody gave me a bum index!" unless length $index > 0;
return ($index) if ($index =~ /rgb/); # Already allocated.
return ($index) if ($index eq 'none'); # Generate by callbacks using none for fill
- my ($r,$g,$b) = @{$self->{colors}->{$index}};
+ my ($r,$g,$b,$a) = @{$self->{colors}->{$index}};
my $color = "rgb($r,$g,$b)";
return $color;
+}
+
+sub _get_opacity {
+ my ($self,$index) = @_;
+ confess "somebody gave me a bum index!" unless length $index > 0;
+ return ($index) if ($index =~ /rgb/); # Already allocated.
+ return ($index) if ($index eq 'none'); # Generate by callbacks using none for fill
+ my ($r,$g,$b,$a) = @{$self->{colors}->{$index}};
+ return $a;
}
sub _create_id {
@@ -1945,13 +2001,16 @@
=head2 Image Copying Methods
-None of the image copying commands are implemented in GD::SVG. If
-your script calls one of the following methods, your script will die
-remorsefully with a warning. With sufficient demand, I might try to
-implement some of these methods. For now, I think that they are
-beyond the intent of GD::SVG.
-
- $image->copy()
+The basic copy() command is implemented in GD::SVG. You can copy one
+GD::SVG into another GD::SVG, or copy a GD::Image or GD::Simple object
+into a GD::SVG, thereby embedding a pixmap image into the SVG image.
+
+All other image copying methods are unsupported, and if your script
+calls one of the following methods, your script will die remorsefully
+with a warning. With sufficient demand, I might try to implement some
+of these methods. For now, I think that they are beyond the intent of
+GD::SVG.
+
$image->clone()
$image->copyMerge()
$image->copyMergeGray()
@@ -2086,6 +2145,15 @@
relative font paths are not recognized due to problems in the libgd
library.
+=item $hasfontconfig = $image-E<gt>useFontConfig($flag)
+
+Call useFontConfig() with a value of 1 in order to enable support for
+fontconfig font patterns (see stringFT). Regardless of the value of
+$flag, this method will return a true value if the fontconfig library
+is present, or false otherwise.
+
+NOT IMPLEMENTED
+
=back
=head2 Alpha Channels
Modified: trunk/libgd-svg-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgd-svg-perl/debian/changelog?rev=35120&op=diff
==============================================================================
--- trunk/libgd-svg-perl/debian/changelog (original)
+++ trunk/libgd-svg-perl/debian/changelog Sun May 10 16:27:28 2009
@@ -1,3 +1,16 @@
+libgd-svg-perl (0.33-1) unstable; urgency=low
+
+ * New upstream version.
+ - Can now embed pixmap information inside an SVG (Lincoln Stein)
+ - Improvements to alpha support (Lincoln Stein)
+ - Ghost methods for more complete mapping to GD (Jason Stajich)
+ * Incremented Standards-Version in debian/control to reflect the
+ conformance with Policy 3.8.1 (no changes needed).
+ * Updated debian/copyright to a lighter version of the
+ machine-readable format.
+
+ -- Charles Plessy <plessy at debian.org> Sun, 10 May 2009 12:19:33 -0400
+
libgd-svg-perl (0.32-1) unstable; urgency=low
* Initial Release (Closes: #517206).
Modified: trunk/libgd-svg-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgd-svg-perl/debian/control?rev=35120&op=diff
==============================================================================
--- trunk/libgd-svg-perl/debian/control (original)
+++ trunk/libgd-svg-perl/debian/control Sun May 10 16:27:28 2009
@@ -5,7 +5,7 @@
Build-Depends-Indep: libgd-gd2-perl, libsvg-perl, perl (>= 5.6.0-12)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Charles Plessy <plessy at debian.org>
-Standards-Version: 3.8.0
+Standards-Version: 3.8.1
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libgd-svg-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libgd-svg-perl/
Homepage: http://search.cpan.org/dist/GD-SVG/
Modified: trunk/libgd-svg-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgd-svg-perl/debian/copyright?rev=35120&op=diff
==============================================================================
--- trunk/libgd-svg-perl/debian/copyright (original)
+++ trunk/libgd-svg-perl/debian/copyright Sun May 10 16:27:28 2009
@@ -1,19 +1,18 @@
-Format-Specification:
- http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196
-Upstream-Maintainer: Todd Harris <harris at cshl.org>
-Upstream-Source: http://search.cpan.org/CPAN/authors/id/T/TW/TWH/GD-SVG-0.32.tar.gz
-Upstream-Name: GD-SVG
+Format: Machine-readable license summary.
-Files: *
-Copyright: © 2003–2008, Todd Harris <harris at cshl.org>,
- © 2003–2008, the Cold Spring Harbor Laboratory
-License: Artistic | GPL-1+
+Name: GD-SVG
+Contact: Todd Harris <harris at cshl.org>
+Source: http://search.cpan.org/CPAN/authors/id/T/TW/TWH/GD-SVG-0.33.tar.gz
+
+Copyright: © 2003–2009, Todd Harris <harris at cshl.org>,
+ © 2003–2009, the Cold Spring Harbor Laboratory
+License: Artistic or GPL-1+
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
Files: debian/*
Copyright: © 2009, Charles Plessy <plessy at debian.org>
-License: Artistic | GPL-1+
+License: Artistic or GPL-1+
License: Artistic
This program is free software; you can redistribute it and/or modify
More information about the Pkg-perl-cvs-commits
mailing list