X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLaTeX-TikZ.git;a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FSet%2FChain.pm;fp=lib%2FLaTeX%2FTikZ%2FSet%2FChain.pm;h=8795de1bb15bfbe0197a9821508f4a7e1e09ef0f;hp=0000000000000000000000000000000000000000;hb=95aada0ec5b3c5a0d78ed0ad53436b0e70860bc7;hpb=1c53f7e28198adfb2905667acd5741f163832d7b

diff --git a/lib/LaTeX/TikZ/Set/Chain.pm b/lib/LaTeX/TikZ/Set/Chain.pm
new file mode 100644
index 0000000..8795de1
--- /dev/null
+++ b/lib/LaTeX/TikZ/Set/Chain.pm
@@ -0,0 +1,268 @@
+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