Scope::Guard is no longer needed.
Makefile.PL
README
lib/LaTeX/TikZ.pm
+lib/LaTeX/TikZ/Context.pm
lib/LaTeX/TikZ/Formatter.pm
lib/LaTeX/TikZ/Functor.pm
lib/LaTeX/TikZ/Functor/Rule.pm
'Math::Trig' => 0,
'Mouse' => '0.80', # register_type_constraint + type constraint bug
'Scalar::Util' => 0,
- 'Scope::Guard' => 0,
'Sub::Name' => 0,
'Task::Weaken' => 0,
'constant' => 0,
L<Sub::Name>.
-L<Scope::Guard>.
-
L<Math::Complex>, L<Math::Trig>.
L<Scalar::Util>, L<List::Util>, L<Task::Weaken>.
--- /dev/null
+package LaTeX::TikZ::Context;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Context - An object modeling in which context a set is evaluated.
+
+=head1 VERSION
+
+Version 0.02
+
+=cut
+
+our $VERSION = '0.02';
+
+use LaTeX::TikZ::Mod (); # Required to work around a bug in Mouse
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+
+=head1 ATTRIBUTES
+
+=head2 C<parent>
+
+The parent context of the current one, or C<undef> for the topmost context.
+
+=cut
+
+has 'parent' => (
+ is => 'ro',
+ isa => 'Maybe[LaTeX::TikZ::Context]',
+ required => 0,
+ default => undef,
+);
+
+=head2 C<mods>
+
+The list of mods that are asked to be applied in this context.
+
+=cut
+
+has '_mods' => (
+ is => 'ro',
+ isa => 'ArrayRef[LaTeX::TikZ::Mod]',
+ required => 0,
+ default => sub { [ ] },
+ init_arg => 'mods',
+);
+
+sub mods { @{$_[0]->_mods} }
+
+has '_applied_mods' => (
+ is => 'ro',
+ isa => 'HashRef[LaTeX::TikZ::Mod]',
+ required => 0,
+ default => sub { { } },
+ init_arg => undef,
+);
+
+=head2 C<effective_mods>
+
+The list of mods that actually need to be applied in this context.
+
+=cut
+
+has '_effective_mods' => (
+ is => 'ro',
+ isa => 'ArrayRef[LaTeX::TikZ::Mod]',
+ required => 0,
+ default => sub { [ ] },
+ init_arg => undef,
+);
+
+sub effective_mods { @{$_[0]->_effective_mods} }
+
+has '_last_mod' => (
+ is => 'rw',
+ isa => 'Int',
+ required => 0,
+ default => 0,
+ init_arg => undef,
+);
+
+my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer');
+
+sub BUILD {
+ my $cxt = shift;
+ my $pcxt = $cxt->parent;
+
+ my $applied_mods = $cxt->_applied_mods;
+ for (my $c = $pcxt; defined $c; $c = $c->parent) {
+ my $mods = $c->_applied_mods;
+ while (my ($tag, $mods_info) = each %$mods) {
+ unshift @{$applied_mods->{$tag}}, @$mods_info;
+ }
+ }
+
+ my $last_mod = defined $pcxt ? $pcxt->_last_mod : 0;
+ my $effective_mods = $cxt->_effective_mods;
+
+ my $last_layer;
+
+MOD:
+ for my $mod ($cxt->mods) {
+ my $is_layer = $ltml_tc->check($mod);
+ $last_layer = $mod if $is_layer;
+
+ my $tag = $mod->tag;
+ my $old = $applied_mods->{$tag} || [];
+ for (@$old) {
+ next MOD if $_->[0]->covers($mod);
+ }
+
+ push @{$applied_mods->{$tag}}, [ $mod, $last_mod++, $is_layer ];
+ push @$effective_mods, $mod;
+ }
+
+ if ($last_layer) {
+ # Clips and mods don't propagate through layers. Hence, if a layer is set,
+ # we should force their reuse.
+ @$effective_mods = $last_layer;
+ push @$effective_mods, map $_->[0],
+ sort { $a->[1] <=> $b->[1] }
+ grep !$_->[2],
+ map @$_,
+ values %$applied_mods;
+ }
+
+ $cxt->_last_mod($last_mod);
+}
+
+=head1 SEE ALSO
+
+L<LaTeX::TikZ>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+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>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2011 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Context
our $VERSION = '0.02';
-use Scope::Guard ();
-
+use LaTeX::TikZ::Context;
use LaTeX::TikZ::Scope;
use LaTeX::TikZ::Tools;
=item *
-C<draw $formatter>
+C<draw $formatter, $context>
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>.
+The current evaluation context is passed as the L<LaTeX::TikZ::Context> object C<$context>.
=back
$set;
}
-{
- our %mods;
- our $last_mod = 0;
-
- around 'draw' => sub {
- my ($orig, $set, $tikz) = @_;
-
- local $last_mod = $last_mod;
-
- # Save a deep copy
- my %saved_idx = map { $_ => $#{$mods{$_}} } keys %mods;
- my $guard = Scope::Guard->new(sub {
- for (keys %mods) {
- if (exists $saved_idx{$_}) {
- $#{$mods{$_}} = $saved_idx{$_};
- } else {
- delete $mods{$_};
- }
- }
- });
-
- my (@mods, $last_layer);
-MOD:
- for my $mod ($set->mods) {
- my $is_layer = $ltml_tc->check($mod);
- $last_layer = $mod if $is_layer;
- my $tag = $mod->tag;
- my $old = $mods{$tag} || [];
- for (@$old) {
- next MOD if $_->[0]->covers($mod);
- }
- push @{$mods{$tag}}, [ $mod, $last_mod++, $is_layer ];
- push @mods, $mod;
- }
-
- if ($last_layer) {
- # Clips and mods don't propagate through layers. Hence if a layer is set,
- # force their reuse.
- @mods = $last_layer;
- push @mods, map $_->[0],
- sort { $a->[1] <=> $b->[1] }
- grep !$_->[2],
- map @$_,
- values %mods;
- }
-
- my $body = $set->$orig($tikz);
-
- if (@mods) {
- $body = LaTeX::TikZ::Scope->new
- ->mod(map $_->apply($tikz), @mods)
- ->body($body);
- }
-
- $body;
- };
-}
+around 'draw' => sub {
+ my ($orig, $set, $tikz, $pcxt) = @_;
+
+ my $cxt = LaTeX::TikZ::Context->new(
+ parent => $pcxt,
+ mods => [ $set->mods ],
+ );
+
+ my $body = $set->$orig($tikz, $cxt);
+
+ my @mods = $cxt->effective_mods;
+ if (@mods) {
+ $body = LaTeX::TikZ::Scope->new
+ ->mod(map $_->apply($tikz), @mods)
+ ->body($body);
+ }
+
+ $body;
+};
=head2 C<layer $layer>
=cut
sub path {
- my ($set, $tikz) = @_;
+ my $set = shift;
my @kids = $set->kids;
return '' unless @kids;
my $conn = $set->connector;
my $prev = $kids[0];
- my $path = $prev->path($tikz);
+ my $path = $prev->path(@_);
if ($set->cycle) {
push @kids, LaTeX::TikZ::Set::Raw->new(
);
}
+ my $tikz = $_[0];
for my $i (1 .. $#kids) {
my $next = $kids[$i];
my $link = $set->$conn($i - 1, $prev, $next, $tikz);
confess('Invalid connector') unless defined $link and not blessed $link;
$link = " $link ";
$link =~ s/\s+/ /g;
- $path .= $link . $next->path($tikz);
+ $path .= $link . $next->path(@_);
$prev = $next;
}
=item *
-C<path $formatter>
+C<path $formatter, $context>
Returns the TikZ code that builds a path out of the current set object as a string formatted by the L<LaTeX::TikZ::Formatter> object C<$formatter>.
+The current evaluation context is passed as the L<LaTeX::TikZ::Context> object C<$context>.
=item *
use strict;
use warnings;
-use Test::More tests => 36;
+use Test::More tests => 37;
BEGIN {
use_ok( 'LaTeX::TikZ' );
+ use_ok( 'LaTeX::TikZ::Context' );
use_ok( 'LaTeX::TikZ::Formatter' );
use_ok( 'LaTeX::TikZ::Functor' );
use_ok( 'LaTeX::TikZ::Functor::Rule' );
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@;
-plan tests => 36;
+plan tests => 37;
my $moose_private = { also_private => [ qr/^BUILD$/, qr/^DEMOLISH$/ ] };
pod_coverage_ok( 'LaTeX::TikZ::Interface' );
pod_coverage_ok( 'LaTeX::TikZ' );
+pod_coverage_ok( 'LaTeX::TikZ::Context', $moose_private);
pod_coverage_ok( 'LaTeX::TikZ::Formatter' );
pod_coverage_ok( 'LaTeX::TikZ::Functor' );
pod_coverage_ok( 'LaTeX::TikZ::Functor::Rule' );
projects / perl / modules / LaTeX-TikZ.git / commitdiff