lib/LaTeX/TikZ/Set/Point.pm

   1 package LaTeX::TikZ::Set::Point;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 LaTeX::TikZ::Set::Point - A set object representing a point.
   9
  10 =head1 VERSION
  11
  12 Version 0.01
  13
  14 =cut
  15
  16 our $VERSION = '0.01';
  17
  18 use LaTeX::TikZ::Point;
  19
  20 use LaTeX::TikZ::Interface;
  21 use LaTeX::TikZ::Functor;
  22
  23 use Any::Moose;
  24 use Any::Moose 'Util::TypeConstraints';
  25
  26 with 'LaTeX::TikZ::Set::Op';
  27
  28 has 'point' => (
  29  is       => 'ro',
  30  isa      => 'LaTeX::TikZ::Point::Autocoerce',
  31  required => 1,
  32  coerce   => 1,
  33  handles  => [ qw/x y/ ],
  34 );
  35
  36 has 'label' => (
  37  is      => 'rw',
  38  isa     => 'Maybe[Str]',
  39  default => undef,
  40 );
  41
  42 enum 'LaTeX::TikZ::Set::Point::Positions' => (
  43  'below left',
  44  'below',
  45  'below right',
  46  'right',
  47  'above right',
  48  'above',
  49  'above left',
  50  'left',
  51 );
  52
  53 has 'pos' => (
  54  is  => 'rw',
  55  isa => 'Maybe[LaTeX::TikZ::Set::Point::Positions]',
  56 );
  57
  58 coerce 'LaTeX::TikZ::Set::Point'
  59     => from 'Any'
  60     => via { __PACKAGE__->new(point => $_) };
  61
  62 coerce 'LaTeX::TikZ::Point::Autocoerce'
  63     => from 'LaTeX::TikZ::Set::Point'
  64     => via { $_->point };
  65
  66 sub path {
  67  my ($set, $tikz) = @_;
  68
  69  my $p = $set->point;
  70
  71  my $path = '(' . $tikz->len($p->x) . ',' . $tikz->len($p->y) . ')';
  72
  73  my $label = $set->label;
  74  if (defined $label) {
  75   my $pos = $set->pos;
  76   $pos = 'above' unless defined $pos;
  77
  78   my $size = sprintf '%0.1fpt', 2 * $tikz->scale / 5;
  79   $path .= " [fill] circle ($size) " . $tikz->label($label, $pos);
  80  }
  81
  82  $path;
  83 }
  84
  85 LaTeX::TikZ::Interface->register(
  86  point => sub {
  87   shift;
  88
  89   my $point;
  90   if (@_ == 0) {
  91    $point = 0;
  92   } elsif (@_ % 2) {
  93    $point = shift;
  94   } else { # @_ even, @_ >= 2
  95    $point = [ shift, shift ];
  96   }
  97
  98   __PACKAGE__->new(point => $point, @_);
  99  },
 100 );
 101
 102 LaTeX::TikZ::Functor->default_rule(
 103  (__PACKAGE__) => sub {
 104   my ($functor, $set, @args) = @_;
 105   $set->new(
 106    point => $set->point,
 107    label => $set->label,
 108    pos   => $set->pos,
 109   );
 110  }
 111 );
 112
 113 __PACKAGE__->meta->make_immutable;
 114
 115 =head1 AUTHOR
 116
 117 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 118
 119 You can contact me by mail or on C<irc.perl.org> (vincent).
 120
 121 =head1 BUGS
 122
 123 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>.
 124 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 125
 126 =head1 SUPPORT
 127
 128 You can find documentation for this module with the perldoc command.
 129
 130     perldoc LaTeX::TikZ
 131
 132 =head1 COPYRIGHT & LICENSE
 133
 134 Copyright 2010 Vincent Pit, all rights reserved.
 135
 136 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 137
 138 =cut
 139
 140 1; # End of LaTeX::TikZ::Set::Point