X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FSet.pm;h=3d8112f91b0a15cb8d652c2d0e812ed44688a8d5;hb=61a93a58351bf2d238dcf81a1a557112b0c0ee85;hp=ab66433ae8322bb72b64888d03dae9f7e739311a;hpb=37b2cca5547d02b2a751a26f9949d492b5002c2e;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Set.pm b/lib/LaTeX/TikZ/Set.pm index ab66433..3d8112f 100644 --- a/lib/LaTeX/TikZ/Set.pm +++ b/lib/LaTeX/TikZ/Set.pm @@ -9,19 +9,18 @@ LaTeX::TikZ::Set - Base role for LaTeX::TikZ set objects. =head1 VERSION -Version 0.01 +Version 0.02 =cut -our $VERSION = '0.01'; - -use Scope::Guard (); +our $VERSION = '0.02'; +use LaTeX::TikZ::Context; use LaTeX::TikZ::Scope; use LaTeX::TikZ::Tools; -use Any::Moose 'Role'; +use Mouse::Role; =head1 ATTRIBUTES @@ -49,19 +48,22 @@ 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 =cut -requires qw( +requires qw< draw -); +>; -=head2 C +=head2 C + + $set->mod(@mods) Apply the given list of L objects to the current set. @@ -82,65 +84,30 @@ 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( + mods => [ map $_->apply($tikz), @mods ], + body => $body, + ); + } -=head2 C + $body; +}; + +=head2 C + + $set->layer($layer) Puts the current set in the corresponding layer. This is a shortcut for C<< $set->mod(Tikz->layer($layer)) >>. @@ -148,17 +115,20 @@ This is a shortcut for C<< $set->mod(Tikz->layer($layer)) >>. =cut sub layer { - return $_[0] unless @_ > 1; + my $set = shift; - my $layer = $_[1]; + return $set unless @_; - $_[0]->mod( + my $layer = $_[0]; + $set->mod( $ltml_tc->check($layer) ? $layer : LaTeX::TikZ::Mod::Layer->new(name => $layer) ) } -=head2 C +=head2 C + + $set->clip($path) Clips the current set by the path given by C<$path>. This is a shortcut for C<< $set->mod(Tikz->clip($path)) >>. @@ -166,12 +136,14 @@ This is a shortcut for C<< $set->mod(Tikz->clip($path)) >>. =cut sub clip { - return $_[0] unless @_ > 1; + my $set = shift; + + return $set unless @_; - $_[0]->mod( + $set->mod( map { $ltmc_tc->check($_) ? $_ : LaTeX::TikZ::Mod::Clip->new(clip => $_) - } @_[1 .. $#_] + } @_ ) } @@ -198,7 +170,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2010 Vincent Pit, all rights reserved. +Copyright 2010,2011,2012,2013,2014,2015 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.