]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blob - lib/LaTeX/TikZ/Set/Point.pm
424d6d1d719579df1984acf280c0338ebe243f33
[perl/modules/LaTeX-TikZ.git] / 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 =head1 RELATIONSHIPS
27
28 This class consumes the L<LaTeX::TikZ::Set::Op> role, and as such implements the L</path> method.
29
30 =cut
31
32 with 'LaTeX::TikZ::Set::Op';
33
34 =head1 ATTRIBUTES
35
36 =head2 C<point>
37
38 The L<LaTeX::TikZ::Point> object representing the underlying geometrical point.
39
40 =cut
41
42 has 'point' => (
43  is       => 'ro',
44  isa      => 'LaTeX::TikZ::Point::Autocoerce',
45  required => 1,
46  coerce   => 1,
47  handles  => [ qw/x y/ ],
48 );
49
50 =head2 C<label>
51
52 An optional label for the point.
53
54 =cut
55
56 has 'label' => (
57  is      => 'rw',
58  isa     => 'Maybe[Str]',
59  default => undef,
60 );
61
62 =head2 C<pos>
63
64 The position of the label around the point.
65
66 =cut
67
68 enum 'LaTeX::TikZ::Set::Point::Positions' => (
69  'below left',
70  'below',
71  'below right',
72  'right',
73  'above right',
74  'above',
75  'above left',
76  'left',
77 );
78
79 has 'pos' => (
80  is  => 'rw',
81  isa => 'Maybe[LaTeX::TikZ::Set::Point::Positions]',
82 );
83
84 coerce 'LaTeX::TikZ::Set::Point'
85     => from 'Any'
86     => via { __PACKAGE__->new(point => $_) };
87
88 coerce 'LaTeX::TikZ::Point::Autocoerce'
89     => from 'LaTeX::TikZ::Set::Point'
90     => via { $_->point };
91
92 =head1 METHODS
93
94 =head2 C<path>
95
96 =cut
97
98 sub path {
99  my ($set, $tikz) = @_;
100
101  my $p = $set->point;
102
103  my $path = '(' . $tikz->len($p->x) . ',' . $tikz->len($p->y) . ')';
104
105  my $label = $set->label;
106  if (defined $label) {
107   my $pos = $set->pos;
108   $pos = 'above' unless defined $pos;
109
110   my $size = sprintf '%0.1fpt', 2 * $tikz->scale / 5;
111   $path .= " [fill] circle ($size) " . $tikz->label($label, $pos);
112  }
113
114  $path;
115 }
116
117 LaTeX::TikZ::Interface->register(
118  point => sub {
119   shift;
120
121   my $point;
122   if (@_ == 0) {
123    $point = 0;
124   } elsif (@_ % 2) {
125    $point = shift;
126   } else { # @_ even, @_ >= 2
127    $point = [ shift, shift ];
128   }
129
130   __PACKAGE__->new(point => $point, @_);
131  },
132 );
133
134 LaTeX::TikZ::Functor->default_rule(
135  (__PACKAGE__) => sub {
136   my ($functor, $set, @args) = @_;
137   $set->new(
138    point => $set->point,
139    label => $set->label,
140    pos   => $set->pos,
141   );
142  }
143 );
144
145 __PACKAGE__->meta->make_immutable;
146
147 =head1 SEE ALSO
148
149 L<LaTeX::TikZ>, L<LaTeX::TikZ::Set::Op>.
150
151 =head1 AUTHOR
152
153 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
154
155 You can contact me by mail or on C<irc.perl.org> (vincent).
156
157 =head1 BUGS
158
159 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>.
160 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
161
162 =head1 SUPPORT
163
164 You can find documentation for this module with the perldoc command.
165
166     perldoc LaTeX::TikZ
167
168 =head1 COPYRIGHT & LICENSE
169
170 Copyright 2010 Vincent Pit, all rights reserved.
171
172 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
173
174 =cut
175
176 1; # End of LaTeX::TikZ::Set::Point