File Coverage

blib/lib/LaTeX/TikZ/Mod/Clip.pm
Criterion Covered Total %
statement 39 39 100.0
branch 2 2 100.0
condition 2 3 66.6
subroutine 14 14 100.0
pod 4 5 80.0
total 61 63 96.8


line stmt bran cond sub pod time code
1             package LaTeX::TikZ::Mod::Clip;
2              
3 10     10   53 use strict;
  10         19  
  10         342  
4 10     10   53 use warnings;
  10         19  
  10         412  
5              
6             =head1 NAME
7              
8             LaTeX::TikZ::Mod::Clip - A modifier that clips sequences with a path.
9              
10             =head1 VERSION
11              
12             Version 0.02
13              
14             =cut
15              
16             our $VERSION = '0.02';
17              
18 10     10   53 use Sub::Name ();
  10         20  
  10         230  
19              
20 10     10   67 use LaTeX::TikZ::Formatter;
  10         27  
  10         327  
21 10     10   51 use LaTeX::TikZ::Mod::Formatted;
  10         16  
  10         214  
22              
23 10     10   56 use LaTeX::TikZ::Interface;
  10         13  
  10         182  
24 10     10   50 use LaTeX::TikZ::Functor;
  10         16  
  10         260  
25              
26 10     10   58 use LaTeX::TikZ::Tools;
  10         21  
  10         194  
27              
28 10     10   57 use Any::Moose;
  10         30  
  10         102  
29              
30             =head1 RELATIONSHIPS
31              
32             This class consumes the L<LaTeX::TikZ::Mod> role, and as such implements the L</tag>, L</covers>, L</declare> and L</apply> methods.
33              
34             =cut
35              
36             with 'LaTeX::TikZ::Mod';
37              
38             =head1 ATTRIBUTES
39              
40             =head2 C<clip>
41              
42             The path that specifies the clipped area.
43              
44             =cut
45              
46             has clip => (
47             is => 'ro',
48             does => 'LaTeX::TikZ::Set::Op',
49             required => 1,
50             );
51              
52             my $default_formatter = LaTeX::TikZ::Formatter->new(
53             unit => 'cm',
54             format => '%.07f',
55             scale => 1,
56             );
57              
58             =head1 METHODS
59              
60             =head2 C<tag>
61              
62             =cut
63              
64 108     108 1 310 sub tag { ref $_[0] }
65              
66             =head2 C<covers>
67              
68             =cut
69              
70             my $get_tc = do {
71             my %tc;
72              
73             Sub::Name::subname('get_tc' => sub {
74             my ($class) = @_;
75              
76             return $tc{$class} if exists $tc{class};
77              
78             my $tc = LaTeX::TikZ::Tools::type_constraint($class);
79             return unless defined $tc;
80              
81             $tc{$class} ||= $tc;
82             })
83             };
84              
85             my $cover_rectangle = Sub::Name::subname('cover_rectangle' => sub {
86             my ($old, $new, $self_tc) = @_;
87              
88             my $p = $new->from;
89             my $q = $new->to;
90              
91             my $x = $p->x;
92             my $y = $p->y;
93             my $X = $q->x;
94             my $Y = $q->y;
95              
96             ($x, $X) = ($X, $x) if $x > $X;
97             ($y, $Y) = ($Y, $y) if $y > $Y;
98              
99             if ($self_tc->check($old)) {
100             # The old rectangle covers the new one if and only if it's inside the new.
101              
102             for ($old->from, $old->to) {
103             my $r = $_->x;
104             return 0 if LaTeX::TikZ::Tools::numcmp($r, $x) < 0
105             or LaTeX::TikZ::Tools::numcmp($X, $r) < 0;
106             my $i = $_->y;
107             return 0 if LaTeX::TikZ::Tools::numcmp($i, $y) < 0
108             or LaTeX::TikZ::Tools::numcmp($Y, $i) < 0;
109             }
110              
111             return 1;
112             }
113              
114             return 0;
115             });
116              
117             my $cover_circle = Sub::Name::subname('cover_circle' => sub {
118             my ($old, $new, $self_tc) = @_;
119              
120             my $c2 = $new->center;
121             my $r2 = $new->radius;
122              
123             if ($self_tc->check($old)) {
124             # The old circle covers the new one if and only if it's inside the new.
125              
126             my $c1 = $old->center;
127             my $r1 = $old->radius;
128              
129             my $d = abs($c1 - $c2);
130              
131             return LaTeX::TikZ::Tools::numcmp($d, $r2) <= 0
132             && LaTeX::TikZ::Tools::numcmp($d + $r1, $r2) <= 0;
133             }
134              
135             return 0;
136             });
137              
138             my @handlers = (
139             [ 'LaTeX::TikZ::Set::Rectangle' => $cover_rectangle ],
140             [ 'LaTeX::TikZ::Set::Circle' => $cover_circle ],
141             );
142              
143             sub covers {
144 34     34 1 180 my ($old, $new) = map $_->clip, @_[0, 1];
145              
146 34         74 for (@handlers) {
147 65         152 my $tc = $get_tc->($_->[0]);
148 65 100 66     585 next unless defined $tc and $tc->check($new);
149 10         40 return $_->[1]->($old, $new, $tc);
150             }
151              
152 24         80 $old->path($default_formatter) eq $new->path($default_formatter);
153             }
154              
155             =head2 C<declare>
156              
157             =cut
158              
159 21     21 1 82 sub declare { }
160              
161             =head2 C<apply>
162              
163             =cut
164              
165             sub apply {
166 42     42 1 125 my ($self) = @_;
167              
168 42         222 LaTeX::TikZ::Mod::Formatted->new(
169             type => 'clip',
170             content => $_[0]->clip->path($_[1]),
171             )
172             }
173              
174             LaTeX::TikZ::Interface->register(
175             clip => sub {
176 1     1 0 2 shift;
177              
178 1         10 __PACKAGE__->new(clip => $_[0]);
179             },
180             );
181              
182             LaTeX::TikZ::Functor->default_rule(
183             (__PACKAGE__) => sub {
184             my ($functor, $mod, @args) = @_;
185             $mod->new(clip => $mod->clip->$functor(@args))
186             }
187             );
188              
189             __PACKAGE__->meta->make_immutable;
190              
191             =head1 SEE ALSO
192              
193             L<LaTeX::TikZ>, L<LaTeX::TikZ::Mod>.
194              
195             =head1 AUTHOR
196              
197             Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
198              
199             You can contact me by mail or on C<irc.perl.org> (vincent).
200              
201             =head1 BUGS
202              
203             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>.
204             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
205              
206             =head1 SUPPORT
207              
208             You can find documentation for this module with the perldoc command.
209              
210             perldoc LaTeX::TikZ
211              
212             =head1 COPYRIGHT & LICENSE
213              
214             Copyright 2010 Vincent Pit, all rights reserved.
215              
216             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
217              
218             =cut
219              
220             1; # End of LaTeX::TikZ::Mod::Clip