File Coverage

blib/lib/LaTeX/TikZ/Set.pm
Criterion Covered Total %
statement 32 32 100.0
branch 6 8 75.0
condition n/a
subroutine 10 10 100.0
pod 4 4 100.0
total 52 54 96.3


line stmt bran cond sub pod time code
1             package LaTeX::TikZ::Set;
2              
3 10     10   51 use strict;
  10         18  
  10         313  
4 10     10   50 use warnings;
  10         12  
  10         379  
5              
6             =head1 NAME
7              
8             LaTeX::TikZ::Set - Base role for LaTeX::TikZ set objects.
9              
10             =head1 VERSION
11              
12             Version 0.02
13              
14             =cut
15              
16             our $VERSION = '0.02';
17              
18 10     10   8046 use Scope::Guard ();
  10         4589  
  10         193  
19              
20 10     10   5877 use LaTeX::TikZ::Scope;
  10         30  
  10         354  
21              
22 10     10   66 use LaTeX::TikZ::Tools;
  10         22  
  10         231  
23              
24 10     10   55 use Any::Moose 'Role';
  10         20  
  10         44  
25              
26             =head1 ATTRIBUTES
27              
28             =head2 C<mods>
29              
30             Returns the list of the L<LaTeX::TikZ::Mod> objects associated with the current set.
31              
32             =cut
33              
34             has '_mods' => (
35             is => 'ro',
36             isa => 'Maybe[ArrayRef[LaTeX::TikZ::Mod]]',
37             init_arg => 'mods',
38             default => sub { [ ] },
39             lazy => 1,
40             );
41              
42 668     668 1 2990 sub mods { @{$_[0]->_mods} }
  668         3073  
43              
44             =head1 METHODS
45              
46             This method is required by the interface :
47              
48             =over 4
49              
50             =item *
51              
52             C<draw $formatter>
53              
54             Returns an array reference of TikZ code lines required to effectively draw the current set object, formatted by the L<LaTeX::TikZ::Formatter> object C<$formatter>.
55              
56             =back
57              
58             =cut
59              
60             requires qw(
61             draw
62             );
63              
64             =head2 C<mod @mods>
65              
66             Apply the given list of L<LaTeX::TikZ::Mod> objects to the current set.
67              
68             =cut
69              
70             my $ltm_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod');
71             my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer');
72             my $ltmc_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Clip');
73              
74             sub mod {
75 102     102 1 6591 my $set = shift;
76              
77 102         461 my @mods = map $ltm_tc->coerce($_), @_;
78 102         5820 $ltm_tc->assert_valid($_) for @mods;
79              
80 101         4397 push @{$set->_mods}, @mods;
  101         523  
81              
82 101         466 $set;
83             }
84              
85             {
86             our %mods;
87             our $last_mod = 0;
88              
89             around 'draw' => sub {
90             my ($orig, $set, $tikz) = @_;
91              
92             local $last_mod = $last_mod;
93              
94             # Save a deep copy
95             my %saved_idx = map { $_ => $#{$mods{$_}} } keys %mods;
96             my $guard = Scope::Guard->new(sub {
97             for (keys %mods) {
98             if (exists $saved_idx{$_}) {
99             $#{$mods{$_}} = $saved_idx{$_};
100             } else {
101             delete $mods{$_};
102             }
103             }
104             });
105              
106             my (@mods, $last_layer);
107             MOD:
108             for my $mod ($set->mods) {
109             my $is_layer = $ltml_tc->check($mod);
110             $last_layer = $mod if $is_layer;
111             my $tag = $mod->tag;
112             my $old = $mods{$tag} || [];
113             for (@$old) {
114             next MOD if $_->[0]->covers($mod);
115             }
116             push @{$mods{$tag}}, [ $mod, $last_mod++, $is_layer ];
117             push @mods, $mod;
118             }
119              
120             if ($last_layer) {
121             # Clips and mods don't propagate through layers. Hence if a layer is set,
122             # force their reuse.
123             @mods = $last_layer;
124             push @mods, map $_->[0],
125             sort { $a->[1] <=> $b->[1] }
126             grep !$_->[2],
127             map @$_,
128             values %mods;
129             }
130              
131             my $body = $set->$orig($tikz);
132              
133             if (@mods) {
134             $body = LaTeX::TikZ::Scope->new
135             ->mod(map $_->apply($tikz), @mods)
136             ->body($body);
137             }
138              
139             $body;
140             };
141             }
142              
143             =head2 C<layer $layer>
144              
145             Puts the current set in the corresponding layer.
146             This is a shortcut for C<< $set->mod(Tikz->layer($layer)) >>.
147              
148             =cut
149              
150             sub layer {
151 5 100   5 1 5502 return $_[0] unless @_ > 1;
152              
153 4         8 my $layer = $_[1];
154              
155 4 100       44 $_[0]->mod(
156             $ltml_tc->check($layer) ? $layer
157             : LaTeX::TikZ::Mod::Layer->new(name => $layer)
158             )
159             }
160              
161             =head2 C<clip $path>
162              
163             Clips the current set by the path given by C<$path>.
164             This is a shortcut for C<< $set->mod(Tikz->clip($path)) >>.
165              
166             =cut
167              
168             sub clip {
169 20 50   20 1 1890 return $_[0] unless @_ > 1;
170              
171 20 50       305 $_[0]->mod(
172             map {
173 20         70 $ltmc_tc->check($_) ? $_ : LaTeX::TikZ::Mod::Clip->new(clip => $_)
174             } @_[1 .. $#_]
175             )
176             }
177              
178             =head1 SEE ALSO
179              
180             L<LaTeX::TikZ>.
181              
182             =head1 AUTHOR
183              
184             Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
185              
186             You can contact me by mail or on C<irc.perl.org> (vincent).
187              
188             =head1 BUGS
189              
190             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>.
191             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
192              
193             =head1 SUPPORT
194              
195             You can find documentation for this module with the perldoc command.
196              
197             perldoc LaTeX::TikZ
198              
199             =head1 COPYRIGHT & LICENSE
200              
201             Copyright 2010 Vincent Pit, all rights reserved.
202              
203             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
204              
205             =cut
206              
207             1; # End of LaTeX::TikZ::Set