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   37 use strict;
  10         13  
  10         279  
4 10     10   32 use warnings;
  10         12  
  10         289  
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.03
13              
14             =cut
15              
16             our $VERSION = '0.03';
17              
18 10     10   33 use Carp ();
  10         11  
  10         82  
19 10     10   4216 use Math::Complex ();
  10         72971  
  10         192  
20 10     10   5497 use Math::Trig ();
  10         15026  
  10         177  
21              
22 10     10   51 use LaTeX::TikZ::Point;
  10         14  
  10         161  
23              
24 10     10   37 use LaTeX::TikZ::Set::Circle;
  10         13  
  10         178  
25 10     10   37 use LaTeX::TikZ::Set::Polyline;
  10         14  
  10         182  
26              
27 10     10   36 use LaTeX::TikZ::Interface;
  10         11  
  10         146  
28              
29 10     10   40 use LaTeX::TikZ::Tools;
  10         13  
  10         171  
30              
31 10     10   38 use Mouse::Util::TypeConstraints 'find_type_constraint';
  10         11  
  10         74  
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 1558 shift;
38 3 100       169 Carp::confess('Tikz->arc($first_point, $second_point, $center)') if @_ < 3;
39 2         4 my ($a, $b, $c) = @_;
40              
41 2         4 for ($a, $b, $c) {
42 6         152 my $p = $ltp_tc->coerce($_);
43 6         59 $ltp_tc->assert_valid($p);
44 6         30 $_ = Math::Complex->make($p->x, $p->y);
45             }
46              
47 2         64 my $r = abs($a - $c);
48 2 100       122 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         36 my $set = LaTeX::TikZ::Set::Circle->new(
52             center => $c,
53             radius => $r,
54             );
55              
56 1         3 my $factor = 1/32;
57              
58 1         2 my $theta = (($b - $c) / ($a - $c))->arg;
59 1         142 my $points = int(abs($theta) / abs(Math::Trig::acos(0.95)));
60 1         17 $theta /= $points + 1;
61 1         9 my $rho = (1 / cos($theta)) / (1 - $factor);
62              
63 1         2 my $ua = ($a - $c) * (1 - $factor) + $c;
64 1         111 my $ub = ($b - $c) * (1 - $factor) + $c;
65              
66 6         434 my @outside = map { $_ * $rho + $c } (
  4         427  
67             $a - $c,
68 1         90 (map { ($a - $c) * Math::Complex->emake(1, $_ * $theta) } 1 .. $points),
69             $b - $c,
70             );
71              
72 1         72 $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, L.
84              
85             =head1 AUTHOR
86              
87             Vincent Pit, C<< >>, L.
88              
89             You can contact me by mail or on C (vincent).
90              
91             =head1 BUGS
92              
93             Please report any bugs or feature requests to C, or through the web interface at L.
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,2011,2012,2013,2014,2015 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