lib/LaTeX/TikZ/Set.pm
lib/LaTeX/TikZ/Set/Arc.pm
lib/LaTeX/TikZ/Set/Arrow.pm
+lib/LaTeX/TikZ/Set/Chain.pm
lib/LaTeX/TikZ/Set/Circle.pm
lib/LaTeX/TikZ/Set/Container.pm
lib/LaTeX/TikZ/Set/Line.pm
Creates a L<LaTeX::TikZ::Set::Union> object out of the paths C<@kids>.
# A path made of two circles
- Tikz->path(
+ Tikz->union(
Tikz->circle(0, 1),
Tikz->circle(1, 1),
)
'even odd rule',
);
+=head3 C<< Tikz->join($connector, @kids) >>
+
+Creates a L<LaTeX::TikZ::Set::Chain> object that joins the paths C<@kinds> with the given C<$connector> which can be, according to L<LaTeX::TikZ::Set::Chain/connector>, a string, an array reference or a code reference.
+
+ # A stair
+ Tikz->join('-|', map [ $_, $_ ], 0 .. 5);
+
+=head3 C<< Tikz->chain($kid0, $link0, $kid1, $link1, ... $kidn) >>
+
+Creates a L<LaTeX::TikZ::Set::Chain> object that chains C<$kid0> to C<$kid1> with the string C<$link0>, C<$kid1> to C<$kid2> with C<$link1>, and so on.
+
+ # An heart-like shape
+ Tikz->chain([ 0, 1 ]
+ => '.. controls (-1, 1.5) and (-0.75, 0.25) ..' => [ 0, 0 ]
+ => '.. controls (0.75, 0.25) and (1, 1.5) ..' => [ 0, 1 ]
+ );
+
=head3 C<< Tikz->seq(@kids) >>
Creates a L<LaTeX::TikZ::Set::Sequence> object out of the sequences or paths C<@kids>.
require LaTeX::TikZ::Set::Union; # union
require LaTeX::TikZ::Set::Sequence; # seq
+ require LaTeX::TikZ::Set::Chain; # chain, join
require LaTeX::TikZ::Set::Point; # point
require LaTeX::TikZ::Set::Line; # line
--- /dev/null
+package LaTeX::TikZ::Set::Chain;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Chain - A set object representing a connected path between several objects.
+
+=head1 VERSION
+
+Version 0.02
+
+=cut
+
+our $VERSION = '0.02';
+
+use LaTeX::TikZ::Set::Point;
+
+use LaTeX::TikZ::Interface;
+use LaTeX::TikZ::Functor;
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+use Any::Moose 'Util::TypeConstraints' => [ qw<subtype as coerce from via> ];
+
+=head1 RELATIONSHIPS
+
+This class consumes the L<LaTeX::TikZ::Set::Path> and L<LaTeX::TikZ::Set::Container> roles, and as such implements the L</path>, L</kids> and L</add> methods.
+
+=cut
+
+with qw<
+ LaTeX::TikZ::Set::Path
+ LaTeX::TikZ::Set::Container
+>;
+
+=head1 ATTRIBUTES
+
+=head2 C<kids>
+
+The L<LaTeX::TikZ::Set::Path> objects that form the chain.
+
+=cut
+
+subtype 'LaTeX::TikZ::Set::Chain::Elements'
+ => as 'ArrayRef[LaTeX::TikZ::Set::Path]';
+
+coerce 'LaTeX::TikZ::Set::Chain::Elements'
+ => from 'ArrayRef[Any]'
+ => via { [ map {
+ blessed($_) && $_->does('LaTeX::TikZ::Set')
+ ? $_
+ : LaTeX::TikZ::Set::Point->new(point => $_)
+ } @$_ ] };
+
+has '_kids' => (
+ is => 'ro',
+ isa => 'LaTeX::TikZ::Set::Chain::Elements',
+ init_arg => 'kids',
+ default => sub { [ ] },
+ coerce => 1,
+);
+
+sub kids { @{$_[0]->_kids} }
+
+=head2 C<connector>
+
+A code reference that describes how two successive elements of the chain are linked.
+It is called repeatedly with these arguments :
+
+=over 4
+
+=item *
+
+The current L<LaTeX::TikZ::Set::Chain> object.
+
+=item *
+
+The index C<$i> of the current position in the chain, starting at C<0> for the link between the two first elements.
+
+=item *
+
+The C<$i>-th L<LaTeX::TikZ::Set> object in the chain.
+
+=item *
+
+The C<$i+1>-th L<LaTeX::TikZ::Set> object in the chain.
+
+=back
+
+You can also pass a string, which will be upgraded to a code reference constantly returning that string ; or an array reference, which will be turned into a code reference returning the C<$i>-th element of the array when asked for the C<$i>-th link.
+
+=cut
+
+subtype 'LaTeX::TikZ::Set::Chain::Connector'
+ => as 'CodeRef';
+
+coerce 'LaTeX::TikZ::Set::Chain::Connector'
+ => from 'Str'
+ => via { my $conn = $_; sub { $conn } };
+
+coerce 'LaTeX::TikZ::Set::Chain::Connector'
+ => from 'ArrayRef[Str]'
+ => via { my $conns = $_; sub { $conns->[$_[1]] } };
+
+has 'connector' => (
+ is => 'ro',
+ isa => 'LaTeX::TikZ::Set::Chain::Connector',
+ required => 1,
+ coerce => 1,
+);
+
+has '_links' => (
+ is => 'ro',
+ isa => 'ArrayRef[Str]',
+ init_arg => undef,
+ default => sub { [ ] },
+);
+
+=head1 METHODS
+
+=head2 C<add>
+
+=cut
+
+my $ltsp_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set::Path');
+
+sub add {
+ my $set = shift;
+
+ $ltsp_tc->assert_valid($_) for @_;
+ return $set unless @_;
+
+ my $kids = $set->_kids;
+ my $links = $set->_links;
+ my $conn = $set->connector;
+
+ push @$kids, shift @_ unless @$kids;
+ return $set unless @_;
+
+ my $prev = $kids->[-1];
+ for my $i (0 .. $#_) {
+ my $next = $_[$i];
+ my $link = $set->$conn($#$kids, $prev, $next);
+ confess('Invalid connector') unless defined $link and not blessed $link;
+ push @$links, $link;
+ push @$kids, $next;
+ $prev = $next;
+ }
+
+ $set;
+}
+
+sub BUILD {
+ my ($set) = @_;
+
+ my @kids = $set->kids;
+ return unless @kids >= 2;
+
+ my $links = $set->_links;
+ my $conn = $set->connector;
+
+ my $prev = $kids[0];
+ for my $i (1 .. $#kids) {
+ my $next = $_[$i];
+ my $link = $set->$conn($i - 1, $prev, $next);
+ confess('Invalid connector') unless defined $link and not blessed $link;
+ push @$links, $link;
+ $prev = $next;
+ }
+}
+
+=head2 C<path>
+
+=cut
+
+sub path {
+ my $set = shift;
+
+ my @kids = $set->kids;
+ return '' unless @kids;
+
+ my $links = $set->_links;
+ my $conn = $set->connector;
+
+ my $path = $kids[0]->path(@_);
+ for my $i (1 .. $#kids) {
+ my $link = ' ' . $links->[$i - 1] . ' ';
+ $link =~ s/\s+/ /g;
+ $path .= $link . $kids[$i]->path(@_);
+ }
+
+ return $path;
+}
+
+LaTeX::TikZ::Interface->register(
+ join => sub {
+ shift;
+ my $conn = shift;
+
+ __PACKAGE__->new(
+ kids => \@_,
+ connector => $conn,
+ );
+ },
+ chain => sub {
+ shift;
+ confess("The 'chain' command expects an odd number of arguments")
+ unless @_ % 2;
+
+ my @kids = shift;
+ my @links;
+ for (my $i = 0; $i < @_; $i += 2) {
+ push @links, $_[$i];
+ push @kids, $_[$i + 1];
+ }
+
+ __PACKAGE__->new(
+ kids => \@kids,
+ connector => \@links,
+ );
+ }
+);
+
+LaTeX::TikZ::Functor->default_rule(
+ (__PACKAGE__) => sub {
+ my ($functor, $set, @args) = @_;
+ $set->new(
+ kids => [ map $_->$functor(@args), $set->kids ],
+ connector => $set->connector,
+ );
+ }
+);
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 SEE ALSO
+
+L<LaTeX::TikZ>, L<LaTeX::TikZ::Set::Path>.
+
+=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 2011 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::Chain
use strict;
use warnings;
-use Test::More tests => 34;
+use Test::More tests => 35;
BEGIN {
use_ok( 'LaTeX::TikZ' );
use_ok( 'LaTeX::TikZ::Set' );
use_ok( 'LaTeX::TikZ::Set::Arc' );
use_ok( 'LaTeX::TikZ::Set::Arrow' );
+ use_ok( 'LaTeX::TikZ::Set::Chain' );
use_ok( 'LaTeX::TikZ::Set::Circle' );
use_ok( 'LaTeX::TikZ::Set::Container' );
use_ok( 'LaTeX::TikZ::Set::Line' );
use strict;
use warnings;
-use Test::More tests => 5 + 20 + 12;
+use Test::More tests => 5 + 22 + 12;
use LaTeX::TikZ;
my @methods = qw<
formatter functor
raw
- union seq
+ union seq chain join
point line polyline closed_polyline rectangle circle arc arrow
raw_mod
clip layer
use strict;
use warnings;
-use Test::More tests => 19 + 2 * 14;
+use Test::More tests => 28 + 2 * 21;
use LaTeX::TikZ;
like $@, failed_valid('Maybe[ArrayRef[LaTeX::TikZ::Set::Path]]'),
'creating an union that contains a sequence croaks';
-my $path = eval {
+my $union = eval {
Tikz->union($foo, $bar, $baz);
};
is $@, '', 'creating an union set doesn\'t croak';
-check $path, 'one path set', <<'RES';
+check $union, 'one union set', <<'RES';
\draw foo bar baz ;
RES
eval {
- $path->add($foo);
+ $union->add($foo);
};
-is $@, '', 'adding something to a path set doesn\'t croak';
+is $@, '', 'adding something to a union set doesn\'t croak';
-check Tikz->seq($path, $path), 'two identical path sets', <<'RES';
+check Tikz->seq($union, $union), 'two identical union sets', <<'RES';
\draw foo bar baz foo ;
\draw foo bar baz foo ;
RES
eval {
- $path->add($seq2);
+ $union->add($seq2);
};
like $@, failed_valid('LaTeX::TikZ::Set::Path'),
- 'adding a sequence to a path croaks';
+ 'adding a sequence to a union croaks';
+
+my $join = eval {
+ Tikz->join('--' => $foo, $bar, $baz);
+};
+is $@, '', 'creating an chain set joined with a string doesn\'t croak';
+
+check $join, 'one chain set joined with a string', <<'RES';
+\draw foo -- bar -- baz ;
+RES
+
+eval {
+ $join->add($foo);
+};
+is $@, '', 'adding a set to a chain set joined with a string doesn\'t croak';
+
+check $join, 'one appended chain set joined with a string', <<'RES';
+\draw foo -- bar -- baz -- foo ;
+RES
+
+$join = eval {
+ Tikz->join(sub { ' ' } => $foo, $bar, $baz);
+};
+is $@, '', 'creating an chain set joined with a coderef doesn\'t croak';
+
+check $join, 'one chain set joined with a string', <<'RES';
+\draw foo bar baz ;
+RES
+
+eval {
+ $join->add($foo);
+};
+is $@, '', 'adding a set to a chain set joined with a coderef doesn\'t croak';
+
+check $join, 'one appended chain set joined with a coderef', <<'RES';
+\draw foo bar baz foo ;
+RES
+
+$join = eval {
+ Tikz->join([ '', '..', '--' ] => $foo, $bar, $baz);
+};
+is $@, '', 'creating an chain set joined with an arrayref doesn\'t croak';
+
+check $join, 'one chain set joined with a string', <<'RES';
+\draw foo bar .. baz ;
+RES
+
+eval {
+ $join->add($foo);
+};
+is $@, '', 'adding a set to a chain set joined with an arrayref doesn\'t croak';
+
+check $join, 'one appended chain set joined with an arrayref', <<'RES';
+\draw foo bar .. baz -- foo ;
+RES
+
+eval {
+ $join->add($bar);
+};
+like $@, qr/^Invalid connector/,
+ 'adding too many sets to a chain set joined with an arrayref croaks';
+
+my $chain = eval {
+ Tikz->chain($foo => '--' => $bar => '->' => $baz);
+};
+is $@, '', 'creating an chain set with chain doesn\'t croak';
+
+check $chain, 'one chain set from chain', <<'RES';
+\draw foo -- bar -> baz ;
+RES
+
+eval {
+ Tikz->chain($foo, '--', $bar, '--');
+};
+like $@, qr/^The 'chain' command expects an odd number of arguments/,
+ 'creating an union that contains a sequence croaks';
Tikz->raw('foo'),
Tikz->point(2),
Tikz->line(-1 => 3)
- ->clip(Tikz->circle(1, 1))
+ ->clip(Tikz->circle(1, 1)),
+ Tikz->union(
+ Tikz->chain(4 => '--' => [ -3, 2 ]),
+ Tikz->join('-|' => [ -1, 0 ], [ 0, 1 ]),
+ ),
)
->clip(Tikz->rectangle([0, -1] => [2, 3]));
\clip (1cm,0cm) circle (1cm) ;
\draw (-1cm,0cm) -- (3cm,0cm) ;
\end{scope}
+\draw (4cm,0cm) -- (-3cm,2cm) (-1cm,0cm) -| (0cm,1cm) ;
\end{scope}
RES
\clip (0cm,1cm) circle (1cm) ;
\draw (-2cm,1cm) -- (2cm,1cm) ;
\end{scope}
+\draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
\end{scope}
RES
\clip (0cm,1cm) circle (1cm) ;
\draw (-2cm,1cm) -- (2cm,1cm) ;
\end{scope}
+\draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
\end{scope}
RES
\draw foo ;
\draw (1cm,1cm) ;
\draw (-2cm,1cm) -- (2cm,1cm) ;
+\draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
RES
my $special = eval {
\clip (0cm,1cm) circle (1cm) ;
\draw (-2cm,1cm) -- (2cm,1cm) ;
\end{scope}
+\draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
\end{scope}
RES
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@;
-plan tests => 34;
+plan tests => 35;
my $moose_private = { also_private => [ qr/^BUILD$/, qr/^DEMOLISH$/ ] };
pod_coverage_ok( 'LaTeX::TikZ::Set' );
pod_coverage_ok( 'LaTeX::TikZ::Set::Arc' );
pod_coverage_ok( 'LaTeX::TikZ::Set::Arrow' );
+pod_coverage_ok( 'LaTeX::TikZ::Set::Chain', $moose_private );
pod_coverage_ok( 'LaTeX::TikZ::Set::Circle' );
pod_coverage_ok( 'LaTeX::TikZ::Set::Container' );
pod_coverage_ok( 'LaTeX::TikZ::Set::Line' );
projects / perl / modules / LaTeX-TikZ.git / commitdiff