~tex-sx/tex-sx/development : contents of svgtopgf.pl at revision 172

~tex-sx/tex-sx/development : (revision 172)

#! /usr/bin/perl -w

exit unless (@ARGV);

use XML::Tiny qw(parsefile);

$precision = 10**3;

open($xmlfile,$ARGV[0]);

$prefix = $ARGV[1];
$debug = 2;

$doc = parsefile($xmlfile);

%fontattribs = %{$doc->[0]{"content"}[1]{"content"}[0]{"attrib"}};
%attribs = %{$doc->[0]{"content"}[1]{"content"}[0]{"content"}[0]{"attrib"}};
$scale = $attribs{"units-per-em"};
$fontwidth = $fontattribs{"horiz-adv-x"}/$scale;
$height = $attribs{"ascent"}/$scale;
$depth = $attribs{"descent"}/$scale;
@glyphs =  @{$doc->[0]{"content"}[1]{"content"}[0]{"content"}};
$nglyphs = @glyphs;

$actions = &init_actions();

for ($i = 0; $i<$nglyphs; $i++) {
    if ($glyphs[$i]{"name"} eq "glyph" and exists($glyphs[$i]{"attrib"}{"unicode"})) {
	$glyph = ord($glyphs[$i]{"attrib"}{"unicode"});
	debugmsg(1,"Generating $glyph");
	if (exists $glyphs[$i]{"attrib"}{"d"}) {
	    $svg = $glyphs[$i]{"attrib"}{"d"};
	    $svg =~ s/\n//g;
	    $lsvg = length($svg);
	    $j = 0;
	    $path = [];
	    $elt = {};
	    while ($j < $lsvg) {
		$c = substr($svg,$j,1);
		if ($c eq " ") {
		    $j++;
		} elsif (index("mzlhvcsqtaMZLHVCSQTA",$c) != -1) {
		    $elt = {
			"type" => $c,
			"coordinates" => [],
		    };
		    push @$path,$elt;
		    $j++;
		} else {
		    pos($svg) = $j;
		    if ($svg =~ /\G(-?[0-9]*\.?[0-9]+)/) {
			push @{$elt->{"coordinates"}}, $1/$scale;
			$j = pos($svg) + length($1);
		    } else {
			$j++;
		    }
		}
	    }
	    &printpgf($prefix . $glyph,$path);
	} else {
	    debugmsg(2,"Empty path, skipping $glyph");
	}
	if (exists $glyphs[$i]{"attrib"}{"horiz-adv-x"}) {
	    $width = $glyphs[$i]{"attrib"}{"horiz-adv-x"}/$scale;
	} else {
	    $width = $fontwidth;
	}
	&printbb($prefix . $glyph,$width,$height,$depth);
    } elsif ($glyphs[$i]{"name"} eq "hkern") {
#	debugmsg(2,"Considering kern");
#	$kerna = ord($glyphs[$i]{"attrib"}{"u1"});
#	$kernb = ord($glyphs[$i]{"attrib"}{"u2"});
#	$kern = -$glyphs[$i]{"attrib"}{"k"}/$scale;
#	&printkern($prefix,$kerna,$kernb,$kern);
    }
}

sub printpgf {
    my $name = shift;
    my $path = shift;
    my $l = @$path;
    my $action;
    my $coord = [0,0,0,0];
    my $lc;
    my $tc;
    my $act;
    my $step;
    print '\expandafter\def\csname ' . $name . '\endcsname{%' . "\n";
    for (my $i = 0; $i < $l; $i++) {
	$action = $path->[$i]{"type"};
	$coords = $path->[$i]{"coordinates"};
	while ($action) {
	    if (exists $actions->{$action}) {
		$action = &{$actions->{$action}}($coord,$coords);
	    } else {
		debugmsg(1,"No action defined for $action");
		$action = '';
	    }
	}
    }
    print '}%' . "\n\n";
}

sub printbb {
    my ($name,$w,$h,$d) = @_;
    print '\expandafter\def\csname ' . $name . '@minbb\endcsname{%' . "\n"
	. '\pgfpointxy{0}{' . $d . '}%' . "\n"
	. '}' . "\n\n";
    print '\expandafter\def\csname ' . $name . '@maxbb\endcsname{%' . "\n"
	. '\pgfpointxy{' . $w . '}{' . $h . '}%' . "\n"
	. '}' . "\n\n";
    return;    
}

sub printkern {
    my ($p,$a,$b,$k) = @_;
    print '\expandafter\def\csname ' . $p . 'kern@' . $a . '@' . $b . '\endcsname{' . &printnum($k) . '}' . "\n";
    return;
}

sub init_actions {

    return  {
    "M" => sub {
	my $coord = shift;
	my $coords = shift;
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] = $x;
	$coord->[1] = $y;
	$coord->[2] = $coord->[0];
	$coord->[3] = $coord->[1];
	print '\pgfpathmoveto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'L';
	} else {
	    return '';
	}
    },
    "m" => sub {
	my $coord = shift;
	my $coords = shift;
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] += $x;
	$coord->[1] += $y;
	$coord->[2] = $coord->[0];
	$coord->[3] = $coord->[1];
	print '\pgfpathmoveto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'l';
	} else {
	    return '';
	}
    },
    "L" => sub {
	my $coord = shift;
	my $coords = shift;
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] = $x;
	$coord->[1] = $y;
	$coord->[2] = $coord->[0];
	$coord->[3] = $coord->[1];
	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'L';
	} else {
	    return '';
	}
    },
    "l" => sub {
	my $coord = shift;
	my $coords = shift;
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] += $x;
	$coord->[1] += $y;
	$coord->[2] = $coord->[0];
	$coord->[3] = $coord->[1];
	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'l';
	} else {
	    return '';
	}
    },
    "V" => sub {
	my $coord = shift;
	my $coords = shift;
	my $y = shift @$coords; 
	$coord->[1] = $y;
	$coord->[2] = $coord->[0];
	$coord->[3] = $coord->[1];
	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'V';
	} else {
	    return '';
	}
    },
    "v" => sub {
	my $coord = shift;
	my $coords = shift;
	my $y = shift @$coords; 
	$coord->[1] += $y;
	$coord->[2] = $coord->[0];
	$coord->[3] = $coord->[1];
	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'v';
	} else {
	    return '';
	}
    },
    "H" => sub {
	my $coord = shift;
	my $coords = shift;
	my $x = shift @$coords; 
	$coord->[0] = $x;
	$coord->[2] = $coord->[0];
	$coord->[3] = $coord->[1];
	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'H';
	} else {
	    return '';
	}
    },
    "h" => sub {
	my $coord = shift;
	my $coords = shift;
	my $x = shift @$coords; 
	$coord->[0] += $x;
	$coord->[2] = $coord->[0];
	$coord->[3] = $coord->[1];
	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'h';
	} else {
	    return '';
	}
    },
    "C" => sub {
	my $coord = shift;
	my $coords = shift;
	my $xa = shift @$coords;
	my $ya = shift @$coords; 
	my $xb = shift @$coords;
	my $yb = shift @$coords; 
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] = $x;
	$coord->[1] = $y;
	$coord->[2] = 2*$x - $xb;
	$coord->[3] = 2*$y - $yb;
	print '\pgfpathcurveto{' 
	    . '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	    . '\pgfpointxy{' . &printnum($xb) . '}{' . &printnum($yb) . '}}{'
	    . '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'C';
	} else {
	    return '';
	}
    },
    "c" => sub {
	my $coord = shift;
	my $coords = shift;
	my $xa = shift @$coords;
	my $ya = shift @$coords; 
	my $xb = shift @$coords;
	my $yb = shift @$coords; 
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$xa += $coord->[0];
	$ya += $coord->[1];
	$xb += $coord->[0];
	$yb += $coord->[1];
	$coord->[0] += $x;
	$coord->[1] += $y;
	$coord->[2] = 2*$coord->[0] - $xb;
	$coord->[3] = 2*$coord->[1] - $yb;
	print '\pgfpathcurveto{' 
	    . '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	    . '\pgfpointxy{' . &printnum($xb) . '}{' . &printnum($yb) . '}}{'
	    . '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'c';
	} else {
	    return '';
	}
    },
    "S" => sub {
	my $coord = shift;
	my $coords = shift;
	my $xa = $coord->[2];
	my $ya = $coord->[3];
	my $xb = shift @$coords;
	my $yb = shift @$coords; 
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] = $x;
	$coord->[1] = $y;
	$coord->[2] = 2*$x - $xb;
	$coord->[3] = 2*$y - $yb;
	print '\pgfpathcurveto{' 
	    . '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	    . '\pgfpointxy{' . &printnum($xb) . '}{' . &printnum($yb) . '}}{'
	    . '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'S';
	} else {
	    return '';
	}
    },
    "s" => sub {
	my $coord = shift;
	my $coords = shift;
	my $xa = $coord->[2];
	my $ya = $coord->[3];
	my $xb = shift @$coords;
	my $yb = shift @$coords; 
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$xb += $coord->[0];
	$yb += $coord->[1];
	$coord->[0] += $x;
	$coord->[1] += $y;
	$coord->[2] = 2*$coord->[0] - $xb;
	$coord->[3] = 2*$coord->[1] - $yb;
	print '\pgfpathcurveto{' 
	    . '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	    . '\pgfpointxy{' . &printnum($xb) . '}{' . &printnum($yb) . '}}{'
	    . '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 's';
	} else {
	    return '';
	}
    },
    "Z" => sub {
	print '\pgfpathclose' . "%\n";
	return '';
    },
    "z" => sub {
	print '\pgfpathclose' . "%\n";
	return '';
    },
    "Q" => sub {
	my $coord = shift;
	my $coords = shift;
	my $xa = shift @$coords;
	my $ya = shift @$coords; 
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] = $x;
	$coord->[1] = $y;
	$coord->[2] = 2*$x - $xa;
	$coord->[3] = 2*$y - $ya;
	print '\pgfpathquadraticcurveto{' 
	    . '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	    . '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'Q';
	} else {
	    return '';
	}
    },
    "q" => sub {
	my $coord = shift;
	my $coords = shift;
	my $xa = shift @$coords;
	my $ya = shift @$coords; 
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$xa += $coord->[0];
	$ya += $coord->[1];
	$coord->[0] += $x;
	$coord->[1] += $y;
	$coord->[2] = 2*$coord->[0] - $xa;
	$coord->[3] = 2*$coord->[1] - $ya;
	print '\pgfpathquadraticcurveto{' 
	    . '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	    . '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'q';
	} else {
	    return '';
	}
    },
    "T" => sub {
	my $coord = shift;
	my $coords = shift;
	my $xa = $coord->[2];
	my $ya = $coord->[3];
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] = $x;
	$coord->[1] = $y;
	$coord->[2] = 2*$x - $xa;
	$coord->[3] = 2*$y - $ya;
	print '\pgfpathquadraticcurveto{' 
	    . '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	    . '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 'T';
	} else {
	    return '';
	}
    },
    "t" => sub {
	my $coord = shift;
	my $coords = shift;
	my $xa = $coord->[2];
	my $ya = $coord->[3];
	my $x = shift @$coords;
	my $y = shift @$coords; 
	$coord->[0] += $x;
	$coord->[1] += $y;
	$coord->[2] = 2*$coord->[0] - $xa;
	$coord->[3] = 2*$coord->[1] - $ya;
	print '\pgfpathquadraticcurveto{' 
	    . '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	    . '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	if (@$coords) {
	    return 't';
	} else {
	    return '';
	}
    },

};

}

sub printnum {
    my $n = shift;
    my $m = 1;
    if ($n < 0) {
	$n = -$n;
	$m = -1;
    }
    return $m * int($precision*$n + .5)/$precision;
}

sub debugmsg {
    my ($lvl, $msg) = @_;
    if ($lvl <= $debug) {
	print STDERR $msg . "\n";
    }
    return;
}

103 by Andrew Stacey Added letter shapes code, fixed bug with rounded corners being applied twice	1	#! /usr/bin/perl -w
	2
	3	exit unless (@ARGV);
	4
	5	use XML::Tiny qw(parsefile);
	6
	7	$precision = 10**3;
	8
	9	open($xmlfile,$ARGV[0]);
	10
	11	$prefix = $ARGV[1];
150.1.18 by Andrew Stacey Bug fixes for pgf-blur: inverse blur needs eo rule, fadings need unique names; tikzmark highlighting code refactored; svgtopgf added rules for quadratic paths	12	$debug = 2;
103 by Andrew Stacey Added letter shapes code, fixed bug with rounded corners being applied twice	13
	14	$doc = parsefile($xmlfile);
	15
	16	%fontattribs = %{$doc->[0]{"content"}[1]{"content"}[0]{"attrib"}};
	17	%attribs = %{$doc->[0]{"content"}[1]{"content"}[0]{"content"}[0]{"attrib"}};
	18	$scale = $attribs{"units-per-em"};
	19	$fontwidth = $fontattribs{"horiz-adv-x"}/$scale;
	20	$height = $attribs{"ascent"}/$scale;
	21	$depth = $attribs{"descent"}/$scale;
	22	@glyphs = @{$doc->[0]{"content"}[1]{"content"}[0]{"content"}};
	23	$nglyphs = @glyphs;
	24
	25	$actions = &init_actions();
	26
	27	for ($i = 0; $i<$nglyphs; $i++) {
106 by Andrew Stacey (Thargelion) New madman code	28	if ($glyphs[$i]{"name"} eq "glyph" and exists($glyphs[$i]{"attrib"}{"unicode"})) {
103 by Andrew Stacey Added letter shapes code, fixed bug with rounded corners being applied twice	29	$glyph = ord($glyphs[$i]{"attrib"}{"unicode"});
	30	debugmsg(1,"Generating $glyph");
106 by Andrew Stacey (Thargelion) New madman code	31	if (exists $glyphs[$i]{"attrib"}{"d"}) {
	32	$svg = $glyphs[$i]{"attrib"}{"d"};
	33	$svg =~ s/\n//g;
	34	$lsvg = length($svg);
	35	$j = 0;
	36	$path = [];
	37	$elt = {};
	38	while ($j < $lsvg) {
	39	$c = substr($svg,$j,1);
	40	if ($c eq " ") {
	41	$j++;
	42	} elsif (index("mzlhvcsqtaMZLHVCSQTA",$c) != -1) {
	43	$elt = {
	44	"type" => $c,
	45	"coordinates" => [],
	46	};
	47	push @$path,$elt;
	48	$j++;
	49	} else {
	50	pos($svg) = $j;
	51	if ($svg =~ /\G(-?[0-9]*\.?[0-9]+)/) {
	52	push @{$elt->{"coordinates"}}, $1/$scale;
	53	$j = pos($svg) + length($1);
	54	} else {
	55	$j++;
	56	}
	57	}
	58	}
	59	&printpgf($prefix . $glyph,$path);
	60	} else {
103 by Andrew Stacey Added letter shapes code, fixed bug with rounded corners being applied twice	61	debugmsg(2,"Empty path, skipping $glyph");
	62	}
	63	if (exists $glyphs[$i]{"attrib"}{"horiz-adv-x"}) {
	64	$width = $glyphs[$i]{"attrib"}{"horiz-adv-x"}/$scale;
	65	} else {
	66	$width = $fontwidth;
	67	}
	68	&printbb($prefix . $glyph,$width,$height,$depth);
	69	} elsif ($glyphs[$i]{"name"} eq "hkern") {
150.1.18 by Andrew Stacey Bug fixes for pgf-blur: inverse blur needs eo rule, fadings need unique names; tikzmark highlighting code refactored; svgtopgf added rules for quadratic paths	70	# debugmsg(2,"Considering kern");
	71	# $kerna = ord($glyphs[$i]{"attrib"}{"u1"});
	72	# $kernb = ord($glyphs[$i]{"attrib"}{"u2"});
	73	# $kern = -$glyphs[$i]{"attrib"}{"k"}/$scale;
	74	# &printkern($prefix,$kerna,$kernb,$kern);
103 by Andrew Stacey Added letter shapes code, fixed bug with rounded corners being applied twice	75	}
	76	}
	77
	78	sub printpgf {
	79	my $name = shift;
	80	my $path = shift;
	81	my $l = @$path;
	82	my $action;
	83	my $coord = [0,0,0,0];
	84	my $lc;
	85	my $tc;
	86	my $act;
	87	my $step;
	88	print '\expandafter\def\csname ' . $name . '\endcsname{%' . "\n";
	89	for (my $i = 0; $i < $l; $i++) {
	90	$action = $path->[$i]{"type"};
	91	$coords = $path->[$i]{"coordinates"};
	92	while ($action) {
	93	if (exists $actions->{$action}) {
	94	$action = &{$actions->{$action}}($coord,$coords);
	95	} else {
	96	debugmsg(1,"No action defined for $action");
	97	$action = '';
	98	}
	99	}
	100	}
	101	print '}%' . "\n\n";
	102	}
	103
	104	sub printbb {
	105	my ($name,$w,$h,$d) = @_;
	106	print '\expandafter\def\csname ' . $name . '@minbb\endcsname{%' . "\n"
	107	. '\pgfpointxy{0}{' . $d . '}%' . "\n"
	108	. '}' . "\n\n";
	109	print '\expandafter\def\csname ' . $name . '@maxbb\endcsname{%' . "\n"
	110	. '\pgfpointxy{' . $w . '}{' . $h . '}%' . "\n"
	111	. '}' . "\n\n";
	112	return;
	113	}
	114
	115	sub printkern {
	116	my ($p,$a,$b,$k) = @_;
	117	print '\expandafter\def\csname ' . $p . 'kern@' . $a . '@' . $b . '\endcsname{' . &printnum($k) . '}' . "\n";
	118	return;
	119	}
	120
	121	sub init_actions {
	122
	123	return {
	124	"M" => sub {
	125	my $coord = shift;
	126	my $coords = shift;
	127	my $x = shift @$coords;
	128	my $y = shift @$coords;
	129	$coord->[0] = $x;
	130	$coord->[1] = $y;
	131	$coord->[2] = $coord->[0];
	132	$coord->[3] = $coord->[1];
	133	print '\pgfpathmoveto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	134	if (@$coords) {
	135	return 'L';
	136	} else {
	137	return '';
	138	}
139	},
140	"m" => sub {
141	my $coord = shift;
142	my $coords = shift;
143	my $x = shift @$coords;
144	my $y = shift @$coords;
145	$coord->[0] += $x;
146	$coord->[1] += $y;
147	$coord->[2] = $coord->[0];
148	$coord->[3] = $coord->[1];
149	print '\pgfpathmoveto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
150	if (@$coords) {
151	return 'l';
152	} else {
153	return '';
154	}
155	},
156	"L" => sub {
157	my $coord = shift;
158	my $coords = shift;
159	my $x = shift @$coords;
160	my $y = shift @$coords;
161	$coord->[0] = $x;
162	$coord->[1] = $y;
163	$coord->[2] = $coord->[0];
164	$coord->[3] = $coord->[1];
165	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
166	if (@$coords) {
167	return 'L';
168	} else {
169	return '';
170	}
171	},
172	"l" => sub {
173	my $coord = shift;
174	my $coords = shift;
175	my $x = shift @$coords;
176	my $y = shift @$coords;
177	$coord->[0] += $x;
178	$coord->[1] += $y;
179	$coord->[2] = $coord->[0];
180	$coord->[3] = $coord->[1];
181	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
182	if (@$coords) {
183	return 'l';
184	} else {
185	return '';
186	}
187	},
188	"V" => sub {
189	my $coord = shift;
190	my $coords = shift;
191	my $y = shift @$coords;
192	$coord->[1] = $y;
193	$coord->[2] = $coord->[0];
194	$coord->[3] = $coord->[1];
195	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
196	if (@$coords) {
197	return 'V';
198	} else {
199	return '';
200	}
201	},
202	"v" => sub {
203	my $coord = shift;
204	my $coords = shift;
205	my $y = shift @$coords;
206	$coord->[1] += $y;
207	$coord->[2] = $coord->[0];
208	$coord->[3] = $coord->[1];
209	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
210	if (@$coords) {
211	return 'v';
212	} else {
213	return '';
214	}
215	},
216	"H" => sub {
217	my $coord = shift;
218	my $coords = shift;
219	my $x = shift @$coords;
220	$coord->[0] = $x;
221	$coord->[2] = $coord->[0];
222	$coord->[3] = $coord->[1];
223	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
224	if (@$coords) {
225	return 'H';
226	} else {
227	return '';
228	}
229	},
230	"h" => sub {
231	my $coord = shift;
232	my $coords = shift;
233	my $x = shift @$coords;
234	$coord->[0] += $x;
235	$coord->[2] = $coord->[0];
236	$coord->[3] = $coord->[1];
237	print '\pgfpathlineto{\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
238	if (@$coords) {
239	return 'h';
240	} else {
241	return '';
242	}
243	},
244	"C" => sub {
245	my $coord = shift;
246	my $coords = shift;
247	my $xa = shift @$coords;
248	my $ya = shift @$coords;
249	my $xb = shift @$coords;
250	my $yb = shift @$coords;
251	my $x = shift @$coords;
252	my $y = shift @$coords;
253	$coord->[0] = $x;
254	$coord->[1] = $y;
255	$coord->[2] = 2*$x - $xb;
256	$coord->[3] = 2*$y - $yb;
257	print '\pgfpathcurveto{'
258	. '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
259	. '\pgfpointxy{' . &printnum($xb) . '}{' . &printnum($yb) . '}}{'
260	. '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
261	if (@$coords) {
262	return 'C';
263	} else {
264	return '';
265	}
266	},
267	"c" => sub {
268	my $coord = shift;
269	my $coords = shift;
270	my $xa = shift @$coords;
271	my $ya = shift @$coords;
272	my $xb = shift @$coords;
273	my $yb = shift @$coords;
274	my $x = shift @$coords;
275	my $y = shift @$coords;
276	$xa += $coord->[0];
277	$ya += $coord->[1];
278	$xb += $coord->[0];
279	$yb += $coord->[1];
280	$coord->[0] += $x;
281	$coord->[1] += $y;
282	$coord->[2] = 2*$coord->[0] - $xb;
283	$coord->[3] = 2*$coord->[1] - $yb;
284	print '\pgfpathcurveto{'
285	. '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
286	. '\pgfpointxy{' . &printnum($xb) . '}{' . &printnum($yb) . '}}{'
287	. '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
288	if (@$coords) {
289	return 'c';
290	} else {
291	return '';
292	}
293	},
294	"S" => sub {
295	my $coord = shift;
296	my $coords = shift;
297	my $xa = $coord->[2];
298	my $ya = $coord->[3];
299	my $xb = shift @$coords;
300	my $yb = shift @$coords;
301	my $x = shift @$coords;
302	my $y = shift @$coords;
303	$coord->[0] = $x;
304	$coord->[1] = $y;
305	$coord->[2] = 2*$x - $xb;
306	$coord->[3] = 2*$y - $yb;
307	print '\pgfpathcurveto{'
308	. '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
309	. '\pgfpointxy{' . &printnum($xb) . '}{' . &printnum($yb) . '}}{'
310	. '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
311	if (@$coords) {
312	return 'S';
313	} else {
314	return '';
315	}
316	},
317	"s" => sub {
318	my $coord = shift;
319	my $coords = shift;
320	my $xa = $coord->[2];
321	my $ya = $coord->[3];
322	my $xb = shift @$coords;
323	my $yb = shift @$coords;
324	my $x = shift @$coords;
325	my $y = shift @$coords;
326	$xb += $coord->[0];
327	$yb += $coord->[1];
328	$coord->[0] += $x;
329	$coord->[1] += $y;
330	$coord->[2] = 2*$coord->[0] - $xb;
331	$coord->[3] = 2*$coord->[1] - $yb;
332	print '\pgfpathcurveto{'
333	. '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
334	. '\pgfpointxy{' . &printnum($xb) . '}{' . &printnum($yb) . '}}{'
335	. '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
336	if (@$coords) {
337	return 's';
338	} else {
339	return '';
340	}
341	},
342	"Z" => sub {
343	print '\pgfpathclose' . "%\n";
344	return '';
345	},
346	"z" => sub {
347	print '\pgfpathclose' . "%\n";
348	return '';
150.1.18 by Andrew Stacey Bug fixes for pgf-blur: inverse blur needs eo rule, fadings need unique names; tikzmark highlighting code refactored; svgtopgf added rules for quadratic paths	349	},
	350	"Q" => sub {
	351	my $coord = shift;
	352	my $coords = shift;
	353	my $xa = shift @$coords;
	354	my $ya = shift @$coords;
	355	my $x = shift @$coords;
	356	my $y = shift @$coords;
	357	$coord->[0] = $x;
	358	$coord->[1] = $y;
	359	$coord->[2] = 2*$x - $xa;
	360	$coord->[3] = 2*$y - $ya;
	361	print '\pgfpathquadraticcurveto{'
	362	. '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	363	. '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	364	if (@$coords) {
	365	return 'Q';
	366	} else {
	367	return '';
	368	}
	369	},
	370	"q" => sub {
	371	my $coord = shift;
	372	my $coords = shift;
	373	my $xa = shift @$coords;
	374	my $ya = shift @$coords;
	375	my $x = shift @$coords;
	376	my $y = shift @$coords;
	377	$xa += $coord->[0];
	378	$ya += $coord->[1];
	379	$coord->[0] += $x;
	380	$coord->[1] += $y;
	381	$coord->[2] = 2*$coord->[0] - $xa;
	382	$coord->[3] = 2*$coord->[1] - $ya;
	383	print '\pgfpathquadraticcurveto{'
	384	. '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	385	. '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	386	if (@$coords) {
	387	return 'q';
	388	} else {
	389	return '';
	390	}
	391	},
	392	"T" => sub {
	393	my $coord = shift;
	394	my $coords = shift;
	395	my $xa = $coord->[2];
	396	my $ya = $coord->[3];
	397	my $x = shift @$coords;
	398	my $y = shift @$coords;
	399	$coord->[0] = $x;
	400	$coord->[1] = $y;
	401	$coord->[2] = 2*$x - $xa;
	402	$coord->[3] = 2*$y - $ya;
	403	print '\pgfpathquadraticcurveto{'
	404	. '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
	405	. '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
	406	if (@$coords) {
	407	return 'T';
	408	} else {
	409	return '';
	410	}
	411	},
	412	"t" => sub {
413	my $coord = shift;
414	my $coords = shift;
415	my $xa = $coord->[2];
416	my $ya = $coord->[3];
417	my $x = shift @$coords;
418	my $y = shift @$coords;
419	$coord->[0] += $x;
420	$coord->[1] += $y;
421	$coord->[2] = 2*$coord->[0] - $xa;
422	$coord->[3] = 2*$coord->[1] - $ya;
423	print '\pgfpathquadraticcurveto{'
424	. '\pgfpointxy{' . &printnum($xa) . '}{' . &printnum($ya) . '}}{'
425	. '\pgfpointxy{' . &printnum($coord->[0]) . '}{' . &printnum($coord->[1]) . '}}' . "%\n";
426	if (@$coords) {
427	return 't';
428	} else {
429	return '';
430	}
431	},
432
103 by Andrew Stacey Added letter shapes code, fixed bug with rounded corners being applied twice	433	};
	434
	435	}
	436
	437	sub printnum {
	438	my $n = shift;
	439	my $m = 1;
	440	if ($n < 0) {
	441	$n = -$n;
	442	$m = -1;
	443	}
	444	return $m * int($precision*$n + .5)/$precision;
	445	}
	446
	447	sub debugmsg {
	448	my ($lvl, $msg) = @_;
	449	if ($lvl <= $debug) {
	450	print STDERR $msg . "\n";
	451	}
	452	return;
	453	}