From: Vincent Pit Date: Sun, 18 Jul 2010 16:47:48 +0000 (+0200) Subject: Get rid of LaTeX::TikZ::Set::Mod X-Git-Tag: v0.01~48 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=cb3b916e0590c6a0b70b60f30304921385462faa;p=perl%2Fmodules%2FLaTeX-TikZ.git Get rid of LaTeX::TikZ::Set::Mod Now all mods can hold mods (again), as Moose method modifiers allow us to extend ->draw in the parent role. --- diff --git a/MANIFEST b/MANIFEST index 54bb4e7..5f168c0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -22,7 +22,6 @@ lib/LaTeX/TikZ/Scope.pm lib/LaTeX/TikZ/Set.pm lib/LaTeX/TikZ/Set/Circle.pm lib/LaTeX/TikZ/Set/Line.pm -lib/LaTeX/TikZ/Set/Mod.pm lib/LaTeX/TikZ/Set/Mutable.pm lib/LaTeX/TikZ/Set/Op.pm lib/LaTeX/TikZ/Set/Path.pm diff --git a/lib/LaTeX/TikZ/API.pm b/lib/LaTeX/TikZ/API.pm index c16adc8..02724e4 100644 --- a/lib/LaTeX/TikZ/API.pm +++ b/lib/LaTeX/TikZ/API.pm @@ -54,8 +54,6 @@ sub register { } sub load { - require LaTeX::TikZ::Set::Mod; - require LaTeX::TikZ::Set::Raw; # raw require LaTeX::TikZ::Set::Path; # path diff --git a/lib/LaTeX/TikZ/Formatter.pm b/lib/LaTeX/TikZ/Formatter.pm index 6592b38..da0656c 100644 --- a/lib/LaTeX/TikZ/Formatter.pm +++ b/lib/LaTeX/TikZ/Formatter.pm @@ -62,13 +62,11 @@ $find_mods = do { Sub::Name::subname('find_mods' => sub { my ($set, $layers, $others) = @_; - if ($set->isa('LaTeX::TikZ::Set::Mod')) { - for ($set->mods) { - if ($_->isa('LaTeX::TikZ::Mod::Layer')) { - push @$layers, $_; - } else { - push @$others, $_; - } + for ($set->mods) { + if ($_->isa('LaTeX::TikZ::Mod::Layer')) { + push @$layers, $_; + } else { + push @$others, $_; } } diff --git a/lib/LaTeX/TikZ/Set.pm b/lib/LaTeX/TikZ/Set.pm index dcaab09..e719643 100644 --- a/lib/LaTeX/TikZ/Set.pm +++ b/lib/LaTeX/TikZ/Set.pm @@ -15,7 +15,9 @@ Version 0.01 our $VERSION = '0.01'; -use LaTeX::TikZ::Set::Mod; +use Scope::Guard (); + +use LaTeX::TikZ::Scope; use LaTeX::TikZ::Tools; @@ -25,28 +27,89 @@ requires qw( draw ); -sub mod { - my $set = $_[0]; +has '_mods' => ( + is => 'ro', + isa => 'Maybe[ArrayRef[LaTeX::TikZ::Mod]]', + init_arg => 'mods', + default => sub { [ ] }, + lazy => 1, +); - return $set unless @_ > 1; +sub mods { @{$_[0]->_mods} } - # 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. +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'); - # Prepend a new set with the mods - my $new = LaTeX::TikZ::Set::Mod->new( - set => $set, - mods => [ @_[1 .. $#_] ], - ); +sub mod { + my $set = shift; - $_[0] = $new unless defined wantarray; + push @{$set->_mods}, + map { $ltm_tc->check($_) ? $_ : $ltm_tc->coerce($_) } + @_; - $new; + $set; } -my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer'); -my $ltmc_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Clip'); +{ + 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) = @_; + + 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->$orig($tikz); + + if (@mods) { + $body = LaTeX::TikZ::Scope->new + ->mod(map $_->apply($tikz), @mods) + ->body($body); + } + + $body; + }; +} sub layer { return $_[0] unless @_ > 1; 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 diff --git a/lib/LaTeX/TikZ/Set/Sequence.pm b/lib/LaTeX/TikZ/Set/Sequence.pm index 7742435..a430fe5 100644 --- a/lib/LaTeX/TikZ/Set/Sequence.pm +++ b/lib/LaTeX/TikZ/Set/Sequence.pm @@ -33,7 +33,6 @@ subtype 'LaTeX::TikZ::Set::Sequence::Elements' => where { $_->does('LaTeX::TikZ::Set::Op') or $_->isa('LaTeX::TikZ::Set::Sequence') - or $_->isa('LaTeX::TikZ::Set::Mod') }; has '_kids' => ( diff --git a/t/00-load.t b/t/00-load.t index 79d5bdd..2825ca7 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 28; +use Test::More tests => 27; BEGIN { use_ok( 'LaTeX::TikZ' ); @@ -25,7 +25,6 @@ BEGIN { use_ok( 'LaTeX::TikZ::Set' ); use_ok( 'LaTeX::TikZ::Set::Circle' ); use_ok( 'LaTeX::TikZ::Set::Line' ); - use_ok( 'LaTeX::TikZ::Set::Mod' ); use_ok( 'LaTeX::TikZ::Set::Mutable' ); use_ok( 'LaTeX::TikZ::Set::Op' ); use_ok( 'LaTeX::TikZ::Set::Path' ); diff --git a/t/20-mod.t b/t/20-mod.t index 256cbdd..a6c4465 100644 --- a/t/20-mod.t +++ b/t/20-mod.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 19 + 2 * 20; +use Test::More tests => 13 + 2 * 17; use LaTeX::TikZ; use LaTeX::TikZ::Formatter; @@ -70,58 +70,21 @@ check $foo, 'one triple modded raw set (with duplicates)', <<'RES'; RES my $bar = Tikz->raw('bar'); -eval { - $foo->add($bar); +$foo = eval { + Tikz->seq( + Tikz->raw('foo'), + $bar + )->mod($red, $width); }; -is $@, '', 'appending to a modded set doesn\'t croak'; +is $@, '', 'setting two mods in a row doesn\'t croak'; -check $foo, 'one triple modded sequence of raw sets (with duplicates)', <<'RES'; +check $foo, 'one triple modded sequence of raw sets', <<'RES'; \begin{scope} [color=red,line width=4.0pt] \draw foo ; \draw bar ; \end{scope} RES -my $set = Tikz->raw('wut'); - -my $set_mod = eval { - $set->mod; -}; -is $@, '', 'calling empty mod out of a set doesn\'t croak'; -is "$set_mod", "$set", 'calling empty mod out of a set returns the set'; - -my $new = eval { - $set->mod(Tikz->raw_mod('raw1')); -}; -is $@, '', - 'creating and applying a raw mod on a set in scalar context doesn\'t croak'; -is ref($new), 'LaTeX::TikZ::Set::Mod', 'new set is of the right kind'; -isnt "$new", "$set", 'new set is different from the old one'; - -check $set, '', <<'RES'; -\draw wut ; -RES - -check $new, '', <<'RES'; -\draw [raw1] wut ; -RES - -eval { - $set->mod(Tikz->raw_mod('raw2')); - (); -}; -is $@, '', - 'creating and applying a raw mod on a set in void context doesn\'t croak'; -is ref($new), 'LaTeX::TikZ::Set::Mod', 'new set is of the right kind'; - -check $set, '', <<'RES'; -\draw [raw2] wut ; -RES - -check $new, '', <<'RES'; -\draw [raw1] wut ; -RES - my $baz = eval { Tikz->raw('baz') ->mod($red); @@ -289,3 +252,21 @@ check $seq, 'mod covering 4', <<'RES'; \draw [raw3] baz ; \end{scope} RES + +eval { + $bar->mod(Tikz->width(50)); +}; +is $@, '', 'creating and adding another width mod doesn\'t croak'; + +check $seq, 'mod covering 4', <<'RES'; +\begin{scope} [color=red,raw2] +\begin{scope} [line width=4.0pt] +\begin{scope} [raw1] +\draw foo ; +\draw [line width=8.0pt] bar ; +\end{scope} +\draw qux ; +\end{scope} +\draw [raw3] baz ; +\end{scope} +RES