]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blob - LaTeX/TikZ/Set/Rectangle.pm
Update VPIT::TestHelpers to 15e8aee3
[perl/modules/LaTeX-TikZ.git] / LaTeX / TikZ / Set / Rectangle.pm
1 package LaTeX::TikZ::Set::Rectangle;
2
3 use strict;
4 use warnings;
5
6 =head1 NAME
7
8 LaTeX::TikZ::Set::Rectangle - A set object representing a rectangle.
9
10 =head1 VERSION
11
12 Version 0.01
13
14 =cut
15
16 our $VERSION = '0.01';
17
18 use LaTeX::TikZ::Set::Point;
19
20 use LaTeX::TikZ::Interface;
21 use LaTeX::TikZ::Functor;
22
23 use Any::Moose;
24
25 =head1 RELATIONSHIPS
26
27 This class consumes the L<LaTeX::TikZ::Set::Op> role, and as such implements the L</path> method.
28
29 =cut
30
31 with 'LaTeX::TikZ::Set::Op';
32
33 =head1 ATTRIBUTES
34
35 =head2 C<from>
36
37 The first corner of the rectangle, as a L<LaTeX::TikZ::Set::Point> object.
38
39 =cut
40
41 has 'from' => (
42  is       => 'ro',
43  isa      => 'LaTeX::TikZ::Set::Point',
44  required => 1,
45  coerce   => 1,
46 );
47
48 =head2 C<to>
49
50 The opposite endpoint of the rectangle, also as a L<LaTeX::TikZ::Set::Point> object.
51
52 =cut
53
54 has 'to' => (
55  is       => 'ro',
56  isa      => 'LaTeX::TikZ::Set::Point',
57  required => 1,
58  coerce   => 1,
59 );
60
61 =head2 C<width>
62
63 The algebraic width of the rectangle.
64
65 =cut
66
67 has 'width' => (
68  is  => 'ro',
69  isa => 'Num',
70 );
71
72 =head2 C<height>
73
74 The algebraic height of the rectangle.
75
76 =cut
77
78 has 'height' => (
79  is  => 'ro',
80  isa => 'Num',
81 );
82
83 =head1 METHODS
84
85 =head2 C<path>
86
87 =cut
88
89 sub path {
90  my $set = shift;
91
92  $set->from->path(@_) . ' rectangle ' . $set->to->path(@_);
93 }
94
95 my $meta = __PACKAGE__->meta;
96 my $tc1  = $meta->find_attribute_by_name('from')->type_constraint;
97 my $tc2  = $meta->find_attribute_by_name('to')->type_constraint;
98
99 around 'BUILDARGS' => sub {
100  my $orig  = shift;
101  my $class = shift;
102
103  if (@_ == 2 and $tc1->check($_[0]) and $tc2->check($_[1])) {
104   my ($from, $to) = @_;
105   @_ = (
106    from   => $from,
107    to     => $to,
108    width  => $to->x - $from->x,
109    height => $to->y - $from->y,
110   );
111  } else {
112   my %args = @_;
113   if (not exists $args{to} and exists $args{from}) {
114    confess(<<'   MSG') unless exists $args{width} and exists $args{height};
115 Attributes 'width' and 'height' are required when 'to' was not given
116    MSG
117    $args{from} = $tc1->coerce($args{from});
118    $meta->find_attribute_by_name($_)->type_constraint->assert_valid($args{$_})
119                                                       for qw/from width height/;
120    my $p = $args{from}->point;
121    $args{to} = LaTeX::TikZ::Point->new(
122     x => $p->x + $args{width},
123     y => $p->y + $args{height},
124    );
125    @_ = %args;
126   }
127  }
128
129  $class->$orig(@_);
130 };
131
132 LaTeX::TikZ::Interface->register(
133  rectangle => sub {
134   shift;
135   my ($p, $q) = @_;
136
137   my $is_relative = !blessed($q) && ref($q) eq 'HASH';
138
139   __PACKAGE__->new(
140    from => $p,
141    ($is_relative ? (map +($_ => $q->{$_}), qw/width height/) : (to => $q)),
142   );
143  },
144 );
145
146 LaTeX::TikZ::Functor->default_rule(
147  (__PACKAGE__) => sub {
148   my ($functor, $set, @args) = @_;
149   $set->new(map { $_ => $set->$_->$functor(@args) } qw/from to/)
150  }
151 );
152
153 __PACKAGE__->meta->make_immutable;
154
155 =head1 SEE ALSO
156
157 L<LaTeX::TikZ>, L<LaTeX::TikZ::Set::Op>.
158
159 =head1 AUTHOR
160
161 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
162
163 You can contact me by mail or on C<irc.perl.org> (vincent).
164
165 =head1 BUGS
166
167 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>.
168 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
169
170 =head1 SUPPORT
171
172 You can find documentation for this module with the perldoc command.
173
174     perldoc LaTeX::TikZ
175
176 =head1 COPYRIGHT & LICENSE
177
178 Copyright 2010 Vincent Pit, all rights reserved.
179
180 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
181
182 =cut
183
184 1; # End of LaTeX::TikZ::Set::Rectangle