X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FSet%2FMod.pm;fp=lib%2FLaTeX%2FTikZ%2FSet%2FMod.pm;h=0000000000000000000000000000000000000000;hb=cb3b916e0590c6a0b70b60f30304921385462faa;hp=f759b0de3ac1d805050440788d756fe1c3225185;hpb=aba26c835113a0332c5480e99f86bfa67111de84;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Set/Mod.pm b/lib/LaTeX/TikZ/Set/Mod.pm deleted file mode 100644 index f759b0d..0000000 --- a/lib/LaTeX/TikZ/Set/Mod.pm +++ /dev/null @@ -1,166 +0,0 @@ -package LaTeX::TikZ::Set::Mod; - -use strict; -use warnings; - -=head1 NAME - -LaTeX::TikZ::Set::Mod - A set object that stores modifiers to be applied underneath. - -=head1 VERSION - -Version 0.01 - -=cut - -our $VERSION = '0.01'; - -use Scope::Guard (); - -use LaTeX::TikZ::Tools; - -use LaTeX::TikZ::Scope; - -use Any::Moose; - -with qw( - LaTeX::TikZ::Set - LaTeX::TikZ::Set::Mutable -); - -has '_set' => ( - is => 'rw', - does => 'LaTeX::TikZ::Set', - init_arg => 'set', - required => 1, -); - -sub set { $_[0]->_set } - - -has '_mods' => ( - is => 'ro', - isa => 'Maybe[ArrayRef[LaTeX::TikZ::Mod]]', - init_arg => 'mods', - default => sub { [ ] }, -); - -sub mods { @{$_[0]->_mods} } - -my $ltm_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod'); -my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer'); - -sub mod { - my $set = shift; - - push @{$set->_mods}, - map { $ltm_tc->check($_) ? $_ : $ltm_tc->coerce($_) } - @_; - - $set; -} - -sub add { - my $set = shift; - - my $kid = $set->_set; - if ($kid->does('LaTeX::TikZ::Set::Mutable')) { - $kid->add(@_); - } else { - require LaTeX::TikZ::Set::Sequence; - $set->_set(LaTeX::TikZ::Set::Sequence->new( - kids => [ $kid, @_ ], - )); - } - - $set; -} - -{ - 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; - } - - sub draw { - my ($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 = $set->mods_unique; - - my $body = $set->_set->draw($tikz); - - if (@mods) { - $body = LaTeX::TikZ::Scope->new - ->mod(map $_->apply($tikz), @mods) - ->body($body); - } - - $body; - } -} - -__PACKAGE__->meta->make_immutable; - -=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 2010 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::Set::Mod