X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FSet.pm;h=075dcb88b9ed88f48a29794a475df6aaeb507fc8;hb=062ab95259610ce39ace60365b659d6113420ce7;hp=dcaab09494b69c2971e619e21a787f9e19c757da;hpb=e8f0879ade07eed4f58cd52c0771f4e1ecc90b09;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Set.pm b/lib/LaTeX/TikZ/Set.pm index dcaab09..075dcb8 100644 --- a/lib/LaTeX/TikZ/Set.pm +++ b/lib/LaTeX/TikZ/Set.pm @@ -9,66 +9,142 @@ 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 LaTeX::TikZ::Set::Mod; +use LaTeX::TikZ::Context; +use LaTeX::TikZ::Scope; use LaTeX::TikZ::Tools; -use Any::Moose 'Role'; +use Mouse::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', + isa => 'Maybe[ArrayRef[LaTeX::TikZ::Mod]]', + init_arg => 'mods', + default => sub { [ ] }, + lazy => 1, ); -sub mod { - my $set = $_[0]; +sub mods { @{$_[0]->_mods} } - return $set unless @_ > 1; +=head1 METHODS - # If $set is already a Tikz::Set::Mod object, the overridden method is - # called instead. This ensures that you can't have two T::S::M objects in a - # row. +This method is required by the interface : - # Prepend a new set with the mods - my $new = LaTeX::TikZ::Set::Mod->new( - set => $set, - mods => [ @_[1 .. $#_] ], - ); +=over 4 - $_[0] = $new unless defined wantarray; +=item * - $new; -} +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< + 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'); +sub mod { + my $set = shift; + + my @mods = map $ltm_tc->coerce($_), @_; + $ltm_tc->assert_valid($_) for @mods; + + push @{$set->_mods}, @mods; + + $set; +} + +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, + ); + } + + $body; +}; + +=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; + 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 + +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; + my $set = shift; + + return $set unless @_; - $_[0]->mod( + $set->mod( map { - $ltmc_tc->check($_) ? $_ : LaTeX::TikZ::Mod::Clip->new($_) - } @_[1 .. $#_] + $ltmc_tc->check($_) ? $_ : LaTeX::TikZ::Mod::Clip->new(clip => $_) + } @_ ) } +=head1 SEE ALSO + +L. + =head1 AUTHOR Vincent Pit, C<< >>, L. @@ -88,7 +164,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.