lib/LaTeX/TikZ/Set/Chain.pm

   1 package LaTeX::TikZ::Set::Chain;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 LaTeX::TikZ::Set::Chain - A set object representing a connected path between several objects.
   9
  10 =head1 VERSION
  11
  12 Version 0.02
  13
  14 =cut
  15
  16 our $VERSION = '0.02';
  17
  18 use LaTeX::TikZ::Set::Point;
  19 use LaTeX::TikZ::Set::Raw;
  20
  21 use LaTeX::TikZ::Interface;
  22 use LaTeX::TikZ::Functor;
  23
  24 use LaTeX::TikZ::Tools;
  25
  26 use Any::Moose;
  27 use Any::Moose 'Util::TypeConstraints' => [ qw<subtype as coerce from via> ];
  28
  29 =head1 RELATIONSHIPS
  30
  31 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.
  32
  33 =cut
  34
  35 with qw<
  36  LaTeX::TikZ::Set::Path
  37  LaTeX::TikZ::Set::Container
  38 >;
  39
  40 =head1 ATTRIBUTES
  41
  42 =head2 C<kids>
  43
  44 The L<LaTeX::TikZ::Set::Path> objects that form the chain.
  45
  46 =cut
  47
  48 subtype 'LaTeX::TikZ::Set::Chain::Elements'
  49      => as 'ArrayRef[LaTeX::TikZ::Set::Path]';
  50
  51 coerce 'LaTeX::TikZ::Set::Chain::Elements'
  52     => from 'ArrayRef[Any]'
  53     => via { [ map {
  54         blessed($_) && $_->does('LaTeX::TikZ::Set')
  55           ? $_
  56           : LaTeX::TikZ::Set::Point->new(point => $_)
  57        } @$_ ] };
  58
  59 has '_kids' => (
  60  is       => 'ro',
  61  isa      => 'LaTeX::TikZ::Set::Chain::Elements',
  62  init_arg => 'kids',
  63  default  => sub { [ ] },
  64  coerce   => 1,
  65 );
  66
  67 sub kids { @{$_[0]->_kids} }
  68
  69 =head2 C<connector>
  70
  71 A code reference that describes how two successive elements of the chain are linked.
  72 When the L</path> method is called, the connector is run repeatedly with these arguments :
  73
  74 =over 4
  75
  76 =item *
  77
  78 The current L<LaTeX::TikZ::Set::Chain> object.
  79
  80 =item *
  81
  82 The index C<$i> of the current position in the chain, starting at C<0> for the link between the two first elements.
  83
  84 =item *
  85
  86 The C<$i>-th L<LaTeX::TikZ::Set> object in the chain.
  87
  88 =item *
  89
  90 The C<$i+1>-th L<LaTeX::TikZ::Set> object in the chain.
  91
  92 =item *
  93
  94 The L<LaTeX::TikZ::Formatter> object.
  95
  96 =back
  97
  98 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.
  99
 100 =cut
 101
 102 subtype 'LaTeX::TikZ::Set::Chain::Connector'
 103      => as 'CodeRef';
 104
 105 coerce 'LaTeX::TikZ::Set::Chain::Connector'
 106     => from 'Str'
 107     => via { my $conn = $_; sub { $conn } };
 108
 109 coerce 'LaTeX::TikZ::Set::Chain::Connector'
 110     => from 'ArrayRef[Str]'
 111     => via { my $conns = $_; sub { $conns->[$_[1]] } };
 112
 113 has 'connector' => (
 114  is       => 'ro',
 115  isa      => 'LaTeX::TikZ::Set::Chain::Connector',
 116  required => 1,
 117  coerce   => 1,
 118 );
 119
 120 =head2 C<cycle>
 121
 122 A boolean that indicates whether the path is a cycle or not.
 123
 124 =cut
 125
 126 has 'cycle' => (
 127  is      => 'ro',
 128  isa     => 'Bool',
 129  default => 0,
 130 );
 131
 132 =head1 METHODS
 133
 134 =head2 C<add>
 135
 136 =cut
 137
 138 my $ltsp_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set::Path');
 139
 140 sub add {
 141  my $set = shift;
 142
 143  $ltsp_tc->assert_valid($_) for @_;
 144
 145  push @{$set->_kids}, @_;
 146
 147  $set;
 148 }
 149
 150 =head2 C<path>
 151
 152 =cut
 153
 154 sub path {
 155  my $set = shift;
 156
 157  my @kids  = $set->kids;
 158  return '' unless @kids;
 159
 160  my $conn  = $set->connector;
 161
 162  my $prev  = $kids[0];
 163  my $path  = $prev->path(@_);
 164
 165  if ($set->cycle) {
 166   push @kids, LaTeX::TikZ::Set::Raw->new(
 167    content => 'cycle',
 168   );
 169  }
 170
 171  my $tikz = $_[0];
 172  for my $i (1 .. $#kids) {
 173   my $next = $kids[$i];
 174   my $link = $set->$conn($i - 1, $prev, $next, $tikz);
 175   confess('Invalid connector') unless defined $link and not blessed $link;
 176   $link    = " $link ";
 177   $link    =~ s/\s+/ /g;
 178   $path   .= $link . $next->path(@_);
 179   $prev    = $next;
 180  }
 181
 182  return $path;
 183 }
 184
 185 =head2 C<begin>
 186
 187 =cut
 188
 189 sub begin {
 190  my $set = shift;
 191
 192  my @kids = $set->kids;
 193  return undef unless @kids;
 194
 195  $kids[0]->begin;
 196 }
 197
 198 =head2 C<end>
 199
 200 =cut
 201
 202 sub end {
 203  my $set = shift;
 204
 205  my @kids = $set->kids;
 206  return undef unless @kids;
 207
 208  $kids[-1]->end;
 209 }
 210
 211 LaTeX::TikZ::Interface->register(
 212  join => sub {
 213   shift;
 214   my $conn = shift;
 215
 216   __PACKAGE__->new(
 217    kids      => \@_,
 218    connector => $conn,
 219   );
 220  },
 221  chain => sub {
 222   shift;
 223   confess("The 'chain' command expects an odd number of arguments")
 224                                                                   unless @_ % 2;
 225
 226   my @kids = shift;
 227   my @links;
 228   for (my $i = 0; $i < @_; $i += 2) {
 229    push @links, $_[$i];
 230    push @kids,  $_[$i + 1];
 231   }
 232
 233   __PACKAGE__->new(
 234    kids      => \@kids,
 235    connector => \@links,
 236   );
 237  }
 238 );
 239
 240 LaTeX::TikZ::Functor->default_rule(
 241  (__PACKAGE__) => sub {
 242   my ($functor, $set, @args) = @_;
 243   $set->new(
 244    kids      => [ map $_->$functor(@args), $set->kids ],
 245    connector => $set->connector,
 246    cycle     => $set->cycle,
 247   );
 248  }
 249 );
 250
 251 __PACKAGE__->meta->make_immutable;
 252
 253 =head1 SEE ALSO
 254
 255 L<LaTeX::TikZ>, L<LaTeX::TikZ::Set::Path>.
 256
 257 =head1 AUTHOR
 258
 259 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 260
 261 You can contact me by mail or on C<irc.perl.org> (vincent).
 262
 263 =head1 BUGS
 264
 265 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>.
 266 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 267
 268 =head1 SUPPORT
 269
 270 You can find documentation for this module with the perldoc command.
 271
 272     perldoc LaTeX::TikZ
 273
 274 =head1 COPYRIGHT & LICENSE
 275
 276 Copyright 2011 Vincent Pit, all rights reserved.
 277
 278 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 279
 280 =cut
 281
 282 1; # End of LaTeX::TikZ::Set::Chain