1 package LaTeX::TikZ::Scope;
8 LaTeX::TikZ::Scope - An object modeling a TikZ scope or layer.
16 our $VERSION = '0.01';
20 use LaTeX::TikZ::Tools;
26 isa => 'Maybe[ArrayRef[LaTeX::TikZ::Mod::Formatted]]',
28 default => sub { [ ] },
31 sub mods { @{$_[0]->_mods} }
33 has '_mods_cache' => (
35 isa => 'Maybe[HashRef[LaTeX::TikZ::Mod::Formatted]]',
37 default => sub { +{ } },
42 isa => 'LaTeX::TikZ::Scope|ArrayRef[Str]',
46 my $my_tc = LaTeX::TikZ::Tools::type_constraint(__PACKAGE__);
47 my $ltmf_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Formatted');
48 my $_body_tc = __PACKAGE__->meta->find_attribute_by_name('_body')
54 my $cache = $scope->_mods_cache;
57 my $mod = $ltmf_tc->check($_) ? $_ : $ltmf_tc->coerce($_);
59 next if exists $cache->{$tag};
60 $cache->{$tag} = $mod;
61 push @{$scope->_mods}, $mod;
79 '@{}' => 'dereference',
86 my $body = $scope->_body;
87 return $scope unless $my_tc->check($body);
89 ->mod ($scope->mods, $body->mods)
94 my $inter = Sub::Name::subname('inter' => sub {
97 my (@left, @common, @right);
100 --$where{$_} for keys %$lh;
101 ++$where{$_} for keys %$rh;
103 while (my ($key, $where) = each %where) {
105 push @left, $lh->{$key};
106 } elsif ($where > 0) {
107 push @right, $rh->{$key};
109 push @common, $rh->{$key};
113 return \@left, \@common, \@right;
119 $scope = $scope->flatten;
121 my ($layer, @clips, @raw_mods);
124 if ($type eq 'clip') {
125 unshift @clips, $_->content;
126 } elsif ($type eq 'layer') {
127 confess("Can't apply two layers in a row") if defined $layer;
128 $layer = $_->content;
130 push @raw_mods, $_->content;
134 my @body = $scope->body;
136 my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef;
138 if (@raw_mods and @body == 1 and $body[0] =~ /^\s*\\draw\b\s*([^\[].*)\s*$/) {
139 $body[0] = "\\draw$mods_string $1"; # Has trailing semicolon
140 $mods_string = undef; # Done with mods
144 my $clip = $clips[$_];
145 my $clip_string = "\\clip $clip ;";
146 my $mods_string = ($_ == $#clips and defined $mods_string)
148 unshift @body, "\\begin{scope}$mods_string",
150 push @body, "\\end{scope}",
153 if (not @clips and defined $mods_string) {
154 unshift @body, "\\begin{scope}$mods_string";
155 push @body, "\\end{scope}";
158 if (defined $layer) {
159 unshift @body, "\\begin{pgfonlayer}{$layer}";
160 push @body, "\\end{pgfonlayer}";
166 sub dereference { [ $_[0]->instantiate ] }
169 my ($left, $right, $rev) = @_;
173 if ($my_tc->check($left)) {
174 $left = $left->flatten;
176 if ($my_tc->check($right)) {
177 $right = $right->flatten;
179 my ($only_left, $common, $only_right) = $inter->(
187 ->body($left->_body);
190 ->body($right->_body);
193 ->body(fold($x, $y, $rev));
195 @right = $right->instantiate;
198 $_body_tc->assert_valid($right);
202 @left = $left->instantiate;
204 if ($my_tc->check($right)) {
205 return fold($right, $left, 1);
207 $_body_tc->assert_valid($_) for $left, $right;
213 $rev ? [ @right, @left ] : [ @left, @right ];
216 __PACKAGE__->meta->make_immutable;
220 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
222 You can contact me by mail or on C<irc.perl.org> (vincent).
226 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>.
227 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
231 You can find documentation for this module with the perldoc command.
235 =head1 COPYRIGHT & LICENSE
237 Copyright 2010 Vincent Pit, all rights reserved.
239 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
243 1; # End of LaTeX::TikZ::Scope