/usr/local/CPAN/SVG-DOM2/SVG/DOM2/Attribute/Path.pm

• package SVG::DOM2::Attribute::Path
  • new
  • serialise
  • deserialise
  • _instruction
  • instructions
• EOF

package SVG::DOM2::Attribute::Path;

use base "XML::DOM2::Attribute";

use strict;
use warnings;
use Carp;

my %imap = (
		m => [qw/x y/],              # move to
		z => [],                     # close path
		l => [qw/x y/],              # line to
		h => ['x'],                  # horz line
		v => ['y'],                  # vert line
		c => [qw/x1 y1 x2 y2 x y/],  # Curveto Cubic Bezier
		s => [qw/x1 y1 x y/],        # Smooth Cubic Bezier
		q => [qw/x1 y1 x y/],        # Curceto Quadratic Bézier
		t => [qw/x y/],              # Smooth Quadratic Bézier
		a => [qw/rx ry xr l s x y/], # Eliptical Arc Curve
);

sub new
{
	my ($proto, %opts) = @_;
	return $proto->SUPER::new(%opts);
}

sub serialise
{
	my ($self) = @_;

	my $lastmode = '';
	my $result = '';
	foreach my $inst ($self->instructions) {
		my %inst = %{$inst};
		$result .= ' ' if length($result);
		my $rel = $inst{'rel'};
		my $mode = $inst{'mode'};
		my @c = @inst{@{$imap{$mode}}};
		$mode = uc($mode) if not $rel;
		$result .= $mode.' ' if $mode ne $lastmode;
		$result .= join(' ', @c) if @c;
		$lastmode = $mode;
	}
	$result =~ s/\s+$//;
	return $result;
}

sub deserialise
{
	my ($self, $path) = @_;

	$path =~ s/(\+|-)/ $1/g;
	$path =~ s/([MmZzLlHhVvCcSsQqTtAa])/ $1 /g;
	$path =~ s/,/ /g;
	$path =~ s/^\s+//;
	$path =~ s/\s+$//;

	my @path = split(/\s+/, $path);
	my @inst;
	my $mode;
	for(my $i = 0; $i <= $#path; $i++) {
		my $s = $path[$i];
		next if not defined($s);
		if(defined($imap{lc($s)})) {
			$mode = $s;
			if(not @{$imap{lc($mode)}}) {
				# Make sure blind instructions are added
				push @inst, _instruction($mode);
			} else {
				next;
			}
		} elsif($s =~ /^\-*\d+\.*\d*$/) {
			# Data for current mode
			my $length = @{$imap{lc($mode)}};
			my $end = $i + $length;
			# Next i if no co-ords to gather
			next if not $end;
			# Add the instruction
			push @inst, _instruction($mode, @path[$i..$end]);
			# Inplicit lineto after moveto
			$mode = 'l' if($mode eq 'm');
			$mode = 'L' if($mode eq 'M');
			$i += $length - 1;
		} else {
			die "Error in path, unexpected instruction '$s' - ".join(', ', keys(%imap))."\n";
		}
	}
	$self->{'path'} = \@inst;
	return $self;
}

sub _instruction
{
    my ($mode, @c) = @_;
    my $reletive = ($mode =~ /A-Z/) ? 1 : 0;
    $mode = lc($mode);
    my %inst = ( mode => $mode, rel => $reletive );
    @inst{@{$imap{$mode}}} = @c if @c;
    return \%inst;
}

sub instructions
{
	my ($self) = @_;
	return @{$self->{'path'}};
}

return 1;