line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::API2::Content; |
2
|
|
|
|
|
|
|
|
3
|
38
|
|
|
38
|
|
300
|
use base 'PDF::API2::Basic::PDF::Dict'; |
|
38
|
|
|
|
|
79
|
|
|
38
|
|
|
|
|
3854
|
|
4
|
|
|
|
|
|
|
|
5
|
38
|
|
|
38
|
|
260
|
use strict; |
|
38
|
|
|
|
|
75
|
|
|
38
|
|
|
|
|
725
|
|
6
|
38
|
|
|
38
|
|
175
|
use warnings; |
|
38
|
|
|
|
|
80
|
|
|
38
|
|
|
|
|
1494
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '2.043'; # VERSION |
9
|
|
|
|
|
|
|
|
10
|
38
|
|
|
38
|
|
203
|
use Carp; |
|
38
|
|
|
|
|
79
|
|
|
38
|
|
|
|
|
1955
|
|
11
|
38
|
|
|
38
|
|
234
|
use Compress::Zlib (); |
|
38
|
|
|
|
|
84
|
|
|
38
|
|
|
|
|
1118
|
|
12
|
38
|
|
|
38
|
|
225
|
use Encode; |
|
38
|
|
|
|
|
75
|
|
|
38
|
|
|
|
|
3891
|
|
13
|
38
|
|
|
38
|
|
298
|
use Math::Trig; |
|
38
|
|
|
|
|
84
|
|
|
38
|
|
|
|
|
6766
|
|
14
|
38
|
|
|
38
|
|
16846
|
use PDF::API2::Matrix; |
|
38
|
|
|
|
|
104
|
|
|
38
|
|
|
|
|
1241
|
|
15
|
|
|
|
|
|
|
|
16
|
38
|
|
|
38
|
|
308
|
use PDF::API2::Basic::PDF::Utils; |
|
38
|
|
|
|
|
81
|
|
|
38
|
|
|
|
|
2766
|
|
17
|
38
|
|
|
38
|
|
249
|
use PDF::API2::Util; |
|
38
|
|
|
|
|
97
|
|
|
38
|
|
|
|
|
469756
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
PDF::API2::Content - Methods for adding graphics and text to a PDF |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 SYNOPSIS |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Start with a PDF page (new or opened) |
26
|
|
|
|
|
|
|
my $pdf = PDF::API2->new(); |
27
|
|
|
|
|
|
|
my $page = $pdf->page(); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# Add a new content object |
30
|
|
|
|
|
|
|
my $content = $page->graphics(); |
31
|
|
|
|
|
|
|
my $content = $page->text(); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Then call the methods below add graphics and text to the page. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=cut |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub new { |
38
|
122
|
|
|
122
|
1
|
228
|
my $class = shift(); |
39
|
122
|
|
|
|
|
424
|
my $self = $class->SUPER::new(); |
40
|
|
|
|
|
|
|
|
41
|
122
|
|
|
|
|
285
|
$self->{' stream'} = ''; |
42
|
122
|
|
|
|
|
241
|
$self->{' poststream'} = ''; |
43
|
122
|
|
|
|
|
538
|
$self->{' font'} = undef; |
44
|
122
|
|
|
|
|
242
|
$self->{' fontset'} = 0; |
45
|
122
|
|
|
|
|
231
|
$self->{' fontsize'} = 0; |
46
|
122
|
|
|
|
|
224
|
$self->{' charspace'} = 0; |
47
|
122
|
|
|
|
|
300
|
$self->{' hscale'} = 100; |
48
|
122
|
|
|
|
|
218
|
$self->{' wordspace'} = 0; |
49
|
122
|
|
|
|
|
212
|
$self->{' leading'} = 0; |
50
|
122
|
|
|
|
|
213
|
$self->{' rise'} = 0; |
51
|
122
|
|
|
|
|
226
|
$self->{' render'} = 0; |
52
|
122
|
|
|
|
|
332
|
$self->{' matrix'} = [1, 0, 0, 1, 0, 0]; |
53
|
122
|
|
|
|
|
321
|
$self->{' textmatrix'} = [1, 0, 0, 1, 0, 0]; |
54
|
122
|
|
|
|
|
264
|
$self->{' textlinematrix'} = [0, 0]; |
55
|
122
|
|
|
|
|
385
|
$self->{' fillcolor'} = [0]; |
56
|
122
|
|
|
|
|
325
|
$self->{' strokecolor'} = [0]; |
57
|
122
|
|
|
|
|
340
|
$self->{' translate'} = [0, 0]; |
58
|
122
|
|
|
|
|
290
|
$self->{' scale'} = [1, 1]; |
59
|
122
|
|
|
|
|
269
|
$self->{' skew'} = [0, 0]; |
60
|
122
|
|
|
|
|
188
|
$self->{' rotate'} = 0; |
61
|
122
|
|
|
|
|
233
|
$self->{' apiistext'} = 0; |
62
|
|
|
|
|
|
|
|
63
|
122
|
|
|
|
|
272
|
return $self; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub outobjdeep { |
67
|
114
|
|
|
114
|
1
|
224
|
my $self = shift(); |
68
|
114
|
|
|
|
|
378
|
$self->textend(); |
69
|
114
|
50
|
66
|
|
|
313
|
if ($self->{'-docompress'} and $self->{'Filter'}) { |
70
|
6
|
|
|
|
|
43
|
$self->{' stream'} = Compress::Zlib::compress($self->{' stream'}); |
71
|
6
|
|
|
|
|
2056
|
$self->{' nofilt'} = 1; |
72
|
6
|
|
|
|
|
21
|
delete $self->{'-docompress'}; |
73
|
|
|
|
|
|
|
} |
74
|
114
|
|
|
|
|
383
|
return $self->SUPER::outobjdeep(@_); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=head1 COORDINATE TRANSFORMATIONS |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
The methods in this section change the coordinate system for the current content |
80
|
|
|
|
|
|
|
object relative to the rest of the document. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Changes to the coordinate system only affect subsequent paths or text. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
A call to any of the methods in this section resets the coordinate system before |
85
|
|
|
|
|
|
|
applying its changes, unless the C option is set. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 translate |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
$content = $content->translate($x, $y); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Moves the origin along the x and y axes. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=cut |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub _translate { |
96
|
12
|
|
|
12
|
|
34
|
my ($x, $y) = @_; |
97
|
12
|
|
|
|
|
47
|
return (1, 0, 0, 1, $x, $y); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub translate { |
101
|
2
|
|
|
2
|
1
|
14
|
my ($self, $x, $y) = @_; |
102
|
2
|
|
|
|
|
15
|
$self->transform(translate => [$x, $y]); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head2 rotate |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
$content = $content->rotate($degrees); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Rotates the coordinate system counter-clockwise. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Use a negative argument to rotate clockwise. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=cut |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _rotate { |
116
|
9
|
|
|
9
|
|
27
|
my $a = deg2rad(shift()); |
117
|
9
|
|
|
|
|
147
|
return (cos($a), sin($a), -sin($a), cos($a), 0, 0); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub rotate { |
121
|
1
|
|
|
1
|
1
|
10
|
my ($self, $a) = @_; |
122
|
1
|
|
|
|
|
4
|
$self->transform(rotate => $a); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head2 scale |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
$content = $content->scale($x, $y); |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Scales (stretches) the coordinate systems along the x and y axes. A value of 1 |
130
|
|
|
|
|
|
|
for either C<$x> or C<$y> represents 100% scale (i.e. no change). |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=cut |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub _scale { |
135
|
9
|
|
|
9
|
|
18
|
my ($x, $y) = @_; |
136
|
9
|
|
|
|
|
25
|
return ($x, 0, 0, $y, 0, 0); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub scale { |
140
|
1
|
|
|
1
|
1
|
9
|
my ($self, $sx, $sy) = @_; |
141
|
1
|
|
|
|
|
5
|
$self->transform(scale => [$sx, $sy]); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head2 skew |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
$content = $content->skew($a, $b); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Skews the coordinate system by C<$a> degrees (counter-clockwise) from the x axis |
149
|
|
|
|
|
|
|
and C<$b> degrees (clockwise) from the y axis. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=cut |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub _skew { |
154
|
9
|
|
|
9
|
|
29
|
my $a = deg2rad(shift()); |
155
|
9
|
|
|
|
|
116
|
my $b = deg2rad(shift()); |
156
|
9
|
|
|
|
|
85
|
return (1, tan($a), tan($b), 1, 0, 0); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub skew { |
160
|
1
|
|
|
1
|
1
|
8
|
my ($self, $a, $b) = @_; |
161
|
1
|
|
|
|
|
5
|
$self->transform(skew => [$a, $b]); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head2 transform |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
$content = $content->transform( |
167
|
|
|
|
|
|
|
translate => [$x, $y], |
168
|
|
|
|
|
|
|
rotate => $degrees, |
169
|
|
|
|
|
|
|
scale => [$x, $y], |
170
|
|
|
|
|
|
|
skew => [$a, $b], |
171
|
|
|
|
|
|
|
relative => $boolean, |
172
|
|
|
|
|
|
|
); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Performs multiple coordinate transformations, in the order recommended by the |
175
|
|
|
|
|
|
|
PDF specification (translate, rotate, scale, then skew). Omitted options will |
176
|
|
|
|
|
|
|
be unchanged. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
If C is true, the specified transformations will be added to any |
179
|
|
|
|
|
|
|
previous changes to the coordinate system. By default, calling C or |
180
|
|
|
|
|
|
|
any of the other transformation methods will overwrite any previous changes to |
181
|
|
|
|
|
|
|
the coordinate system. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=cut |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub _to_matrix { |
186
|
39
|
|
|
39
|
|
347
|
my @array = @_; |
187
|
39
|
|
|
|
|
165
|
return PDF::API2::Matrix->new([$array[0], $array[1], 0], |
188
|
|
|
|
|
|
|
[$array[2], $array[3], 0], |
189
|
|
|
|
|
|
|
[$array[4], $array[5], 1]); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub _transform { |
193
|
15
|
|
|
15
|
|
40
|
my %opts = @_; |
194
|
15
|
|
|
|
|
126
|
my $m = PDF::API2::Matrix->new([1, 0, 0], [0, 1, 0], [0, 0, 1]); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# Undocumented; only used by textpos() |
197
|
15
|
50
|
|
|
|
78
|
if (defined $opts{'-matrix'}) { |
198
|
0
|
|
|
|
|
0
|
$m = $m->multiply(_to_matrix(@{$opts{'-matrix'}})); |
|
0
|
|
|
|
|
0
|
|
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# Note that the transformations are applied in reverse order. See PDF 1.7 |
202
|
|
|
|
|
|
|
# specification section 8.3.4: Transformation Matrices. |
203
|
15
|
100
|
|
|
|
48
|
if (defined $opts{'skew'}) { |
204
|
9
|
|
|
|
|
15
|
$m = $m->multiply(_to_matrix(_skew(@{$opts{'skew'}}))); |
|
9
|
|
|
|
|
27
|
|
205
|
|
|
|
|
|
|
} |
206
|
15
|
100
|
|
|
|
52
|
if (defined $opts{'scale'}) { |
207
|
9
|
|
|
|
|
17
|
$m = $m->multiply(_to_matrix(_scale(@{$opts{'scale'}}))); |
|
9
|
|
|
|
|
22
|
|
208
|
|
|
|
|
|
|
} |
209
|
15
|
100
|
|
|
|
54
|
if (defined $opts{'rotate'}) { |
210
|
9
|
|
|
|
|
29
|
$m = $m->multiply(_to_matrix(_rotate($opts{'rotate'}))); |
211
|
|
|
|
|
|
|
} |
212
|
15
|
100
|
|
|
|
54
|
if (defined $opts{'translate'}) { |
213
|
12
|
|
|
|
|
42
|
$m = $m->multiply(_to_matrix(_translate(@{$opts{'translate'}}))); |
|
12
|
|
|
|
|
53
|
|
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Undocumented; only used by textpos() |
217
|
15
|
50
|
|
|
|
70
|
if ($opts{'-point'}) { |
218
|
|
|
|
|
|
|
my $mp = PDF::API2::Matrix->new([$opts{'-point'}->[0], |
219
|
0
|
|
|
|
|
0
|
$opts{'-point'}->[1], 1]); |
220
|
0
|
|
|
|
|
0
|
$mp = $mp->multiply($m); |
221
|
0
|
|
|
|
|
0
|
return ($mp->[0][0], $mp->[0][1]); |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
return ( |
225
|
15
|
|
|
|
|
155
|
$m->[0][0], $m->[0][1], |
226
|
|
|
|
|
|
|
$m->[1][0], $m->[1][1], |
227
|
|
|
|
|
|
|
$m->[2][0], $m->[2][1] |
228
|
|
|
|
|
|
|
); |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# Transformations are described in the PDF 1.7 specification, section 8.3.3: |
232
|
|
|
|
|
|
|
# Common Transformations. |
233
|
|
|
|
|
|
|
sub transform { |
234
|
16
|
|
|
16
|
1
|
2055
|
my ($self, %options) = @_; |
235
|
16
|
100
|
|
|
|
67
|
return $self->transform_rel(%options) if $options{'relative'}; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# Deprecated options (remove hyphens) |
238
|
15
|
|
|
|
|
40
|
foreach my $option (qw(translate rotate scale skew)) { |
239
|
60
|
100
|
|
|
|
157
|
if (exists $options{'-' . $option}) { |
240
|
14
|
|
33
|
|
|
82
|
$options{$option} //= delete $options{'-' . $option}; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# Apply the transformations |
245
|
15
|
|
|
|
|
76
|
$self->matrix(_transform(%options)); |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# Store the transformations for lookup or future relative transformations |
248
|
15
|
|
100
|
|
|
70
|
$self->{' translate'} = $options{'translate'} // [0, 0]; |
249
|
15
|
|
100
|
|
|
73
|
$self->{' rotate'} = $options{'rotate'} // 0; |
250
|
15
|
|
100
|
|
|
56
|
$self->{' scale'} = $options{'scale'} // [1, 1]; |
251
|
15
|
|
100
|
|
|
57
|
$self->{' skew'} = $options{'skew'} // [0, 0]; |
252
|
|
|
|
|
|
|
|
253
|
15
|
|
|
|
|
51
|
return $self; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub transform_rel { |
257
|
2
|
|
|
2
|
1
|
16
|
my ($self, %options) = @_; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# Deprecated options (remove hyphens) |
260
|
2
|
|
|
|
|
8
|
foreach my $option (qw(translate rotate scale skew)) { |
261
|
8
|
100
|
|
|
|
25
|
if (exists $options{'-' . $option}) { |
262
|
4
|
|
33
|
|
|
18
|
$options{$option} //= delete $options{'-' . $option}; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
2
|
50
|
|
|
|
4
|
my ($sa1, $sb1) = @{$options{'skew'} ? $options{'skew'} : [0, 0]}; |
|
2
|
|
|
|
|
11
|
|
267
|
2
|
|
|
|
|
4
|
my ($sa0, $sb0) = @{$self->{' skew'}}; |
|
2
|
|
|
|
|
8
|
|
268
|
|
|
|
|
|
|
|
269
|
2
|
50
|
|
|
|
5
|
my ($sx1, $sy1) = @{$options{'scale'} ? $options{'scale'} : [1, 1]}; |
|
2
|
|
|
|
|
9
|
|
270
|
2
|
|
|
|
|
16
|
my ($sx0, $sy0) = @{$self->{' scale'}}; |
|
2
|
|
|
|
|
9
|
|
271
|
|
|
|
|
|
|
|
272
|
2
|
|
50
|
|
|
10
|
my $r1 = $options{'rotate'} // 0; |
273
|
2
|
|
|
|
|
5
|
my $r0 = $self->{' rotate'}; |
274
|
|
|
|
|
|
|
|
275
|
2
|
50
|
|
|
|
4
|
my ($tx1, $ty1) = @{$options{'translate'} ? $options{'translate'} : [0, 0]}; |
|
2
|
|
|
|
|
7
|
|
276
|
2
|
|
|
|
|
4
|
my ($tx0, $ty0) = @{$self->{' translate'}}; |
|
2
|
|
|
|
|
8
|
|
277
|
|
|
|
|
|
|
|
278
|
2
|
|
|
|
|
18
|
$self->transform( |
279
|
|
|
|
|
|
|
skew => [$sa0 + $sa1, $sb0 + $sb1], |
280
|
|
|
|
|
|
|
scale => [$sx0 * $sx1, $sy0 * $sy1], |
281
|
|
|
|
|
|
|
rotate => $r0 + $r1, |
282
|
|
|
|
|
|
|
translate => [$tx0 + $tx1, $ty0 + $ty1], |
283
|
|
|
|
|
|
|
); |
284
|
|
|
|
|
|
|
|
285
|
2
|
|
|
|
|
9
|
return $self; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head2 matrix |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
$graphics = $graphics->matrix($a, $b, $c, $d, $e, $f); |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
($a, $b, $c, $d, $e, $f) = $text->matrix($a, $b, $c, $d, $e, $f); |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Sets the current transformation matrix manually. Unless you have a particular |
295
|
|
|
|
|
|
|
need to enter transformations manually, you should use the C method |
296
|
|
|
|
|
|
|
instead. |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
The return value differs based on whether the caller is a graphics content |
299
|
|
|
|
|
|
|
object or a text content object. |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=cut |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
sub _matrix_text { |
304
|
3
|
|
|
3
|
|
12
|
my ($a, $b, $c, $d, $e, $f) = @_; |
305
|
3
|
|
|
|
|
21
|
return (floats($a, $b, $c, $d, $e, $f), 'Tm'); |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub _matrix_gfx { |
309
|
23
|
|
|
23
|
|
61
|
my ($a, $b, $c, $d, $e, $f) = @_; |
310
|
23
|
|
|
|
|
114
|
return (floats($a, $b, $c, $d, $e, $f), 'cm'); |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub matrix { |
314
|
26
|
|
|
26
|
1
|
66
|
my $self = shift(); |
315
|
26
|
50
|
|
|
|
89
|
if (scalar(@_)) { |
316
|
26
|
|
|
|
|
87
|
my ($a, $b, $c, $d, $e, $f) = @_; |
317
|
26
|
100
|
|
|
|
79
|
if ($self->_in_text_object()) { |
318
|
3
|
|
|
|
|
18
|
$self->add(_matrix_text($a, $b, $c, $d, $e, $f)); |
319
|
3
|
|
|
|
|
39
|
$self->{' textmatrix'} = [$a, $b, $c, $d, $e, $f]; |
320
|
3
|
|
|
|
|
16
|
$self->{' textlinematrix'} = [0, 0]; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
else { |
323
|
23
|
|
|
|
|
139
|
$self->add(_matrix_gfx($a, $b, $c, $d, $e, $f)); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
26
|
100
|
|
|
|
87
|
if ($self->_in_text_object()) { |
328
|
3
|
|
|
|
|
10
|
return @{$self->{' textmatrix'}}; |
|
3
|
|
|
|
|
11
|
|
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
else { |
331
|
23
|
|
|
|
|
47
|
return $self; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
sub matrix_update { |
336
|
70
|
|
|
70
|
0
|
145
|
my ($self, $tx, $ty) = @_; |
337
|
70
|
|
|
|
|
130
|
$self->{' textlinematrix'}->[0] += $tx; |
338
|
70
|
|
|
|
|
110
|
$self->{' textlinematrix'}->[1] += $ty; |
339
|
70
|
|
|
|
|
103
|
return $self; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=head1 GRAPHICS STATE |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head2 save |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
$content = $content->save(); |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Saves the current graphics state on a stack. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=cut |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub _save { |
353
|
11
|
|
|
11
|
|
75
|
return 'q'; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub save { |
357
|
11
|
|
|
11
|
1
|
32
|
my $self = shift; |
358
|
11
|
50
|
|
|
|
47
|
if ($self->_in_text_object()) { |
359
|
0
|
|
|
|
|
0
|
carp 'Calling save from a text content object has no effect'; |
360
|
0
|
|
|
|
|
0
|
return; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
11
|
|
|
|
|
65
|
$self->add(_save()); |
364
|
|
|
|
|
|
|
|
365
|
11
|
|
|
|
|
21
|
return $self; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=head2 restore |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
$content = $content->restore(); |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Restores the most recently saved graphics state, removing it from the stack. |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub _restore { |
377
|
11
|
|
|
11
|
|
45
|
return 'Q'; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub restore { |
381
|
11
|
|
|
11
|
1
|
43
|
my $self = shift; |
382
|
11
|
50
|
|
|
|
34
|
if ($self->_in_text_object()) { |
383
|
0
|
|
|
|
|
0
|
carp 'Calling save from a text content object has no effect'; |
384
|
0
|
|
|
|
|
0
|
return; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
11
|
|
|
|
|
65
|
$self->add(_restore()); |
388
|
|
|
|
|
|
|
|
389
|
11
|
|
|
|
|
22
|
return $self; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head2 line_width |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
$content = $content->line_width($points); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Sets the width of the stroke in points. |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=cut |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
sub _linewidth { |
401
|
88
|
|
|
88
|
|
126
|
my $linewidth = shift(); |
402
|
88
|
|
|
|
|
227
|
return ($linewidth, 'w'); |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# Deprecated (renamed) |
406
|
87
|
|
|
87
|
1
|
203
|
sub linewidth { return line_width(@_) } |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub line_width { |
409
|
88
|
|
|
88
|
1
|
157
|
my ($self, $line_width) = @_; |
410
|
|
|
|
|
|
|
|
411
|
88
|
|
|
|
|
152
|
$self->add(_linewidth($line_width)); |
412
|
|
|
|
|
|
|
|
413
|
88
|
|
|
|
|
166
|
return $self; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=head2 line_cap |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
$content = $content->line_cap($style); |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Sets the shape that will be used at the ends of open subpaths (and dashes, if |
421
|
|
|
|
|
|
|
any) when they are stroked. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=over |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=item * "butt" or 0 = Butt Cap, default |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
The stroke ends at the end of the path, with no projection. |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=item * "round" or 1 = Round Cap) |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
An arc is drawn around the end of the path with a diameter equal to the line |
432
|
|
|
|
|
|
|
width, and is filled in. |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=item * "square" or 2 = Projecting Square Cap |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
The stroke continues past the end of the path for half the line width. |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=back |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=cut |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
sub _linecap { |
443
|
2
|
|
|
2
|
|
6
|
my $linecap = shift(); |
444
|
2
|
|
|
|
|
8
|
return ($linecap, 'J'); |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# Deprecated (renamed) |
448
|
1
|
|
|
1
|
1
|
7
|
sub linecap { return line_cap(@_) } |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
sub line_cap { |
451
|
2
|
|
|
2
|
1
|
16
|
my $self = shift(); |
452
|
|
|
|
|
|
|
|
453
|
2
|
50
|
66
|
|
|
15
|
if ($self->{' graphics'} and not @_) { |
454
|
0
|
|
|
|
|
0
|
croak "Missing argument to line_cap"; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
2
|
|
50
|
|
|
11
|
my $style = shift() // 0; |
458
|
2
|
50
|
|
|
|
9
|
$style = 0 if $style eq 'butt'; |
459
|
2
|
100
|
|
|
|
8
|
$style = 1 if $style eq 'round'; |
460
|
2
|
50
|
|
|
|
8
|
$style = 2 if $style eq 'square'; |
461
|
|
|
|
|
|
|
|
462
|
2
|
50
|
33
|
|
|
14
|
unless ($style >= 0 and $style <= 2) { |
463
|
0
|
0
|
|
|
|
0
|
if ($self->{' graphics'}) { |
464
|
0
|
|
|
|
|
0
|
croak "Unknown line cap style \"$style\""; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
else { |
467
|
0
|
|
|
|
|
0
|
confess "Unknown line cap style \"$style\""; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
2
|
|
|
|
|
9
|
$self->add(_linecap($style)); |
472
|
|
|
|
|
|
|
|
473
|
2
|
|
|
|
|
8
|
return $self; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=head2 line_join |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
$content = $content->line_join($style); |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
Sets the style of join to be used at corners of a path. |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=over |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=item * "miter" or 0 = Miter Join, default |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
The outer edges of the stroke extend until they meet, up to the limit specified |
487
|
|
|
|
|
|
|
below. If the limit would be surpassed, a bevel join is used instead. |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=item * "round" or 1 = Round Join |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
A circle with a diameter equal to the linewidth is drawn around the corner |
492
|
|
|
|
|
|
|
point, producing a rounded corner. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=item * "bevel" or 2 = Bevel Join |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
A triangle is drawn to fill in the notch between the two strokes. |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=back |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=cut |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub _linejoin { |
503
|
2
|
|
|
2
|
|
4
|
my $linejoin = shift(); |
504
|
2
|
|
|
|
|
10
|
return ($linejoin, 'j'); |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
# Deprecated (renamed) |
508
|
1
|
|
|
1
|
1
|
8
|
sub linejoin { return line_join(@_) } |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
sub line_join { |
511
|
2
|
|
|
2
|
1
|
13
|
my $self = shift(); |
512
|
|
|
|
|
|
|
|
513
|
2
|
50
|
66
|
|
|
14
|
if ($self->{' graphics'} and not @_) { |
514
|
0
|
|
|
|
|
0
|
croak "Missing argument to line_join"; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
2
|
|
50
|
|
|
8
|
my $style = shift() // 0; |
518
|
2
|
50
|
|
|
|
12
|
$style = 0 if $style eq 'miter'; |
519
|
2
|
50
|
|
|
|
8
|
$style = 1 if $style eq 'round'; |
520
|
2
|
100
|
|
|
|
9
|
$style = 2 if $style eq 'bevel'; |
521
|
|
|
|
|
|
|
|
522
|
2
|
50
|
33
|
|
|
14
|
unless ($style >= 0 and $style <= 2) { |
523
|
0
|
0
|
|
|
|
0
|
if ($self->{' graphics'}) { |
524
|
0
|
|
|
|
|
0
|
croak "Unknown line join style \"$style\""; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
else { |
527
|
0
|
|
|
|
|
0
|
confess "Unknown line join style \"$style\""; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
2
|
|
|
|
|
12
|
$self->add(_linejoin($style)); |
532
|
|
|
|
|
|
|
|
533
|
2
|
|
|
|
|
6
|
return $self; |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=head2 miter_limit |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
$content = $content->miter_limit($ratio); |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
Sets the miter limit when the line join style is a miter join. |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
The C<$ratio> is the maximum length of the miter (inner to outer corner) divided |
543
|
|
|
|
|
|
|
by the line width. Any miter above this ratio will be converted to a bevel |
544
|
|
|
|
|
|
|
join. The practical effect is that lines meeting at shallow angles are chopped |
545
|
|
|
|
|
|
|
off instead of producing long pointed corners. |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
There is no documented default miter limit. |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=cut |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub _miterlimit { |
552
|
3
|
|
|
3
|
|
6
|
my $limit = shift(); |
553
|
3
|
|
|
|
|
11
|
return ($limit, 'M'); |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# Deprecated; miterlimit was originally named incorrectly |
557
|
1
|
|
|
1
|
1
|
7
|
sub meterlimit { return miter_limit(@_) } |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# Deprecated (renamed) |
560
|
1
|
|
|
1
|
1
|
8
|
sub miterlimit { return miter_limit(@_) } |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
sub miter_limit { |
563
|
3
|
|
|
3
|
1
|
19
|
my ($self, $limit) = @_; |
564
|
|
|
|
|
|
|
|
565
|
3
|
|
|
|
|
10
|
$self->add(_miterlimit($limit)); |
566
|
|
|
|
|
|
|
|
567
|
3
|
|
|
|
|
8
|
return $self; |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=head2 line_dash_pattern |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# Solid line |
573
|
|
|
|
|
|
|
$content = $content->line_dash_pattern(); |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# Equal length lines and gaps |
576
|
|
|
|
|
|
|
$content = $content->line_dash_pattern($length); |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
# Specified line and gap lengths |
579
|
|
|
|
|
|
|
$content = $content->line_dash_pattern($line1, $gap1, $line2, $gap2, ...); |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
# Offset the starting point |
582
|
|
|
|
|
|
|
$content = $content->line_dash_pattern( |
583
|
|
|
|
|
|
|
pattern => [$line1, $gap1, $line2, $gap2, ...], |
584
|
|
|
|
|
|
|
offset => $points, |
585
|
|
|
|
|
|
|
); |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
Sets the line dash pattern. |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
If called without any arguments, a solid line will be drawn. |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
If called with one argument, the dashes and gaps will have equal lengths. |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
If called with two or more arguments, the arguments represent alternating dash |
594
|
|
|
|
|
|
|
and gap lengths. |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
If called with a hash of arguments, a dash phase may be set, which specifies the |
597
|
|
|
|
|
|
|
distance into the pattern at which to start the dash. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=cut |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub _linedash { |
602
|
10
|
|
|
10
|
|
21
|
my @options = @_; |
603
|
|
|
|
|
|
|
|
604
|
10
|
100
|
|
|
|
27
|
unless (@options) { |
605
|
7
|
|
|
|
|
28
|
return ('[', ']', '0', 'd'); |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
3
|
50
|
|
|
|
20
|
if ($options[0] =~ /^\d/) { |
609
|
3
|
|
|
|
|
19
|
return ('[', floats(@options), '] 0 d'); |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
|
612
|
0
|
|
|
|
|
0
|
my %options = @options; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
# Deprecated option names |
615
|
0
|
0
|
|
|
|
0
|
if ($options{'-pattern'}) { |
616
|
0
|
|
0
|
|
|
0
|
$options{'pattern'} //= delete $options{'-pattern'}; |
617
|
|
|
|
|
|
|
} |
618
|
0
|
0
|
|
|
|
0
|
if ($options{'-shift'}) { |
619
|
0
|
|
0
|
|
|
0
|
$options{'offset'} //= delete $options{'-shift'}; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
# Deprecated: the -full and -clear options will be removed in a future |
623
|
|
|
|
|
|
|
# release |
624
|
0
|
0
|
0
|
|
|
0
|
if (exists $options{'-full'} or exists $options{'-clear'}) { |
625
|
0
|
|
0
|
|
|
0
|
$options{'pattern'} //= [$options{'-full'} // 0, $options{'-clear'} // 0]; |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
0
|
|
|
|
|
0
|
return ('[', floats(@{$options{'pattern'}}), ']', |
629
|
0
|
|
0
|
|
|
0
|
($options{'offset'} || 0), 'd'); |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# Deprecated (renamed) |
633
|
7
|
|
|
7
|
1
|
24
|
sub linedash { return line_dash_pattern(@_) } |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
sub line_dash_pattern { |
636
|
10
|
|
|
10
|
1
|
33
|
my ($self, @a) = @_; |
637
|
|
|
|
|
|
|
|
638
|
10
|
|
|
|
|
31
|
$self->add(_linedash(@a)); |
639
|
|
|
|
|
|
|
|
640
|
10
|
|
|
|
|
24
|
return $self; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=head2 flatness_tolerance |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
$content = $content->flatness_tolerance($tolerance); |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
Sets the maximum distance in device pixels between the mathematically correct |
648
|
|
|
|
|
|
|
path for a curve and an approximation constructed from straight line segments. |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
C<$tolerance> is an integer between 0 and 100, where 0 represents the device's |
651
|
|
|
|
|
|
|
default flatness tolerance. |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
=cut |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
sub _flatness { |
656
|
2
|
|
|
2
|
|
5
|
my $flatness = shift(); |
657
|
2
|
|
|
|
|
9
|
return ($flatness, 'i'); |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
# Deprecated (renamed) |
661
|
1
|
|
|
1
|
1
|
10
|
sub flatness { return flatness_tolerance(@_) } |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
sub flatness_tolerance { |
664
|
2
|
|
|
2
|
1
|
13
|
my ($self, $flatness) = @_; |
665
|
|
|
|
|
|
|
|
666
|
2
|
|
|
|
|
9
|
$self->add(_flatness($flatness)); |
667
|
|
|
|
|
|
|
|
668
|
2
|
|
|
|
|
4
|
return $self; |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=head2 egstate |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
$content = $content->egstate($object); |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
Adds a L object containing a set of graphics |
676
|
|
|
|
|
|
|
state parameters. |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=cut |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
sub egstate { |
681
|
0
|
|
|
0
|
1
|
0
|
my ($self, $egstate) = @_; |
682
|
0
|
|
|
|
|
0
|
$self->add('/' . $egstate->name(), 'gs'); |
683
|
0
|
|
|
|
|
0
|
$self->resource('ExtGState', $egstate->name(), $egstate); |
684
|
0
|
|
|
|
|
0
|
return $self; |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=head1 PATH CONSTRUCTION (DRAWING) |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
Note that paths will not appear until a path painting method is called |
690
|
|
|
|
|
|
|
(L"stroke">, L"fill">, or L"paint">). |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=head2 move |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
$content = $content->move($x, $y); |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
Starts a new path at the specified coordinates. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=cut |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
sub _move { |
701
|
0
|
|
|
0
|
|
0
|
my ($x, $y) =@_; |
702
|
0
|
|
|
|
|
0
|
return (floats($x, $y), 'm'); |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
sub move { |
706
|
107
|
|
|
107
|
1
|
248
|
my $self = shift(); |
707
|
107
|
|
|
|
|
167
|
my ($x, $y); |
708
|
107
|
|
|
|
|
249
|
while (defined($x = shift())) { |
709
|
107
|
|
|
|
|
172
|
$y = shift(); |
710
|
107
|
50
|
|
|
|
230
|
if ($self->_in_text_object()) { |
711
|
0
|
|
|
|
|
0
|
$self->add_post(floats($x, $y), 'm'); |
712
|
|
|
|
|
|
|
} |
713
|
|
|
|
|
|
|
else { |
714
|
107
|
|
|
|
|
310
|
$self->add(floats($x, $y), 'm'); |
715
|
|
|
|
|
|
|
} |
716
|
107
|
|
|
|
|
244
|
$self->{' x'} = $self->{' mx'} = $x; |
717
|
107
|
|
|
|
|
279
|
$self->{' y'} = $self->{' my'} = $y; |
718
|
|
|
|
|
|
|
} |
719
|
107
|
|
|
|
|
214
|
return $self; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=head2 line |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
$content = $content->line($x, $y); |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
Extends the path in a line from the current coordinates to the specified |
727
|
|
|
|
|
|
|
coordinates. |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=cut |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
sub _line { |
732
|
0
|
|
|
0
|
|
0
|
my ($x, $y) = @_; |
733
|
0
|
|
|
|
|
0
|
return (floats($x, $y), 'l'); |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
sub line { |
737
|
95
|
|
|
95
|
1
|
151
|
my $self = shift(); |
738
|
95
|
|
|
|
|
131
|
my ($x, $y); |
739
|
95
|
|
|
|
|
219
|
while (defined($x = shift())) { |
740
|
96
|
|
|
|
|
132
|
$y = shift(); |
741
|
96
|
50
|
|
|
|
166
|
if ($self->_in_text_object()) { |
742
|
0
|
|
|
|
|
0
|
$self->add_post(floats($x, $y), 'l'); |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
else { |
745
|
96
|
|
|
|
|
217
|
$self->add(floats($x, $y), 'l'); |
746
|
|
|
|
|
|
|
} |
747
|
96
|
|
|
|
|
188
|
$self->{' x'} = $x; |
748
|
96
|
|
|
|
|
225
|
$self->{' y'} = $y; |
749
|
|
|
|
|
|
|
} |
750
|
95
|
|
|
|
|
180
|
return $self; |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=head2 hline |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
$content = $content->hline($x); |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
Extends the path in a horizontal line from the current position to the specified |
758
|
|
|
|
|
|
|
x coordinate. |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=cut |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
sub hline { |
763
|
2
|
|
|
2
|
1
|
14
|
my ($self, $x) = @_; |
764
|
2
|
|
|
|
|
7
|
$self->{' x'} = $x; |
765
|
2
|
50
|
|
|
|
6
|
if ($self->_in_text_object()) { |
766
|
0
|
|
|
|
|
0
|
$self->add_post(floats($x, $self->{' y'}), 'l'); |
767
|
|
|
|
|
|
|
} |
768
|
|
|
|
|
|
|
else { |
769
|
2
|
|
|
|
|
10
|
$self->add(floats($x, $self->{' y'}), 'l'); |
770
|
|
|
|
|
|
|
} |
771
|
2
|
|
|
|
|
7
|
return $self; |
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=head2 vline |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
$content = $content->vline($x); |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
Extends the path in a vertical line from the current position to the specified y |
779
|
|
|
|
|
|
|
coordinate. |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=cut |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
sub vline { |
784
|
1
|
|
|
1
|
1
|
10
|
my ($self, $y) = @_; |
785
|
1
|
50
|
|
|
|
6
|
if ($self->_in_text_object()) { |
786
|
0
|
|
|
|
|
0
|
$self->add_post(floats($self->{' x'}, $y), 'l'); |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
else { |
789
|
1
|
|
|
|
|
6
|
$self->add(floats($self->{' x'}, $y), 'l'); |
790
|
|
|
|
|
|
|
} |
791
|
1
|
|
|
|
|
5
|
$self->{' y'} = $y; |
792
|
1
|
|
|
|
|
2
|
return $self; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=head2 polyline |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
$content = $content->polyline($x1, $y1, $x2, $y2, ...); |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
Extends the path from the current position in one or more straight lines. |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=cut |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
sub polyline { |
804
|
2
|
|
|
2
|
1
|
25
|
my $self = shift(); |
805
|
2
|
50
|
|
|
|
8
|
unless (@_ % 2 == 0) { |
806
|
0
|
|
|
|
|
0
|
croak 'polyline requires pairs of coordinates'; |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
|
809
|
2
|
|
|
|
|
8
|
while (@_) { |
810
|
3
|
|
|
|
|
5
|
my $x = shift(); |
811
|
3
|
|
|
|
|
6
|
my $y = shift(); |
812
|
3
|
|
|
|
|
9
|
$self->line($x, $y); |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
|
815
|
2
|
|
|
|
|
14
|
return $self; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
# Deprecated; replace with move and polyline. Deprecated because poly breaks |
819
|
|
|
|
|
|
|
# the convention followed by every other path-drawing method (other than |
820
|
|
|
|
|
|
|
# enclosed shapes) of extending the path from the current position. |
821
|
|
|
|
|
|
|
sub poly { |
822
|
2
|
|
|
2
|
1
|
12
|
my $self = shift(); |
823
|
2
|
|
|
|
|
4
|
my $x = shift(); |
824
|
2
|
|
|
|
|
4
|
my $y = shift(); |
825
|
2
|
|
|
|
|
6
|
$self->move($x, $y); |
826
|
2
|
|
|
|
|
7
|
$self->line(@_); |
827
|
2
|
|
|
|
|
5
|
return $self; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=head2 curve |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
$content = $content->curve($cx1, $cy1, $cx2, $cy2, $x, $y); |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
Extends the path in a curve from the current point to C<($x, $y)>, using the two |
835
|
|
|
|
|
|
|
specified points to create a cubic Bezier curve. |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=cut |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
sub curve { |
840
|
78
|
|
|
78
|
1
|
117
|
my $self = shift(); |
841
|
78
|
|
|
|
|
111
|
my ($x1, $y1, $x2, $y2, $x3, $y3); |
842
|
78
|
|
|
|
|
162
|
while (defined($x1 = shift())) { |
843
|
78
|
|
|
|
|
99
|
$y1 = shift(); |
844
|
78
|
|
|
|
|
105
|
$x2 = shift(); |
845
|
78
|
|
|
|
|
99
|
$y2 = shift(); |
846
|
78
|
|
|
|
|
102
|
$x3 = shift(); |
847
|
78
|
|
|
|
|
100
|
$y3 = shift(); |
848
|
78
|
50
|
|
|
|
129
|
if ($self->_in_text_object()) { |
849
|
0
|
|
|
|
|
0
|
$self->add_post(floats($x1, $y1, $x2, $y2, $x3, $y3), 'c'); |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
else { |
852
|
78
|
|
|
|
|
199
|
$self->add(floats($x1, $y1, $x2, $y2, $x3, $y3), 'c'); |
853
|
|
|
|
|
|
|
} |
854
|
78
|
|
|
|
|
163
|
$self->{' x'} = $x3; |
855
|
78
|
|
|
|
|
182
|
$self->{' y'} = $y3; |
856
|
|
|
|
|
|
|
} |
857
|
78
|
|
|
|
|
126
|
return $self; |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=head2 spline |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
$content = $content->spline($cx1, $cy1, $x, $y); |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
Extends the path in a curve from the current point to C<($x, $y)>, using the two |
865
|
|
|
|
|
|
|
specified points to create a spline. |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=cut |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
sub spline { |
870
|
1
|
|
|
1
|
1
|
7
|
my $self = shift(); |
871
|
|
|
|
|
|
|
|
872
|
1
|
|
|
|
|
6
|
while (scalar @_ >= 4) { |
873
|
1
|
|
|
|
|
4
|
my $cx = shift(); |
874
|
1
|
|
|
|
|
3
|
my $cy = shift(); |
875
|
1
|
|
|
|
|
2
|
my $x = shift(); |
876
|
1
|
|
|
|
|
3
|
my $y = shift(); |
877
|
1
|
|
|
|
|
5
|
my $c1x = (2 * $cx + $self->{' x'}) / 3; |
878
|
1
|
|
|
|
|
5
|
my $c1y = (2 * $cy + $self->{' y'}) / 3; |
879
|
1
|
|
|
|
|
4
|
my $c2x = (2 * $cx + $x) / 3; |
880
|
1
|
|
|
|
|
3
|
my $c2y = (2 * $cy + $y) / 3; |
881
|
1
|
|
|
|
|
3
|
$self->curve($c1x, $c1y, $c2x, $c2y, $x, $y); |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=head2 arc |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
$content = $content->arc($x, $y, $major, $minor, $a, $b); |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Extends the path along an arc of an ellipse centered at C<[$x, $y]>. C<$major> |
890
|
|
|
|
|
|
|
and C<$minor> represent the axes of the ellipse, and the arc moves from C<$a> |
891
|
|
|
|
|
|
|
degrees to C<$b> degrees. |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=cut |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
# Private |
896
|
|
|
|
|
|
|
sub arctocurve { |
897
|
144
|
|
|
144
|
0
|
247
|
my ($a, $b, $alpha, $beta) = @_; |
898
|
144
|
100
|
|
|
|
248
|
if (abs($beta - $alpha) > 30) { |
899
|
|
|
|
|
|
|
return ( |
900
|
68
|
|
|
|
|
223
|
arctocurve($a, $b, $alpha, ($beta + $alpha) / 2), |
901
|
|
|
|
|
|
|
arctocurve($a, $b, ($beta + $alpha) / 2, $beta) |
902
|
|
|
|
|
|
|
); |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
else { |
905
|
76
|
|
|
|
|
112
|
$alpha = ($alpha * pi / 180); |
906
|
76
|
|
|
|
|
101
|
$beta = ($beta * pi / 180); |
907
|
|
|
|
|
|
|
|
908
|
76
|
|
|
|
|
144
|
my $bcp = (4.0 / 3 * (1 - cos(($beta - $alpha) / 2)) / sin(($beta - $alpha) / 2)); |
909
|
76
|
|
|
|
|
119
|
my $sin_alpha = sin($alpha); |
910
|
76
|
|
|
|
|
115
|
my $sin_beta = sin($beta); |
911
|
76
|
|
|
|
|
124
|
my $cos_alpha = cos($alpha); |
912
|
76
|
|
|
|
|
97
|
my $cos_beta = cos($beta); |
913
|
|
|
|
|
|
|
|
914
|
76
|
|
|
|
|
114
|
my $p0_x = $a * $cos_alpha; |
915
|
76
|
|
|
|
|
98
|
my $p0_y = $b * $sin_alpha; |
916
|
76
|
|
|
|
|
111
|
my $p1_x = $a * ($cos_alpha - $bcp * $sin_alpha); |
917
|
76
|
|
|
|
|
103
|
my $p1_y = $b * ($sin_alpha + $bcp * $cos_alpha); |
918
|
76
|
|
|
|
|
100
|
my $p2_x = $a * ($cos_beta + $bcp * $sin_beta); |
919
|
76
|
|
|
|
|
109
|
my $p2_y = $b * ($sin_beta - $bcp * $cos_beta); |
920
|
76
|
|
|
|
|
94
|
my $p3_x = $a * $cos_beta; |
921
|
76
|
|
|
|
|
92
|
my $p3_y = $b * $sin_beta; |
922
|
|
|
|
|
|
|
|
923
|
76
|
|
|
|
|
320
|
return ($p0_x, $p0_y, $p1_x, $p1_y, $p2_x, $p2_y, $p3_x, $p3_y); |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
sub arc { |
928
|
4
|
|
|
4
|
1
|
41
|
my ($self, $x, $y, $a, $b, $alpha, $beta, $move) = @_; |
929
|
4
|
|
|
|
|
13
|
my @points = arctocurve($a, $b, $alpha, $beta); |
930
|
4
|
|
|
|
|
10
|
my ($p0_x, $p0_y, $p1_x, $p1_y, $p2_x, $p2_y, $p3_x, $p3_y); |
931
|
|
|
|
|
|
|
|
932
|
4
|
|
|
|
|
9
|
$p0_x = $x + shift(@points); |
933
|
4
|
|
|
|
|
7
|
$p0_y = $y + shift(@points); |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
# Deprecated |
936
|
4
|
100
|
|
|
|
16
|
$self->move($p0_x, $p0_y) if $move; |
937
|
|
|
|
|
|
|
|
938
|
4
|
|
|
|
|
16
|
while (scalar @points) { |
939
|
40
|
|
|
|
|
61
|
$p1_x = $x + shift(@points); |
940
|
40
|
|
|
|
|
70
|
$p1_y = $y + shift(@points); |
941
|
40
|
|
|
|
|
57
|
$p2_x = $x + shift(@points); |
942
|
40
|
|
|
|
|
66
|
$p2_y = $y + shift(@points); |
943
|
40
|
|
|
|
|
54
|
$p3_x = $x + shift(@points); |
944
|
40
|
|
|
|
|
51
|
$p3_y = $y + shift(@points); |
945
|
40
|
|
|
|
|
93
|
$self->curve($p1_x, $p1_y, $p2_x, $p2_y, $p3_x, $p3_y); |
946
|
40
|
|
|
|
|
59
|
shift(@points); |
947
|
40
|
|
|
|
|
50
|
shift(@points); |
948
|
40
|
|
|
|
|
66
|
$self->{' x'} = $p3_x; |
949
|
40
|
|
|
|
|
82
|
$self->{' y'} = $p3_y; |
950
|
|
|
|
|
|
|
} |
951
|
4
|
|
|
|
|
10
|
return $self; |
952
|
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
# Extends the path along an arc of a circle of the specified radius from |
955
|
|
|
|
|
|
|
# C<[x1,y1]> to C<[x2,y2]>. |
956
|
|
|
|
|
|
|
# |
957
|
|
|
|
|
|
|
# Set C<$move> to a true value if this arc is the beginning of a new path |
958
|
|
|
|
|
|
|
# instead of the continuation of an existing path. |
959
|
|
|
|
|
|
|
# |
960
|
|
|
|
|
|
|
# Set C<$outer> to a true value to draw the larger arc between the two points |
961
|
|
|
|
|
|
|
# instead of the smaller one. |
962
|
|
|
|
|
|
|
# |
963
|
|
|
|
|
|
|
# Set C<$reverse> to a true value to draw the mirror image of the specified arc. |
964
|
|
|
|
|
|
|
# |
965
|
|
|
|
|
|
|
# C<$radius * 2> cannot be smaller than the distance from C<[x1,y1]> to |
966
|
|
|
|
|
|
|
# C<[x2,y2]>. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
# Deprecated; recreate using arc (Bogen is German for arc) |
969
|
|
|
|
|
|
|
sub bogen { |
970
|
4
|
|
|
4
|
0
|
29
|
my ($self, $x1, $y1, $x2, $y2, $r, $move, $larc, $spf) = @_; |
971
|
4
|
|
|
|
|
7
|
my ($p0_x, $p0_y, $p1_x, $p1_y, $p2_x, $p2_y, $p3_x, $p3_y); |
972
|
4
|
|
|
|
|
7
|
my $x = $x2 - $x1; |
973
|
4
|
|
|
|
|
6
|
my $y = $y2 - $y1; |
974
|
4
|
|
|
|
|
12
|
my $z = sqrt($x ** 2 + $y ** 2); |
975
|
4
|
|
|
|
|
15
|
my $alpha_rad = asin($y / $z); |
976
|
|
|
|
|
|
|
|
977
|
4
|
50
|
33
|
|
|
39
|
$alpha_rad += pi / 2 if $x < 0 and $y > 0; |
978
|
4
|
50
|
33
|
|
|
11
|
$alpha_rad -= pi / 2 if $x < 0 and $y < 0; |
979
|
|
|
|
|
|
|
|
980
|
4
|
|
|
|
|
14
|
my $alpha = rad2deg($alpha_rad); |
981
|
|
|
|
|
|
|
# use the complement angle for span |
982
|
4
|
100
|
66
|
|
|
48
|
$alpha -= 180 if $spf and $spf > 0; |
983
|
|
|
|
|
|
|
|
984
|
4
|
|
|
|
|
7
|
my $d = 2 * $r; |
985
|
4
|
|
|
|
|
7
|
my ($beta, $beta_rad, @points); |
986
|
|
|
|
|
|
|
|
987
|
4
|
|
|
|
|
9
|
$beta = rad2deg(2 * asin($z / $d)); |
988
|
4
|
100
|
66
|
|
|
57
|
$beta = 360 - $beta if $larc and $larc > 0; |
989
|
|
|
|
|
|
|
|
990
|
4
|
|
|
|
|
9
|
$beta_rad = deg2rad($beta); |
991
|
|
|
|
|
|
|
|
992
|
4
|
|
|
|
|
42
|
@points = arctocurve($r, $r, 90 + $alpha + $beta / 2, 90 + $alpha - $beta / 2); |
993
|
|
|
|
|
|
|
|
994
|
4
|
100
|
66
|
|
|
17
|
if ($spf and $spf > 0) { |
995
|
1
|
|
|
|
|
5
|
my @pts = @points; |
996
|
1
|
|
|
|
|
4
|
@points = (); |
997
|
1
|
|
|
|
|
4
|
while ($y = pop(@pts)) { |
998
|
15
|
|
|
|
|
18
|
$x = pop(@pts); |
999
|
15
|
|
|
|
|
29
|
push(@points, $x, $y); |
1000
|
|
|
|
|
|
|
} |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
|
1003
|
4
|
|
|
|
|
7
|
$p0_x = shift(@points); |
1004
|
4
|
|
|
|
|
7
|
$p0_y = shift(@points); |
1005
|
4
|
|
|
|
|
6
|
$x = $x1 - $p0_x; |
1006
|
4
|
|
|
|
|
8
|
$y = $y1 - $p0_y; |
1007
|
|
|
|
|
|
|
|
1008
|
4
|
100
|
|
|
|
10
|
$self->move($x1, $y1) if $move; |
1009
|
|
|
|
|
|
|
|
1010
|
4
|
|
|
|
|
9
|
while (scalar @points) { |
1011
|
36
|
|
|
|
|
57
|
$p1_x = $x + shift(@points); |
1012
|
36
|
|
|
|
|
46
|
$p1_y = $y + shift(@points); |
1013
|
36
|
|
|
|
|
53
|
$p2_x = $x + shift(@points); |
1014
|
36
|
|
|
|
|
51
|
$p2_y = $y + shift(@points); |
1015
|
|
|
|
|
|
|
# if we run out of data points, use the end point instead |
1016
|
36
|
100
|
|
|
|
72
|
if (scalar @points == 0) { |
1017
|
1
|
|
|
|
|
2
|
$p3_x = $x2; |
1018
|
1
|
|
|
|
|
2
|
$p3_y = $y2; |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
else { |
1021
|
35
|
|
|
|
|
51
|
$p3_x = $x + shift(@points); |
1022
|
35
|
|
|
|
|
44
|
$p3_y = $y + shift(@points); |
1023
|
|
|
|
|
|
|
} |
1024
|
36
|
|
|
|
|
91
|
$self->curve($p1_x, $p1_y, $p2_x, $p2_y, $p3_x, $p3_y); |
1025
|
36
|
|
|
|
|
50
|
shift(@points); |
1026
|
36
|
|
|
|
|
73
|
shift(@points); |
1027
|
|
|
|
|
|
|
} |
1028
|
4
|
|
|
|
|
12
|
return $self; |
1029
|
|
|
|
|
|
|
} |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
=head2 close |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
$content = $content->close(); |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
Closes the current path by extending a line from the current position to the |
1036
|
|
|
|
|
|
|
starting position. |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=cut |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
sub close { |
1041
|
13
|
|
|
13
|
1
|
67
|
my $self = shift(); |
1042
|
13
|
|
|
|
|
34
|
$self->add('h'); |
1043
|
13
|
|
|
|
|
36
|
$self->{' x'} = $self->{' mx'}; |
1044
|
13
|
|
|
|
|
22
|
$self->{' y'} = $self->{' my'}; |
1045
|
13
|
|
|
|
|
25
|
return $self; |
1046
|
|
|
|
|
|
|
} |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
=head2 end |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
$content = $content->end(); |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
Ends the current path without filling or stroking. |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=cut |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
# Deprecated (renamed) |
1057
|
1
|
|
|
1
|
1
|
10
|
sub endpath { return end(@_) } |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
sub end { |
1060
|
2
|
|
|
2
|
1
|
15
|
my $self = shift(); |
1061
|
2
|
|
|
|
|
11
|
$self->add('n'); |
1062
|
2
|
|
|
|
|
8
|
return $self; |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=head1 SHAPE CONSTRUCTION (DRAWING) |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
The following are convenience methods for drawing closed paths. |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
Note that shapes will not appear until a path painting method is called |
1070
|
|
|
|
|
|
|
(L"stroke">, L"fill">, or L"paint">). |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
=head2 rectangle |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
$content = $content->rectangle($x1, $y1, $x2, $y2); |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
Creates a new rectangle-shaped path, between the two points C<[$x1, $y1]> |
1077
|
|
|
|
|
|
|
and C<[$x2, $y2]>. |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=cut |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
sub rectangle { |
1082
|
2
|
|
|
2
|
1
|
22
|
my ($self, $x1, $y1, $x2, $y2) = @_; |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
# Ensure that x1,y1 is lower-left and x2,y2 is upper-right |
1085
|
2
|
100
|
|
|
|
6
|
if ($x2 < $x1) { |
1086
|
1
|
|
|
|
|
2
|
my $x = $x1; |
1087
|
1
|
|
|
|
|
4
|
$x1 = $x2; |
1088
|
1
|
|
|
|
|
2
|
$x2 = $x; |
1089
|
|
|
|
|
|
|
} |
1090
|
2
|
50
|
|
|
|
7
|
if ($y2 < $y1) { |
1091
|
0
|
|
|
|
|
0
|
my $y = $y1; |
1092
|
0
|
|
|
|
|
0
|
$y1 = $y2; |
1093
|
0
|
|
|
|
|
0
|
$y2 = $y; |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
|
1096
|
2
|
|
|
|
|
10
|
$self->add(floats($x1, $y1, ($x2 - $x1), ($y2 - $y1)), 're'); |
1097
|
2
|
|
|
|
|
5
|
$self->{' x'} = $x1; |
1098
|
2
|
|
|
|
|
4
|
$self->{' y'} = $y1; |
1099
|
|
|
|
|
|
|
|
1100
|
2
|
|
|
|
|
5
|
return $self; |
1101
|
|
|
|
|
|
|
} |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
# Deprecated; replace with individual calls to rectangle |
1104
|
|
|
|
|
|
|
sub rect { |
1105
|
5
|
|
|
5
|
1
|
18
|
my $self = shift(); |
1106
|
5
|
|
|
|
|
10
|
my ($x, $y, $w, $h); |
1107
|
5
|
|
|
|
|
11
|
while (defined($x = shift())) { |
1108
|
6
|
|
|
|
|
9
|
$y = shift(); |
1109
|
6
|
|
|
|
|
8
|
$w = shift(); |
1110
|
6
|
|
|
|
|
9
|
$h = shift(); |
1111
|
6
|
|
|
|
|
17
|
$self->add(floats($x, $y, $w, $h), 're'); |
1112
|
|
|
|
|
|
|
} |
1113
|
5
|
|
|
|
|
9
|
$self->{' x'} = $x; |
1114
|
5
|
|
|
|
|
9
|
$self->{' y'} = $y; |
1115
|
5
|
|
|
|
|
19
|
return $self; |
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
# Deprecated; replace with rectangle, converting x2/y2 to w/h. |
1119
|
|
|
|
|
|
|
sub rectxy { |
1120
|
2
|
|
|
2
|
1
|
12
|
my ($self, $x, $y, $x2, $y2) = @_; |
1121
|
2
|
|
|
|
|
9
|
$self->rect($x, $y, ($x2 - $x), ($y2 - $y)); |
1122
|
2
|
|
|
|
|
4
|
return $self; |
1123
|
|
|
|
|
|
|
} |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
=head2 circle |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
$content = $content->circle($x, $y, $radius); |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
Creates a new circular path centered on C<[$x, $y]> with the specified radius. |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
=cut |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
sub circle { |
1134
|
1
|
|
|
1
|
1
|
11
|
my ($self, $x, $y, $r) = @_; |
1135
|
1
|
|
|
|
|
6
|
$self->arc($x, $y, $r, $r, 0, 360, 1); |
1136
|
1
|
|
|
|
|
5
|
$self->close(); |
1137
|
1
|
|
|
|
|
5
|
return $self; |
1138
|
|
|
|
|
|
|
} |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
=head2 ellipse |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
$content = $content->ellipse($x, $y, $major, $minor); |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
Creates a new elliptical path centered on C<[$x, $y]> with the specified major |
1145
|
|
|
|
|
|
|
and minor axes. |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
=cut |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
sub ellipse { |
1150
|
1
|
|
|
1
|
1
|
19
|
my ($self, $x, $y, $a, $b) = @_; |
1151
|
1
|
|
|
|
|
5
|
$self->arc($x, $y, $a, $b, 0, 360, 1); |
1152
|
1
|
|
|
|
|
6
|
$self->close(); |
1153
|
1
|
|
|
|
|
3
|
return $self; |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=head2 pie |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
$content = $content->pie($x, $y, $major, $minor, $a, $b); |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
Creates a new wedge-shaped path from an ellipse centered on C<[$x, $y]> with the |
1161
|
|
|
|
|
|
|
specified major and minor axes, extending from C<$a> degrees to C<$b> degrees. |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
=cut |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
sub pie { |
1166
|
0
|
|
|
0
|
1
|
0
|
my $self = shift(); |
1167
|
0
|
|
|
|
|
0
|
my ($x, $y, $a, $b, $alpha, $beta) = @_; |
1168
|
0
|
|
|
|
|
0
|
my ($p0_x, $p0_y) = arctocurve($a, $b, $alpha, $beta); |
1169
|
0
|
|
|
|
|
0
|
$self->move($x, $y); |
1170
|
0
|
|
|
|
|
0
|
$self->line($p0_x + $x, $p0_y + $y); |
1171
|
0
|
|
|
|
|
0
|
$self->arc($x, $y, $a, $b, $alpha, $beta); |
1172
|
0
|
|
|
|
|
0
|
$self->close(); |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
=head1 PATH PAINTING (DRAWING) |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
=head2 stroke_color |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
$content = $content->stroke_color($color, @arguments); |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
Sets the stroke color, which is black by default. |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
# Use a named color |
1184
|
|
|
|
|
|
|
$content->stroke_color('blue'); |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
# Use an RGB color (start with '#') |
1187
|
|
|
|
|
|
|
$content->stroke_color('#FF0000'); |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
# Use a CMYK color (start with '%') |
1190
|
|
|
|
|
|
|
$content->stroke_color('%FF000000'); |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
# Use a spot color with 100% coverage. |
1193
|
|
|
|
|
|
|
my $spot = $pdf->colorspace('spot', 'PANTONE Red 032 C', '#EF3340'); |
1194
|
|
|
|
|
|
|
$content->stroke_color($spot, 1.0); |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
RGB and CMYK colors can have one-byte, two-byte, three-byte, or four-byte values |
1197
|
|
|
|
|
|
|
for each color, depending on the level of precision needed. For instance, cyan |
1198
|
|
|
|
|
|
|
can be given as C<%F000> or C<%FFFF000000000000>. |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
=head2 fill_color |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
$content = $content->fill_color($color, @arguments); |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
Sets the fill color, which is black by default. Arguments are the same as in |
1205
|
|
|
|
|
|
|
L"stroke_color">. |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
=cut |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
# default colorspaces: rgb/hsv/named cmyk/hsl lab |
1210
|
|
|
|
|
|
|
# ... only one text string |
1211
|
|
|
|
|
|
|
# |
1212
|
|
|
|
|
|
|
# pattern or shading space |
1213
|
|
|
|
|
|
|
# ... only one object |
1214
|
|
|
|
|
|
|
# |
1215
|
|
|
|
|
|
|
# legacy greylevel |
1216
|
|
|
|
|
|
|
# ... only one value |
1217
|
|
|
|
|
|
|
sub _makecolor { |
1218
|
26
|
|
|
26
|
|
82
|
my ($self, $sf, @clr) = @_; |
1219
|
|
|
|
|
|
|
|
1220
|
26
|
100
|
33
|
|
|
180
|
if ($clr[0] =~ /^[a-z\#\!]+/) { |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
# colorname or #! specifier |
1222
|
|
|
|
|
|
|
# with rgb target colorspace |
1223
|
|
|
|
|
|
|
# namecolor returns always a RGB |
1224
|
23
|
100
|
|
|
|
89
|
return namecolor($clr[0]), ($sf ? 'rg' : 'RG'); |
1225
|
|
|
|
|
|
|
} |
1226
|
|
|
|
|
|
|
elsif ($clr[0] =~ /^[\%]+/) { |
1227
|
|
|
|
|
|
|
# % specifier |
1228
|
|
|
|
|
|
|
# with cmyk target colorspace |
1229
|
2
|
100
|
|
|
|
13
|
return namecolor_cmyk($clr[0]), ($sf ? 'k' : 'K'); |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
elsif ($clr[0] =~ /^[\$\&]/) { |
1232
|
|
|
|
|
|
|
# &$ specifier |
1233
|
|
|
|
|
|
|
# with L*a*b target colorspace |
1234
|
0
|
0
|
|
|
|
0
|
if (!defined $self->resource('ColorSpace', 'LabS')) { |
1235
|
0
|
|
|
|
|
0
|
my $dc = PDFDict(); |
1236
|
0
|
|
|
|
|
0
|
my $cs = PDFArray(PDFName('Lab'), $dc); |
1237
|
0
|
|
|
|
|
0
|
$dc->{'WhitePoint'} = PDFArray(map { PDFNum($_) } qw(1 1 1)); |
|
0
|
|
|
|
|
0
|
|
1238
|
0
|
|
|
|
|
0
|
$dc->{'Range'} = PDFArray(map { PDFNum($_) } qw(-128 127 -128 127)); |
|
0
|
|
|
|
|
0
|
|
1239
|
0
|
|
|
|
|
0
|
$dc->{'Gamma'} = PDFArray(map { PDFNum($_) } qw(2.2 2.2 2.2)); |
|
0
|
|
|
|
|
0
|
|
1240
|
0
|
|
|
|
|
0
|
$self->resource('ColorSpace', 'LabS', $cs); |
1241
|
|
|
|
|
|
|
} |
1242
|
0
|
0
|
|
|
|
0
|
return '/LabS', ($sf ? 'cs' : 'CS'), namecolor_lab($clr[0]), ($sf ? 'sc' : 'SC'); |
|
|
0
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
elsif (scalar @clr == 1 and ref($clr[0])) { |
1245
|
|
|
|
|
|
|
# pattern or shading space |
1246
|
0
|
0
|
|
|
|
0
|
return '/Pattern', ($sf ? 'cs' : 'CS'), '/' . ($clr[0]->name()), ($sf ? 'scn' : 'SCN'); |
|
|
0
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
elsif (scalar @clr == 1) { |
1249
|
|
|
|
|
|
|
# grey color spec. |
1250
|
0
|
0
|
|
|
|
0
|
return $clr[0], $sf ? 'g' : 'G'; |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
elsif (scalar @clr > 1 and ref($clr[0])) { |
1253
|
|
|
|
|
|
|
# indexed colorspace plus color-index |
1254
|
|
|
|
|
|
|
# or custom colorspace plus param |
1255
|
1
|
|
|
|
|
3
|
my $cs = shift(@clr); |
1256
|
1
|
50
|
|
|
|
5
|
return '/' . $cs->name(), ($sf ? 'cs' : 'CS'), $cs->param(@clr), ($sf ? 'sc' : 'SC'); |
|
|
50
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
elsif (scalar @clr == 2) { |
1259
|
|
|
|
|
|
|
# indexed colorspace plus color-index |
1260
|
|
|
|
|
|
|
# or custom colorspace plus param |
1261
|
0
|
0
|
|
|
|
0
|
return '/' . $clr[0]->name(), ($sf ? 'cs' : 'CS'), $clr[0]->param($clr[1]), ($sf ? 'sc' : 'SC'); |
|
|
0
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
} |
1263
|
|
|
|
|
|
|
elsif (scalar @clr == 3) { |
1264
|
|
|
|
|
|
|
# legacy rgb color-spec (0 <= x <= 1) |
1265
|
0
|
0
|
|
|
|
0
|
return floats($clr[0], $clr[1], $clr[2]), ($sf ? 'rg' : 'RG'); |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
elsif (scalar @clr == 4) { |
1268
|
|
|
|
|
|
|
# legacy cmyk color-spec (0 <= x <= 1) |
1269
|
0
|
0
|
|
|
|
0
|
return floats($clr[0], $clr[1], $clr[2], $clr[3]), ($sf ? 'k' : 'K'); |
1270
|
|
|
|
|
|
|
} |
1271
|
|
|
|
|
|
|
else { |
1272
|
0
|
|
|
|
|
0
|
die 'invalid color specification.'; |
1273
|
|
|
|
|
|
|
} |
1274
|
|
|
|
|
|
|
} |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
sub _fillcolor { |
1277
|
15
|
|
|
15
|
|
41
|
my ($self, @clrs) = @_; |
1278
|
15
|
50
|
|
|
|
68
|
if (ref($clrs[0]) =~ m|^PDF::API2::Resource::ColorSpace|) { |
|
|
50
|
|
|
|
|
|
1279
|
0
|
|
|
|
|
0
|
$self->resource('ColorSpace', $clrs[0]->name(), $clrs[0]); |
1280
|
|
|
|
|
|
|
} |
1281
|
|
|
|
|
|
|
elsif (ref($clrs[0]) =~ m|^PDF::API2::Resource::Pattern|) { |
1282
|
0
|
|
|
|
|
0
|
$self->resource('Pattern', $clrs[0]->name(), $clrs[0]); |
1283
|
|
|
|
|
|
|
} |
1284
|
|
|
|
|
|
|
|
1285
|
15
|
|
|
|
|
69
|
return $self->_makecolor(1, @clrs); |
1286
|
|
|
|
|
|
|
} |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
# Deprecated |
1289
|
13
|
|
|
13
|
0
|
75
|
sub fillcolor { return fill_color(@_) } |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
sub fill_color { |
1292
|
15
|
|
|
15
|
1
|
39
|
my $self = shift(); |
1293
|
15
|
50
|
|
|
|
44
|
if (@_) { |
1294
|
15
|
|
|
|
|
31
|
@{$self->{' fillcolor'}} = @_; |
|
15
|
|
|
|
|
43
|
|
1295
|
15
|
|
|
|
|
100
|
$self->add($self->_fillcolor(@_)); |
1296
|
|
|
|
|
|
|
} |
1297
|
15
|
|
|
|
|
32
|
return @{$self->{' fillcolor'}}; |
|
15
|
|
|
|
|
66
|
|
1298
|
|
|
|
|
|
|
} |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
sub _strokecolor { |
1301
|
11
|
|
|
11
|
|
27
|
my ($self, @clrs) = @_; |
1302
|
11
|
100
|
|
|
|
57
|
if (ref($clrs[0]) =~ m|^PDF::API2::Resource::ColorSpace|) { |
|
|
50
|
|
|
|
|
|
1303
|
1
|
|
|
|
|
7
|
$self->resource('ColorSpace', $clrs[0]->name(), $clrs[0]); |
1304
|
|
|
|
|
|
|
} |
1305
|
|
|
|
|
|
|
elsif (ref($clrs[0]) =~ m|^PDF::API2::Resource::Pattern|) { |
1306
|
0
|
|
|
|
|
0
|
$self->resource('Pattern', $clrs[0]->name(), $clrs[0]); |
1307
|
|
|
|
|
|
|
} |
1308
|
11
|
|
|
|
|
33
|
return $self->_makecolor(0, @clrs); |
1309
|
|
|
|
|
|
|
} |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
# Deprecated |
1312
|
8
|
|
|
8
|
0
|
35
|
sub strokecolor { return stroke_color(@_) } |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
sub stroke_color { |
1315
|
11
|
|
|
11
|
1
|
31
|
my $self = shift(); |
1316
|
11
|
50
|
|
|
|
30
|
if (@_) { |
1317
|
11
|
|
|
|
|
23
|
@{$self->{' strokecolor'}} = @_; |
|
11
|
|
|
|
|
34
|
|
1318
|
11
|
|
|
|
|
41
|
$self->add($self->_strokecolor(@_)); |
1319
|
|
|
|
|
|
|
} |
1320
|
11
|
|
|
|
|
23
|
return @{$self->{' strokecolor'}}; |
|
11
|
|
|
|
|
37
|
|
1321
|
|
|
|
|
|
|
} |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
=head2 stroke |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
$content = $content->stroke(); |
1326
|
|
|
|
|
|
|
|
1327
|
|
|
|
|
|
|
Strokes the current path. |
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
=cut |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
sub _stroke { |
1332
|
121
|
|
|
121
|
|
276
|
return 'S'; |
1333
|
|
|
|
|
|
|
} |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
sub stroke { |
1336
|
121
|
|
|
121
|
1
|
266
|
my $self = shift(); |
1337
|
121
|
|
|
|
|
210
|
$self->add(_stroke()); |
1338
|
121
|
|
|
|
|
236
|
return $self; |
1339
|
|
|
|
|
|
|
} |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
=head2 fill |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
$content = $content->fill(rule => $rule); |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
Fills the current path. |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
C<$rule> describes which areas are filled in when the path intersects with itself. |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
=over |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
=item * nonzero (default) |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
Use the nonzero winding number rule. This tends to mean that the entire area |
1354
|
|
|
|
|
|
|
enclosed by the path is filled in, with some exceptions depending on the |
1355
|
|
|
|
|
|
|
direction of the path. |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
=item * even-odd |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
Use the even-odd rule. This tends to mean that the presence of fill alternates |
1360
|
|
|
|
|
|
|
each time the path is intersected. |
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
=back |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
See PDF specification 1.7 section 8.5.3.3, Filling, for more details. |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
=cut |
1367
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
sub fill { |
1369
|
3
|
|
|
3
|
1
|
27
|
my $self = shift(); |
1370
|
|
|
|
|
|
|
|
1371
|
3
|
|
|
|
|
7
|
my $even_odd; |
1372
|
3
|
100
|
|
|
|
11
|
if (@_ == 2) { |
1373
|
1
|
|
|
|
|
6
|
my %options = @_; |
1374
|
1
|
50
|
50
|
|
|
8
|
if (($options{'rule'} // 'nonzero') eq 'even-odd') { |
1375
|
1
|
|
|
|
|
2
|
$even_odd = 1; |
1376
|
|
|
|
|
|
|
} |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
else { |
1379
|
|
|
|
|
|
|
# Deprecated |
1380
|
2
|
|
|
|
|
4
|
$even_odd = shift(); |
1381
|
|
|
|
|
|
|
} |
1382
|
|
|
|
|
|
|
|
1383
|
3
|
100
|
|
|
|
15
|
$self->add($even_odd ? 'f*' : 'f'); |
1384
|
|
|
|
|
|
|
|
1385
|
3
|
|
|
|
|
8
|
return $self; |
1386
|
|
|
|
|
|
|
} |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
=head2 paint |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
$content = $content->paint(rule => $rule); |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
Fills and strokes the current path. C<$rule> is as described in L"fill">. |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
=cut |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
# Deprecated (renamed) |
1397
|
2
|
|
|
2
|
1
|
14
|
sub fillstroke { return paint(@_) } |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
sub paint { |
1400
|
4
|
|
|
4
|
1
|
33
|
my $self = shift(); |
1401
|
|
|
|
|
|
|
|
1402
|
4
|
|
|
|
|
6
|
my $even_odd; |
1403
|
4
|
100
|
|
|
|
18
|
if (@_ == 2) { |
1404
|
1
|
|
|
|
|
4
|
my %options = @_; |
1405
|
1
|
50
|
50
|
|
|
6
|
if (($options{'rule'} // 'nonzero') eq 'even-odd') { |
1406
|
1
|
|
|
|
|
3
|
$even_odd = 1; |
1407
|
|
|
|
|
|
|
} |
1408
|
|
|
|
|
|
|
} |
1409
|
|
|
|
|
|
|
else { |
1410
|
|
|
|
|
|
|
# Deprecated |
1411
|
3
|
|
|
|
|
6
|
$even_odd = shift(); |
1412
|
|
|
|
|
|
|
} |
1413
|
|
|
|
|
|
|
|
1414
|
4
|
100
|
|
|
|
20
|
$self->add($even_odd ? 'B*' : 'B'); |
1415
|
|
|
|
|
|
|
|
1416
|
4
|
|
|
|
|
9
|
return $self; |
1417
|
|
|
|
|
|
|
} |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
=head2 clip |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
$content = $content->clip(rule => $rule); |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
Modifies the current clipping path (initially the entire page) by intersecting |
1424
|
|
|
|
|
|
|
it with the current path following the next path-painting command. C<$rule> is |
1425
|
|
|
|
|
|
|
as described in L"fill">. |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
=cut |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
sub clip { |
1430
|
3
|
|
|
3
|
1
|
26
|
my $self = shift(); |
1431
|
|
|
|
|
|
|
|
1432
|
3
|
|
|
|
|
6
|
my $even_odd; |
1433
|
3
|
100
|
|
|
|
14
|
if (@_ == 2) { |
1434
|
1
|
|
|
|
|
5
|
my %options = @_; |
1435
|
1
|
50
|
50
|
|
|
6
|
if (($options{'rule'} // 'nonzero') eq 'even-odd') { |
1436
|
1
|
|
|
|
|
3
|
$even_odd = 1; |
1437
|
|
|
|
|
|
|
} |
1438
|
|
|
|
|
|
|
} |
1439
|
|
|
|
|
|
|
else { |
1440
|
|
|
|
|
|
|
# Deprecated |
1441
|
2
|
|
|
|
|
6
|
$even_odd = shift(); |
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
|
1444
|
3
|
100
|
|
|
|
16
|
$self->add($even_odd ? 'W*' : 'W'); |
1445
|
|
|
|
|
|
|
|
1446
|
3
|
|
|
|
|
6
|
return $self; |
1447
|
|
|
|
|
|
|
} |
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
sub shade { |
1450
|
0
|
|
|
0
|
0
|
0
|
my ($self, $shade, @cord) = @_; |
1451
|
|
|
|
|
|
|
|
1452
|
0
|
|
|
|
|
0
|
my @tm = ( |
1453
|
|
|
|
|
|
|
$cord[2] - $cord[0], 0, |
1454
|
|
|
|
|
|
|
0 , $cord[3] - $cord[1], |
1455
|
|
|
|
|
|
|
$cord[0] , $cord[1], |
1456
|
|
|
|
|
|
|
); |
1457
|
|
|
|
|
|
|
|
1458
|
0
|
|
|
|
|
0
|
$self->save(); |
1459
|
0
|
|
|
|
|
0
|
$self->matrix(@tm); |
1460
|
0
|
|
|
|
|
0
|
$self->add('/' . $shade->name(), 'sh'); |
1461
|
0
|
|
|
|
|
0
|
$self->resource('Shading', $shade->name(), $shade); |
1462
|
0
|
|
|
|
|
0
|
$self->restore(); |
1463
|
|
|
|
|
|
|
|
1464
|
0
|
|
|
|
|
0
|
return $self; |
1465
|
|
|
|
|
|
|
} |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
=head1 EXTERNAL OBJECTS |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
=head2 object |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
$content = $content->object($object, $x, $y, $scale_x, $scale_y); |
1472
|
|
|
|
|
|
|
|
1473
|
|
|
|
|
|
|
Places an image or other external object (a.k.a. XObject) on the page in the |
1474
|
|
|
|
|
|
|
specified location. |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
For images, C<$scale_x> and C<$scale_y> represent the width and height of the |
1477
|
|
|
|
|
|
|
image on the page in points. If C<$scale_x> is omitted, it will default to 72 |
1478
|
|
|
|
|
|
|
pixels per inch. If C<$scale_y> is omitted, the image will be scaled |
1479
|
|
|
|
|
|
|
proportionally based on the image dimensions. |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
For other external objects, the scale is a multiplier, where 1 (the default) |
1482
|
|
|
|
|
|
|
represents 100% (i.e. no change). |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
If coordinate transformations have been made (see Coordinate Transformations |
1485
|
|
|
|
|
|
|
above), the position and scale will be relative to the updated coordinates. |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
If no coordinate transformations are needed, this method can be called directly |
1488
|
|
|
|
|
|
|
from the L object instead. |
1489
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
=cut |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
# Behavior based on argument count |
1493
|
|
|
|
|
|
|
# 0: Place at 0, 0, 100% |
1494
|
|
|
|
|
|
|
# 2: Place at X, Y, 100% |
1495
|
|
|
|
|
|
|
# 3: Place at X, Y, scaled |
1496
|
|
|
|
|
|
|
# 4: Place at X, Y, scale_w, scale_h |
1497
|
|
|
|
|
|
|
sub object { |
1498
|
0
|
|
|
0
|
1
|
0
|
my ($self, $object, $x, $y, $scale_x, $scale_y) = @_; |
1499
|
0
|
|
0
|
|
|
0
|
$x //= 0; |
1500
|
0
|
|
0
|
|
|
0
|
$y //= 0; |
1501
|
0
|
0
|
|
|
|
0
|
if ($object->isa('PDF::API2::Resource::XObject::Image')) { |
1502
|
0
|
|
0
|
|
|
0
|
$scale_x //= $object->width(); |
1503
|
0
|
|
0
|
|
|
0
|
$scale_y //= $object->height() * $scale_x / $object->width(); |
1504
|
|
|
|
|
|
|
} |
1505
|
|
|
|
|
|
|
else { |
1506
|
0
|
|
0
|
|
|
0
|
$scale_x //= 1; |
1507
|
0
|
|
0
|
|
|
0
|
$scale_y //= $scale_x; |
1508
|
|
|
|
|
|
|
} |
1509
|
|
|
|
|
|
|
|
1510
|
0
|
|
|
|
|
0
|
$self->save(); |
1511
|
0
|
|
|
|
|
0
|
$self->matrix($scale_x, 0, 0, $scale_y, $x, $y); |
1512
|
0
|
|
|
|
|
0
|
$self->add('/' . $object->name(), 'Do'); |
1513
|
0
|
|
|
|
|
0
|
$self->restore(); |
1514
|
|
|
|
|
|
|
|
1515
|
0
|
|
|
|
|
0
|
$self->resource('XObject', $object->name(), $object); |
1516
|
|
|
|
|
|
|
|
1517
|
0
|
|
|
|
|
0
|
return $self; |
1518
|
|
|
|
|
|
|
} |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
# Deprecated |
1521
|
|
|
|
|
|
|
sub image { |
1522
|
8
|
|
|
8
|
1
|
67
|
my $self = shift; |
1523
|
8
|
|
|
|
|
19
|
my $img = shift; |
1524
|
8
|
|
|
|
|
27
|
my ($x, $y, $w, $h) = @_; |
1525
|
8
|
50
|
|
|
|
49
|
if (defined $img->{'Metadata'}) { |
1526
|
0
|
|
|
|
|
0
|
$self->metaStart('PPAM:PlacedImage', $img->{'Metadata'}); |
1527
|
|
|
|
|
|
|
} |
1528
|
8
|
|
|
|
|
77
|
$self->save(); |
1529
|
8
|
50
|
33
|
|
|
79
|
unless (defined $w) { |
1530
|
0
|
|
|
|
|
0
|
$h = $img->height(); |
1531
|
0
|
|
|
|
|
0
|
$w = $img->width(); |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
elsif (not defined $h) { |
1534
|
|
|
|
|
|
|
$h = $img->height() * $w; |
1535
|
|
|
|
|
|
|
$w = $img->width() * $w; |
1536
|
|
|
|
|
|
|
} |
1537
|
8
|
|
|
|
|
60
|
$self->matrix($w, 0, 0, $h, $x, $y); |
1538
|
8
|
|
|
|
|
61
|
$self->add('/' . $img->name(), 'Do'); |
1539
|
8
|
|
|
|
|
45
|
$self->restore(); |
1540
|
8
|
|
|
|
|
34
|
$self->{' x'} = $x; |
1541
|
8
|
|
|
|
|
34
|
$self->{' y'} = $y; |
1542
|
8
|
|
|
|
|
44
|
$self->resource('XObject', $img->name(), $img); |
1543
|
8
|
50
|
|
|
|
34
|
if (defined $img->{'Metadata'}) { |
1544
|
0
|
|
|
|
|
0
|
$self->metaEnd(); |
1545
|
|
|
|
|
|
|
} |
1546
|
8
|
|
|
|
|
25
|
return $self; |
1547
|
|
|
|
|
|
|
} |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
# Deprecated |
1550
|
|
|
|
|
|
|
sub formimage { |
1551
|
2
|
|
|
2
|
1
|
17
|
my ($self, $img, $x, $y, $s) = @_; |
1552
|
2
|
|
|
|
|
12
|
$self->save(); |
1553
|
2
|
50
|
|
|
|
8
|
if (defined $s) { |
1554
|
2
|
|
|
|
|
11
|
$self->matrix($s, 0, 0, $s, $x, $y); |
1555
|
|
|
|
|
|
|
} |
1556
|
|
|
|
|
|
|
else { |
1557
|
0
|
|
|
|
|
0
|
$self->matrix(1, 0, 0, 1, $x, $y); |
1558
|
|
|
|
|
|
|
} |
1559
|
2
|
|
|
|
|
11
|
$self->add('/' . $img->name(), 'Do'); |
1560
|
2
|
|
|
|
|
12
|
$self->restore(); |
1561
|
2
|
|
|
|
|
17
|
$self->resource('XObject', $img->name(), $img); |
1562
|
2
|
|
|
|
|
9
|
return $self; |
1563
|
|
|
|
|
|
|
} |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
=head1 TEXT STATE |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
All of the following parameters that take a size are applied before any scaling |
1568
|
|
|
|
|
|
|
takes place, so you don't need to adjust values to counteract scaling. |
1569
|
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
|
=head2 font |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
$content = $content->font($font, $size); |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
Sets the font and font size. C<$font> is an object created by calling |
1575
|
|
|
|
|
|
|
L to add the font to the document. |
1576
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
my $pdf = PDF::API2->new(); |
1578
|
|
|
|
|
|
|
my $page = $pdf->page(); |
1579
|
|
|
|
|
|
|
my $text = $pdf->text(); |
1580
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
my $font = $pdf->font('Helvetica'); |
1582
|
|
|
|
|
|
|
$text->font($font, 24); |
1583
|
|
|
|
|
|
|
$text->position(72, 720); |
1584
|
|
|
|
|
|
|
$text->text('Hello, World!'); |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
$pdf->save('sample.pdf'); |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
=cut |
1589
|
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
|
sub _font { |
1591
|
18
|
|
|
18
|
|
76
|
my ($font, $size) = @_; |
1592
|
18
|
100
|
|
|
|
65
|
if ($font->isvirtual()) { |
1593
|
1
|
|
|
|
|
5
|
return('/' . $font->fontlist->[0]->name() . ' ' . float($size) . ' Tf'); |
1594
|
|
|
|
|
|
|
} |
1595
|
|
|
|
|
|
|
else { |
1596
|
17
|
|
|
|
|
59
|
return('/' . $font->name() . ' ' . float($size) . ' Tf'); |
1597
|
|
|
|
|
|
|
} |
1598
|
|
|
|
|
|
|
} |
1599
|
|
|
|
|
|
|
sub font { |
1600
|
19
|
|
|
19
|
1
|
681
|
my ($self, $font, $size) = @_; |
1601
|
19
|
100
|
|
|
|
46
|
unless ($size) { |
1602
|
1
|
|
|
|
|
75
|
croak q{A font size is required}; |
1603
|
|
|
|
|
|
|
} |
1604
|
18
|
|
|
|
|
70
|
$self->fontset($font, $size); |
1605
|
18
|
|
|
|
|
76
|
$self->add(_font($font, $size)); |
1606
|
18
|
|
|
|
|
42
|
$self->{' fontset'} = 1; |
1607
|
18
|
|
|
|
|
41
|
return $self; |
1608
|
|
|
|
|
|
|
} |
1609
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
sub fontset { |
1611
|
18
|
|
|
18
|
0
|
41
|
my ($self, $font, $size) = @_; |
1612
|
18
|
|
|
|
|
35
|
$self->{' font'} = $font; |
1613
|
18
|
|
|
|
|
34
|
$self->{' fontsize'} = $size; |
1614
|
18
|
|
|
|
|
34
|
$self->{' fontset'} = 0; |
1615
|
|
|
|
|
|
|
|
1616
|
18
|
100
|
|
|
|
88
|
if ($font->isvirtual()) { |
1617
|
1
|
|
|
|
|
1
|
foreach my $f (@{$font->fontlist()}) { |
|
1
|
|
|
|
|
8
|
|
1618
|
2
|
|
|
|
|
10
|
$self->resource('Font', $f->name(), $f); |
1619
|
|
|
|
|
|
|
} |
1620
|
|
|
|
|
|
|
} |
1621
|
|
|
|
|
|
|
else { |
1622
|
17
|
|
|
|
|
56
|
$self->resource('Font', $font->name(), $font); |
1623
|
|
|
|
|
|
|
} |
1624
|
|
|
|
|
|
|
|
1625
|
18
|
|
|
|
|
32
|
return $self; |
1626
|
|
|
|
|
|
|
} |
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
=head2 character_spacing |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
$spacing = $content->character_spacing($spacing); |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
Sets the spacing between characters. This is initially zero. |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
=cut |
1635
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
sub _charspace { |
1637
|
3
|
|
|
3
|
|
7
|
my $spacing = shift(); |
1638
|
3
|
|
|
|
|
15
|
return float($spacing, 6) . ' Tc'; |
1639
|
|
|
|
|
|
|
} |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
# Deprecated (renamed) |
1642
|
3
|
|
|
3
|
1
|
797
|
sub charspace { return character_spacing(@_) } |
1643
|
|
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
sub character_spacing { |
1645
|
4
|
|
|
4
|
1
|
17
|
my ($self, $spacing) = @_; |
1646
|
4
|
100
|
|
|
|
12
|
if (defined $spacing) { |
1647
|
3
|
|
|
|
|
8
|
$self->{' charspace'} = $spacing; |
1648
|
3
|
|
|
|
|
12
|
$self->add(_charspace($spacing)); |
1649
|
|
|
|
|
|
|
} |
1650
|
4
|
|
|
|
|
13
|
return $self->{' charspace'}; |
1651
|
|
|
|
|
|
|
} |
1652
|
|
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
=head2 word_spacing |
1654
|
|
|
|
|
|
|
|
1655
|
|
|
|
|
|
|
$spacing = $content->word_spacing($spacing); |
1656
|
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
Sets the spacing between words. This is initially zero (i.e. just the width of |
1658
|
|
|
|
|
|
|
the space). |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
Word spacing might only affect simple fonts and composite fonts where the space |
1661
|
|
|
|
|
|
|
character is a single-byte code. This is a limitation of the PDF specification |
1662
|
|
|
|
|
|
|
at least as of version 1.7 (see section 9.3.3). It's possible that a later |
1663
|
|
|
|
|
|
|
version of the specification will support word spacing in fonts that use |
1664
|
|
|
|
|
|
|
multi-byte codes. |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
=cut |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
sub _wordspace { |
1669
|
15
|
|
|
15
|
|
24
|
my $spacing = shift(); |
1670
|
15
|
|
|
|
|
75
|
return float($spacing, 6) . ' Tw'; |
1671
|
|
|
|
|
|
|
} |
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
# Deprecated (renamed) |
1674
|
24
|
|
|
24
|
1
|
503
|
sub wordspace { return word_spacing(@_) } |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
sub word_spacing { |
1677
|
25
|
|
|
25
|
1
|
60
|
my ($self, $spacing) = @_; |
1678
|
25
|
100
|
|
|
|
56
|
if (defined $spacing) { |
1679
|
15
|
|
|
|
|
24
|
$self->{' wordspace'} = $spacing; |
1680
|
15
|
|
|
|
|
35
|
$self->add(_wordspace($spacing)); |
1681
|
|
|
|
|
|
|
} |
1682
|
25
|
|
|
|
|
51
|
return $self->{' wordspace'}; |
1683
|
|
|
|
|
|
|
} |
1684
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
=head2 hscale |
1686
|
|
|
|
|
|
|
|
1687
|
|
|
|
|
|
|
$scale = $content->hscale($scale); |
1688
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
Sets/gets the percentage of horizontal text scaling. Enter a scale greater than |
1690
|
|
|
|
|
|
|
100 to stretch text, less than 100 to squeeze text, or 100 to disable any |
1691
|
|
|
|
|
|
|
existing scaling. |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
=cut |
1694
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
sub _hscale { |
1696
|
2
|
|
|
2
|
|
5
|
my $scale = shift(); |
1697
|
2
|
|
|
|
|
7
|
return float($scale, 6) . ' Tz'; |
1698
|
|
|
|
|
|
|
} |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
sub hscale { |
1701
|
14
|
|
|
14
|
1
|
51
|
my ($self, $scale) = @_; |
1702
|
14
|
100
|
|
|
|
40
|
if (defined $scale) { |
1703
|
2
|
|
|
|
|
5
|
$self->{' hscale'} = $scale; |
1704
|
2
|
|
|
|
|
9
|
$self->add(_hscale($scale)); |
1705
|
|
|
|
|
|
|
} |
1706
|
14
|
|
|
|
|
55
|
return $self->{' hscale'}; |
1707
|
|
|
|
|
|
|
} |
1708
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
# Deprecated: hscale was originally named incorrectly (as hspace) |
1710
|
1
|
|
|
1
|
1
|
8
|
sub hspace { return hscale(@_) } |
1711
|
0
|
|
|
0
|
|
0
|
sub _hspace { return _hscale(@_) } |
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
=head2 leading |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
$leading = $content->leading($leading); |
1716
|
|
|
|
|
|
|
|
1717
|
|
|
|
|
|
|
Sets/gets the text leading, which is the distance between baselines. This is |
1718
|
|
|
|
|
|
|
initially zero (i.e. the lines will be printed on top of each other). |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
=cut |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
# Deprecated: leading is the correct name for this operator |
1723
|
0
|
|
|
0
|
|
0
|
sub _lead { return _leading(@_) } |
1724
|
1
|
|
|
1
|
1
|
9
|
sub lead { return leading(@_) } |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
sub _leading { |
1727
|
11
|
|
|
11
|
|
19
|
my $leading = shift(); |
1728
|
11
|
|
|
|
|
28
|
return float($leading) . ' TL'; |
1729
|
|
|
|
|
|
|
} |
1730
|
|
|
|
|
|
|
sub leading { |
1731
|
46
|
|
|
46
|
1
|
129
|
my ($self, $leading) = @_; |
1732
|
46
|
100
|
|
|
|
87
|
if (defined ($leading)) { |
1733
|
11
|
|
|
|
|
20
|
$self->{' leading'} = $leading; |
1734
|
11
|
|
|
|
|
35
|
$self->add(_leading($leading)); |
1735
|
|
|
|
|
|
|
} |
1736
|
46
|
|
|
|
|
89
|
return $self->{' leading'}; |
1737
|
|
|
|
|
|
|
} |
1738
|
|
|
|
|
|
|
|
1739
|
|
|
|
|
|
|
=head2 render |
1740
|
|
|
|
|
|
|
|
1741
|
|
|
|
|
|
|
$mode = $content->render($mode); |
1742
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
Sets the text rendering mode. |
1744
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
=over |
1746
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
=item * 0 = Fill text |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
=item * 1 = Stroke text (outline) |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
=item * 2 = Fill, then stroke text |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
=item * 3 = Neither fill nor stroke text (invisible) |
1754
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
=item * 4 = Fill text and add to path for clipping |
1756
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
=item * 5 = Stroke text and add to path for clipping |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
=item * 6 = Fill, then stroke text and add to path for clipping |
1760
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
=item * 7 = Add text to path for clipping |
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
=back |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
=cut |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
sub _render { |
1768
|
1
|
|
|
1
|
|
2
|
my $mode = shift(); |
1769
|
1
|
|
|
|
|
7
|
return intg($mode) . ' Tr'; |
1770
|
|
|
|
|
|
|
} |
1771
|
|
|
|
|
|
|
|
1772
|
|
|
|
|
|
|
sub render { |
1773
|
1
|
|
|
1
|
1
|
8
|
my ($self, $mode) = @_; |
1774
|
1
|
50
|
|
|
|
3
|
if (defined ($mode)) { |
1775
|
1
|
|
|
|
|
3
|
$self->{' render'} = $mode; |
1776
|
1
|
|
|
|
|
5
|
$self->add(_render($mode)); |
1777
|
|
|
|
|
|
|
} |
1778
|
1
|
|
|
|
|
3
|
return $self->{' render'}; |
1779
|
|
|
|
|
|
|
} |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
=head2 rise |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
$distance = $content->rise($distance); |
1784
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
Adjusts the baseline up or down from its current location. This is initially |
1786
|
|
|
|
|
|
|
zero. |
1787
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
Use this to create superscripts or subscripts (usually with an adjustment to the |
1789
|
|
|
|
|
|
|
font size as well). |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
=cut |
1792
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
sub _rise { |
1794
|
1
|
|
|
1
|
|
2
|
my $distance = shift(); |
1795
|
1
|
|
|
|
|
5
|
return float($distance) . ' Ts'; |
1796
|
|
|
|
|
|
|
} |
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
sub rise { |
1799
|
1
|
|
|
1
|
1
|
9
|
my ($self, $distance) = @_; |
1800
|
1
|
50
|
|
|
|
5
|
if (defined ($distance)) { |
1801
|
1
|
|
|
|
|
4
|
$self->{' rise'} = $distance; |
1802
|
1
|
|
|
|
|
5
|
$self->add(_rise($distance)); |
1803
|
|
|
|
|
|
|
} |
1804
|
1
|
|
|
|
|
4
|
return $self->{' rise'}; |
1805
|
|
|
|
|
|
|
} |
1806
|
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
|
# Formerly documented; still used internally |
1808
|
|
|
|
|
|
|
sub textstate { |
1809
|
0
|
|
|
0
|
0
|
0
|
my $self = shift(); |
1810
|
0
|
|
|
|
|
0
|
my %state; |
1811
|
0
|
0
|
|
|
|
0
|
if (@_) { |
1812
|
0
|
|
|
|
|
0
|
%state = @_; |
1813
|
0
|
|
|
|
|
0
|
foreach my $k (qw(charspace hscale wordspace leading rise render)) { |
1814
|
0
|
0
|
|
|
|
0
|
next unless $state{$k}; |
1815
|
0
|
|
|
|
|
0
|
$self->can($k)->($self, $state{$k}); |
1816
|
|
|
|
|
|
|
} |
1817
|
0
|
0
|
0
|
|
|
0
|
if ($state{'font'} and $state{'fontsize'}) { |
1818
|
0
|
|
|
|
|
0
|
$self->font($state{'font'}, $state{'fontsize'}); |
1819
|
|
|
|
|
|
|
} |
1820
|
0
|
0
|
|
|
|
0
|
if ($state{'textmatrix'}) { |
1821
|
0
|
|
|
|
|
0
|
$self->matrix(@{$state{'textmatrix'}}); |
|
0
|
|
|
|
|
0
|
|
1822
|
0
|
|
|
|
|
0
|
@{$self->{' translate'}} = @{$state{'translate'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1823
|
0
|
|
|
|
|
0
|
$self->{' rotate'} = $state{'rotate'}; |
1824
|
0
|
|
|
|
|
0
|
@{$self->{' scale'}} = @{$state{'scale'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1825
|
0
|
|
|
|
|
0
|
@{$self->{' skew'}} = @{$state{'skew'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1826
|
|
|
|
|
|
|
} |
1827
|
0
|
0
|
|
|
|
0
|
if ($state{'fillcolor'}) { |
1828
|
0
|
|
|
|
|
0
|
$self->fillcolor(@{$state{'fillcolor'}}); |
|
0
|
|
|
|
|
0
|
|
1829
|
|
|
|
|
|
|
} |
1830
|
0
|
0
|
|
|
|
0
|
if ($state{'strokecolor'}) { |
1831
|
0
|
|
|
|
|
0
|
$self->strokecolor(@{$state{'strokecolor'}}); |
|
0
|
|
|
|
|
0
|
|
1832
|
|
|
|
|
|
|
} |
1833
|
0
|
|
|
|
|
0
|
%state = (); |
1834
|
|
|
|
|
|
|
} |
1835
|
|
|
|
|
|
|
else { |
1836
|
0
|
|
|
|
|
0
|
foreach my $k (qw(font fontsize charspace hscale wordspace leading rise render)) { |
1837
|
0
|
|
|
|
|
0
|
$state{$k} = $self->{" $k"}; |
1838
|
|
|
|
|
|
|
} |
1839
|
0
|
|
|
|
|
0
|
$state{'matrix'} = [@{$self->{' matrix'}}]; |
|
0
|
|
|
|
|
0
|
|
1840
|
0
|
|
|
|
|
0
|
$state{'textmatrix'} = [@{$self->{' textmatrix'}}]; |
|
0
|
|
|
|
|
0
|
|
1841
|
0
|
|
|
|
|
0
|
$state{'textlinematrix'} = [@{$self->{' textlinematrix'}}]; |
|
0
|
|
|
|
|
0
|
|
1842
|
0
|
|
|
|
|
0
|
$state{'rotate'} = $self->{' rotate'}; |
1843
|
0
|
|
|
|
|
0
|
$state{'scale'} = [@{$self->{' scale'}}]; |
|
0
|
|
|
|
|
0
|
|
1844
|
0
|
|
|
|
|
0
|
$state{'skew'} = [@{$self->{' skew'}}]; |
|
0
|
|
|
|
|
0
|
|
1845
|
0
|
|
|
|
|
0
|
$state{'translate'} = [@{$self->{' translate'}}]; |
|
0
|
|
|
|
|
0
|
|
1846
|
0
|
|
|
|
|
0
|
$state{'fillcolor'} = [@{$self->{' fillcolor'}}]; |
|
0
|
|
|
|
|
0
|
|
1847
|
0
|
|
|
|
|
0
|
$state{'strokecolor'} = [@{$self->{' strokecolor'}}]; |
|
0
|
|
|
|
|
0
|
|
1848
|
|
|
|
|
|
|
} |
1849
|
0
|
|
|
|
|
0
|
return %state; |
1850
|
|
|
|
|
|
|
} |
1851
|
|
|
|
|
|
|
|
1852
|
|
|
|
|
|
|
=head1 TEXT PLACEMENT |
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
=head2 position |
1855
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
# Set |
1857
|
|
|
|
|
|
|
$content = $content->position($x, $y); |
1858
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
# Get |
1860
|
|
|
|
|
|
|
($x, $y) = $content->position(); |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
If called with arguments, moves to the start of the current line of text, offset |
1863
|
|
|
|
|
|
|
by C<$x> and C<$y>. |
1864
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
If called without arguments, returns the current position of the cursor (before |
1866
|
|
|
|
|
|
|
the effects of any coordinate transformation methods). |
1867
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
=cut |
1869
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
sub position { |
1871
|
59
|
|
|
59
|
1
|
139
|
my ($self, $x, $y) = @_; |
1872
|
|
|
|
|
|
|
|
1873
|
59
|
50
|
66
|
|
|
129
|
if (defined $x and not defined $y) { |
1874
|
0
|
|
|
|
|
0
|
croak 'position requires either 0 or 2 arguments'; |
1875
|
|
|
|
|
|
|
} |
1876
|
|
|
|
|
|
|
|
1877
|
59
|
100
|
|
|
|
111
|
if (defined $x) { |
1878
|
1
|
|
|
|
|
4
|
$self->add(float($x), float($y), 'Td'); |
1879
|
1
|
|
|
|
|
7
|
$self->matrix_update($x, $y); |
1880
|
1
|
|
|
|
|
3
|
$self->{' textlinematrix'}->[0] = $x; |
1881
|
1
|
|
|
|
|
3
|
return $self; |
1882
|
|
|
|
|
|
|
} |
1883
|
|
|
|
|
|
|
|
1884
|
58
|
|
|
|
|
66
|
return @{$self->{' textlinematrix'}}; |
|
58
|
|
|
|
|
169
|
|
1885
|
|
|
|
|
|
|
} |
1886
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
# Deprecated; replace with position |
1888
|
|
|
|
|
|
|
sub distance { |
1889
|
1
|
|
|
1
|
1
|
10
|
my ($self, $dx, $dy) = @_; |
1890
|
1
|
|
|
|
|
4
|
$self->add(float($dx), float($dy), 'Td'); |
1891
|
1
|
|
|
|
|
8
|
$self->matrix_update($dx, $dy); |
1892
|
1
|
|
|
|
|
4
|
$self->{' textlinematrix'}->[0] = $dx; |
1893
|
|
|
|
|
|
|
} |
1894
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
# Deprecated; use position (ignores leading) or crlf (uses leading) instead |
1896
|
|
|
|
|
|
|
sub cr { |
1897
|
3
|
|
|
3
|
1
|
16
|
my ($self, $offset) = @_; |
1898
|
3
|
100
|
|
|
|
8
|
if (defined $offset) { |
1899
|
2
|
|
|
|
|
7
|
$self->add(0, float($offset), 'Td'); |
1900
|
2
|
|
|
|
|
5
|
$self->matrix_update(0, $offset); |
1901
|
|
|
|
|
|
|
} |
1902
|
|
|
|
|
|
|
else { |
1903
|
1
|
|
|
|
|
5
|
$self->add('T*'); |
1904
|
1
|
|
|
|
|
4
|
$self->matrix_update(0, $self->leading() * -1); |
1905
|
|
|
|
|
|
|
} |
1906
|
3
|
|
|
|
|
6
|
$self->{' textlinematrix'}->[0] = 0; |
1907
|
|
|
|
|
|
|
} |
1908
|
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
|
=head2 crlf |
1910
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
$content = $content->crlf(); |
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
Moves to the start of the next line, based on the L"leading"> setting. |
1914
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
If leading isn't set, a default distance of 120% of the font size will be used. |
1916
|
|
|
|
|
|
|
|
1917
|
|
|
|
|
|
|
=cut |
1918
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
sub crlf { |
1920
|
23
|
|
|
23
|
1
|
66
|
my $self = shift(); |
1921
|
23
|
|
|
|
|
47
|
my $leading = $self->leading(); |
1922
|
23
|
100
|
100
|
|
|
65
|
if ($leading or not $self->{' fontsize'}) { |
1923
|
22
|
|
|
|
|
40
|
$self->add('T*'); |
1924
|
|
|
|
|
|
|
} |
1925
|
|
|
|
|
|
|
else { |
1926
|
1
|
|
|
|
|
4
|
$leading = $self->{' fontsize'} * 1.2; |
1927
|
1
|
|
|
|
|
5
|
$self->add(0, float($leading * -1), 'Td'); |
1928
|
|
|
|
|
|
|
} |
1929
|
|
|
|
|
|
|
|
1930
|
23
|
|
|
|
|
60
|
$self->matrix_update(0, $leading * -1); |
1931
|
23
|
|
|
|
|
30
|
$self->{' textlinematrix'}->[0] = 0; |
1932
|
23
|
|
|
|
|
53
|
return $self; |
1933
|
|
|
|
|
|
|
} |
1934
|
|
|
|
|
|
|
|
1935
|
|
|
|
|
|
|
# Deprecated; replace with crlf |
1936
|
|
|
|
|
|
|
sub nl { |
1937
|
1
|
|
|
1
|
1
|
7
|
my $self = shift(); |
1938
|
1
|
|
|
|
|
5
|
$self->add('T*'); |
1939
|
1
|
|
|
|
|
4
|
$self->matrix_update(0, $self->leading() * -1); |
1940
|
1
|
|
|
|
|
3
|
$self->{' textlinematrix'}->[0] = 0; |
1941
|
|
|
|
|
|
|
} |
1942
|
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
|
sub _textpos { |
1944
|
0
|
|
|
0
|
|
0
|
my ($self, @xy) = @_; |
1945
|
|
|
|
|
|
|
|
1946
|
0
|
|
|
|
|
0
|
my ($x, $y) = (0, 0); |
1947
|
0
|
|
|
|
|
0
|
while (@xy) { |
1948
|
0
|
|
|
|
|
0
|
$x += shift(@xy); |
1949
|
0
|
|
|
|
|
0
|
$y += shift(@xy); |
1950
|
|
|
|
|
|
|
} |
1951
|
|
|
|
|
|
|
my (@m) = _transform( |
1952
|
0
|
|
|
|
|
0
|
-matrix => $self->{' textmatrix'}, |
1953
|
|
|
|
|
|
|
-point => [$x, $y], |
1954
|
|
|
|
|
|
|
); |
1955
|
|
|
|
|
|
|
|
1956
|
0
|
|
|
|
|
0
|
return ($m[0], $m[1]); |
1957
|
|
|
|
|
|
|
} |
1958
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
# Deprecated |
1960
|
|
|
|
|
|
|
sub textpos { |
1961
|
0
|
|
|
0
|
0
|
0
|
my $self = shift(); |
1962
|
0
|
|
|
|
|
0
|
return $self->_textpos(@{$self->{' textlinematrix'}}); |
|
0
|
|
|
|
|
0
|
|
1963
|
|
|
|
|
|
|
} |
1964
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
# Deprecated; replace with position (without arguments) |
1966
|
|
|
|
|
|
|
sub textpos2 { |
1967
|
0
|
|
|
0
|
0
|
0
|
my $self = shift(); |
1968
|
0
|
|
|
|
|
0
|
return $self->position(); |
1969
|
|
|
|
|
|
|
} |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
=head2 text |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
my $width = $content->text($text, %options); |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
Places text on the page. Returns the width of the text in points. |
1976
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
Options: |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
=over |
1980
|
|
|
|
|
|
|
|
1981
|
|
|
|
|
|
|
=item * align |
1982
|
|
|
|
|
|
|
|
1983
|
|
|
|
|
|
|
One of C (default), C, or C. Text will be placed such that |
1984
|
|
|
|
|
|
|
it begins, is centered on, or ends at the current text position, respectively. |
1985
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
In each case, the position will then be moved to the end of the text. |
1987
|
|
|
|
|
|
|
|
1988
|
|
|
|
|
|
|
=item * indent |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
Indents the text by the number of points. |
1991
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
If C is set to anything other than C, this setting will be ignored. |
1993
|
|
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
=item * underline |
1995
|
|
|
|
|
|
|
|
1996
|
|
|
|
|
|
|
Underlines the text. The value may be one of the following: |
1997
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
=over |
1999
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
=item * auto |
2001
|
|
|
|
|
|
|
|
2002
|
|
|
|
|
|
|
Determines the underline distance from the text based on the font and font size. |
2003
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
=item * $distance |
2005
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
Manually set the underline distance in points. A positive distance moves the |
2007
|
|
|
|
|
|
|
line downward. |
2008
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
=item * [$distance, $thickness, ...] |
2010
|
|
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
Manually set both the underline distance and line thickness, both in points. |
2012
|
|
|
|
|
|
|
|
2013
|
|
|
|
|
|
|
Repeat these arguments to include multiple underlines. |
2014
|
|
|
|
|
|
|
|
2015
|
|
|
|
|
|
|
=back |
2016
|
|
|
|
|
|
|
|
2017
|
|
|
|
|
|
|
=back |
2018
|
|
|
|
|
|
|
|
2019
|
|
|
|
|
|
|
=cut |
2020
|
|
|
|
|
|
|
|
2021
|
|
|
|
|
|
|
sub _text_underline { |
2022
|
0
|
|
|
0
|
|
0
|
my ($self, $xy1, $xy2, $underline, $color) = @_; |
2023
|
0
|
|
0
|
|
|
0
|
$color ||= 'black'; |
2024
|
|
|
|
|
|
|
|
2025
|
0
|
|
|
|
|
0
|
my @underline; |
2026
|
0
|
0
|
|
|
|
0
|
if (ref($underline) eq 'ARRAY') { |
2027
|
0
|
|
|
|
|
0
|
@underline = @$underline; |
2028
|
|
|
|
|
|
|
} |
2029
|
|
|
|
|
|
|
else { |
2030
|
0
|
|
|
|
|
0
|
@underline = ($underline, 1); |
2031
|
|
|
|
|
|
|
} |
2032
|
0
|
0
|
|
|
|
0
|
push @underline, 1 if @underline % 2; |
2033
|
|
|
|
|
|
|
|
2034
|
0
|
|
0
|
|
|
0
|
my $underlineposition = (-$self->{' font'}->underlineposition() * $self->{' fontsize'} / 1000 || 1); |
2035
|
0
|
|
0
|
|
|
0
|
my $underlinethickness = ($self->{' font'}->underlinethickness() * $self->{' fontsize'} / 1000 || 1); |
2036
|
0
|
|
|
|
|
0
|
my $pos = 1; |
2037
|
|
|
|
|
|
|
|
2038
|
0
|
|
|
|
|
0
|
while (@underline) { |
2039
|
0
|
|
|
|
|
0
|
$self->add_post(_save()); |
2040
|
|
|
|
|
|
|
|
2041
|
0
|
|
|
|
|
0
|
my $distance = shift(@underline); |
2042
|
0
|
|
|
|
|
0
|
my $thickness = shift(@underline); |
2043
|
0
|
|
|
|
|
0
|
my $scolor = $color; |
2044
|
0
|
0
|
|
|
|
0
|
if (ref($thickness)) { |
2045
|
0
|
|
|
|
|
0
|
($thickness, $scolor) = @$thickness; |
2046
|
|
|
|
|
|
|
} |
2047
|
0
|
0
|
|
|
|
0
|
if ($distance eq 'auto') { |
2048
|
0
|
|
|
|
|
0
|
$distance = $pos * $underlineposition; |
2049
|
|
|
|
|
|
|
} |
2050
|
0
|
0
|
|
|
|
0
|
if ($thickness eq 'auto') { |
2051
|
0
|
|
|
|
|
0
|
$thickness = $underlinethickness; |
2052
|
|
|
|
|
|
|
} |
2053
|
|
|
|
|
|
|
|
2054
|
0
|
|
|
|
|
0
|
my ($x1, $y1) = $self->_textpos(@$xy1, 0, -($distance + ($thickness / 2))); |
2055
|
0
|
|
|
|
|
0
|
my ($x2, $y2) = $self->_textpos(@$xy2, 0, -($distance + ($thickness / 2))); |
2056
|
|
|
|
|
|
|
|
2057
|
0
|
|
|
|
|
0
|
$self->add_post($self->_strokecolor($scolor)); |
2058
|
0
|
|
|
|
|
0
|
$self->add_post(_linewidth($thickness)); |
2059
|
0
|
|
|
|
|
0
|
$self->add_post(_move($x1, $y1)); |
2060
|
0
|
|
|
|
|
0
|
$self->add_post(_line($x2, $y2)); |
2061
|
0
|
|
|
|
|
0
|
$self->add_post(_stroke()); |
2062
|
|
|
|
|
|
|
|
2063
|
0
|
|
|
|
|
0
|
$self->add_post(_restore()); |
2064
|
0
|
|
|
|
|
0
|
$pos++; |
2065
|
|
|
|
|
|
|
} |
2066
|
|
|
|
|
|
|
} |
2067
|
|
|
|
|
|
|
|
2068
|
|
|
|
|
|
|
sub text { |
2069
|
30
|
|
|
30
|
1
|
128
|
my ($self, $text, %opts) = @_; |
2070
|
30
|
100
|
|
|
|
77
|
unless ($self->{' fontset'}) { |
2071
|
1
|
50
|
33
|
|
|
4
|
unless (defined $self->{' font'} and $self->{' fontsize'}) { |
2072
|
1
|
|
|
|
|
168
|
croak q{Can't add text without first setting a font and font size}; |
2073
|
|
|
|
|
|
|
} |
2074
|
0
|
|
|
|
|
0
|
$self->font($self->{' font'}, $self->{' fontsize'}); |
2075
|
0
|
|
|
|
|
0
|
$self->{' fontset'} = 1; |
2076
|
|
|
|
|
|
|
} |
2077
|
|
|
|
|
|
|
|
2078
|
|
|
|
|
|
|
# Deprecated options (remove hyphens) |
2079
|
29
|
100
|
|
|
|
61
|
if (exists $opts{'-indent'}) { |
2080
|
10
|
|
33
|
|
|
57
|
$opts{'indent'} //= delete $opts{'-indent'}; |
2081
|
|
|
|
|
|
|
} |
2082
|
29
|
50
|
|
|
|
83
|
if (exists $opts{'-underline'}) { |
2083
|
0
|
|
0
|
|
|
0
|
$opts{'underline'} //= delete $opts{'-underline'}; |
2084
|
|
|
|
|
|
|
} |
2085
|
|
|
|
|
|
|
|
2086
|
29
|
|
|
|
|
70
|
my $width = $self->text_width($text); |
2087
|
|
|
|
|
|
|
|
2088
|
29
|
100
|
|
|
|
81
|
if (defined $opts{'align'}) { |
2089
|
12
|
100
|
|
|
|
44
|
if ($opts{'align'} eq 'left') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2090
|
|
|
|
|
|
|
# NOOP |
2091
|
|
|
|
|
|
|
} |
2092
|
|
|
|
|
|
|
elsif ($opts{'align'} eq 'center') { |
2093
|
3
|
|
|
|
|
9
|
$opts{'indent'} = -($width / 2); |
2094
|
|
|
|
|
|
|
} |
2095
|
|
|
|
|
|
|
elsif ($opts{'align'} eq 'right') { |
2096
|
3
|
|
|
|
|
7
|
$opts{'indent'} = -$width; |
2097
|
|
|
|
|
|
|
} |
2098
|
|
|
|
|
|
|
else { |
2099
|
0
|
|
|
|
|
0
|
croak 'Invalid alignment: ' . $opts{'align'}; |
2100
|
|
|
|
|
|
|
} |
2101
|
|
|
|
|
|
|
} |
2102
|
|
|
|
|
|
|
|
2103
|
29
|
100
|
|
|
|
77
|
if (defined $opts{'indent'}) { |
2104
|
12
|
|
|
|
|
99
|
$self->matrix_update($opts{'indent'}, 0); |
2105
|
|
|
|
|
|
|
} |
2106
|
|
|
|
|
|
|
|
2107
|
29
|
|
|
|
|
98
|
my $underline_start = [$self->position()]; |
2108
|
|
|
|
|
|
|
|
2109
|
29
|
100
|
|
|
|
72
|
if (defined $opts{'indent'}) { |
2110
|
12
|
|
|
|
|
28
|
my $indent = -$opts{'indent'}; |
2111
|
12
|
|
|
|
|
55
|
$indent *= (1000 / $self->{' fontsize'}) * (100 / $self->hscale()); |
2112
|
12
|
|
|
|
|
64
|
$self->add($self->{' font'}->text($text, $self->{' fontsize'}, $indent)); |
2113
|
|
|
|
|
|
|
} |
2114
|
|
|
|
|
|
|
else { |
2115
|
17
|
|
|
|
|
58
|
$self->add($self->{' font'}->text($text, $self->{' fontsize'})); |
2116
|
|
|
|
|
|
|
} |
2117
|
|
|
|
|
|
|
|
2118
|
29
|
|
|
|
|
109
|
$self->matrix_update($width, 0); |
2119
|
|
|
|
|
|
|
|
2120
|
29
|
|
|
|
|
55
|
my $underline_end = [$self->position()]; |
2121
|
|
|
|
|
|
|
|
2122
|
29
|
50
|
|
|
|
80
|
if (defined $opts{'underline'}) { |
2123
|
|
|
|
|
|
|
$self->_text_underline($underline_start, $underline_end, |
2124
|
|
|
|
|
|
|
$opts{'underline'}, |
2125
|
0
|
|
|
|
|
0
|
$opts{'-strokecolor'}); |
2126
|
|
|
|
|
|
|
} |
2127
|
|
|
|
|
|
|
|
2128
|
29
|
|
|
|
|
91
|
return $width; |
2129
|
|
|
|
|
|
|
} |
2130
|
|
|
|
|
|
|
|
2131
|
|
|
|
|
|
|
# Deprecated; replace with text($line, align => 'center') |
2132
|
|
|
|
|
|
|
sub text_center { |
2133
|
6
|
|
|
6
|
1
|
59
|
my ($self, $text, @opts) = @_; |
2134
|
6
|
|
|
|
|
30
|
my $width = $self->advancewidth($text); |
2135
|
6
|
|
|
|
|
46
|
return $self->text($text, -indent => -($width / 2), @opts); |
2136
|
|
|
|
|
|
|
} |
2137
|
|
|
|
|
|
|
|
2138
|
|
|
|
|
|
|
# Deprecated; replace with text($line, align => 'right') |
2139
|
|
|
|
|
|
|
sub text_right { |
2140
|
3
|
|
|
3
|
1
|
25
|
my ($self, $text, @opts) = @_; |
2141
|
3
|
|
|
|
|
9
|
my $width = $self->advancewidth($text); |
2142
|
3
|
|
|
|
|
12
|
return $self->text($text, -indent => -$width, @opts); |
2143
|
|
|
|
|
|
|
} |
2144
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
=head2 text_justified |
2146
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
my $width = $content->text_justified($text, $width, %options); |
2148
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
As C, filling the specified width by adjusting the space between words. |
2150
|
|
|
|
|
|
|
|
2151
|
|
|
|
|
|
|
=cut |
2152
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
sub text_justified { |
2154
|
1
|
|
|
1
|
1
|
17
|
my ($self, $text, $width, %opts) = @_; |
2155
|
1
|
|
|
|
|
4
|
my $initial_width = $self->text_width($text); |
2156
|
1
|
|
|
|
|
20
|
my $space_count = (split /\s/, $text) - 1; |
2157
|
1
|
|
|
|
|
5
|
my $ws = $self->wordspace(); |
2158
|
1
|
50
|
|
|
|
7
|
$self->wordspace(($width - $initial_width) / $space_count) if $space_count; |
2159
|
1
|
|
|
|
|
7
|
$self->text($text, %opts); |
2160
|
1
|
|
|
|
|
4
|
$self->wordspace($ws); |
2161
|
1
|
|
|
|
|
4
|
return $width; |
2162
|
|
|
|
|
|
|
} |
2163
|
|
|
|
|
|
|
|
2164
|
|
|
|
|
|
|
sub _text_fill_line { |
2165
|
19
|
|
|
19
|
|
33
|
my ($self, $text, $width) = @_; |
2166
|
19
|
|
|
|
|
95
|
my @words = split(/\x20/, $text); |
2167
|
19
|
|
|
|
|
34
|
my @line = (); |
2168
|
19
|
|
|
|
|
27
|
local $" = ' '; |
2169
|
19
|
|
|
|
|
36
|
while (@words) { |
2170
|
112
|
|
|
|
|
175
|
push @line, (shift @words); |
2171
|
112
|
100
|
|
|
|
254
|
last if $self->advancewidth("@line") > $width; |
2172
|
|
|
|
|
|
|
} |
2173
|
19
|
100
|
66
|
|
|
105
|
if ((scalar @line > 1) and ($self->advancewidth("@line") > $width)) { |
2174
|
12
|
|
|
|
|
24
|
unshift @words, pop @line; |
2175
|
|
|
|
|
|
|
} |
2176
|
19
|
|
|
|
|
47
|
my $ret = "@words"; |
2177
|
19
|
|
|
|
|
35
|
my $line = "@line"; |
2178
|
19
|
|
|
|
|
58
|
return $line, $ret; |
2179
|
|
|
|
|
|
|
} |
2180
|
|
|
|
|
|
|
|
2181
|
|
|
|
|
|
|
sub text_fill_left { |
2182
|
7
|
|
|
7
|
0
|
14
|
my ($self, $text, $width, %opts) = @_; |
2183
|
7
|
|
|
|
|
15
|
my ($line, $ret) = $self->_text_fill_line($text, $width); |
2184
|
7
|
|
|
|
|
20
|
$width = $self->text($line, %opts); |
2185
|
7
|
|
|
|
|
19
|
return $width, $ret; |
2186
|
|
|
|
|
|
|
} |
2187
|
|
|
|
|
|
|
|
2188
|
|
|
|
|
|
|
sub text_fill_center { |
2189
|
2
|
|
|
2
|
0
|
5
|
my ($self, $text, $width, %opts) = @_; |
2190
|
2
|
|
|
|
|
5
|
my ($line, $ret) = $self->_text_fill_line($text, $width); |
2191
|
2
|
|
|
|
|
10
|
$width = $self->text_center($line, %opts); |
2192
|
2
|
|
|
|
|
6
|
return $width, $ret; |
2193
|
|
|
|
|
|
|
} |
2194
|
|
|
|
|
|
|
|
2195
|
|
|
|
|
|
|
sub text_fill_right { |
2196
|
2
|
|
|
2
|
0
|
9
|
my ($self, $text, $width, %opts) = @_; |
2197
|
2
|
|
|
|
|
5
|
my ($line, $ret) = $self->_text_fill_line($text, $width); |
2198
|
2
|
|
|
|
|
9
|
$width = $self->text_right($line, %opts); |
2199
|
2
|
|
|
|
|
8
|
return $width, $ret; |
2200
|
|
|
|
|
|
|
} |
2201
|
|
|
|
|
|
|
|
2202
|
|
|
|
|
|
|
sub text_fill_justified { |
2203
|
8
|
|
|
8
|
0
|
21
|
my ($self, $text, $width, %opts) = @_; |
2204
|
8
|
|
|
|
|
24
|
my ($line, $ret) = $self->_text_fill_line($text, $width); |
2205
|
8
|
|
|
|
|
20
|
my $ws = $self->wordspace(); |
2206
|
8
|
|
|
|
|
15
|
my $w = $self->advancewidth($line); |
2207
|
8
|
|
|
|
|
47
|
my $space_count = (split /\s/, $line) - 1; |
2208
|
|
|
|
|
|
|
|
2209
|
|
|
|
|
|
|
# Normal Line |
2210
|
8
|
100
|
|
|
|
16
|
if ($ret) { |
2211
|
4
|
50
|
|
|
|
17
|
$self->wordspace(($width - $w) / $space_count) if $space_count; |
2212
|
4
|
|
|
|
|
15
|
$width = $self->text($line, %opts, align => 'left'); |
2213
|
4
|
|
|
|
|
10
|
$self->wordspace($ws); |
2214
|
4
|
|
|
|
|
13
|
return $width, $ret; |
2215
|
|
|
|
|
|
|
} |
2216
|
|
|
|
|
|
|
|
2217
|
|
|
|
|
|
|
# Last Line |
2218
|
4
|
100
|
|
|
|
11
|
if ($opts{'align-last'}) { |
2219
|
3
|
50
|
|
|
|
17
|
unless ($opts{'align-last'} =~ /^(left|center|right|justified)$/) { |
2220
|
0
|
|
|
|
|
0
|
croak 'Invalid align-last (must be left, center, right, or justified)'; |
2221
|
|
|
|
|
|
|
} |
2222
|
|
|
|
|
|
|
} |
2223
|
4
|
|
100
|
|
|
13
|
my $align_last = $opts{'align-last'} // 'left'; |
2224
|
4
|
100
|
|
|
|
15
|
if ($align_last eq 'left') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2225
|
1
|
|
|
|
|
5
|
$width = $self->text($line, %opts, align => 'left'); |
2226
|
|
|
|
|
|
|
} |
2227
|
|
|
|
|
|
|
elsif ($align_last eq 'center') { |
2228
|
1
|
|
|
|
|
5
|
$width = $self->text($line, %opts, align => 'center'); |
2229
|
|
|
|
|
|
|
} |
2230
|
|
|
|
|
|
|
elsif ($align_last eq 'right') { |
2231
|
1
|
|
|
|
|
5
|
$width = $self->text($line, %opts, align => 'right'); |
2232
|
|
|
|
|
|
|
} |
2233
|
|
|
|
|
|
|
else { |
2234
|
1
|
50
|
|
|
|
7
|
$self->wordspace(($width - $w) / $space_count) if $space_count; |
2235
|
1
|
|
|
|
|
6
|
$width = $self->text($line, %opts, align => 'left'); |
2236
|
1
|
|
|
|
|
5
|
$self->wordspace($ws); |
2237
|
|
|
|
|
|
|
} |
2238
|
4
|
|
|
|
|
13
|
return $width, $ret; |
2239
|
|
|
|
|
|
|
} |
2240
|
|
|
|
|
|
|
|
2241
|
|
|
|
|
|
|
=head2 paragraph |
2242
|
|
|
|
|
|
|
|
2243
|
|
|
|
|
|
|
# Scalar context |
2244
|
|
|
|
|
|
|
$overflow_text = $content->paragraph($text, $width, $height, %options); |
2245
|
|
|
|
|
|
|
|
2246
|
|
|
|
|
|
|
# Array context |
2247
|
|
|
|
|
|
|
($overflow, $height) = $content->paragraph($text, $width, $height, %options); |
2248
|
|
|
|
|
|
|
|
2249
|
|
|
|
|
|
|
Fills the rectangle with as much of the provided text as will fit. |
2250
|
|
|
|
|
|
|
|
2251
|
|
|
|
|
|
|
In array context, returns the remaining text (if any) of the positioned text and |
2252
|
|
|
|
|
|
|
the remaining (unused) height. In scalar context, returns the remaining text |
2253
|
|
|
|
|
|
|
(if any). |
2254
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
Line spacing follows L"leading">, if set, or 120% of the font size by default. |
2256
|
|
|
|
|
|
|
|
2257
|
|
|
|
|
|
|
B |
2258
|
|
|
|
|
|
|
|
2259
|
|
|
|
|
|
|
=over |
2260
|
|
|
|
|
|
|
|
2261
|
|
|
|
|
|
|
=item * align |
2262
|
|
|
|
|
|
|
|
2263
|
|
|
|
|
|
|
Specifies the alignment for each line of text. May be set to C (default), |
2264
|
|
|
|
|
|
|
C, C, or C. |
2265
|
|
|
|
|
|
|
|
2266
|
|
|
|
|
|
|
=item * align-last |
2267
|
|
|
|
|
|
|
|
2268
|
|
|
|
|
|
|
Specifies the alignment for the last line of justified text. May be set to |
2269
|
|
|
|
|
|
|
C (default), C, C, or C. |
2270
|
|
|
|
|
|
|
|
2271
|
|
|
|
|
|
|
=item * underline |
2272
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
As described in L"text">. |
2274
|
|
|
|
|
|
|
|
2275
|
|
|
|
|
|
|
=back |
2276
|
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
=cut |
2278
|
|
|
|
|
|
|
|
2279
|
|
|
|
|
|
|
sub paragraph { |
2280
|
10
|
|
|
10
|
1
|
63
|
my ($self, $text, $width, $height, %opts) = @_; |
2281
|
|
|
|
|
|
|
|
2282
|
|
|
|
|
|
|
# Deprecated options (remove hyphens) |
2283
|
10
|
100
|
|
|
|
25
|
if (exists $opts{'-align'}) { |
2284
|
6
|
|
33
|
|
|
23
|
$opts{'align'} //= delete $opts{'-align'}; |
2285
|
|
|
|
|
|
|
} |
2286
|
10
|
100
|
|
|
|
21
|
if (exists $opts{'-align-last'}) { |
2287
|
3
|
|
33
|
|
|
10
|
$opts{'align-last'} //= delete $opts{'-align-last'}; |
2288
|
|
|
|
|
|
|
} |
2289
|
10
|
50
|
|
|
|
44
|
if (exists $opts{'-underline'}) { |
2290
|
0
|
|
0
|
|
|
0
|
$opts{'underline'} //= delete $opts{'-underline'}; |
2291
|
|
|
|
|
|
|
} |
2292
|
|
|
|
|
|
|
|
2293
|
10
|
|
|
|
|
25
|
my $leading = $self->leading(); |
2294
|
10
|
50
|
|
|
|
20
|
unless ($leading) { |
2295
|
0
|
|
|
|
|
0
|
$leading = $self->{' fontsize'} * 1.2; |
2296
|
|
|
|
|
|
|
} |
2297
|
|
|
|
|
|
|
|
2298
|
|
|
|
|
|
|
# If the text contains newlines, call paragraph on each line |
2299
|
10
|
100
|
|
|
|
27
|
if ($text =~ /\n/) { |
2300
|
1
|
|
|
|
|
2
|
my $overflow = ''; |
2301
|
1
|
|
|
|
|
6
|
foreach my $line (split /\n/, $text) { |
2302
|
|
|
|
|
|
|
# If there's overflow, no more text can be placed. |
2303
|
3
|
50
|
|
|
|
8
|
if (length($overflow)) { |
2304
|
0
|
|
|
|
|
0
|
$overflow .= "\n" . $line; |
2305
|
0
|
|
|
|
|
0
|
next; |
2306
|
|
|
|
|
|
|
} |
2307
|
|
|
|
|
|
|
|
2308
|
|
|
|
|
|
|
# Place a blank line if there are consecutive newlines |
2309
|
3
|
100
|
|
|
|
5
|
unless (length($line)) { |
2310
|
1
|
|
|
|
|
3
|
$self->crlf(); |
2311
|
1
|
|
|
|
|
2
|
$height -= $leading; |
2312
|
1
|
|
|
|
|
1
|
next; |
2313
|
|
|
|
|
|
|
} |
2314
|
|
|
|
|
|
|
|
2315
|
2
|
|
|
|
|
10
|
($line, $height) = $self->paragraph($line, $width, $height, %opts); |
2316
|
2
|
100
|
|
|
|
8
|
$overflow .= $line if length($line); |
2317
|
|
|
|
|
|
|
} |
2318
|
|
|
|
|
|
|
|
2319
|
1
|
50
|
|
|
|
4
|
return ($overflow, $height) if wantarray(); |
2320
|
1
|
|
|
|
|
4
|
return $overflow; |
2321
|
|
|
|
|
|
|
} |
2322
|
|
|
|
|
|
|
|
2323
|
9
|
|
|
|
|
12
|
my $w; |
2324
|
9
|
|
|
|
|
23
|
while (length($text) > 0) { |
2325
|
21
|
|
|
|
|
24
|
$height -= $leading; |
2326
|
21
|
100
|
|
|
|
39
|
last if $height < 0; |
2327
|
|
|
|
|
|
|
|
2328
|
19
|
|
100
|
|
|
44
|
my $align = $opts{'align'} // 'left'; |
2329
|
19
|
100
|
|
|
|
44
|
if ($align eq 'justified') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2330
|
8
|
|
|
|
|
33
|
($w, $text) = $self->text_fill_justified($text, $width, %opts); |
2331
|
|
|
|
|
|
|
} |
2332
|
|
|
|
|
|
|
elsif ($align eq 'right') { |
2333
|
2
|
|
|
|
|
16
|
($w, $text) = $self->text_fill_right($text, $width, %opts); |
2334
|
|
|
|
|
|
|
} |
2335
|
|
|
|
|
|
|
elsif ($align eq 'center') { |
2336
|
2
|
|
|
|
|
14
|
($w, $text) = $self->text_fill_center($text, $width, %opts); |
2337
|
|
|
|
|
|
|
} |
2338
|
|
|
|
|
|
|
else { |
2339
|
7
|
|
|
|
|
22
|
($w, $text) = $self->text_fill_left($text, $width, %opts); |
2340
|
|
|
|
|
|
|
} |
2341
|
19
|
|
|
|
|
42
|
$self->crlf(); |
2342
|
|
|
|
|
|
|
} |
2343
|
|
|
|
|
|
|
|
2344
|
9
|
100
|
|
|
|
24
|
return ($text, $height) if wantarray(); |
2345
|
7
|
|
|
|
|
17
|
return $text; |
2346
|
|
|
|
|
|
|
} |
2347
|
|
|
|
|
|
|
|
2348
|
|
|
|
|
|
|
# Deprecated former name |
2349
|
0
|
|
|
0
|
1
|
0
|
sub section { return paragraphs(@_) } |
2350
|
|
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
# Deprecated; merged into paragraph |
2352
|
1
|
|
|
1
|
1
|
21
|
sub paragraphs { return paragraph(@_) } |
2353
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
sub textlabel { |
2355
|
0
|
|
|
0
|
0
|
0
|
my ($self, $x, $y, $font, $size, $text, %opts, $wht) = @_; |
2356
|
0
|
|
|
|
|
0
|
my %trans_opts = (-translate => [$x,$y]); |
2357
|
0
|
|
|
|
|
0
|
my %text_state; |
2358
|
0
|
0
|
|
|
|
0
|
$trans_opts{'-rotate'} = $opts{'-rotate'} if $opts{'-rotate'}; |
2359
|
|
|
|
|
|
|
|
2360
|
0
|
|
|
|
|
0
|
my $wastext = $self->_in_text_object(); |
2361
|
0
|
0
|
|
|
|
0
|
if ($wastext) { |
2362
|
0
|
|
|
|
|
0
|
%text_state = $self->textstate(); |
2363
|
0
|
|
|
|
|
0
|
$self->textend(); |
2364
|
|
|
|
|
|
|
} |
2365
|
0
|
|
|
|
|
0
|
$self->save(); |
2366
|
0
|
|
|
|
|
0
|
$self->textstart(); |
2367
|
|
|
|
|
|
|
|
2368
|
0
|
|
|
|
|
0
|
$self->transform(%trans_opts); |
2369
|
|
|
|
|
|
|
|
2370
|
0
|
0
|
|
|
|
0
|
if ($opts{'-color'}) { |
2371
|
0
|
0
|
|
|
|
0
|
my $color = ref($opts{'-color'}) ? @{$opts{'-color'}} : $opts{'-color'}; |
|
0
|
|
|
|
|
0
|
|
2372
|
0
|
|
|
|
|
0
|
$self->fillcolor($color); |
2373
|
|
|
|
|
|
|
} |
2374
|
0
|
0
|
|
|
|
0
|
if ($opts{'-strokecolor'}) { |
2375
|
|
|
|
|
|
|
my $color = (ref($opts{'-strokecolor'}) |
2376
|
0
|
|
|
|
|
0
|
? @{$opts{'-strokecolor'}} |
2377
|
0
|
0
|
|
|
|
0
|
: $opts{'-strokecolor'}); |
2378
|
0
|
|
|
|
|
0
|
$self->strokecolor($color); |
2379
|
|
|
|
|
|
|
} |
2380
|
|
|
|
|
|
|
|
2381
|
0
|
|
|
|
|
0
|
$self->font($font, $size); |
2382
|
|
|
|
|
|
|
|
2383
|
0
|
0
|
|
|
|
0
|
$self->charspace($opts{'-charspace'}) if $opts{'-charspace'}; |
2384
|
0
|
0
|
|
|
|
0
|
$self->hscale($opts{'-hscale'}) if $opts{'-hscale'}; |
2385
|
0
|
0
|
|
|
|
0
|
$self->wordspace($opts{'-wordspace'}) if $opts{'-wordspace'}; |
2386
|
0
|
0
|
|
|
|
0
|
$self->render($opts{'-render'}) if $opts{'-render'}; |
2387
|
|
|
|
|
|
|
|
2388
|
0
|
|
0
|
|
|
0
|
my $align = $opts{'-align'} // 'left'; |
2389
|
0
|
0
|
0
|
|
|
0
|
if ($opts{'-right'} or $align =~ /^r/i) { |
|
|
0
|
0
|
|
|
|
|
2390
|
0
|
|
|
|
|
0
|
$wht = $self->text_right($text, %opts); |
2391
|
|
|
|
|
|
|
} |
2392
|
|
|
|
|
|
|
elsif ($opts{'-center'} or $align =~ /^c/i) { |
2393
|
0
|
|
|
|
|
0
|
$wht = $self->text_center($text, %opts); |
2394
|
|
|
|
|
|
|
} |
2395
|
|
|
|
|
|
|
else { |
2396
|
0
|
|
|
|
|
0
|
$wht = $self->text($text, %opts); |
2397
|
|
|
|
|
|
|
} |
2398
|
|
|
|
|
|
|
|
2399
|
0
|
|
|
|
|
0
|
$self->textend(); |
2400
|
0
|
|
|
|
|
0
|
$self->restore(); |
2401
|
|
|
|
|
|
|
|
2402
|
0
|
0
|
|
|
|
0
|
if ($wastext) { |
2403
|
0
|
|
|
|
|
0
|
$self->textstart(); |
2404
|
0
|
|
|
|
|
0
|
$self->textstate(%text_state); |
2405
|
|
|
|
|
|
|
} |
2406
|
0
|
|
|
|
|
0
|
return $wht; |
2407
|
|
|
|
|
|
|
} |
2408
|
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
|
=head2 text_width |
2410
|
|
|
|
|
|
|
|
2411
|
|
|
|
|
|
|
my $width = $content->text_width($line, %overrides); |
2412
|
|
|
|
|
|
|
|
2413
|
|
|
|
|
|
|
Returns the width of a line of text based on the current text state attributes. |
2414
|
|
|
|
|
|
|
These can optionally be overridden: |
2415
|
|
|
|
|
|
|
|
2416
|
|
|
|
|
|
|
my $width = $content->text_width($line, |
2417
|
|
|
|
|
|
|
font => $font, |
2418
|
|
|
|
|
|
|
size => $size, |
2419
|
|
|
|
|
|
|
character_spacing => $spacing, |
2420
|
|
|
|
|
|
|
word_spacing => $spacing, |
2421
|
|
|
|
|
|
|
hscale => $scale, |
2422
|
|
|
|
|
|
|
); |
2423
|
|
|
|
|
|
|
|
2424
|
|
|
|
|
|
|
=cut |
2425
|
|
|
|
|
|
|
|
2426
|
|
|
|
|
|
|
# Deprecated (renamed) |
2427
|
153
|
|
|
153
|
1
|
1057
|
sub advancewidth { return text_width(@_) } |
2428
|
|
|
|
|
|
|
|
2429
|
|
|
|
|
|
|
sub text_width { |
2430
|
183
|
|
|
183
|
1
|
276
|
my ($self, $text, %opts) = @_; |
2431
|
183
|
50
|
33
|
|
|
520
|
return 0 unless defined($text) and length($text); |
2432
|
|
|
|
|
|
|
|
2433
|
|
|
|
|
|
|
# Convert new names to old names |
2434
|
183
|
50
|
|
|
|
285
|
if (exists $opts{'size'}) { |
2435
|
0
|
|
|
|
|
0
|
$opts{'fontsize'} = delete $opts{'size'}; |
2436
|
|
|
|
|
|
|
} |
2437
|
183
|
50
|
|
|
|
274
|
if (exists $opts{'character_spacing'}) { |
2438
|
0
|
|
|
|
|
0
|
$opts{'charspace'} = delete $opts{'character_spacing'}; |
2439
|
|
|
|
|
|
|
} |
2440
|
183
|
50
|
|
|
|
251
|
if (exists $opts{'word_spacing'}) { |
2441
|
0
|
|
|
|
|
0
|
$opts{'charspace'} = delete $opts{'word_spacing'}; |
2442
|
|
|
|
|
|
|
} |
2443
|
|
|
|
|
|
|
|
2444
|
183
|
|
|
|
|
289
|
foreach my $k (qw(font fontsize wordspace charspace hscale)) { |
2445
|
915
|
100
|
|
|
|
1904
|
$opts{$k} = $self->{" $k"} unless defined $opts{$k}; |
2446
|
|
|
|
|
|
|
} |
2447
|
|
|
|
|
|
|
|
2448
|
|
|
|
|
|
|
# Width of glyphs |
2449
|
183
|
|
|
|
|
381
|
my $width = $opts{'font'}->width($text) * $opts{'fontsize'}; |
2450
|
|
|
|
|
|
|
|
2451
|
|
|
|
|
|
|
# Width of space characters |
2452
|
183
|
|
|
|
|
284
|
my $space_count = $text =~ y/\x20/\x20/; |
2453
|
183
|
|
|
|
|
250
|
$width += $opts{'wordspace'} * $space_count; |
2454
|
|
|
|
|
|
|
|
2455
|
|
|
|
|
|
|
# Width of space between characters |
2456
|
183
|
|
|
|
|
223
|
my $char_count = length($text); |
2457
|
183
|
|
|
|
|
233
|
$width += $opts{'charspace'} * ($char_count - 1); |
2458
|
|
|
|
|
|
|
|
2459
|
|
|
|
|
|
|
# Horizontal scale multiplier |
2460
|
183
|
|
|
|
|
232
|
$width *= $opts{'hscale'} / 100; |
2461
|
|
|
|
|
|
|
|
2462
|
183
|
|
|
|
|
508
|
return $width; |
2463
|
|
|
|
|
|
|
} |
2464
|
|
|
|
|
|
|
|
2465
|
|
|
|
|
|
|
sub metaStart { |
2466
|
0
|
|
|
0
|
0
|
0
|
my ($self, $tag, $obj) = @_; |
2467
|
0
|
|
|
|
|
0
|
$self->add("/$tag"); |
2468
|
0
|
0
|
|
|
|
0
|
if (defined $obj) { |
2469
|
0
|
|
|
|
|
0
|
my $dict = PDFDict(); |
2470
|
0
|
|
|
|
|
0
|
$dict->{'Metadata'} = $obj; |
2471
|
0
|
|
|
|
|
0
|
$self->resource('Properties', $obj->name(), $dict); |
2472
|
0
|
|
|
|
|
0
|
$self->add('/' . $obj->name()); |
2473
|
0
|
|
|
|
|
0
|
$self->add('BDC'); |
2474
|
|
|
|
|
|
|
} |
2475
|
|
|
|
|
|
|
else { |
2476
|
0
|
|
|
|
|
0
|
$self->add('BMC'); |
2477
|
|
|
|
|
|
|
} |
2478
|
0
|
|
|
|
|
0
|
return $self; |
2479
|
|
|
|
|
|
|
} |
2480
|
|
|
|
|
|
|
|
2481
|
|
|
|
|
|
|
sub metaEnd { |
2482
|
0
|
|
|
0
|
0
|
0
|
my $self = shift(); |
2483
|
0
|
|
|
|
|
0
|
$self->add('EMC'); |
2484
|
0
|
|
|
|
|
0
|
return $self; |
2485
|
|
|
|
|
|
|
} |
2486
|
|
|
|
|
|
|
|
2487
|
|
|
|
|
|
|
sub add_post { |
2488
|
0
|
|
|
0
|
0
|
0
|
my $self = shift(); |
2489
|
0
|
0
|
|
|
|
0
|
if (@_) { |
2490
|
0
|
0
|
|
|
|
0
|
unless ($self->{' poststream'} =~ /\s$/) { |
2491
|
0
|
|
|
|
|
0
|
$self->{' poststream'} .= ' '; |
2492
|
|
|
|
|
|
|
} |
2493
|
0
|
|
|
|
|
0
|
$self->{' poststream'} .= join(' ', @_) . ' '; |
2494
|
|
|
|
|
|
|
} |
2495
|
0
|
|
|
|
|
0
|
return $self; |
2496
|
|
|
|
|
|
|
} |
2497
|
|
|
|
|
|
|
|
2498
|
|
|
|
|
|
|
sub add { |
2499
|
778
|
|
|
778
|
1
|
1185
|
my $self = shift(); |
2500
|
778
|
50
|
|
|
|
1517
|
if (@_) { |
2501
|
778
|
100
|
|
|
|
2647
|
unless ($self->{' stream'} =~ /\s$/) { |
2502
|
129
|
|
|
|
|
312
|
$self->{' stream'} .= ' '; |
2503
|
|
|
|
|
|
|
} |
2504
|
778
|
|
|
|
|
3211
|
$self->{' stream'} .= encode('iso-8859-1', join(' ', @_) . ' '); |
2505
|
|
|
|
|
|
|
} |
2506
|
778
|
|
|
|
|
24902
|
return $self; |
2507
|
|
|
|
|
|
|
} |
2508
|
|
|
|
|
|
|
|
2509
|
|
|
|
|
|
|
# Shortcut method for determining if we're inside a text object |
2510
|
|
|
|
|
|
|
# (i.e. between BT and ET). See textstart and textend. |
2511
|
|
|
|
|
|
|
sub _in_text_object { |
2512
|
500
|
|
|
500
|
|
729
|
my $self = shift(); |
2513
|
500
|
|
|
|
|
1197
|
return $self->{' apiistext'}; |
2514
|
|
|
|
|
|
|
} |
2515
|
|
|
|
|
|
|
|
2516
|
|
|
|
|
|
|
sub compressFlate { |
2517
|
28
|
|
|
28
|
0
|
55
|
my $self = shift(); |
2518
|
28
|
|
|
|
|
87
|
$self->{'Filter'} = PDFArray(PDFName('FlateDecode')); |
2519
|
28
|
|
|
|
|
71
|
$self->{'-docompress'} = 1; |
2520
|
28
|
|
|
|
|
64
|
return $self; |
2521
|
|
|
|
|
|
|
} |
2522
|
|
|
|
|
|
|
|
2523
|
|
|
|
|
|
|
sub textstart { |
2524
|
19
|
|
|
19
|
0
|
38
|
my $self = shift(); |
2525
|
19
|
50
|
|
|
|
60
|
unless ($self->_in_text_object()) { |
2526
|
19
|
|
|
|
|
74
|
$self->add(' BT '); |
2527
|
19
|
|
|
|
|
47
|
$self->{' apiistext'} = 1; |
2528
|
19
|
|
|
|
|
35
|
$self->{' font'} = undef; |
2529
|
19
|
|
|
|
|
33
|
$self->{' fontset'} = 0; |
2530
|
19
|
|
|
|
|
31
|
$self->{' fontsize'} = 0; |
2531
|
19
|
|
|
|
|
36
|
$self->{' charspace'} = 0; |
2532
|
19
|
|
|
|
|
30
|
$self->{' hscale'} = 100; |
2533
|
19
|
|
|
|
|
29
|
$self->{' wordspace'} = 0; |
2534
|
19
|
|
|
|
|
26
|
$self->{' leading'} = 0; |
2535
|
19
|
|
|
|
|
28
|
$self->{' rise'} = 0; |
2536
|
19
|
|
|
|
|
29
|
$self->{' render'} = 0; |
2537
|
19
|
|
|
|
|
38
|
@{$self->{' matrix'}} = (1, 0, 0, 1, 0, 0); |
|
19
|
|
|
|
|
46
|
|
2538
|
19
|
|
|
|
|
36
|
@{$self->{' textmatrix'}} = (1, 0, 0, 1, 0, 0); |
|
19
|
|
|
|
|
39
|
|
2539
|
19
|
|
|
|
|
29
|
@{$self->{' textlinematrix'}} = (0, 0); |
|
19
|
|
|
|
|
31
|
|
2540
|
19
|
|
|
|
|
34
|
@{$self->{' fillcolor'}} = 0; |
|
19
|
|
|
|
|
33
|
|
2541
|
19
|
|
|
|
|
34
|
@{$self->{' strokecolor'}} = 0; |
|
19
|
|
|
|
|
26
|
|
2542
|
19
|
|
|
|
|
33
|
@{$self->{' translate'}} = (0, 0); |
|
19
|
|
|
|
|
33
|
|
2543
|
19
|
|
|
|
|
30
|
@{$self->{' scale'}} = (1, 1); |
|
19
|
|
|
|
|
30
|
|
2544
|
19
|
|
|
|
|
28
|
@{$self->{' skew'}} = (0, 0); |
|
19
|
|
|
|
|
31
|
|
2545
|
19
|
|
|
|
|
30
|
$self->{' rotate'} = 0; |
2546
|
|
|
|
|
|
|
} |
2547
|
19
|
|
|
|
|
54
|
return $self; |
2548
|
|
|
|
|
|
|
} |
2549
|
|
|
|
|
|
|
|
2550
|
|
|
|
|
|
|
sub textend { |
2551
|
123
|
|
|
123
|
0
|
195
|
my $self = shift(); |
2552
|
123
|
100
|
|
|
|
295
|
if ($self->_in_text_object()) { |
2553
|
15
|
|
|
|
|
59
|
$self->add(' ET ', $self->{' poststream'}); |
2554
|
15
|
|
|
|
|
26
|
$self->{' apiistext'} = 0; |
2555
|
15
|
|
|
|
|
31
|
$self->{' poststream'} = ''; |
2556
|
|
|
|
|
|
|
} |
2557
|
123
|
|
|
|
|
210
|
return $self; |
2558
|
|
|
|
|
|
|
} |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
sub resource { |
2561
|
31
|
|
|
31
|
0
|
111
|
my ($self, $type, $key, $obj, $force) = @_; |
2562
|
31
|
100
|
|
|
|
113
|
if ($self->{' apipage'}) { |
2563
|
|
|
|
|
|
|
# we are a content stream on a page. |
2564
|
29
|
|
|
|
|
162
|
return $self->{' apipage'}->resource($type, $key, $obj, $force); |
2565
|
|
|
|
|
|
|
} |
2566
|
|
|
|
|
|
|
else { |
2567
|
|
|
|
|
|
|
# we are a self-contained content stream. |
2568
|
2
|
|
33
|
|
|
9
|
$self->{'Resources'} //= PDFDict(); |
2569
|
|
|
|
|
|
|
|
2570
|
2
|
|
|
|
|
5
|
my $dict = $self->{'Resources'}; |
2571
|
2
|
50
|
|
|
|
12
|
$dict->realise() if ref($dict) =~ /Objind$/; |
2572
|
|
|
|
|
|
|
|
2573
|
2
|
|
33
|
|
|
16
|
$dict->{$type} ||= PDFDict(); |
2574
|
2
|
50
|
|
|
|
11
|
$dict->{$type}->realise() if ref($dict->{$type}) =~ /Objind$/; |
2575
|
2
|
50
|
|
|
|
10
|
unless (defined $obj) { |
2576
|
0
|
|
|
|
|
|
return $dict->{$type}->{$key}; |
2577
|
|
|
|
|
|
|
} |
2578
|
|
|
|
|
|
|
else { |
2579
|
2
|
50
|
|
|
|
6
|
if ($force) { |
2580
|
0
|
|
|
|
|
0
|
$dict->{$type}->{$key} = $obj; |
2581
|
|
|
|
|
|
|
} |
2582
|
|
|
|
|
|
|
else { |
2583
|
2
|
|
33
|
|
|
11
|
$dict->{$type}->{$key} //= $obj; |
2584
|
|
|
|
|
|
|
} |
2585
|
2
|
|
|
|
|
7
|
return $dict; |
2586
|
|
|
|
|
|
|
} |
2587
|
|
|
|
|
|
|
} |
2588
|
|
|
|
|
|
|
} |
2589
|
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
=head1 MIGRATION |
2591
|
|
|
|
|
|
|
|
2592
|
|
|
|
|
|
|
See L for an overview. |
2593
|
|
|
|
|
|
|
|
2594
|
|
|
|
|
|
|
=over |
2595
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
=item transform(%hyphen_prefixed_options); |
2597
|
|
|
|
|
|
|
|
2598
|
|
|
|
|
|
|
Remove hyphens from option names (C<-translate> becomes C, etc.). |
2599
|
|
|
|
|
|
|
|
2600
|
|
|
|
|
|
|
=item transform_rel |
2601
|
|
|
|
|
|
|
|
2602
|
|
|
|
|
|
|
Replace with L"transform">, setting option C to true. Remove |
2603
|
|
|
|
|
|
|
hyphens from the names of other options. |
2604
|
|
|
|
|
|
|
|
2605
|
|
|
|
|
|
|
=item linewidth |
2606
|
|
|
|
|
|
|
|
2607
|
|
|
|
|
|
|
Replace with L"line_width">. |
2608
|
|
|
|
|
|
|
|
2609
|
|
|
|
|
|
|
=item linecap |
2610
|
|
|
|
|
|
|
|
2611
|
|
|
|
|
|
|
Replace with L"line_cap">. |
2612
|
|
|
|
|
|
|
|
2613
|
|
|
|
|
|
|
=item linejoin |
2614
|
|
|
|
|
|
|
|
2615
|
|
|
|
|
|
|
Replace with L"line_join">. |
2616
|
|
|
|
|
|
|
|
2617
|
|
|
|
|
|
|
=item meterlimit |
2618
|
|
|
|
|
|
|
|
2619
|
|
|
|
|
|
|
=item miterlimit |
2620
|
|
|
|
|
|
|
|
2621
|
|
|
|
|
|
|
Replace with L"miter_limit">. |
2622
|
|
|
|
|
|
|
|
2623
|
|
|
|
|
|
|
=item linedash |
2624
|
|
|
|
|
|
|
|
2625
|
|
|
|
|
|
|
Replace with L"line_dash_pattern">. Remove hyphens from option names. Rename |
2626
|
|
|
|
|
|
|
C<-shift> to C. |
2627
|
|
|
|
|
|
|
|
2628
|
|
|
|
|
|
|
=item flatness |
2629
|
|
|
|
|
|
|
|
2630
|
|
|
|
|
|
|
Replace with L"flatness_tolerance">. |
2631
|
|
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
=item poly |
2633
|
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
|
Replace with L"move"> (first two arguments) and L"polyline"> (remaining |
2635
|
|
|
|
|
|
|
arguments). |
2636
|
|
|
|
|
|
|
|
2637
|
|
|
|
|
|
|
=item endpath |
2638
|
|
|
|
|
|
|
|
2639
|
|
|
|
|
|
|
Replace with L"end">. |
2640
|
|
|
|
|
|
|
|
2641
|
|
|
|
|
|
|
=item rect |
2642
|
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
|
Replace with L"rectangle">, converting the C<$w> (third) and C<$h> (fourth) |
2644
|
|
|
|
|
|
|
arguments to the X and Y values of the upper-right corner: |
2645
|
|
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
# Old |
2647
|
|
|
|
|
|
|
$content->rect($x, $y, $w, $h); |
2648
|
|
|
|
|
|
|
|
2649
|
|
|
|
|
|
|
# New |
2650
|
|
|
|
|
|
|
$content->rectangle($x, $y, $x + $w, $y + $h); |
2651
|
|
|
|
|
|
|
|
2652
|
|
|
|
|
|
|
=item rectxy |
2653
|
|
|
|
|
|
|
|
2654
|
|
|
|
|
|
|
Replace with L"rectangle">. |
2655
|
|
|
|
|
|
|
|
2656
|
|
|
|
|
|
|
=item fill(1) |
2657
|
|
|
|
|
|
|
|
2658
|
|
|
|
|
|
|
Replace with C<$content-Efill(rule =E 'even-odd')>. |
2659
|
|
|
|
|
|
|
|
2660
|
|
|
|
|
|
|
=item fillstroke |
2661
|
|
|
|
|
|
|
|
2662
|
|
|
|
|
|
|
Replace with L"paint">. |
2663
|
|
|
|
|
|
|
|
2664
|
|
|
|
|
|
|
=item clip(1) |
2665
|
|
|
|
|
|
|
|
2666
|
|
|
|
|
|
|
Replace with C<$content-Eclip(rule =E 'even-odd')>. |
2667
|
|
|
|
|
|
|
|
2668
|
|
|
|
|
|
|
=item image |
2669
|
|
|
|
|
|
|
|
2670
|
|
|
|
|
|
|
=item formimage |
2671
|
|
|
|
|
|
|
|
2672
|
|
|
|
|
|
|
Replace with L"object">. |
2673
|
|
|
|
|
|
|
|
2674
|
|
|
|
|
|
|
=item charspace |
2675
|
|
|
|
|
|
|
|
2676
|
|
|
|
|
|
|
Replace with L"character_spacing">. |
2677
|
|
|
|
|
|
|
|
2678
|
|
|
|
|
|
|
=item wordspace |
2679
|
|
|
|
|
|
|
|
2680
|
|
|
|
|
|
|
Replace with L"word_spacing">. |
2681
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
=item hspace |
2683
|
|
|
|
|
|
|
|
2684
|
|
|
|
|
|
|
Replace with L"hscale">. |
2685
|
|
|
|
|
|
|
|
2686
|
|
|
|
|
|
|
=item lead |
2687
|
|
|
|
|
|
|
|
2688
|
|
|
|
|
|
|
Replace with L"leading">. |
2689
|
|
|
|
|
|
|
|
2690
|
|
|
|
|
|
|
=item distance |
2691
|
|
|
|
|
|
|
|
2692
|
|
|
|
|
|
|
Replace with L"position">. |
2693
|
|
|
|
|
|
|
|
2694
|
|
|
|
|
|
|
=item cr |
2695
|
|
|
|
|
|
|
|
2696
|
|
|
|
|
|
|
Replace with either L"position"> (if called with arguments) or L"crlf"> (if |
2697
|
|
|
|
|
|
|
called without arguments). |
2698
|
|
|
|
|
|
|
|
2699
|
|
|
|
|
|
|
=item nl |
2700
|
|
|
|
|
|
|
|
2701
|
|
|
|
|
|
|
Replace with L"crlf">. |
2702
|
|
|
|
|
|
|
|
2703
|
|
|
|
|
|
|
=item text(%hyphen_prefixed_options) |
2704
|
|
|
|
|
|
|
|
2705
|
|
|
|
|
|
|
Remove initial hyphens from option names. |
2706
|
|
|
|
|
|
|
|
2707
|
|
|
|
|
|
|
=item text_center |
2708
|
|
|
|
|
|
|
|
2709
|
|
|
|
|
|
|
Replace with L"text">, setting C to C. |
2710
|
|
|
|
|
|
|
|
2711
|
|
|
|
|
|
|
=item text_right |
2712
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
Replace with L"text">, setting C to C. |
2714
|
|
|
|
|
|
|
|
2715
|
|
|
|
|
|
|
=item paragraph(%hyphen_prefixed_options) |
2716
|
|
|
|
|
|
|
|
2717
|
|
|
|
|
|
|
Remove initial hyphens from option names. C<-align-last> becomes C. |
2718
|
|
|
|
|
|
|
|
2719
|
|
|
|
|
|
|
=item section |
2720
|
|
|
|
|
|
|
|
2721
|
|
|
|
|
|
|
=item paragraphs |
2722
|
|
|
|
|
|
|
|
2723
|
|
|
|
|
|
|
Replace with L"paragraph">. |
2724
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
=item advancewidth |
2726
|
|
|
|
|
|
|
|
2727
|
|
|
|
|
|
|
Replace with L"text_width">. |
2728
|
|
|
|
|
|
|
|
2729
|
|
|
|
|
|
|
=back |
2730
|
|
|
|
|
|
|
|
2731
|
|
|
|
|
|
|
=cut |
2732
|
|
|
|
|
|
|
|
2733
|
|
|
|
|
|
|
1; |