File Coverage

blib/lib/LaTeX/TikZ/Set/Arc.pm
Criterion Covered Total %
statement 54 54 100.0
branch 4 4 100.0
condition n/a
subroutine 12 12 100.0
pod 0 1 0.0
total 70 71 98.5


line stmt bran cond sub pod time code
1             package LaTeX::TikZ::Set::Arc;
2              
3 10     10   66 use strict;
  10         17  
  10         329  
4 10     10   56 use warnings;
  10         18  
  10         411  
5              
6             =head1 NAME
7              
8             LaTeX::TikZ::Set::Arc - A combined set object representing an arc.
9              
10             =head1 VERSION
11              
12             Version 0.02
13              
14             =cut
15              
16             our $VERSION = '0.02';
17              
18 10     10   89 use Carp ();
  10         20  
  10         147  
19 10     10   70908 use Math::Complex ();
  10         130726  
  10         250  
20 10     10   11326 use Math::Trig ();
  10         25212  
  10         442  
21              
22 10     10   137 use LaTeX::TikZ::Point;
  10         25  
  10         341  
23              
24 10     10   77 use LaTeX::TikZ::Set::Circle;
  10         18  
  10         294  
25 10     10   59 use LaTeX::TikZ::Set::Polyline;
  10         22  
  10         234  
26              
27 10     10   57 use LaTeX::TikZ::Interface;
  10         21  
  10         202  
28              
29 10     10   54 use LaTeX::TikZ::Tools;
  10         22  
  10         300  
30              
31 10     10   53 use Any::Moose 'Util::TypeConstraints' => [ 'find_type_constraint' ];
  10         26  
  10         93  
32              
33             my $ltp_tc = find_type_constraint('LaTeX::TikZ::Point::Autocoerce');
34              
35             LaTeX::TikZ::Interface->register(
36             arc => sub {
37 3     3 0 1990 shift;
38 3 100       344 Carp::confess('Tikz->arc($first_point, $second_point, $center)') if @_ < 3;
39 2         16 my ($a, $b, $c) = @_;
40              
41 2         6 for ($a, $b, $c) {
42 6         228 my $p = $ltp_tc->coerce($_);
43 6         86 $ltp_tc->assert_valid($p);
44 6         54 $_ = Math::Complex->make($p->x, $p->y);
45             }
46              
47 2         102 my $r = abs($a - $c);
48 2 100       190 Carp::confess("The two first points aren't on a circle of center the last")
49             unless LaTeX::TikZ::Tools::numeq(abs($b - $c), $r);
50              
51 1         13 my $set = LaTeX::TikZ::Set::Circle->new(
52             center => $c,
53             radius => $r,
54             );
55              
56 1         5 my $factor = 1/32;
57              
58 1         5 my $theta = (($b - $c) / ($a - $c))->arg;
59 1         258 my $points = int(abs($theta) / abs(Math::Trig::acos(0.95)));
60 1         27812 $theta /= $points + 1;
61 1         28 my $rho = (1 / cos($theta)) / (1 - $factor);
62              
63 1         14 my $ua = ($a - $c) * (1 - $factor) + $c;
64 1         340 my $ub = ($b - $c) * (1 - $factor) + $c;
65              
66 6         866 my @outside = map { $_ * $rho + $c } (
  4         817  
67             $a - $c,
68 1         175 (map { ($a - $c) * Math::Complex->emake(1, $_ * $theta) } 1 .. $points),
69             $b - $c,
70             );
71              
72 1         185 $set->clip(
73             LaTeX::TikZ::Set::Polyline->new(
74             points => [ $ua, @outside, $ub ],
75             closed => 1,
76             ),
77             );
78             },
79             );
80              
81             =head1 SEE ALSO
82              
83             L<LaTeX::TikZ>, L<LaTeX::TikZ::Set>.
84              
85             =head1 AUTHOR
86              
87             Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
88              
89             You can contact me by mail or on C<irc.perl.org> (vincent).
90              
91             =head1 BUGS
92              
93             Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
94             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
95              
96             =head1 SUPPORT
97              
98             You can find documentation for this module with the perldoc command.
99              
100             perldoc LaTeX::TikZ
101              
102             =head1 COPYRIGHT & LICENSE
103              
104             Copyright 2010 Vincent Pit, all rights reserved.
105              
106             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
107              
108             =cut
109              
110             1; # End of LaTeX::TikZ::Set::Arc