line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Image::SVG::Path; |
2
|
7
|
|
|
7
|
|
508537
|
use warnings; |
|
7
|
|
|
|
|
70
|
|
|
7
|
|
|
|
|
243
|
|
3
|
7
|
|
|
7
|
|
39
|
use strict; |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
985
|
|
4
|
|
|
|
|
|
|
require Exporter; |
5
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
6
|
|
|
|
|
|
|
our @SVG_REGEX = qw/ |
7
|
|
|
|
|
|
|
$closepath |
8
|
|
|
|
|
|
|
$curveto |
9
|
|
|
|
|
|
|
$smooth_curveto |
10
|
|
|
|
|
|
|
$drawto_command |
11
|
|
|
|
|
|
|
$drawto_commands |
12
|
|
|
|
|
|
|
$elliptical_arc |
13
|
|
|
|
|
|
|
$horizontal_lineto |
14
|
|
|
|
|
|
|
$lineto |
15
|
|
|
|
|
|
|
$moveto |
16
|
|
|
|
|
|
|
$quadratic_bezier_curveto |
17
|
|
|
|
|
|
|
$smooth_quadratic_bezier_curveto |
18
|
|
|
|
|
|
|
$svg_path |
19
|
|
|
|
|
|
|
$vertical_lineto |
20
|
|
|
|
|
|
|
/; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
our @FUNCTIONS = qw/extract_path_info reverse_path create_path_string/; |
23
|
|
|
|
|
|
|
our @EXPORT_OK = (@FUNCTIONS, @SVG_REGEX); |
24
|
|
|
|
|
|
|
our %EXPORT_TAGS = (all => \@FUNCTIONS, regex => \@SVG_REGEX); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our $VERSION = '0.35'; |
27
|
|
|
|
|
|
|
|
28
|
7
|
|
|
7
|
|
50
|
use Carp; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
30019
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# These are the fields in the "arc" hash which is returned when an "A" |
31
|
|
|
|
|
|
|
# command is processed. |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my @arc_fields = qw/rx ry x_axis_rotation large_arc_flag sweep_flag x y/; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# Return "relative" or "absolute" depending on whether the command is |
36
|
|
|
|
|
|
|
# upper or lower case. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub position_type |
39
|
|
|
|
|
|
|
{ |
40
|
201
|
|
|
201
|
0
|
382
|
my ($curve_type) = @_; |
41
|
201
|
100
|
|
|
|
432
|
if (lc $curve_type eq $curve_type) { |
|
|
50
|
|
|
|
|
|
42
|
84
|
|
|
|
|
171
|
return "relative"; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
elsif (uc $curve_type eq $curve_type) { |
45
|
117
|
|
|
|
|
245
|
return "absolute"; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
else { |
48
|
0
|
|
|
|
|
0
|
croak "I don't know what to do with '$curve_type'"; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub add_coords |
53
|
|
|
|
|
|
|
{ |
54
|
30
|
|
|
30
|
0
|
50
|
my ($first_ref, $to_add_ref) = @_; |
55
|
30
|
|
|
|
|
59
|
$first_ref->[0] += $to_add_ref->[0]; |
56
|
30
|
|
|
|
|
50
|
$first_ref->[1] += $to_add_ref->[1]; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub reverse_path |
60
|
|
|
|
|
|
|
{ |
61
|
0
|
|
|
0
|
1
|
0
|
my ($path) = @_; |
62
|
0
|
|
|
|
|
0
|
my $me = 'reverse_path'; |
63
|
0
|
0
|
|
|
|
0
|
if (! $path) { |
64
|
0
|
|
|
|
|
0
|
croak "$me: no input"; |
65
|
|
|
|
|
|
|
} |
66
|
0
|
|
|
|
|
0
|
my @values = extract_path_info ($path, { |
67
|
|
|
|
|
|
|
no_smooth => 1, |
68
|
|
|
|
|
|
|
absolute => 1, |
69
|
|
|
|
|
|
|
}); |
70
|
0
|
0
|
|
|
|
0
|
if (! @values) { |
71
|
0
|
|
|
|
|
0
|
return ''; |
72
|
|
|
|
|
|
|
} |
73
|
0
|
|
|
|
|
0
|
my @rvalues; |
74
|
0
|
|
|
|
|
0
|
my $end_point = $values[0]->{point}; |
75
|
0
|
|
|
|
|
0
|
for my $value (@values[1..$#values]) { |
76
|
0
|
|
|
|
|
0
|
my $element = {}; |
77
|
0
|
|
|
|
|
0
|
$element->{type} = $value->{type}; |
78
|
|
|
|
|
|
|
# print "$element->{type}\n"; |
79
|
0
|
0
|
|
|
|
0
|
if ($value->{type} eq 'cubic-bezier') { |
80
|
0
|
|
|
|
|
0
|
$element->{control1} = $value->{control2}; |
81
|
0
|
|
|
|
|
0
|
$element->{control2} = $value->{control1}; |
82
|
0
|
|
|
|
|
0
|
$element->{end} = $end_point; |
83
|
0
|
|
|
|
|
0
|
$end_point = $value->{end}; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
else { |
86
|
0
|
|
|
|
|
0
|
croak "Can't handle path element type '$value->{type}'"; |
87
|
|
|
|
|
|
|
} |
88
|
0
|
|
|
|
|
0
|
unshift @rvalues, $element; |
89
|
|
|
|
|
|
|
} |
90
|
0
|
|
|
|
|
0
|
my $moveto = { |
91
|
|
|
|
|
|
|
type => 'moveto', |
92
|
|
|
|
|
|
|
point => $end_point, |
93
|
|
|
|
|
|
|
}; |
94
|
0
|
|
|
|
|
0
|
unshift @rvalues, $moveto; |
95
|
0
|
|
|
|
|
0
|
my $rpath = create_path_string (\@rvalues); |
96
|
0
|
|
|
|
|
0
|
return $rpath; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub create_path_string |
100
|
|
|
|
|
|
|
{ |
101
|
1
|
|
|
1
|
1
|
324
|
my ($info_ref) = @_; |
102
|
1
|
|
|
|
|
3
|
my $path = ''; |
103
|
1
|
|
|
|
|
4
|
for my $element (@$info_ref) { |
104
|
31
|
|
|
|
|
45
|
my $t = $element->{type}; |
105
|
|
|
|
|
|
|
# print "$t\n"; |
106
|
31
|
100
|
|
|
|
90
|
if ($t eq 'moveto') { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
107
|
2
|
|
|
|
|
2
|
my @p = @{$element->{point}}; |
|
2
|
|
|
|
|
6
|
|
108
|
2
|
|
|
|
|
20
|
$path .= sprintf ("M%f,%f ", @p); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
elsif ($t eq 'cubic-bezier') { |
111
|
0
|
|
|
|
|
0
|
my @c1 = @{$element->{control1}}; |
|
0
|
|
|
|
|
0
|
|
112
|
0
|
|
|
|
|
0
|
my @c2 = @{$element->{control2}}; |
|
0
|
|
|
|
|
0
|
|
113
|
0
|
|
|
|
|
0
|
my @e = @{$element->{end}}; |
|
0
|
|
|
|
|
0
|
|
114
|
0
|
|
|
|
|
0
|
$path .= sprintf ("C%f,%f %f,%f %f,%f ", @c1, @c2, @e); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
elsif ($t eq 'closepath') { |
117
|
2
|
|
|
|
|
5
|
$path .= "Z"; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
elsif ($t eq 'vertical-line-to') { |
120
|
14
|
|
|
|
|
47
|
$path .= sprintf ("V%f ", $element->{y}); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
elsif ($t eq 'horizontal-line-to') { |
123
|
8
|
|
|
|
|
29
|
$path .= sprintf ("H%f ", $element->{x}); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
elsif ($t eq 'line-to') { |
126
|
4
|
|
|
|
|
6
|
$path .= sprintf ("L%f,%f ", @{$element->{point}}); |
|
4
|
|
|
|
|
21
|
|
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
elsif ($t eq 'arc') { |
129
|
1
|
|
|
|
|
3
|
my @f = map {sprintf ("%f", $element->{$_})} @arc_fields; |
|
7
|
|
|
|
|
28
|
|
130
|
1
|
|
|
|
|
7
|
$path .= "A ". join (',', @f) . " "; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
else { |
133
|
0
|
|
|
|
|
0
|
croak "Don't know how to deal with type '$t'"; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
} |
136
|
1
|
|
|
|
|
5
|
return $path; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# Match the e or E in an exponent. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my $e = qr/[eE]/; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# This whitespace regex is from the SVG grammar, |
144
|
|
|
|
|
|
|
# https://www.w3.org/TR/SVG/paths.html#PathDataBNF. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $wsp = qr/[\x20\x09\x0D\x0A]/; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# The latter commented-out part of this regex fixes a backtracking |
149
|
|
|
|
|
|
|
# problem caused by numbers like 123-234 which are supposed to be |
150
|
|
|
|
|
|
|
# parsed as two numbers "123" and "-234", as if containing a |
151
|
|
|
|
|
|
|
# comma. The regular expression blows up and cannot handle this |
152
|
|
|
|
|
|
|
# format. However, adding this final part slows the module down by a |
153
|
|
|
|
|
|
|
# factor of about 25%, so they are commented out. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
my $comma_wsp = qr/$wsp+|$wsp*,$wsp*/;#|(?<=[0-9])(?=-)/; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
# The following regular expression splits the path into pieces. Note |
158
|
|
|
|
|
|
|
# this only splits on '-' or '+' when not preceeded by 'e'. This |
159
|
|
|
|
|
|
|
# regular expression is not following the SVG grammar, it is going our |
160
|
|
|
|
|
|
|
# own way. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# Regular expressions to match numbers |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# Digit sequence |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my $ds = qr/[0-9]+/; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
my $sign = qr/[\+\-]/; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# Fractional constant |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
my $fc = qr/$ds?\.$ds/; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
my $exponent = qr/$e$sign?$ds/x; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Floating point constant |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
my $fpc = qr/ |
179
|
|
|
|
|
|
|
$fc |
180
|
|
|
|
|
|
|
$exponent? |
181
|
|
|
|
|
|
|
| |
182
|
|
|
|
|
|
|
$ds |
183
|
|
|
|
|
|
|
$exponent |
184
|
|
|
|
|
|
|
/x; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# Non-negative number. $floating_point_constant needs to go before |
187
|
|
|
|
|
|
|
# $ds, otherwise it matches the shorter $ds every time. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
my $nnn = qr/ |
190
|
|
|
|
|
|
|
$fpc |
191
|
|
|
|
|
|
|
| |
192
|
|
|
|
|
|
|
$ds |
193
|
|
|
|
|
|
|
/x; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
my $number = qr/$sign?$nnn/; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
my $pair = qr/$number$comma_wsp?$number/; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
my $pairs = qr/(?:$pair$wsp)*$pair/; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
my $numbers = qr/(?:$number$wsp)*$number/; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# Quadratic bezier curve |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
my $qarg = qr/$pair$comma_wsp?$pair/; |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
our $quadratic_bezier_curveto = qr/ |
208
|
|
|
|
|
|
|
([Qq]) |
209
|
|
|
|
|
|
|
$wsp* |
210
|
|
|
|
|
|
|
( |
211
|
|
|
|
|
|
|
(?:$qarg $comma_wsp?)* |
212
|
|
|
|
|
|
|
$qarg |
213
|
|
|
|
|
|
|
) |
214
|
|
|
|
|
|
|
/x; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
our $smooth_quadratic_bezier_curveto = |
217
|
|
|
|
|
|
|
qr/ |
218
|
|
|
|
|
|
|
([Tt]) |
219
|
|
|
|
|
|
|
$wsp* |
220
|
|
|
|
|
|
|
( |
221
|
|
|
|
|
|
|
(?:$pair $comma_wsp?)* |
222
|
|
|
|
|
|
|
$pair |
223
|
|
|
|
|
|
|
) |
224
|
|
|
|
|
|
|
/x; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# Cubic bezier curve |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
my $sarg = qr/$pair$comma_wsp?$pair/; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
our $smooth_curveto = qr/ |
231
|
|
|
|
|
|
|
([Ss]) |
232
|
|
|
|
|
|
|
$wsp* |
233
|
|
|
|
|
|
|
( |
234
|
|
|
|
|
|
|
(?: |
235
|
|
|
|
|
|
|
$sarg |
236
|
|
|
|
|
|
|
$comma_wsp |
237
|
|
|
|
|
|
|
)* |
238
|
|
|
|
|
|
|
$sarg |
239
|
|
|
|
|
|
|
) |
240
|
|
|
|
|
|
|
/x; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
my $carg = qr/(?:$pair $comma_wsp?){2} $pair/x; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
our $curveto = qr/ |
245
|
|
|
|
|
|
|
([Cc]) |
246
|
|
|
|
|
|
|
$wsp* |
247
|
|
|
|
|
|
|
( |
248
|
|
|
|
|
|
|
(?:$carg $comma_wsp)* |
249
|
|
|
|
|
|
|
$carg |
250
|
|
|
|
|
|
|
) |
251
|
|
|
|
|
|
|
/x; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
my $flag = qr/[01]/; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
my $cpair = qr/($number)$comma_wsp?($number)/; |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
my $ceaa = qr/ |
258
|
|
|
|
|
|
|
($nnn) |
259
|
|
|
|
|
|
|
$comma_wsp? |
260
|
|
|
|
|
|
|
($nnn) |
261
|
|
|
|
|
|
|
$comma_wsp? |
262
|
|
|
|
|
|
|
($number) |
263
|
|
|
|
|
|
|
$comma_wsp |
264
|
|
|
|
|
|
|
($flag) |
265
|
|
|
|
|
|
|
$comma_wsp? |
266
|
|
|
|
|
|
|
($flag) |
267
|
|
|
|
|
|
|
$comma_wsp? |
268
|
|
|
|
|
|
|
$cpair |
269
|
|
|
|
|
|
|
/x; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
my $eaa = qr/ |
272
|
|
|
|
|
|
|
$nnn |
273
|
|
|
|
|
|
|
$comma_wsp? |
274
|
|
|
|
|
|
|
$nnn |
275
|
|
|
|
|
|
|
$comma_wsp? |
276
|
|
|
|
|
|
|
$number |
277
|
|
|
|
|
|
|
$comma_wsp |
278
|
|
|
|
|
|
|
$flag |
279
|
|
|
|
|
|
|
$comma_wsp? |
280
|
|
|
|
|
|
|
$flag |
281
|
|
|
|
|
|
|
$comma_wsp? |
282
|
|
|
|
|
|
|
$cpair |
283
|
|
|
|
|
|
|
/x; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
our $elliptical_arc = qr/([Aa]) $wsp* ((?:$eaa $comma_wsp?)* $eaa)/x; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
our $vertical_lineto = qr/([Vv]) $wsp* ($numbers)/x; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
our $horizontal_lineto = qr/([Hh]) $wsp* ($numbers)/x; |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
our $lineto = qr/([Ll]) $wsp* ($pairs)/x; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
our $closepath = qr/([Zz])/; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
our $moveto = qr/ |
296
|
|
|
|
|
|
|
([Mm]) $wsp* ($pairs) |
297
|
|
|
|
|
|
|
/x; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
our $drawto_command = qr/ |
300
|
|
|
|
|
|
|
( |
301
|
|
|
|
|
|
|
$closepath |
302
|
|
|
|
|
|
|
| |
303
|
|
|
|
|
|
|
$lineto |
304
|
|
|
|
|
|
|
| |
305
|
|
|
|
|
|
|
$horizontal_lineto |
306
|
|
|
|
|
|
|
| |
307
|
|
|
|
|
|
|
$vertical_lineto |
308
|
|
|
|
|
|
|
| |
309
|
|
|
|
|
|
|
$curveto |
310
|
|
|
|
|
|
|
| |
311
|
|
|
|
|
|
|
$smooth_curveto |
312
|
|
|
|
|
|
|
| |
313
|
|
|
|
|
|
|
$quadratic_bezier_curveto |
314
|
|
|
|
|
|
|
| |
315
|
|
|
|
|
|
|
$smooth_quadratic_bezier_curveto |
316
|
|
|
|
|
|
|
| |
317
|
|
|
|
|
|
|
$elliptical_arc |
318
|
|
|
|
|
|
|
) |
319
|
|
|
|
|
|
|
/x; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
our $drawto_commands = qr/ |
322
|
|
|
|
|
|
|
(?:$drawto_command $wsp)* |
323
|
|
|
|
|
|
|
$drawto_command |
324
|
|
|
|
|
|
|
/x; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
our $mdc_group = qr/ |
327
|
|
|
|
|
|
|
$moveto |
328
|
|
|
|
|
|
|
$wsp* |
329
|
|
|
|
|
|
|
$drawto_commands |
330
|
|
|
|
|
|
|
/x; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
my $mdc_groups = qr/ |
333
|
|
|
|
|
|
|
$mdc_group+ |
334
|
|
|
|
|
|
|
/x; |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
our $moveto_drawto_command_groups = $mdc_groups; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
our $svg_path = qr/ |
339
|
|
|
|
|
|
|
$wsp* |
340
|
|
|
|
|
|
|
$mdc_groups? |
341
|
|
|
|
|
|
|
$wsp* |
342
|
|
|
|
|
|
|
/x; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
# Old regex. |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
#my $number_re = qr/(?:[\+\-0-9.]|$e)+/i; |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# This is where we depart from the SVG grammar and go our own way. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
my $numbers_re = qr/(?:$number|$comma_wsp+)*/; |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub extract_path_info |
353
|
|
|
|
|
|
|
{ |
354
|
63
|
|
|
63
|
1
|
80474
|
my ($path, $options_ref) = @_; |
355
|
|
|
|
|
|
|
# Error/message reporting thing. Not sure why I did this now. |
356
|
63
|
|
|
|
|
110
|
my $me = 'extract_path_info'; |
357
|
63
|
50
|
|
|
|
181
|
if (! $path) { |
358
|
0
|
|
|
|
|
0
|
croak "$me: no input"; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
# Create an empty options so that we don't have to |
361
|
|
|
|
|
|
|
# keep testing whether the "options" string is defined or not |
362
|
|
|
|
|
|
|
# before trying to read a hash value from it. |
363
|
63
|
100
|
|
|
|
152
|
if ($options_ref) { |
364
|
31
|
50
|
|
|
|
87
|
if (ref $options_ref ne 'HASH') { |
365
|
0
|
|
|
|
|
0
|
croak "$me: second argument should be a hash reference"; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
else { |
369
|
32
|
|
|
|
|
60
|
$options_ref = {}; |
370
|
|
|
|
|
|
|
} |
371
|
63
|
50
|
|
|
|
139
|
if (! wantarray) { |
372
|
0
|
|
|
|
|
0
|
croak "$me: extract_path_info returns an array of values"; |
373
|
|
|
|
|
|
|
} |
374
|
63
|
|
|
|
|
115
|
my $verbose = $options_ref->{verbose}; |
375
|
63
|
100
|
|
|
|
128
|
if ($verbose) { |
376
|
2
|
|
|
|
|
29
|
print "$me: I am trying to split up '$path'.\n"; |
377
|
|
|
|
|
|
|
} |
378
|
63
|
|
|
|
|
88
|
my @path_info; |
379
|
63
|
|
|
|
|
463
|
my @path = split /([cslqtahvzm])/i, $path; |
380
|
63
|
50
|
33
|
|
|
750
|
if ( $path[0] !~ /^$wsp*$/ || $path[1] !~ /[Mm]/ ) { |
381
|
0
|
|
|
|
|
0
|
croak "No moveto at start of path '$path'"; |
382
|
|
|
|
|
|
|
} |
383
|
63
|
|
|
|
|
124
|
shift @path; |
384
|
63
|
|
|
|
|
101
|
my $path_pos=0; |
385
|
63
|
|
|
|
|
90
|
my @curves; |
386
|
63
|
|
|
|
|
158
|
while ($path_pos < scalar @path) { |
387
|
201
|
|
|
|
|
369
|
my $command = $path[$path_pos]; |
388
|
201
|
|
|
|
|
325
|
my $values = $path[$path_pos+1]; |
389
|
201
|
100
|
|
|
|
363
|
if (! defined $values) { |
390
|
28
|
|
|
|
|
47
|
$values = ''; |
391
|
|
|
|
|
|
|
} |
392
|
201
|
|
|
|
|
415
|
my $original = "${command}${values}"; |
393
|
201
|
50
|
|
|
|
14824
|
if ($original !~ /$moveto|$drawto_command/x) { |
394
|
0
|
|
|
|
|
0
|
warn "Cannot parse '$original' using moveto/drawto_command regex"; |
395
|
|
|
|
|
|
|
} |
396
|
201
|
|
|
|
|
1199
|
$values=~s/^$wsp*//; |
397
|
201
|
|
|
|
|
598
|
push @curves, [$command, $values, $original]; |
398
|
201
|
|
|
|
|
639
|
$path_pos+=2; |
399
|
|
|
|
|
|
|
} |
400
|
63
|
|
|
|
|
136
|
for my $curve_data (@curves) { |
401
|
201
|
|
|
|
|
414
|
my ($command, $values) = @$curve_data; |
402
|
201
|
|
|
|
|
319
|
my $ucc = uc $command; |
403
|
|
|
|
|
|
|
# print "$curve\n"; |
404
|
201
|
|
|
|
|
279
|
my @numbers; |
405
|
201
|
100
|
|
|
|
351
|
if ($ucc eq 'A') { |
406
|
8
|
|
|
|
|
110
|
@numbers = ($values =~ /$ceaa/g); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
else { |
409
|
193
|
|
|
|
|
1910
|
@numbers = ($values =~ /($number)/g); |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
# Remove leading plus signs to keep the same behaviour as |
412
|
|
|
|
|
|
|
# before. |
413
|
201
|
|
|
|
|
430
|
@numbers = map {s/^\+//; $_} @numbers; |
|
576
|
|
|
|
|
778
|
|
|
576
|
|
|
|
|
1103
|
|
414
|
|
|
|
|
|
|
# print "@numbers\n"; |
415
|
201
|
100
|
|
|
|
459
|
if ($verbose) { |
416
|
12
|
|
|
|
|
144
|
printf "$me: Extracted %d numbers: %s\n", scalar (@numbers), |
417
|
|
|
|
|
|
|
join (" ! ", @numbers); |
418
|
|
|
|
|
|
|
} |
419
|
201
|
100
|
|
|
|
988
|
if ($ucc eq 'C') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
420
|
9
|
|
|
|
|
16
|
my $expect_numbers = 6; |
421
|
9
|
50
|
|
|
|
22
|
if (@numbers % $expect_numbers != 0) { |
422
|
0
|
|
|
|
|
0
|
croak "$me: Wrong number of values for a C curve " . |
423
|
|
|
|
|
|
|
scalar @numbers . " in '$path'"; |
424
|
|
|
|
|
|
|
} |
425
|
9
|
|
|
|
|
25
|
my $position = position_type ($command); |
426
|
9
|
|
|
|
|
35
|
for (my $i = 0; $i < @numbers / $expect_numbers; $i++) { |
427
|
26
|
|
|
|
|
41
|
my $offset = $expect_numbers * $i; |
428
|
26
|
|
|
|
|
62
|
my @control1 = @numbers[$offset + 0, $offset + 1]; |
429
|
26
|
|
|
|
|
72
|
my @control2 = @numbers[$offset + 2, $offset + 3]; |
430
|
26
|
|
|
|
|
51
|
my @end = @numbers[$offset + 4, $offset + 5]; |
431
|
|
|
|
|
|
|
# Put each of these abbreviated things into the list |
432
|
|
|
|
|
|
|
# as a separate path. |
433
|
26
|
|
|
|
|
144
|
push @path_info, { |
434
|
|
|
|
|
|
|
type => 'cubic-bezier', |
435
|
|
|
|
|
|
|
name => 'curveto', |
436
|
|
|
|
|
|
|
position => $position, |
437
|
|
|
|
|
|
|
control1 => \@control1, |
438
|
|
|
|
|
|
|
control2 => \@control2, |
439
|
|
|
|
|
|
|
end => \@end, |
440
|
|
|
|
|
|
|
svg_key => $command, |
441
|
|
|
|
|
|
|
}; |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
elsif (uc $command eq 'S') { |
445
|
7
|
|
|
|
|
11
|
my $expect_numbers = 4; |
446
|
7
|
50
|
|
|
|
19
|
if (@numbers % $expect_numbers != 0) { |
447
|
0
|
|
|
|
|
0
|
croak "$me: Wrong number of values for an S curve " . |
448
|
|
|
|
|
|
|
scalar @numbers . " in '$path'"; |
449
|
|
|
|
|
|
|
} |
450
|
7
|
|
|
|
|
16
|
my $position = position_type ($command); |
451
|
7
|
|
|
|
|
26
|
for (my $i = 0; $i < @numbers / $expect_numbers; $i++) { |
452
|
8
|
|
|
|
|
17
|
my $offset = $expect_numbers * $i; |
453
|
8
|
|
|
|
|
21
|
my @control2 = @numbers[$offset + 0, $offset + 1]; |
454
|
8
|
|
|
|
|
19
|
my @end = @numbers[$offset + 2, $offset + 3]; |
455
|
8
|
|
|
|
|
50
|
push @path_info, { |
456
|
|
|
|
|
|
|
type => 'smooth-cubic-bezier', |
457
|
|
|
|
|
|
|
name => 'shorthand/smooth curveto', |
458
|
|
|
|
|
|
|
position => $position, |
459
|
|
|
|
|
|
|
control2 => \@control2, |
460
|
|
|
|
|
|
|
end => \@end, |
461
|
|
|
|
|
|
|
svg_key => $command, |
462
|
|
|
|
|
|
|
}; |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
elsif (uc $command eq 'L') { |
466
|
29
|
|
|
|
|
46
|
my $expect_numbers = 2; |
467
|
|
|
|
|
|
|
# Maintain this check here, even though it's duplicated |
468
|
|
|
|
|
|
|
# inside build_lineto, because it's specific to the lineto |
469
|
29
|
50
|
|
|
|
67
|
if (@numbers % $expect_numbers != 0) { |
470
|
0
|
|
|
|
|
0
|
croak "Odd number of values for an L command " . |
471
|
|
|
|
|
|
|
scalar (@numbers) . " in '$path'"; |
472
|
|
|
|
|
|
|
} |
473
|
29
|
|
|
|
|
60
|
my $position = position_type ($command); |
474
|
29
|
|
|
|
|
69
|
push @path_info, build_lineto ($position, @numbers); |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
elsif (uc $command eq 'Z') { |
477
|
33
|
50
|
|
|
|
79
|
if (@numbers > 0) { |
478
|
0
|
|
|
|
|
0
|
croak "Wrong number of values for a Z command " . |
479
|
|
|
|
|
|
|
scalar @numbers . " in '$path'"; |
480
|
|
|
|
|
|
|
} |
481
|
33
|
|
|
|
|
68
|
my $position = position_type ($command); |
482
|
33
|
|
|
|
|
137
|
push @path_info, { |
483
|
|
|
|
|
|
|
type => 'closepath', |
484
|
|
|
|
|
|
|
name => 'closepath', |
485
|
|
|
|
|
|
|
position => $position, |
486
|
|
|
|
|
|
|
svg_key => $command, |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
elsif (uc $command eq 'Q') { |
490
|
6
|
|
|
|
|
8
|
my $expect_numbers = 4; |
491
|
6
|
50
|
|
|
|
24
|
if (@numbers % $expect_numbers != 0) { |
492
|
0
|
|
|
|
|
0
|
croak "Wrong number of values for a Q command " . |
493
|
|
|
|
|
|
|
scalar @numbers . " in '$path'"; |
494
|
|
|
|
|
|
|
} |
495
|
6
|
|
|
|
|
17
|
my $position = position_type ($command); |
496
|
6
|
|
|
|
|
27
|
for (my $i = 0; $i < @numbers / $expect_numbers; $i++) { |
497
|
7
|
|
|
|
|
13
|
my $o = $expect_numbers * $i; |
498
|
7
|
|
|
|
|
55
|
push @path_info, { |
499
|
|
|
|
|
|
|
type => 'quadratic-bezier', |
500
|
|
|
|
|
|
|
name => 'quadratic Bézier curveto', |
501
|
|
|
|
|
|
|
position => $position, |
502
|
|
|
|
|
|
|
control => [@numbers[$o, $o + 1]], |
503
|
|
|
|
|
|
|
end => [@numbers[$o + 2, $o + 3]], |
504
|
|
|
|
|
|
|
svg_key => $command, |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
elsif (uc $command eq 'T') { |
509
|
4
|
|
|
|
|
9
|
my $expect_numbers = 2; |
510
|
4
|
50
|
|
|
|
20
|
if (@numbers % $expect_numbers != 0) { |
511
|
0
|
|
|
|
|
0
|
croak "$me: Wrong number of values for an T command " . |
512
|
|
|
|
|
|
|
scalar @numbers . " in '$path'"; |
513
|
|
|
|
|
|
|
} |
514
|
4
|
|
|
|
|
10
|
my $position = position_type ($command); |
515
|
4
|
|
|
|
|
19
|
for (my $i = 0; $i < @numbers / $expect_numbers; $i++) { |
516
|
5
|
|
|
|
|
11
|
my $o = $expect_numbers * $i; |
517
|
5
|
|
|
|
|
32
|
push @path_info, { |
518
|
|
|
|
|
|
|
type => 'smooth-quadratic-bezier', |
519
|
|
|
|
|
|
|
name => 'Shorthand/smooth quadratic Bézier curveto', |
520
|
|
|
|
|
|
|
position => $position, |
521
|
|
|
|
|
|
|
end => [@numbers[$o, $o + 1]], |
522
|
|
|
|
|
|
|
svg_key => $command, |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
elsif (uc $command eq 'H') { |
527
|
12
|
|
|
|
|
19
|
my $position = position_type ($command); |
528
|
12
|
|
|
|
|
35
|
for (my $i = 0; $i < @numbers; $i++) { |
529
|
13
|
|
|
|
|
75
|
push @path_info, { |
530
|
|
|
|
|
|
|
type => 'horizontal-line-to', |
531
|
|
|
|
|
|
|
name => 'horizontal lineto', |
532
|
|
|
|
|
|
|
position => $position, |
533
|
|
|
|
|
|
|
x => $numbers[$i], |
534
|
|
|
|
|
|
|
svg_key => $command, |
535
|
|
|
|
|
|
|
}; |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
elsif (uc $command eq 'V') { |
539
|
21
|
|
|
|
|
42
|
my $position = position_type ($command); |
540
|
21
|
|
|
|
|
53
|
for (my $i = 0; $i < @numbers; $i++) { |
541
|
22
|
|
|
|
|
126
|
push @path_info, { |
542
|
|
|
|
|
|
|
type => 'vertical-line-to', |
543
|
|
|
|
|
|
|
name => 'vertical lineto', |
544
|
|
|
|
|
|
|
position => $position, |
545
|
|
|
|
|
|
|
y => $numbers[$i], |
546
|
|
|
|
|
|
|
svg_key => $command, |
547
|
|
|
|
|
|
|
}; |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
elsif (uc $command eq 'A') { |
551
|
8
|
|
|
|
|
19
|
my $position = position_type ($command); |
552
|
8
|
|
|
|
|
15
|
my $expect_numbers = 7; |
553
|
8
|
50
|
|
|
|
20
|
if (@numbers % $expect_numbers != 0) { |
554
|
0
|
|
|
|
|
0
|
my $n = scalar (@numbers); |
555
|
0
|
|
|
|
|
0
|
croak "$me: Need multiple of 7 parameters for arc, got $n (@numbers)"; |
556
|
|
|
|
|
|
|
} |
557
|
8
|
|
|
|
|
46
|
for (my $i = 0; $i < @numbers / $expect_numbers; $i++) { |
558
|
9
|
|
|
|
|
15
|
my $o = $expect_numbers * $i; |
559
|
9
|
|
|
|
|
13
|
my %arc; |
560
|
9
|
|
|
|
|
20
|
$arc{svg_key} = $command; |
561
|
9
|
|
|
|
|
20
|
$arc{type} = 'arc'; |
562
|
9
|
|
|
|
|
13
|
$arc{name} = 'elliptical arc'; |
563
|
9
|
|
|
|
|
14
|
$arc{position} = $position; |
564
|
9
|
|
|
|
|
64
|
@arc{@arc_fields} = @numbers[$o .. $o + 6]; |
565
|
9
|
|
|
|
|
43
|
push @path_info, \%arc; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
elsif (uc $command eq 'M') { |
569
|
72
|
|
|
|
|
106
|
my $expect_numbers = 2; |
570
|
72
|
|
|
|
|
149
|
my $position = position_type ($command); |
571
|
72
|
50
|
|
|
|
192
|
if (@numbers < $expect_numbers) { |
572
|
0
|
|
|
|
|
0
|
croak "$me: Need at least $expect_numbers numbers for move to"; |
573
|
|
|
|
|
|
|
} |
574
|
72
|
50
|
|
|
|
183
|
if (@numbers % $expect_numbers != 0) { |
575
|
0
|
|
|
|
|
0
|
croak "$me: Odd number of values for an M command " . |
576
|
|
|
|
|
|
|
scalar (@numbers) . " in '$path'"; |
577
|
|
|
|
|
|
|
} |
578
|
72
|
|
|
|
|
367
|
push @path_info, { |
579
|
|
|
|
|
|
|
type => 'moveto', |
580
|
|
|
|
|
|
|
name => 'moveto', |
581
|
|
|
|
|
|
|
position => $position, |
582
|
|
|
|
|
|
|
point => [@numbers[0,1]], |
583
|
|
|
|
|
|
|
svg_key => $command, |
584
|
|
|
|
|
|
|
}; |
585
|
|
|
|
|
|
|
# M can be followed by implicit line-to commands, so |
586
|
|
|
|
|
|
|
# consume these. |
587
|
72
|
100
|
|
|
|
228
|
if (@numbers > $expect_numbers) { |
588
|
9
|
|
|
|
|
33
|
my @implicit_lineto = splice @numbers, $expect_numbers; |
589
|
9
|
|
|
|
|
38
|
push @path_info, build_lineto ($position, @implicit_lineto); |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
else { |
593
|
0
|
|
|
|
|
0
|
croak "I don't know what to do with a curve type '$command'"; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
# Now sort it out if the user wants to get rid of the absolute |
598
|
|
|
|
|
|
|
# paths etc. |
599
|
|
|
|
|
|
|
|
600
|
63
|
|
|
|
|
131
|
my $absolute = $options_ref->{absolute}; |
601
|
63
|
|
100
|
|
|
228
|
my $no_smooth = $options_ref->{no_shortcuts} || $options_ref->{no_smooth}; |
602
|
63
|
100
|
|
|
|
142
|
if ($absolute) { |
603
|
7
|
100
|
|
|
|
17
|
if ($verbose) { |
604
|
2
|
|
|
|
|
18
|
print "Making all coordinates absolute.\n"; |
605
|
|
|
|
|
|
|
} |
606
|
7
|
|
|
|
|
20
|
my @abs_pos = (0, 0); |
607
|
7
|
|
|
|
|
12
|
my @start_drawing; |
608
|
|
|
|
|
|
|
my $previous; |
609
|
7
|
|
|
|
|
10
|
my $begin_drawing = 1; ##This will get updated after |
610
|
7
|
|
|
|
|
17
|
for my $element (@path_info) { |
611
|
73
|
100
|
|
|
|
227
|
if ($element->{type} eq 'moveto') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
612
|
13
|
|
|
|
|
17
|
$begin_drawing = 1; |
613
|
13
|
100
|
|
|
|
30
|
if ($element->{position} eq 'relative') { |
614
|
5
|
|
|
|
|
9
|
my $ip = $options_ref->{initial_position}; |
615
|
5
|
50
|
|
|
|
10
|
if ($ip) { |
616
|
0
|
0
|
0
|
|
|
0
|
if (ref $ip ne 'ARRAY' || |
617
|
|
|
|
|
|
|
scalar @$ip != 2) { |
618
|
0
|
|
|
|
|
0
|
croak "$me: The initial position supplied doesn't look like a pair of coordinates"; |
619
|
|
|
|
|
|
|
} |
620
|
0
|
|
|
|
|
0
|
add_coords ($element->{point}, $ip); |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
else { |
623
|
5
|
|
|
|
|
13
|
add_coords ($element->{point}, \@abs_pos); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
} |
626
|
13
|
|
|
|
|
19
|
@abs_pos = @{$element->{point}}; |
|
13
|
|
|
|
|
32
|
|
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
elsif ($element->{type} eq 'line-to') { |
629
|
18
|
100
|
|
|
|
37
|
if ($element->{position} eq 'relative') { |
630
|
17
|
|
|
|
|
32
|
add_coords ($element->{point}, \@abs_pos); |
631
|
|
|
|
|
|
|
} |
632
|
18
|
100
|
|
|
|
39
|
if ($begin_drawing) { |
633
|
6
|
100
|
|
|
|
13
|
if ($verbose) { |
634
|
1
|
|
|
|
|
20
|
printf "Beginning drawing at [%.4f, %.4f]\n", @abs_pos; |
635
|
|
|
|
|
|
|
} |
636
|
6
|
|
|
|
|
11
|
$begin_drawing = 0; |
637
|
6
|
|
|
|
|
14
|
@start_drawing = @abs_pos; |
638
|
|
|
|
|
|
|
} |
639
|
18
|
|
|
|
|
24
|
@abs_pos = @{$element->{point}}; |
|
18
|
|
|
|
|
46
|
|
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
elsif ($element->{type} eq 'horizontal-line-to') { |
642
|
10
|
50
|
|
|
|
18
|
if ($element->{position} eq 'relative') { |
643
|
10
|
|
|
|
|
18
|
$element->{x} += $abs_pos[0]; |
644
|
|
|
|
|
|
|
} |
645
|
10
|
50
|
|
|
|
18
|
if ($begin_drawing) { |
646
|
0
|
0
|
|
|
|
0
|
if ($verbose) { |
647
|
0
|
|
|
|
|
0
|
printf "Beginning drawing at [%.4f, %.4f]\n", @abs_pos; |
648
|
|
|
|
|
|
|
} |
649
|
0
|
|
|
|
|
0
|
$begin_drawing = 0; |
650
|
0
|
|
|
|
|
0
|
@start_drawing = @abs_pos; |
651
|
|
|
|
|
|
|
} |
652
|
10
|
|
|
|
|
12
|
$abs_pos[0] = $element->{x}; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
elsif ($element->{type} eq 'vertical-line-to') { |
655
|
18
|
50
|
|
|
|
31
|
if ($element->{position} eq 'relative') { |
656
|
18
|
|
|
|
|
45
|
$element->{y} += $abs_pos[1]; |
657
|
|
|
|
|
|
|
} |
658
|
18
|
100
|
|
|
|
32
|
if ($begin_drawing) { |
659
|
4
|
100
|
|
|
|
10
|
if ($verbose) { |
660
|
2
|
|
|
|
|
37
|
printf "Beginning drawing at [%.4f, %.4f]\n", @abs_pos; |
661
|
|
|
|
|
|
|
} |
662
|
4
|
|
|
|
|
9
|
$begin_drawing = 0; |
663
|
4
|
|
|
|
|
11
|
@start_drawing = @abs_pos; |
664
|
|
|
|
|
|
|
} |
665
|
18
|
|
|
|
|
24
|
$abs_pos[1] = $element->{y}; |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
elsif ($element->{type} eq 'cubic-bezier') { |
668
|
0
|
0
|
|
|
|
0
|
if ($element->{position} eq 'relative') { |
669
|
0
|
|
|
|
|
0
|
add_coords ($element->{control1}, \@abs_pos); |
670
|
0
|
|
|
|
|
0
|
add_coords ($element->{control2}, \@abs_pos); |
671
|
0
|
|
|
|
|
0
|
add_coords ($element->{end}, \@abs_pos); |
672
|
|
|
|
|
|
|
} |
673
|
0
|
0
|
|
|
|
0
|
if ($begin_drawing) { |
674
|
0
|
0
|
|
|
|
0
|
if ($verbose) { |
675
|
0
|
|
|
|
|
0
|
printf "Beginning drawing at [%.4f, %.4f]\n", @abs_pos; |
676
|
|
|
|
|
|
|
} |
677
|
0
|
|
|
|
|
0
|
$begin_drawing = 0; |
678
|
0
|
|
|
|
|
0
|
@start_drawing = @abs_pos; |
679
|
|
|
|
|
|
|
} |
680
|
0
|
|
|
|
|
0
|
@abs_pos = @{$element->{end}}; |
|
0
|
|
|
|
|
0
|
|
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
elsif ($element->{type} eq 'smooth-cubic-bezier') { |
683
|
2
|
50
|
|
|
|
8
|
if ($element->{position} eq 'relative') { |
684
|
2
|
|
|
|
|
7
|
add_coords ($element->{control2}, \@abs_pos); |
685
|
2
|
|
|
|
|
5
|
add_coords ($element->{end}, \@abs_pos); |
686
|
|
|
|
|
|
|
} |
687
|
2
|
50
|
|
|
|
6
|
if ($no_smooth) { |
688
|
2
|
|
|
|
|
3
|
$element->{type} = 'cubic-bezier'; |
689
|
2
|
|
|
|
|
4
|
$element->{svg_key} = 'C'; |
690
|
2
|
100
|
66
|
|
|
10
|
if ($previous && $previous->{type} eq 'cubic-bezier') { |
691
|
|
|
|
|
|
|
$element->{control1} = [ |
692
|
|
|
|
|
|
|
2 * $abs_pos[0] - $previous->{control2}->[0], |
693
|
1
|
|
|
|
|
5
|
2 * $abs_pos[1] - $previous->{control2}->[1], |
694
|
|
|
|
|
|
|
]; |
695
|
|
|
|
|
|
|
} else { |
696
|
1
|
|
|
|
|
3
|
$element->{control1} = [@abs_pos]; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
} |
699
|
2
|
100
|
|
|
|
6
|
if ($begin_drawing) { |
700
|
1
|
50
|
|
|
|
3
|
if ($verbose) { |
701
|
0
|
|
|
|
|
0
|
printf "Beginning drawing at [%.4f, %.4f]\n", @abs_pos; |
702
|
|
|
|
|
|
|
} |
703
|
1
|
|
|
|
|
4
|
$begin_drawing = 0; |
704
|
1
|
|
|
|
|
3
|
@start_drawing = @abs_pos; |
705
|
|
|
|
|
|
|
} |
706
|
2
|
|
|
|
|
2
|
@abs_pos = @{$element->{end}}; |
|
2
|
|
|
|
|
6
|
|
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
elsif ($element->{type} eq 'quadratic-bezier') { |
709
|
1
|
50
|
|
|
|
5
|
if ($element->{position} eq 'relative') { |
710
|
1
|
|
|
|
|
4
|
add_coords ($element->{control}, \@abs_pos); |
711
|
1
|
|
|
|
|
4
|
add_coords ($element->{end}, \@abs_pos); |
712
|
|
|
|
|
|
|
} |
713
|
1
|
50
|
|
|
|
4
|
if ($begin_drawing) { |
714
|
1
|
50
|
|
|
|
4
|
if ($verbose) { |
715
|
0
|
|
|
|
|
0
|
printf "Beginning drawing at [%.4f, %.4f]\n", @abs_pos; |
716
|
|
|
|
|
|
|
} |
717
|
1
|
|
|
|
|
2
|
$begin_drawing = 0; |
718
|
1
|
|
|
|
|
3
|
@start_drawing = @abs_pos; |
719
|
|
|
|
|
|
|
} |
720
|
1
|
|
|
|
|
2
|
@abs_pos = @{$element->{end}}; |
|
1
|
|
|
|
|
3
|
|
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
elsif ($element->{type} eq 'smooth-quadratic-bezier') { |
723
|
2
|
50
|
|
|
|
6
|
if ($element->{position} eq 'relative') { |
724
|
2
|
|
|
|
|
6
|
add_coords ($element->{end}, \@abs_pos); |
725
|
|
|
|
|
|
|
} |
726
|
2
|
50
|
|
|
|
5
|
if ($no_smooth) { |
727
|
2
|
|
|
|
|
5
|
$element->{type} = 'quadratic-bezier'; |
728
|
2
|
|
|
|
|
5
|
$element->{svg_key} = 'Q'; |
729
|
2
|
100
|
66
|
|
|
9
|
if ($previous && $previous->{type} eq 'quadratic-bezier') { |
730
|
|
|
|
|
|
|
$element->{control} = [ |
731
|
|
|
|
|
|
|
2 * $abs_pos[0] - $previous->{control}->[0], |
732
|
1
|
|
|
|
|
5
|
2 * $abs_pos[1] - $previous->{control}->[1], |
733
|
|
|
|
|
|
|
]; |
734
|
|
|
|
|
|
|
} else { |
735
|
1
|
|
|
|
|
4
|
$element->{control} = [@abs_pos]; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
} |
738
|
2
|
100
|
|
|
|
11
|
if ($begin_drawing) { |
739
|
1
|
50
|
|
|
|
4
|
if ($verbose) { |
740
|
0
|
|
|
|
|
0
|
printf "Beginning drawing at [%.4f, %.4f]\n", @abs_pos; |
741
|
|
|
|
|
|
|
} |
742
|
1
|
|
|
|
|
2
|
$begin_drawing = 0; |
743
|
1
|
|
|
|
|
3
|
@start_drawing = @abs_pos; |
744
|
|
|
|
|
|
|
} |
745
|
2
|
|
|
|
|
3
|
@abs_pos = @{$element->{end}}; |
|
2
|
|
|
|
|
6
|
|
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
elsif ($element->{type} eq 'arc') { |
748
|
|
|
|
|
|
|
|
749
|
1
|
50
|
|
|
|
5
|
if ($element->{position} eq 'relative') { |
750
|
1
|
|
|
|
|
4
|
$element->{x} += $abs_pos[0]; |
751
|
1
|
|
|
|
|
3
|
$element->{y} += $abs_pos[1]; |
752
|
|
|
|
|
|
|
} |
753
|
1
|
50
|
|
|
|
3
|
if ($begin_drawing) { |
754
|
0
|
0
|
|
|
|
0
|
if ($verbose) { |
755
|
0
|
|
|
|
|
0
|
printf "Beginning drawing at [%.4f, %.4f]\n", @abs_pos; |
756
|
|
|
|
|
|
|
} |
757
|
0
|
|
|
|
|
0
|
$begin_drawing = 0; |
758
|
0
|
|
|
|
|
0
|
@start_drawing = @abs_pos; |
759
|
|
|
|
|
|
|
} |
760
|
1
|
|
|
|
|
3
|
@abs_pos = ($element->{x}, $element->{y}); |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
elsif ($element->{type} eq 'closepath') { |
763
|
8
|
100
|
|
|
|
16
|
if ($verbose) { |
764
|
2
|
|
|
|
|
26
|
printf "Closing drawing shape to [%.4f, %.4f]\n", @start_drawing; |
765
|
|
|
|
|
|
|
} |
766
|
8
|
|
|
|
|
22
|
@abs_pos = @start_drawing; |
767
|
8
|
|
|
|
|
12
|
$begin_drawing = 1; |
768
|
|
|
|
|
|
|
} |
769
|
73
|
|
|
|
|
116
|
$element->{position} = 'absolute'; |
770
|
73
|
50
|
|
|
|
120
|
if (! $element->{svg_key}) { |
771
|
0
|
|
|
|
|
0
|
die "No SVG key"; |
772
|
|
|
|
|
|
|
} |
773
|
73
|
|
|
|
|
112
|
$element->{svg_key} = uc $element->{svg_key}; |
774
|
73
|
|
|
|
|
114
|
$previous = $element; |
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
} |
777
|
63
|
|
|
|
|
369
|
return @path_info; |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
# Given a current position and an array of coordinates, use the |
781
|
|
|
|
|
|
|
# coordinates to build up line-to elements until the coordinates are |
782
|
|
|
|
|
|
|
# exhausted. Before entering this, it should have been checked that |
783
|
|
|
|
|
|
|
# there is an even number of coordinates. |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
sub build_lineto |
786
|
|
|
|
|
|
|
{ |
787
|
38
|
|
|
38
|
0
|
94
|
my ($position, @coords) = @_; |
788
|
38
|
|
|
|
|
66
|
my @path_info = (); |
789
|
38
|
|
|
|
|
69
|
my $n_coords = scalar (@coords); |
790
|
38
|
50
|
|
|
|
91
|
if ($n_coords % 2 != 0) { |
791
|
|
|
|
|
|
|
# This trap should never be reached, since we should always |
792
|
|
|
|
|
|
|
# check before entering this routine. However, we keep it for |
793
|
|
|
|
|
|
|
# safety. |
794
|
0
|
|
|
|
|
0
|
croak "Odd number of coordinates in lineto"; |
795
|
|
|
|
|
|
|
} |
796
|
38
|
|
|
|
|
117
|
while (my ($x, $y) = splice @coords, 0, 2) { |
797
|
54
|
100
|
|
|
|
359
|
push @path_info, { |
798
|
|
|
|
|
|
|
type => 'line-to', |
799
|
|
|
|
|
|
|
name => 'lineto', |
800
|
|
|
|
|
|
|
position => $position, |
801
|
|
|
|
|
|
|
point => [$x, $y], |
802
|
|
|
|
|
|
|
end => [$x, $y], |
803
|
|
|
|
|
|
|
svg_key => ($position eq 'absolute' ? 'L' : 'l'), |
804
|
|
|
|
|
|
|
}; |
805
|
|
|
|
|
|
|
} |
806
|
38
|
|
|
|
|
112
|
return @path_info; |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
1; |