line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package LaTeX::TikZ::Scope; |
2
|
|
|
|
|
|
|
|
3
|
10
|
|
|
10
|
|
52
|
use strict; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
305
|
|
4
|
10
|
|
|
10
|
|
53
|
use warnings; |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
462
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
LaTeX::TikZ::Scope - An object modeling a TikZ scope or layer. |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 VERSION |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Version 0.02 |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=cut |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
17
|
|
|
|
|
|
|
|
18
|
10
|
|
|
10
|
|
56
|
use Sub::Name (); |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
165
|
|
19
|
|
|
|
|
|
|
|
20
|
10
|
|
|
10
|
|
52
|
use LaTeX::TikZ::Tools; |
|
10
|
|
|
|
|
17
|
|
|
10
|
|
|
|
|
201
|
|
21
|
|
|
|
|
|
|
|
22
|
10
|
|
|
10
|
|
58
|
use Any::Moose; |
|
10
|
|
|
|
|
15
|
|
|
10
|
|
|
|
|
91
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head2 C<mods> |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=cut |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has '_mods' => ( |
31
|
|
|
|
|
|
|
is => 'ro', |
32
|
|
|
|
|
|
|
isa => 'Maybe[ArrayRef[LaTeX::TikZ::Mod::Formatted]]', |
33
|
|
|
|
|
|
|
init_arg => undef, |
34
|
|
|
|
|
|
|
default => sub { [ ] }, |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
161
|
|
|
161
|
1
|
217
|
sub mods { @{$_[0]->_mods} } |
|
161
|
|
|
|
|
650
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
has '_mods_cache' => ( |
40
|
|
|
|
|
|
|
is => 'ro', |
41
|
|
|
|
|
|
|
isa => 'Maybe[HashRef[LaTeX::TikZ::Mod::Formatted]]', |
42
|
|
|
|
|
|
|
init_arg => undef, |
43
|
|
|
|
|
|
|
default => sub { +{ } }, |
44
|
|
|
|
|
|
|
); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head2 C<body> |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=cut |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
has '_body' => ( |
51
|
|
|
|
|
|
|
is => 'rw', |
52
|
|
|
|
|
|
|
isa => 'LaTeX::TikZ::Scope|ArrayRef[Str]', |
53
|
|
|
|
|
|
|
init_arg => 'body', |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $my_tc = LaTeX::TikZ::Tools::type_constraint(__PACKAGE__); |
57
|
|
|
|
|
|
|
my $ltmf_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Formatted'); |
58
|
|
|
|
|
|
|
my $_body_tc = __PACKAGE__->meta->find_attribute_by_name('_body') |
59
|
|
|
|
|
|
|
->type_constraint; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 METHODS |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head2 C<mod> |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=cut |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub mod { |
68
|
199
|
|
|
199
|
1
|
906
|
my $scope = shift; |
69
|
|
|
|
|
|
|
|
70
|
199
|
|
|
|
|
475
|
my $cache = $scope->_mods_cache; |
71
|
|
|
|
|
|
|
|
72
|
199
|
|
|
|
|
423
|
for (@_) { |
73
|
238
|
|
|
|
|
1029
|
my $mod = $ltmf_tc->coerce($_); |
74
|
238
|
|
|
|
|
2803
|
$ltmf_tc->assert_valid($mod); |
75
|
238
|
|
|
|
|
2358
|
my $tag = $mod->tag; |
76
|
238
|
100
|
|
|
|
840
|
next if exists $cache->{$tag}; |
77
|
236
|
|
|
|
|
597
|
$cache->{$tag} = $mod; |
78
|
236
|
|
|
|
|
291
|
push @{$scope->_mods}, $mod; |
|
236
|
|
|
|
|
1052
|
|
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
199
|
|
|
|
|
1220
|
$scope; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 C<body> |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub body { |
89
|
340
|
|
|
340
|
1
|
547
|
my $scope = shift; |
90
|
|
|
|
|
|
|
|
91
|
340
|
100
|
|
|
|
743
|
if (@_) { |
92
|
199
|
|
|
|
|
923
|
$scope->_body($_[0]); |
93
|
199
|
|
|
|
|
816
|
$scope; |
94
|
|
|
|
|
|
|
} else { |
95
|
141
|
|
|
|
|
195
|
@{$scope->_body}; |
|
141
|
|
|
|
|
639
|
|
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
use overload ( |
100
|
10
|
|
|
|
|
70
|
'@{}' => 'dereference', |
101
|
10
|
|
|
10
|
|
29103
|
); |
|
10
|
|
|
|
|
9566
|
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head2 C<flatten> |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=cut |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub flatten { |
108
|
269
|
|
|
269
|
1
|
367
|
my ($scope) = @_; |
109
|
|
|
|
|
|
|
|
110
|
269
|
|
|
|
|
1518
|
do { |
111
|
279
|
|
|
|
|
655
|
my $body = $scope->_body; |
112
|
279
|
100
|
|
|
|
1360
|
return $scope unless $my_tc->check($body); |
113
|
10
|
|
|
|
|
65
|
$scope = $scope->new |
114
|
|
|
|
|
|
|
->mod ($scope->mods, $body->mods) |
115
|
|
|
|
|
|
|
->body($body->_body) |
116
|
|
|
|
|
|
|
} while (1); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
my $inter = Sub::Name::subname('inter' => sub { |
120
|
|
|
|
|
|
|
my ($lh, $rh) = @_; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
my (@left, @common, @right); |
123
|
|
|
|
|
|
|
my %where; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
--$where{$_} for keys %$lh; |
126
|
|
|
|
|
|
|
++$where{$_} for keys %$rh; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
while (my ($key, $where) = each %where) { |
129
|
|
|
|
|
|
|
if ($where < 0) { |
130
|
|
|
|
|
|
|
push @left, $lh->{$key}; |
131
|
|
|
|
|
|
|
} elsif ($where > 0) { |
132
|
|
|
|
|
|
|
push @right, $rh->{$key}; |
133
|
|
|
|
|
|
|
} else { |
134
|
|
|
|
|
|
|
push @common, $rh->{$key}; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
return \@left, \@common, \@right; |
139
|
|
|
|
|
|
|
}); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head2 C<instantiate> |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub instantiate { |
146
|
141
|
|
|
141
|
1
|
212
|
my ($scope) = @_; |
147
|
|
|
|
|
|
|
|
148
|
141
|
|
|
|
|
306
|
$scope = $scope->flatten; |
149
|
|
|
|
|
|
|
|
150
|
141
|
|
|
|
|
220
|
my ($layer, @clips, @raw_mods); |
151
|
141
|
|
|
|
|
335
|
for ($scope->mods) { |
152
|
162
|
|
|
|
|
439
|
my $type = $_->type; |
153
|
162
|
100
|
|
|
|
637
|
if ($type eq 'clip') { |
|
|
100
|
|
|
|
|
|
154
|
38
|
|
|
|
|
165
|
unshift @clips, $_->content; |
155
|
|
|
|
|
|
|
} elsif ($type eq 'layer') { |
156
|
23
|
50
|
|
|
|
65
|
confess("Can't apply two layers in a row") if defined $layer; |
157
|
23
|
|
|
|
|
82
|
$layer = $_->content; |
158
|
|
|
|
|
|
|
} else { # raw |
159
|
101
|
|
|
|
|
386
|
push @raw_mods, $_->content; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
141
|
|
|
|
|
429
|
my @body = $scope->body; |
164
|
|
|
|
|
|
|
|
165
|
141
|
100
|
|
|
|
529
|
my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef; |
166
|
|
|
|
|
|
|
|
167
|
141
|
100
|
100
|
|
|
1070
|
if (@raw_mods and @body == 1 and $body[0] =~ /^\s*\\draw\b\s*([^\[].*)\s*$/) { |
|
|
|
66
|
|
|
|
|
168
|
40
|
|
|
|
|
155
|
$body[0] = "\\draw$mods_string $1"; # Has trailing semicolon |
169
|
40
|
|
|
|
|
69
|
$mods_string = undef; # Done with mods |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
141
|
|
|
|
|
420
|
for (0 .. $#clips) { |
173
|
38
|
|
|
|
|
60
|
my $clip = $clips[$_]; |
174
|
38
|
|
|
|
|
91
|
my $clip_string = "\\clip $clip ;"; |
175
|
38
|
100
|
100
|
|
|
185
|
my $mods_string = ($_ == $#clips and defined $mods_string) |
176
|
|
|
|
|
|
|
? $mods_string : ''; |
177
|
38
|
|
|
|
|
172
|
unshift @body, "\\begin{scope}$mods_string", |
178
|
|
|
|
|
|
|
$clip_string; |
179
|
38
|
|
|
|
|
114
|
push @body, "\\end{scope}", |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
141
|
100
|
100
|
|
|
649
|
if (not @clips and defined $mods_string) { |
183
|
37
|
|
|
|
|
123
|
unshift @body, "\\begin{scope}$mods_string"; |
184
|
37
|
|
|
|
|
69
|
push @body, "\\end{scope}"; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
141
|
100
|
|
|
|
314
|
if (defined $layer) { |
188
|
23
|
|
|
|
|
56
|
unshift @body, "\\begin{pgfonlayer}{$layer}"; |
189
|
23
|
|
|
|
|
45
|
push @body, "\\end{pgfonlayer}"; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
141
|
|
|
|
|
1416
|
return @body; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head2 C<dereference> |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=cut |
198
|
|
|
|
|
|
|
|
199
|
51
|
|
|
51
|
1
|
186
|
sub dereference { [ $_[0]->instantiate ] } |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head2 C<fold> |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=cut |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub fold { |
206
|
125
|
|
|
125
|
1
|
222
|
my ($left, $right, $rev) = @_; |
207
|
|
|
|
|
|
|
|
208
|
125
|
|
|
|
|
166
|
my (@left, @right); |
209
|
|
|
|
|
|
|
|
210
|
125
|
100
|
|
|
|
554
|
if ($my_tc->check($left)) { |
211
|
73
|
|
|
|
|
273
|
$left = $left->flatten; |
212
|
|
|
|
|
|
|
|
213
|
73
|
100
|
|
|
|
306
|
if ($my_tc->check($right)) { |
214
|
55
|
|
|
|
|
113
|
$right = $right->flatten; |
215
|
|
|
|
|
|
|
|
216
|
55
|
|
|
|
|
239
|
my ($only_left, $common, $only_right) = $inter->( |
217
|
|
|
|
|
|
|
$left->_mods_cache, |
218
|
|
|
|
|
|
|
$right->_mods_cache, |
219
|
|
|
|
|
|
|
); |
220
|
|
|
|
|
|
|
|
221
|
55
|
|
|
|
|
81
|
my $has_different_layers; |
222
|
55
|
|
|
|
|
118
|
for (@$only_left) { |
223
|
29
|
100
|
|
|
|
143
|
if ($_->type eq 'layer') { |
224
|
5
|
|
|
|
|
7
|
$has_different_layers = 1; |
225
|
5
|
|
|
|
|
8
|
last; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
55
|
100
|
|
|
|
138
|
unless ($has_different_layers) { |
229
|
50
|
|
|
|
|
108
|
for (@$only_right) { |
230
|
23
|
100
|
|
|
|
123
|
if ($_->type eq 'layer') { |
231
|
1
|
|
|
|
|
4
|
$has_different_layers = 1; |
232
|
1
|
|
|
|
|
3
|
last; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
55
|
100
|
100
|
|
|
277
|
if (!$has_different_layers and @$common) { |
238
|
19
|
|
|
|
|
133
|
my $x = $left->new |
239
|
|
|
|
|
|
|
->mod(@$only_left) |
240
|
|
|
|
|
|
|
->body($left->_body); |
241
|
19
|
|
|
|
|
129
|
my $y = $left->new |
242
|
|
|
|
|
|
|
->mod(@$only_right) |
243
|
|
|
|
|
|
|
->body($right->_body); |
244
|
19
|
|
|
|
|
123
|
return $left->new |
245
|
|
|
|
|
|
|
->mod(@$common) |
246
|
|
|
|
|
|
|
->body(fold($x, $y, $rev)); |
247
|
|
|
|
|
|
|
} else { |
248
|
36
|
|
|
|
|
110
|
@right = $right->instantiate; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} else { |
251
|
18
|
|
|
|
|
86
|
$_body_tc->assert_valid($right); |
252
|
18
|
|
|
|
|
188
|
@right = @$right; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
54
|
|
|
|
|
160
|
@left = $left->instantiate; |
256
|
|
|
|
|
|
|
} else { |
257
|
52
|
100
|
|
|
|
220
|
if ($my_tc->check($right)) { |
258
|
12
|
|
|
|
|
61
|
return fold($right, $left, 1); |
259
|
|
|
|
|
|
|
} else { |
260
|
40
|
|
|
|
|
191
|
$_body_tc->assert_valid($_) for $left, $right; |
261
|
40
|
|
|
|
|
673
|
@left = @$left; |
262
|
40
|
|
|
|
|
87
|
@right = @$right; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
94
|
100
|
|
|
|
711
|
$rev ? [ @right, @left ] : [ @left, @right ]; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head1 SEE ALSO |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
L<LaTeX::TikZ>. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=head1 AUTHOR |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
You can contact me by mail or on C<irc.perl.org> (vincent). |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=head1 BUGS |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
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>. |
284
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=head1 SUPPORT |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
perldoc LaTeX::TikZ |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Copyright 2010 Vincent Pit, all rights reserved. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=cut |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
1; # End of LaTeX::TikZ::Scope |