| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package PDF::Make::Builder::Shape::Pie; |
|
2
|
42
|
|
|
42
|
|
211
|
use strict; |
|
|
42
|
|
|
|
|
61
|
|
|
|
42
|
|
|
|
|
1216
|
|
|
3
|
42
|
|
|
42
|
|
141
|
use warnings; |
|
|
42
|
|
|
|
|
52
|
|
|
|
42
|
|
|
|
|
1525
|
|
|
4
|
42
|
|
|
42
|
|
410
|
use Object::Proto; |
|
|
42
|
|
|
|
|
114
|
|
|
|
42
|
|
|
|
|
2141
|
|
|
5
|
42
|
|
|
42
|
|
17770
|
use POSIX qw(floor); |
|
|
42
|
|
|
|
|
235509
|
|
|
|
42
|
|
|
|
|
209
|
|
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
|
8
|
42
|
|
|
42
|
|
55027
|
Object::Proto::define('PDF::Make::Builder::Shape::Pie', |
|
9
|
|
|
|
|
|
|
'fill_colour:Str:default(#000)', |
|
10
|
|
|
|
|
|
|
'x:Num:required', |
|
11
|
|
|
|
|
|
|
'y:Num:required', |
|
12
|
|
|
|
|
|
|
'r:Num:required', |
|
13
|
|
|
|
|
|
|
'rx:Num:required', |
|
14
|
|
|
|
|
|
|
'ry:Num:required', |
|
15
|
|
|
|
|
|
|
); |
|
16
|
42
|
|
|
|
|
2139
|
Object::Proto::import_accessors('PDF::Make::Builder::Shape::Pie'); |
|
17
|
|
|
|
|
|
|
} |
|
18
|
|
|
|
|
|
|
|
|
19
|
42
|
|
|
42
|
|
247
|
use constant PI => 3.14159265358979323846; |
|
|
42
|
|
|
|
|
55
|
|
|
|
42
|
|
|
|
|
16801
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub add { |
|
22
|
1
|
|
|
1
|
1
|
2
|
my ($self, $builder) = @_; |
|
23
|
1
|
|
|
|
|
3
|
my $page = $builder->page; |
|
24
|
1
|
|
|
|
|
3
|
my $canvas = $page->canvas; |
|
25
|
1
|
|
|
|
|
2
|
my $font = $builder->font; |
|
26
|
|
|
|
|
|
|
|
|
27
|
1
|
|
|
|
|
3
|
my $cx = $self->x; |
|
28
|
1
|
|
|
|
|
3
|
my $cy = $self->y; |
|
29
|
1
|
|
|
|
|
2
|
my $radius = $self->r; |
|
30
|
1
|
|
|
|
|
4
|
my $start_deg = $self->rx; |
|
31
|
1
|
|
|
|
|
17
|
my $end_deg = $self->ry; |
|
32
|
1
|
|
|
|
|
5
|
my ($cr, $cg, $cb) = $font->hex_to_rgb(fill_colour $self); |
|
33
|
|
|
|
|
|
|
|
|
34
|
1
|
|
|
|
|
3
|
my $start = $start_deg * PI / 180; |
|
35
|
1
|
|
|
|
|
9
|
my $end = $end_deg * PI / 180; |
|
36
|
|
|
|
|
|
|
|
|
37
|
1
|
|
|
|
|
11
|
$canvas->q->rg($cr, $cg, $cb); |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Move to center, line to arc start |
|
40
|
1
|
|
|
|
|
4
|
$canvas->m($cx, $cy); |
|
41
|
1
|
|
|
|
|
9
|
$canvas->l($cx + $radius * cos($start), $cy + $radius * sin($start)); |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Approximate arc with Bezier segments (max 90 degrees each) |
|
44
|
1
|
|
|
|
|
3
|
my $angle = $end - $start; |
|
45
|
1
|
50
|
|
|
|
7
|
$angle += 2 * PI if $angle < 0; |
|
46
|
1
|
|
|
|
|
3
|
my $segments = int($angle / (PI / 2)) + 1; |
|
47
|
1
|
|
|
|
|
3
|
my $seg_angle = $angle / $segments; |
|
48
|
|
|
|
|
|
|
|
|
49
|
1
|
|
|
|
|
2
|
my $a = $start; |
|
50
|
1
|
|
|
|
|
5
|
for (1 .. $segments) { |
|
51
|
2
|
|
|
|
|
6
|
my $a2 = $a + $seg_angle; |
|
52
|
2
|
|
|
|
|
45
|
my $alpha = 4.0 / 3.0 * (1 - cos($seg_angle / 2)) / sin($seg_angle / 2); |
|
53
|
|
|
|
|
|
|
|
|
54
|
2
|
|
|
|
|
19
|
my $x1 = $cx + $radius * cos($a); |
|
55
|
2
|
|
|
|
|
4
|
my $y1 = $cy + $radius * sin($a); |
|
56
|
2
|
|
|
|
|
15
|
my $x4 = $cx + $radius * cos($a2); |
|
57
|
2
|
|
|
|
|
10
|
my $y4 = $cy + $radius * sin($a2); |
|
58
|
|
|
|
|
|
|
|
|
59
|
2
|
|
|
|
|
5
|
my $cpx1 = $x1 - $alpha * $radius * sin($a); |
|
60
|
2
|
|
|
|
|
5
|
my $cpy1 = $y1 + $alpha * $radius * cos($a); |
|
61
|
2
|
|
|
|
|
4
|
my $cpx2 = $x4 + $alpha * $radius * sin($a2); |
|
62
|
2
|
|
|
|
|
2
|
my $cpy2 = $y4 - $alpha * $radius * cos($a2); |
|
63
|
|
|
|
|
|
|
|
|
64
|
2
|
|
|
|
|
13
|
$canvas->c($cpx1, $cpy1, $cpx2, $cpy2, $x4, $y4); |
|
65
|
2
|
|
|
|
|
4
|
$a = $a2; |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
|
|
68
|
1
|
|
|
|
|
5
|
$canvas->h->f->Q; |
|
69
|
|
|
|
|
|
|
|
|
70
|
1
|
|
|
|
|
3
|
return $self; |
|
71
|
|
|
|
|
|
|
} |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
1; |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
__END__ |