]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blob - lib/LaTeX/TikZ/Mod/Clip.pm
06db1baa5d8036dcc40e1e2dee5a14dc36470600
[perl/modules/LaTeX-TikZ.git] / lib / LaTeX / TikZ / Mod / Clip.pm
1 package LaTeX::TikZ::Mod::Clip;
2
3 use strict;
4 use warnings;
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 use Sub::Name ();
19
20 use LaTeX::TikZ::Formatter;
21 use LaTeX::TikZ::Mod::Formatted;
22
23 use LaTeX::TikZ::Interface;
24 use LaTeX::TikZ::Functor;
25
26 use LaTeX::TikZ::Tools;
27
28 use Mouse;
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::Path',
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 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  my ($old, $new) = map $_->clip, @_[0, 1];
145
146  for (@handlers) {
147   my $tc = $get_tc->($_->[0]);
148   next unless defined $tc and $tc->check($new);
149   return $_->[1]->($old, $new, $tc);
150  }
151
152  $old->path($default_formatter) eq $new->path($default_formatter);
153 }
154
155 =head2 C<declare>
156
157 =cut
158
159 sub declare { }
160
161 =head2 C<apply>
162
163 =cut
164
165 sub apply {
166  my ($self) = @_;
167
168  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   shift;
177
178   __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,2011,2012,2013,2014,2015 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