view release on metacpan or  search on metacpan

lib/Image/Base/SVG.pm  view on Meta::CPAN

# Image-Base-SVG is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Image-Base-SVG.  If not, see <http://www.gnu.org/licenses/>.


package Image::Base::SVG;
use 5.006;  # SVG is 5.6 for weakening
use strict;
use Carp;
use SVG; # version 2.50 needs an import() to create methods

use vars '$VERSION', '@ISA';
$VERSION = 5;

use Image::Base;
@ISA = ('Image::Base');

# uncomment this to run the ### lines
# use Smart::Comments '###';


sub new {
  my ($class, %params) = @_;
  ### Image-Base-SVG new(): %params

  # $obj->new(...) means make a copy, with some extra settings
  if (ref $class) {
    my $self = $class;
    $class = ref $self;
    croak "Cannot clone $class yet ..."

    # if (! defined $params{'-svg_object'}) {
    #   $params{'-svg_object'} = $self->{'-svg_object'}->cloneNode;
    # }
    # # inherit everything else
    # %params = (%$self, %params);
    # ### copy params: \%params
  }

  my $svg = delete $params{'-svg_object'};
  if (! $svg) {
    $svg = SVG->new ((exists $params{'-width'}
                      ? (width => delete $params{'-width'})
                      : ()),
                     (exists $params{'-height'} ?
                      (height => delete $params{'-height'})
                      : ()));
  }

  my $self = bless { -svg_object => $svg }, $class;
  ### %params
  $self->set (%params);
  return $self;
}

# these two not documented yet
my %key_to_cdata = ('-title'       => 'title',
                    '-description' => 'desc');

my %key_to_attribute = ('-width'  => 'width',
                        '-height' => 'height');
sub _get {
  my ($self, $key) = @_;
  ### _get(): $key

  if (my $tagname = $key_to_cdata{$key}) {
    my $elem;      
    return (($elem = _get_tag($self,$tagname))
            && $elem->getCDATA);

  } elsif (my $aname = $key_to_attribute{$key}) {
    return _svg_element($self)->getAttribute ($aname);

  } else {
    return $self->{$key};
  }
}

sub set {
  my $self = shift;
  while (@_) {
    my $key = shift;
    @_ or croak "Odd number of arguments to set()";
    my $value = shift;

    if (my $tagname = $key_to_cdata{$key}) {
      my $elem = _get_or_create_tag($self,$tagname);
      $elem->cdata ($value);

    } elsif (my $aname = $key_to_attribute{$key}) {
      ### $aname
      ### $value
      _svg_element($self)->setAttribute ($aname, $value);

    } else {
      $self->{$key} = $value;
    }
  }
}
sub _get_tag {
  my ($self,$tagname) = @_;
  my $svg = $self->{'-svg_object'};
  return ($svg->getElements($tagname))[0];
}
sub _get_or_create_tag {
  my ($self,$tagname) = @_;
  my $svg = $self->{'-svg_object'};
  my @elems = $svg->getElements($tagname);
  if (@elems) {
    return $elems[0];
  } else {
    return $svg->tag($tagname);
  }
}
sub _svg_element {
  my ($self) = @_;
  my $svg = $self->{'-svg_object'};
  ### docroot: $svg->{'-docroot'}
  ### elems: join(',',$svg->getElements())

  return ($svg->getElements($svg->{'-docroot'}))[0]
    || die "Oops, -docroot element not found";
}

sub xy {
  my ($self, $x, $y, $colour) = @_;
  ### Image-Base-SVG xy(): @_[1 .. $#_]

  my $svg = $self->{'-svg_object'};
  if (@_ == 3) {
    return undef;  # no pixel fetching available
  } else {
    $svg->rectangle (x => $x, y => $y,
                     width => 1, height => 1,
                     fill => $colour);
  }
}

sub rectangle {
  my ($self, $x1,$y1, $x2,$y2, $colour, $fill) = @_;
  ### Image-Base-SVG rectangle(): @_[1 .. $#_]

  $fill ||= ($x1 == $x2 || $y1 == $y2);  # 1xN or Nx1 done filled
  if (! $fill) {
    $x1 += .5;  # for stroke width 1
    $y1 += .5;
    $x2 -= .5;
    $y2 -= .5;

lib/Image/Base/SVG.pm  view on Meta::CPAN

    $self->set('-file', $filename);
  } else {
    $filename = $self->get('-file');
  }
  ### $filename

  # stringize any oopery to stop SVG::Parser being clever ... maybe
  $filename = "$filename";

  # use SVG::Parser qw(SVG::Parser::SAX=XML::LibXML::SAX::Parser);
  # use SVG::Parser qw(SVG::Parser::SAX=XML::LibXML::SAX::Parser);

  eval 'use SVG::Parser; 1' or die;
  my $parser = SVG::Parser->new (
                                 # -debug => 1,
                                );
  my $svg = $parser->parse_file ($filename);
  $self->{'-svg_object'} = $svg;
}

sub save {
  my ($self, $filename) = @_;
  ### Image-Base-SVG save(): @_
  if (@_ > 1) {
    $self->set('-file', $filename);
  } else {
    $filename = $self->get('-file');
  }
  ### $filename

  open my $fh, '>', $filename,
    or croak "Cannot create $filename: $!";

  if (! $self->save_fh ($fh)) {
    my $err = "Error writing $filename: $!";
    { local $!; close $fh; }
    croak $err;
  }
  close $fh
    or croak "Error closing $filename: $!";
}

# not yet documented ...
sub save_fh {
  my ($self, $fh) = @_;
  ### save_fh() ...
  ### elements: $self->{'-elements'}
  ### height: $self->{'-height'}

  my $svg = $self->{'-svg_object'};
  # $svg->comment ("\n\tGenerated using ".ref($self)." version ".$self->VERSION."\n");
  return print $fh $svg->xmlify;
}

# sub _add_comment {
#   my ($self) = @_;
#   my $svg_element = _svg_element($self);
#   my $generated
#     = "\n\tGenerated using ".ref($self)." version ".$self->VERSION."\n";
#   foreach my $comment ($svg_element->getElements('comment')) {
#     if ($comment->cdata eq $generated) {
#       return;
#     }
#   }
#   $self->{'-svg_object'}->comment ($generated);
# }

1;
__END__

=for stopwords SVG filename Ryde

=head1 NAME

Image::Base::SVG -- SVG image file output

=head1 SYNOPSIS

 use Image::Base::SVG;
 my $image = Image::Base::SVG->new (-width => 100,
                                    -height => 100);
 $image->rectangle (0,0, 99,99, 'black');
 $image->xy (20,20, 'green');
 $image->line (50,50, 70,70, 'red');
 $image->line (50,50, 70,70, 'blue');
 $image->save ('/some/filename.svg');

=head1 CLASS HIERARCHY

C<Image::Base::SVG> is a subclass of C<Image::Base>,

    Image::Base
      Image::Base::SVG

=head1 DESCRIPTION

C<Image::Base::SVG> extends C<Image::Base> to create or update SVG format
image files using the C<SVG> module.  The C<SVG> module holds the contents
of an SVG file in memory as an object which can be variously manipulated.
See L<SVG::Manual> for details.

C<Image::Base> is pixel oriented so isn't really the sort of thing SVG is
meant for, but this module can direct C<Image::Base> style code at an C<SVG>
object.  The C<SVG> module has many more features if used natively.

It's often fairly easy to spit out SVG directly too, and for instance the
C<Image::Base::SVGout> module can do that.  The advantage of the C<SVG>
object comes when combining images or fragments, or going through elements
for post-facto mangling.

In the current code the SVG elements emitted assume some default style
attributes such as stroke-width 1.  Perhaps that should be set explicitly on
each element.

=head2 Colours

Colour names are per the SVG spec, which is CSS style syntax

    #RGB                    hex, 1 digit
    #RRGGBB                 hex, 2 digit
    rgb(255,255,255)        integers 0 to 255