File Coverage

blib/lib/Math/Shape/Rectangle.pm
Criterion Covered Total %
statement 115 117 98.2
branch 40 50 80.0
condition 5 6 83.3
subroutine 15 15 100.0
pod 6 6 100.0
total 181 194 93.3


line stmt bran cond sub pod time code
1 6     6   16717 use strict;
  6         9  
  6         230  
2 6     6   22 use warnings;
  6         8  
  6         246  
3             package Math::Shape::Rectangle;
4             $Math::Shape::Rectangle::VERSION = '0.14';
5 6     6   81 use 5.008;
  6         13  
  6         161  
6 6     6   24 use Carp;
  6         4  
  6         308  
7 6     6   448 use Math::Shape::Vector;
  6         7  
  6         157  
8 6     6   26 use Math::Shape::Utils;
  6         9  
  6         292  
9 6     6   731 use Math::Shape::Line;
  6         10  
  6         102  
10 6     6   604 use Math::Shape::LineSegment;
  6         7  
  6         102  
11 6     6   23 use Math::Shape::Range;
  6         6  
  6         6329  
12              
13             # ABSTRACT: an axis-aligned 2d rectangle
14              
15              
16             sub new {
17 62 50   62 1 133 croak 'incorrect number of args' unless @_ == 5;
18 62         79 my ($class, $x, $y, $l, $h) = @_;
19 62         124 bless { origin => Math::Shape::Vector->new($x, $y),
20             size => Math::Shape::Vector->new($l, $h),
21             }, $class;
22             }
23              
24              
25             sub clamp
26             {
27 12 50   12 1 37 croak 'clamp must be called with a Math::Shape::Vector object' unless $_[1]->isa('Math::Shape::Vector');
28 12         13 my ($self, $vector) = @_;
29              
30 12         48 my $clamp_x = clamp_on_range($vector->{x}, $self->{origin}->{x}, $self->{origin}->{x} + $self->{size}->{x});
31 12         34 my $clamp_y = clamp_on_range($vector->{y}, $self->{origin}->{y}, $self->{origin}->{y} + $self->{size}->{y});
32 12         29 Math::Shape::Vector->new($clamp_x, $clamp_y);
33             }
34              
35              
36             sub corner
37             {
38 32 50   32 1 42 croak 'Incorrect number of arguments for corner(). Requires a number between 0 and 3.' unless @_ == 2;
39 32         27 my ($self, $nr) = @_;
40              
41 32         24 my $corner;
42 32         22 my $mod = $nr % 4;
43              
44 32 100       67 if ($mod == 0)
    100          
    100          
    50          
45             {
46 8         25 $corner = Math::Shape::Vector->new(
47             $self->{origin}{x} + $self->{size}{x},
48             $self->{origin}{y},
49             );
50             }
51             elsif ($mod == 1)
52             {
53 8         28 $corner = Math::Shape::Vector->new(
54             $self->{origin}{x},,
55             $self->{origin}{y},
56             );
57 8         17 $corner->add_vector($self->{size});
58             }
59             elsif ($mod == 2)
60             {
61 8         26 $corner = Math::Shape::Vector->new(
62             $self->{origin}{x},
63             $self->{origin}{y} + $self->{size}{y},
64             );
65             }
66             elsif ($mod == 3)
67             {
68 8         22 $corner = Math::Shape::Vector->new(
69             $self->{origin}{x},
70             $self->{origin}{y},
71             );
72             }
73             else
74             {
75 0         0 croak 'corner() not called with a number between 0 and 3';
76             }
77             }
78              
79              
80             sub separating_axis
81             {
82 8 50   8 1 25 croak 'separating_axis() requires a Math::Shape::LineSegment object as an argument' unless $_[1]->isa('Math::Shape::LineSegment');
83 8         8 my ($self, $axis) = @_;
84              
85 8         19 my $n = $axis->{start}->subtract_vector($axis->{end});
86 8         14 my $point0 = $self->corner(0);
87 8         17 my $point1 = $self->corner(1);
88 8         10 my $point2 = $self->corner(2);
89 8         13 my $point3 = $self->corner(3);
90              
91 8         20 my $r_edge_a = Math::Shape::LineSegment->new(
92             $point0->{x},
93             $point0->{y},
94             $point1->{x},
95             $point1->{y},
96             );
97 8         21 my $r_edge_range_a = $r_edge_a->project($n);
98 8         26 my $r_edge_b = Math::Shape::LineSegment->new(
99             $point2->{x},
100             $point2->{y},
101             $point3->{x},
102             $point3->{y},
103             );
104 8         16 my $r_edge_range_b = $r_edge_b->project($n);
105 8         19 my $r_projection = $r_edge_range_a->hull($r_edge_range_b);
106 8         16 my $axis_range = $axis->project($n);
107 8 100       15 $axis_range->is_overlapping($r_projection)
108             ? 0 : 1;
109             }
110              
111              
112             sub enlarge
113             {
114 24 50   24 1 53 croak 'enlarge() must be called with a Math::Shape::Vector object' unless $_[1]->isa('Math::Shape::Vector');
115 24         23 my ($self, $v) = @_;
116              
117 24         63 my $size = Math::Shape::Vector->new(
118             maximum($self->{origin}{x} + $self->{size}{x}, $v->{x}),
119             maximum($self->{origin}{y} + $self->{size}{y}, $v->{y}),
120             );
121              
122 24         55 my $origin = Math::Shape::Vector->new(
123             minimum($self->{origin}{x}, $v->{x}),
124             minimum($self->{origin}{y}, $v->{y}),
125             );
126 24         36 my $enlarged_size = $size->subtract_vector($origin);
127              
128 24         48 Math::Shape::Rectangle->new(
129             $origin->{x},
130             $origin->{y},
131             $enlarged_size->{x},
132             $enlarged_size->{y},
133             );
134             }
135              
136              
137             sub collides {
138 70     70 1 106 my ($self, $other_obj) = @_;
139              
140 70 100       533 if ($other_obj->isa('Math::Shape::Rectangle'))
    100          
    100          
    100          
    100          
    50          
141             {
142 14         23 my $a_left = $self->{origin}{x};
143 14         22 my $a_right = $a_left + $self->{size}{x};
144 14         18 my $b_left = $other_obj->{origin}->{x};
145 14         18 my $b_right = $b_left + $other_obj->{size}{x};
146 14         30 my $a_bottom = $self->{origin}{y};
147 14         17 my $a_top = $a_bottom + $self->{size}{y};
148 14         12 my $b_bottom = $other_obj->{origin}{y};
149 14         15 my $b_top = $b_bottom + $other_obj->{size}{y};
150              
151             # overlap returns 1 / 0 already, so no need to use ternary to force 1/0 response
152 14 100       33 overlap($a_left, $a_right, $b_left, $b_right)
153             && overlap($a_bottom, $a_top, $b_bottom, $b_top);
154             }
155             elsif ($other_obj->isa('Math::Shape::Vector'))
156             {
157 12         21 my $left = $self->{origin}{x};
158 12         17 my $right = $left + $self->{size}{x};
159 12         13 my $bottom = $self->{origin}{y};
160 12         16 my $top = $bottom + $self->{size}{y};
161              
162             # use ternary here as Perl will return undef if false, but we need 0
163 12 100 100     156 $left <= $other_obj->{x}
164             && $bottom <= $other_obj->{y}
165             && $other_obj->{x} <= $right
166             && $other_obj->{y} <= $top
167             ? 1 : 0;
168             }
169             elsif ($other_obj->isa('Math::Shape::Line'))
170             {
171 24         60 my $n = $other_obj->{direction}->rotate_90;
172 24         32 my $c1 = $self->{origin};
173 24         52 my $c2 = $c1->add_vector($self->{size});
174 24         58 my $c3 = Math::Shape::Vector->new($c2->{x}, $c1->{y});
175 24         56 my $c4 = Math::Shape::Vector->new($c1->{x}, $c2->{y});
176 24         51 $c1 = $c1->subtract_vector($other_obj->{base});
177 24         43 $c2 = $c2->subtract_vector($other_obj->{base});
178 24         72 $c3 = $c3->subtract_vector($other_obj->{base});
179 24         53 $c4 = $c4->subtract_vector($other_obj->{base});
180              
181 24         53 my $dp1 = $n->dot_product($c1);
182 24         41 my $dp2 = $n->dot_product($c2);
183 24         44 my $dp3 = $n->dot_product($c3);
184 24         47 my $dp4 = $n->dot_product($c4);
185              
186             # use ternary here as Perl will return undef if false, but we need 0
187 24 100 66     262 ($dp1 * $dp2 <= 0)
188             || ($dp2 * $dp3 <= 0)
189             || ($dp3 * $dp4 <= 0)
190             ? 1 : 0;
191             }
192             elsif ($other_obj->isa('Math::Shape::LineSegment'))
193             {
194             # convert LineSegment into an infinite line and test for collision
195 12         20 my $base = $other_obj->{start};
196 12         32 my $direction = $other_obj->{end}->subtract_vector($other_obj->{start});
197 12         46 my $s_line = Math::Shape::Line->new($base->{x}, $base->{y}, $direction->{x}, $direction->{y});
198 12 100       58 return 0 unless $self->collides($s_line);
199              
200             # convert both objects to ranges and check for overlap along x axis
201 6         31 my $r_range_x = Math::Shape::Range->new(
202             $self->{origin}{x},
203             $self->{origin}{x} + $self->{size}{x},
204             );
205 6         21 my $s_range_x = Math::Shape::Range->new(
206             $other_obj->{start}{x},
207             $other_obj->{end}{x},
208             );
209 6         22 $s_range_x = $s_range_x->sort;
210 6 50       16 return 0 unless $s_range_x->is_overlapping($r_range_x);
211              
212             # convert both objects to ranges and check for overlap along y axis
213 6         23 my $r_range_y = Math::Shape::Range->new(
214             $self->{origin}{y},
215             $self->{origin}{y} + $self->{size}{y},
216             );
217 6         20 my $s_range_y = Math::Shape::Range->new(
218             $other_obj->{start}{y},
219             $other_obj->{end}{y},
220             );
221 6         12 $s_range_y = $s_range_y->sort;
222 6 50       12 return 0 unless $s_range_y->is_overlapping($r_range_y);
223             }
224             elsif ($other_obj->isa('Math::Shape::OrientedRectangle'))
225             {
226             # get rectangular hull of oriented rectangle
227             # if no collision with hull, we're good
228 6         23 my $or_hull = $other_obj->hull;
229 6 100       13 return 0 unless $self->collides($or_hull);
230              
231             # if oriented rectangle edge 0 is a separating axis, we're good
232 4         11 my $or_edge_0 = $other_obj->get_edge(0);
233 4 50       11 return 0 if $self->separating_axis($or_edge_0);
234              
235             # if oriented rectangle edge 1 is a separating axis, we're good
236 4         10 my $or_edge_1 = $other_obj->get_edge(1);
237 4 100       8 return 0 if $self->separating_axis($or_edge_1);
238              
239             # must be collision
240 3         17 1;
241             }
242             elsif ($other_obj->isa('Math::Shape::Circle'))
243             {
244             # if it's a circle use the circle's collision method
245 2         6 $other_obj->collides($self);
246             }
247             else
248             {
249 0           croak 'collides must be called with a Math::Shape::Vector library object';
250             }
251             }
252              
253             1;
254              
255             __END__