line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package LaTeX::TikZ::Functor; |
2
|
|
|
|
|
|
|
|
3
|
10
|
|
|
10
|
|
60
|
use strict; |
|
10
|
|
|
|
|
16
|
|
|
10
|
|
|
|
|
811
|
|
4
|
10
|
|
|
10
|
|
57
|
use warnings; |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
537
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
LaTeX::TikZ::Functor - Build functor methods that recursively visit nodes of a LaTeX::TikZ::Set tree. |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 VERSION |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Version 0.02 |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=cut |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 DESCRIPTION |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
A functor takes a L<LaTeX::TikZ::Set> tree and clones it according to certain rules. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Rules can apply not only to L<LaTeX::TikZ::Set> consumer objects, but also to the L<LaTeX::TikZ::Mod> consumer objects they contain. |
23
|
|
|
|
|
|
|
The are stored as L<LaTeX::TikZ::Functor::Rule> objects. |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
When the functor is called onto a set object, all its associated rules are tried successively, and the handler of the first matching rule is executed with : |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=over 4 |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=item * |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
the functor object as its first argument ; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=item * |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
the current set object as its second argument ; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=item * |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
the arguments passed to the functor itself starting at the third argument. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=back |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
The handler is expected to return the new set/mod that will in the resulting set tree. |
44
|
|
|
|
|
|
|
If the new set is different from the original, then the functor is applied to all the mods of the set, and their cloned version are added to the new set. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
If no matching rule is found, the object is returned as-is. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=cut |
49
|
|
|
|
|
|
|
|
50
|
10
|
|
|
10
|
|
59
|
use Carp (); |
|
10
|
|
|
|
|
16
|
|
|
10
|
|
|
|
|
169
|
|
51
|
|
|
|
|
|
|
|
52
|
10
|
|
|
10
|
|
51
|
use Sub::Name (); |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
165
|
|
53
|
|
|
|
|
|
|
|
54
|
10
|
|
|
10
|
|
6237
|
use LaTeX::TikZ::Functor::Rule; |
|
10
|
|
|
|
|
29
|
|
|
10
|
|
|
|
|
304
|
|
55
|
|
|
|
|
|
|
|
56
|
10
|
|
|
10
|
|
337
|
use LaTeX::TikZ::Interface; |
|
10
|
|
|
|
|
26
|
|
|
10
|
|
|
|
|
207
|
|
57
|
|
|
|
|
|
|
|
58
|
10
|
|
|
10
|
|
54
|
use LaTeX::TikZ::Tools; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
2070
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set'); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my $validate_spec; |
63
|
|
|
|
|
|
|
BEGIN { |
64
|
|
|
|
|
|
|
$validate_spec = Sub::Name::subname('validate_spec' => sub { |
65
|
100
|
|
|
|
|
179
|
my ($spec) = @_; |
66
|
|
|
|
|
|
|
|
67
|
100
|
|
|
|
|
137
|
my ($replace, $target); |
68
|
100
|
50
|
33
|
|
|
1294
|
if (defined $spec and ref $spec eq '' |
|
|
|
33
|
|
|
|
|
69
|
|
|
|
|
|
|
and $spec =~ /^(\+?)([A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z][A-Za-z0-9_]*)*)$/) { |
70
|
100
|
|
66
|
|
|
568
|
$replace = defined($1) && $1 eq '+'; |
71
|
100
|
|
|
|
|
312
|
$target = $2; |
72
|
|
|
|
|
|
|
} else { |
73
|
0
|
|
|
|
|
0
|
Carp::confess("Invalid rule spec $spec"); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
100
|
|
|
|
|
366
|
return $target, $replace; |
77
|
10
|
|
|
10
|
|
6288
|
}); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 METHODS |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head2 C<< new rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ] >> |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Creates a new functor object that will use both the default and these user-specified rules. |
85
|
|
|
|
|
|
|
The functor is also a code reference that expects to be called against L<LaTeX::TikZ::Set> objects. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
The default set and mod rules clone their relevant objects, so you get a clone functor (for the default set types) if you don't specify any user rule. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# The default is a clone method |
90
|
|
|
|
|
|
|
my $clone = Tikz->functor; |
91
|
|
|
|
|
|
|
my $dup = $set->$clone; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
If there is already a default rule for one of the C<$spec>s, it is replaced by the new one ; otherwise, the user rule is appended to the list of default rules. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# A translator |
96
|
|
|
|
|
|
|
my $translate = Tikz->functor( |
97
|
|
|
|
|
|
|
# Only replace the way point sets are cloned |
98
|
|
|
|
|
|
|
'LaTeX::TikZ::Set::Point' => sub { |
99
|
|
|
|
|
|
|
my ($functor, $set, $x, $y) = @_; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
$set->new( |
102
|
|
|
|
|
|
|
point => [ |
103
|
|
|
|
|
|
|
$set->x + $x, |
104
|
|
|
|
|
|
|
$set->y + $y, |
105
|
|
|
|
|
|
|
], |
106
|
|
|
|
|
|
|
label => $set->label, |
107
|
|
|
|
|
|
|
pos => $set->pos, |
108
|
|
|
|
|
|
|
); |
109
|
|
|
|
|
|
|
}, |
110
|
|
|
|
|
|
|
); |
111
|
|
|
|
|
|
|
my $shifted = $set->$translate(1, 1); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
But if one of the C<$spec>s begins with C<'+'>, the rule will replace I<all> default rules that apply to subclasses or subroles of C<$spec> (including C<$spec> itself). |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# A mod stripper |
116
|
|
|
|
|
|
|
my $strip = Tikz->functor( |
117
|
|
|
|
|
|
|
# Replace all existent mod rules by this simple one |
118
|
|
|
|
|
|
|
'+LaTeX::TikZ::Mod' => sub { return }, |
119
|
|
|
|
|
|
|
); |
120
|
|
|
|
|
|
|
my $naked = $set->$strip; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
The functor will map unhandled sets and mods to themselves without cloning them, since it has no way to know how to do it. |
123
|
|
|
|
|
|
|
Thus, if you define your own L<LaTeX::TikZ::Set> or L<LaTeX::TikZ::Mod> object, be sure to register a default rule for it with the L</default_rule> method. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=cut |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
my @default_set_rules; |
128
|
|
|
|
|
|
|
my @default_mod_rules; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub new { |
131
|
10
|
|
|
10
|
1
|
45
|
my ($class, %args) = @_; |
132
|
|
|
|
|
|
|
|
133
|
10
|
|
|
|
|
53
|
my @set_rules = @default_set_rules; |
134
|
10
|
|
|
|
|
35
|
my @mod_rules = @default_mod_rules; |
135
|
|
|
|
|
|
|
|
136
|
10
|
50
|
|
|
|
28
|
my @user_rules = @{$args{rules} || []}; |
|
10
|
|
|
|
|
73
|
|
137
|
10
|
|
|
|
|
50
|
while (@user_rules) { |
138
|
10
|
|
|
|
|
56
|
my ($spec, $handler) = splice @user_rules, 0, 2; |
139
|
|
|
|
|
|
|
|
140
|
10
|
|
|
|
|
48
|
my ($target, $replace) = $validate_spec->($spec); |
141
|
|
|
|
|
|
|
|
142
|
10
|
|
|
|
|
146
|
my $rule = LaTeX::TikZ::Functor::Rule->new( |
143
|
|
|
|
|
|
|
target => $target, |
144
|
|
|
|
|
|
|
handler => $handler, |
145
|
|
|
|
|
|
|
); |
146
|
|
|
|
|
|
|
|
147
|
10
|
100
|
|
|
|
123
|
$rule->insert( |
148
|
|
|
|
|
|
|
into => $rule->is_set ? \@set_rules : \@mod_rules, |
149
|
|
|
|
|
|
|
overwrite => 1, |
150
|
|
|
|
|
|
|
replace => $replace, |
151
|
|
|
|
|
|
|
); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
10
|
|
|
|
|
30
|
my %dispatch = map { $_->target => $_ } @set_rules, @mod_rules; |
|
90
|
|
|
|
|
372
|
|
155
|
|
|
|
|
|
|
|
156
|
10
|
|
|
|
|
34
|
my $self; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
$self = bless sub { |
159
|
31
|
|
|
31
|
|
52
|
my $set = shift; |
160
|
|
|
|
|
|
|
|
161
|
31
|
|
|
|
|
96
|
$lts_tc->assert_valid($set); |
162
|
|
|
|
|
|
|
|
163
|
31
|
|
|
|
|
2037
|
my $rule = $dispatch{ref($set)}; |
164
|
31
|
50
|
|
|
|
85
|
unless ($rule) { |
165
|
0
|
|
|
|
|
0
|
for (@set_rules) { |
166
|
0
|
0
|
|
|
|
0
|
if ($_->handles($set)) { |
167
|
0
|
|
|
|
|
0
|
$rule = $_; |
168
|
0
|
|
|
|
|
0
|
last; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
} |
172
|
31
|
50
|
|
|
|
67
|
return $set unless $rule; |
173
|
|
|
|
|
|
|
|
174
|
31
|
|
|
|
|
154
|
my $new_set = $rule->handler->($self, $set, @_); |
175
|
31
|
50
|
|
|
|
374
|
return $set if $new_set == $set; |
176
|
|
|
|
|
|
|
|
177
|
31
|
|
|
|
|
39
|
my @new_mods; |
178
|
|
|
|
|
|
|
MOD: |
179
|
31
|
|
|
|
|
100
|
for my $mod ($set->mods) { |
180
|
10
|
|
|
|
|
25
|
my $rule = $dispatch{ref($mod)}; |
181
|
10
|
100
|
|
|
|
26
|
unless ($rule) { |
182
|
6
|
|
|
|
|
13
|
for (@mod_rules) { |
183
|
6
|
50
|
|
|
|
22
|
if ($_->handles($mod)) { |
184
|
6
|
|
|
|
|
282
|
$rule = $_; |
185
|
6
|
|
|
|
|
14
|
last; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} |
189
|
10
|
50
|
|
|
|
59
|
push @new_mods, $rule ? $rule->handler->($self, $mod, @_) |
190
|
|
|
|
|
|
|
: $mod; |
191
|
|
|
|
|
|
|
} |
192
|
31
|
|
|
|
|
357
|
$new_set->mod(@new_mods); |
193
|
|
|
|
|
|
|
|
194
|
31
|
|
|
|
|
208
|
return $new_set; |
195
|
10
|
|
|
|
|
133
|
}, $class; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
LaTeX::TikZ::Interface->register( |
199
|
|
|
|
|
|
|
functor => sub { |
200
|
2
|
|
|
2
|
0
|
1729
|
shift; |
201
|
|
|
|
|
|
|
|
202
|
2
|
|
|
|
|
19
|
__PACKAGE__->new(rules => \@_); |
203
|
|
|
|
|
|
|
}, |
204
|
|
|
|
|
|
|
); |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head2 C<< default_rule $spec => $handler >> |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Adds to all subsequently created functors a default rule for the class or role C<$spec>. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
An exception is thrown if there is already a default rule for C<$spec> ; otherwise, the new rule is appended to the current list of rules. |
211
|
|
|
|
|
|
|
But if C<$spec> begins with C<'+'>, the rule will replace I<all> default rules that apply to subclasses or subroles of C<$spec> (including C<$spec> itself). |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Returns true if and only if an existent rule was replaced. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=cut |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub default_rule { |
218
|
90
|
|
|
90
|
1
|
152
|
shift; |
219
|
90
|
|
|
|
|
175
|
my ($spec, $handler) = @_; |
220
|
|
|
|
|
|
|
|
221
|
90
|
|
|
|
|
263
|
my ($target, $replace) = $validate_spec->($spec); |
222
|
|
|
|
|
|
|
|
223
|
90
|
|
|
|
|
974
|
my $rule = LaTeX::TikZ::Functor::Rule->new( |
224
|
|
|
|
|
|
|
target => $target, |
225
|
|
|
|
|
|
|
handler => $handler, |
226
|
|
|
|
|
|
|
); |
227
|
|
|
|
|
|
|
|
228
|
90
|
100
|
|
|
|
749
|
$rule->insert( |
229
|
|
|
|
|
|
|
into => $rule->is_set ? \@default_set_rules : \@default_mod_rules, |
230
|
|
|
|
|
|
|
overwrite => 0, |
231
|
|
|
|
|
|
|
replace => $replace, |
232
|
|
|
|
|
|
|
); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head1 SEE ALSO |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
L<LaTeX::TikZ>, L<LaTeX::TikZ::Functor::Rule>. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head1 AUTHOR |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
You can contact me by mail or on C<irc.perl.org> (vincent). |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head1 BUGS |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
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>. |
248
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=head1 SUPPORT |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
perldoc LaTeX::TikZ |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Copyright 2010 Vincent Pit, all rights reserved. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=cut |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
1; # End of LaTeX::TikZ::Functor |