From: Vincent Pit Date: Sun, 6 Feb 2011 21:15:58 +0000 (+0100) Subject: Abstract the mod antiduplication logic in a new context object X-Git-Tag: rt87282~11 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=4ec204cfd114d9ce19fd616f093503c971b00a1f;p=perl%2Fmodules%2FLaTeX-TikZ.git Abstract the mod antiduplication logic in a new context object Scope::Guard is no longer needed. --- diff --git a/MANIFEST b/MANIFEST index bfb95b9..14baa38 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4,6 +4,7 @@ META.yml 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 diff --git a/Makefile.PL b/Makefile.PL index 705e233..ff2e181 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -19,7 +19,6 @@ my %PREREQ_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, diff --git a/lib/LaTeX/TikZ.pm b/lib/LaTeX/TikZ.pm index 69a55c8..7ba3a74 100644 --- a/lib/LaTeX/TikZ.pm +++ b/lib/LaTeX/TikZ.pm @@ -386,8 +386,6 @@ L with L 0.80 or greater. L. -L. - L, L. L, L, L. diff --git a/lib/LaTeX/TikZ/Context.pm b/lib/LaTeX/TikZ/Context.pm new file mode 100644 index 0000000..5909cb8 --- /dev/null +++ b/lib/LaTeX/TikZ/Context.pm @@ -0,0 +1,164 @@ +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 + +The parent context of the current one, or C for the topmost context. + +=cut + +has 'parent' => ( + is => 'ro', + isa => 'Maybe[LaTeX::TikZ::Context]', + required => 0, + default => undef, +); + +=head2 C + +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 + +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. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 diff --git a/lib/LaTeX/TikZ/Set.pm b/lib/LaTeX/TikZ/Set.pm index 4e6eafc..e673097 100644 --- a/lib/LaTeX/TikZ/Set.pm +++ b/lib/LaTeX/TikZ/Set.pm @@ -15,8 +15,7 @@ Version 0.02 our $VERSION = '0.02'; -use Scope::Guard (); - +use LaTeX::TikZ::Context; use LaTeX::TikZ::Scope; use LaTeX::TikZ::Tools; @@ -49,9 +48,10 @@ This method is required by the interface : =item * -C +C Returns an array reference of TikZ code lines required to effectively draw the current set object, formatted by the L object C<$formatter>. +The current evaluation context is passed as the L object C<$context>. =back @@ -82,63 +82,25 @@ sub mod { $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 diff --git a/lib/LaTeX/TikZ/Set/Chain.pm b/lib/LaTeX/TikZ/Set/Chain.pm index d1022f8..eb5395f 100644 --- a/lib/LaTeX/TikZ/Set/Chain.pm +++ b/lib/LaTeX/TikZ/Set/Chain.pm @@ -152,7 +152,7 @@ sub add { =cut sub path { - my ($set, $tikz) = @_; + my $set = shift; my @kids = $set->kids; return '' unless @kids; @@ -160,7 +160,7 @@ sub path { 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( @@ -168,13 +168,14 @@ sub path { ); } + 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; } diff --git a/lib/LaTeX/TikZ/Set/Path.pm b/lib/LaTeX/TikZ/Set/Path.pm index 081f35b..e681828 100644 --- a/lib/LaTeX/TikZ/Set/Path.pm +++ b/lib/LaTeX/TikZ/Set/Path.pm @@ -39,9 +39,10 @@ These methods are required by the interface : =item * -C +C Returns the TikZ code that builds a path out of the current set object as a string formatted by the L object C<$formatter>. +The current evaluation context is passed as the L object C<$context>. =item * diff --git a/t/00-load.t b/t/00-load.t index e8ec3aa..1fa8c0f 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -3,10 +3,11 @@ 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' ); diff --git a/t/92-pod-coverage.t b/t/92-pod-coverage.t index bb340b6..4968988 100644 --- a/t/92-pod-coverage.t +++ b/t/92-pod-coverage.t @@ -15,7 +15,7 @@ my $min_pc = 0.18; 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$/ ] }; @@ -23,6 +23,7 @@ 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' );