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
}
sub load {
- require LaTeX::TikZ::Set::Mod;
-
require LaTeX::TikZ::Set::Raw; # raw
require LaTeX::TikZ::Set::Path; # path
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, $_;
}
}
our $VERSION = '0.01';
-use LaTeX::TikZ::Set::Mod;
+use Scope::Guard ();
+
+use LaTeX::TikZ::Scope;
use LaTeX::TikZ::Tools;
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;
+++ /dev/null
-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<< <perl at profvince.com> >>, L<http://www.profvince.com>.
-
-You can contact me by mail or on C<irc.perl.org> (vincent).
-
-=head1 BUGS
-
-Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
-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
=> where {
$_->does('LaTeX::TikZ::Set::Op')
or $_->isa('LaTeX::TikZ::Set::Sequence')
- or $_->isa('LaTeX::TikZ::Set::Mod')
};
has '_kids' => (
use strict;
use warnings;
-use Test::More tests => 28;
+use Test::More tests => 27;
BEGIN {
use_ok( 'LaTeX::TikZ' );
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' );
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;
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);
\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
projects / perl / modules / LaTeX-TikZ.git / commitdiff