File Coverage

blib/lib/LaTeX/TikZ/Set/Chain.pm

Criterion	Covered	Total	%
statement	71	71	100.0
branch	9	12	75.0
condition	2	3	66.6
subroutine	16	16	100.0
pod	5	7	71.4
total	103	109	94.5

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.03

=cut

our $VERSION = '0.03';

use LaTeX::TikZ::Set::Point;
use LaTeX::TikZ::Set::Raw;

use LaTeX::TikZ::Interface;
use LaTeX::TikZ::Functor;

use LaTeX::TikZ::Tools;

use Mouse;
use Mouse::Util::TypeConstraints qw;

=head1 RELATIONSHIPS

This class consumes the L and L roles, and as such implements the L, L and L methods.

=cut

with qw<
 LaTeX::TikZ::Set::Path
 LaTeX::TikZ::Set::Container
>;

=head1 ATTRIBUTES

=head2 C

The L 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

A code reference that describes how two successive elements of the chain are linked.
When the L method is called, the connector is run repeatedly with these arguments :

=over 4

=item *

The current L 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 object in the chain.

=item *

The C<$i+1>-th L object in the chain.

=item *

The L object.

=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,
);

=head2 C

A boolean that indicates whether the path is a cycle or not.

=cut

has 'cycle' => (
 is      => 'ro',
 isa     => 'Bool',
 default => 0,
);

=head1 METHODS

=head2 C

=cut

my $ltsp_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set::Path');

sub add {
 my $set = shift;

 $ltsp_tc->assert_valid($_) for @_;

 push @{$set->_kids}, @_;

 $set;
}

=head2 C

=cut

sub path {
 my $set = shift;

 my @kids  = $set->kids;
 return '' unless @kids;

 my $conn  = $set->connector;

 my $prev  = $kids[0];
 my $path  = $prev->path(@_);

 if ($set->cycle) {
  push @kids, LaTeX::TikZ::Set::Raw->new(
   content => 'cycle',
  );
 }

 my $tikz = $_[0];
 for my $i (1 .. $#kids) {
  my $next = $kids[$i];
  my $link = $set->$conn($i - 1, $prev, $next, $tikz);
  confess('Invalid connector') unless defined $link and not blessed $link;
  $link    = " $link ";
  $link    =~ s/\s+/ /g;
  $path   .= $link . $next->path(@_);
  $prev    = $next;
 }

 return $path;
}

=head2 C

=cut

sub begin {
 my $set = shift;

 my @kids = $set->kids;
 return undef unless @kids;

 $kids[0]->begin;
}

=head2 C

=cut

sub end {
 my $set = shift;

 my @kids = $set->kids;
 return undef unless @kids;

 $kids[-1]->end;
}

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,
   cycle     => $set->cycle,
  );
 }
);

__PACKAGE__->meta->make_immutable;

=head1 SEE ALSO

L, L.

=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,2011,2012,2013,2014,2015 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