X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FSet.pm;h=47363a4866fef4cbcca1b5ab2cc4ad58394dcf05;hb=f54cadb836315572aa2c4bcb16f221da1687df7a;hp=e719643a3a7fea5d64c81efd4cd873da5ee2fd4e;hpb=cb3b916e0590c6a0b70b60f30304921385462faa;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Set.pm b/lib/LaTeX/TikZ/Set.pm index e719643..47363a4 100644 --- a/lib/LaTeX/TikZ/Set.pm +++ b/lib/LaTeX/TikZ/Set.pm @@ -9,11 +9,11 @@ LaTeX::TikZ::Set - Base role for LaTeX::TikZ set objects. =head1 VERSION -Version 0.01 +Version 0.02 =cut -our $VERSION = '0.01'; +our $VERSION = '0.02'; use Scope::Guard (); @@ -23,9 +23,13 @@ use LaTeX::TikZ::Tools; use Any::Moose 'Role'; -requires qw( - draw -); +=head1 ATTRIBUTES + +=head2 C + +Returns the list of the L objects associated with the current set. + +=cut has '_mods' => ( is => 'ro', @@ -37,6 +41,32 @@ has '_mods' => ( sub mods { @{$_[0]->_mods} } +=head1 METHODS + +This method is required by the interface : + +=over 4 + +=item * + +C + +Returns an array reference of TikZ code lines required to effectively draw the current set object, formatted by the L object C<$formatter>. + +=back + +=cut + +requires qw( + draw +); + +=head2 C + +Apply the given list of L objects to the current set. + +=cut + my $ltm_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod'); my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer'); my $ltmc_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Clip'); @@ -44,9 +74,10 @@ my $ltmc_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Clip'); sub mod { my $set = shift; - push @{$set->_mods}, - map { $ltm_tc->check($_) ? $_ : $ltm_tc->coerce($_) } - @_; + my @mods = map $ltm_tc->coerce($_), @_; + $ltm_tc->assert_valid($_) for @mods; + + push @{$set->_mods}, @mods; $set; } @@ -55,31 +86,6 @@ sub mod { our %mods; our $last_mod = 0; - sub mods_unique { - my ($set) = @_; - - my (@mods, $has_layer); -MOD: - for my $mod ($set->mods) { - $has_layer = 1 if $ltml_tc->check($mod); - my $tag = $mod->tag; - my $old = $mods{$tag} || []; - for (@$old) { - next MOD if $_->[0]->cover($mod); - } - push @{$mods{$tag}}, [ $mod, $last_mod++ ]; - push @mods, $mod; - } - - if ($has_layer) { - # Clips and mods don't propagate through layers. Hence if a layer is set, - # force their reuse. - @mods = map $_->[0], sort { $a->[1] <=> $b->[1] } map @$_, values %mods; - } - - return @mods; - } - around 'draw' => sub { my ($orig, $set, $tikz) = @_; @@ -97,7 +103,30 @@ MOD: } }); - my @mods = $set->mods_unique; + 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); @@ -111,6 +140,13 @@ MOD: }; } +=head2 C + +Puts the current set in the corresponding layer. +This is a shortcut for C<< $set->mod(Tikz->layer($layer)) >>. + +=cut + sub layer { return $_[0] unless @_ > 1; @@ -122,16 +158,27 @@ sub layer { ) } +=head2 C + +Clips the current set by the path given by C<$path>. +This is a shortcut for C<< $set->mod(Tikz->clip($path)) >>. + +=cut + sub clip { return $_[0] unless @_ > 1; $_[0]->mod( map { - $ltmc_tc->check($_) ? $_ : LaTeX::TikZ::Mod::Clip->new($_) + $ltmc_tc->check($_) ? $_ : LaTeX::TikZ::Mod::Clip->new(clip => $_) } @_[1 .. $#_] ) } +=head1 SEE ALSO + +L. + =head1 AUTHOR Vincent Pit, C<< >>, L.