1 package SDL::Game::Rect;
16 my $self = $class->SUPER::new($x, $y, $w, $h);
19 croak SDL::GetError();
25 #############################
27 #############################
29 my ($self, $val) = (@_);
31 $self->top($val - $self->height); # y = val - height
33 return $self->top + $self->height; # y + height
37 my ($self, $val) = (@_);
39 $self->left($val - $self->width); # x = val - width
41 return $self->left + $self->width; # x + width
45 my ($self, $val) = (@_);
47 $self->left($val - ($self->width >> 1)); # x = val - (width/2)
49 return $self->left + ($self->width >> 1); # x + (width/2)
53 my ($self, $val) = (@_);
55 $self->top($val - ($self->height >> 1)); # y = val - (height/2)
57 return $self->top + ($self->height >> 1); # y + (height/2)
61 my ($self, $w, $h) = (@_);
63 return ($self->width, $self->height) # (width, height)
64 unless (defined $w or defined $h);
67 $self->width($w); # width
70 $self->height($h); # height
75 my ($self, $y, $x) = (@_);
77 return ($self->top, $self->left) # (top, left)
78 unless (defined $y or defined $x);
81 $self->left($x); # left
90 my ($self, $centery, $x) = (@_);
92 return ($self->top + ($self->height >> 1), $self->left) # (centery, left)
93 unless (defined $centery or defined $x);
96 $self->left($x); # left
98 if (defined $centery) {
99 $self->top($centery - ($self->height >> 1)); # y = centery - (height/2)
105 my ($self, $bottom, $x) = (@_);
107 return ($self->top + $self->height, $self->left) # (bottom, left)
108 unless (defined $bottom or defined $x);
111 $self->left($x); # left
113 if (defined $bottom) {
114 $self->top($bottom - $self->height); # y = bottom - height
120 my ($self, $centerx, $centery) = (@_);
122 return ($self->left + ($self->width >> 1), $self->top + ($self->height >> 1))
123 unless (defined $centerx or defined $centery);
125 if (defined $centerx) {
126 $self->left($centerx - ($self->width >> 1)); # x = centerx - (width/2)
128 if (defined $centery) {
129 $self->top($centery - ($self->height >> 1)); # y = centery - (height/2)
135 my ($self, $y, $right) = (@_);
137 return ($self->top, $self->left + $self->width) # (top, right)
138 unless (defined $y or defined $right);
140 if (defined $right) {
141 $self->left($right - $self->width); # x = right - width
144 $self->top($y); # top
150 my ($self, $centery, $right) = (@_);
152 return ($self->top + ($self->height >> 1), $self->left + $self->width) # (centery, right)
153 unless (defined $centery or defined $right);
155 if (defined $right) {
156 $self->left($right - $self->width); # x = right - width
158 if (defined $centery) {
159 $self->top($centery - ($self->height >> 1)); # y = centery - (height/2)
165 my ($self, $bottom, $right) = (@_);
167 return ($self->top + $self->height, $self->left + $self->width) # (bottom, right)
168 unless (defined $bottom or defined $right);
170 if (defined $right) {
171 $self->left($right - $self->width); # x = right - width
173 if (defined $bottom) {
174 $self->top($bottom - $self->height); # y = bottom - height
180 my ($self, $centerx, $y) = (@_);
182 return ($self->left + ($self->width >> 1), $self->top) # (centerx, top)
183 unless (defined $centerx or defined $y);
186 $self->top($y); # top
188 if (defined $centerx) {
189 $self->left($centerx - ($self->width >> 1)); # x = centerx - (width/2)
195 my ($self, $centerx, $bottom) = (@_);
197 return ($self->left + ($self->width >> 1), $self->top + $self->height) # (centerx, bottom)
198 unless (defined $centerx or defined $bottom);
200 if (defined $bottom) {
201 $self->top($bottom - $self->height); # y = bottom - height
203 if (defined $centerx) {
204 $self->left($centerx - ($self->width >> 1)); # x = centerx - (width/2)
209 ###############################
211 ###############################
220 -left => $self->left,
221 -width => $self->width,
222 -height => $self->height,
227 my ($self, $x, $y) = (@_);
228 if (not defined $x or not defined $y) {
230 croak "must receive x and y positions as argument";
233 -top => $self->top + $y,
234 -left => $self->left + $x,
235 -width => $self->width,
236 -height => $self->height,
241 my ($self, $x, $y) = (@_);
242 if (not defined $x or not defined $y) {
244 croak "must receive x and y positions as argument";
246 $self->x($self->x + $x);
247 $self->y($self->y + $y);
253 my ($self, $x, $y) = (@_);
254 if (not defined $x or not defined $y) {
256 croak "must receive x and y positions as argument";
260 -left => $self->left - ($x / 2),
261 -top => $self->top - ($y / 2),
262 -width => $self->width + $x,
263 -height => $self->height + $y,
268 my ($self, $x, $y) = (@_);
269 if (not defined $x or not defined $y) {
271 croak "must receive x and y positions as argument";
274 $self->x( $self->x - ($x / 2) );
275 $self->y( $self->y - ($y / 2) );
277 $self->w( $self->w + $x );
278 $self->h( $self->h + $y );
281 sub _get_clamp_coordinates {
282 my ($self_pos, $self_len, $rect_pos, $rect_len) = (@_);
284 if ($self_len >= $rect_len) {
285 return $rect_pos + ($rect_len / 2) - ($self_len / 2);
287 elsif ($self_pos < $rect_pos) {
290 elsif ( ($self_pos + $self_len) > ($rect_pos + $rect_len) ) {
291 return $rect_pos + $rect_len - $self_len;
299 my ($self, $rect) = (@_);
301 unless ($rect->isa('SDL::Rect')) {
302 croak "must receive an SDL::Rect-based object";
305 my $x = _get_clamp_coordinates($self->x, $self->w, $rect->x, $rect->w);
306 my $y = _get_clamp_coordinates($self->y, $self->h, $rect->y, $rect->h);
308 return $self->new($x, $y, $self->w, $self->h);
312 my ($self, $rect) = (@_);
314 unless ($rect->isa('SDL::Rect')) {
315 croak "must receive an SDL::Rect-based object";
318 my $x = _get_clamp_coordinates($self->x, $self->w, $rect->x, $rect->w);
319 my $y = _get_clamp_coordinates($self->y, $self->h, $rect->y, $rect->h);
327 sub _get_intersection_coordinates {
328 my ($self, $rect) = (@_);
334 if (($self->x >= $rect->x) && ($self->x < ($rect->x + $rect->w))) {
337 elsif (($rect->x >= $self->x) && ($rect->x < ($self->x + $self->w))) {
345 if ((($self->x + $self->w) > $rect->x) && (($self->x + $self->w) <= ($rect->x + $rect->w))) {
346 $w = ($self->x + $self->w) - $x;
348 elsif ((($rect->x + $rect->w) > $self->x) && (($rect->x + $rect->w) <= ($self->x + $self->w))) {
349 $w = ($rect->x + $rect->w) - $x;
356 if (($self->y >= $rect->y) && ($self->y < ($rect->y + $rect->h))) {
359 elsif (($rect->y >= $self->y) && ($rect->y < ($self->y + $self->h))) {
367 if ((($self->y + $self->h) > $rect->y) && (($self->y + $self->h) <= ($rect->y + $rect->h))) {
368 $h = ($self->y + $self->h) - $y;
370 elsif ((($rect->y + $rect->h) > $self->y) && (($rect->y + $rect->h) <= ($self->y + $self->h))) {
371 $h = ($rect->y + $rect->h) - $y;
377 return ($x, $y, $w, $h);
380 # if we got here, the two rects do not intersect
381 return ($self->x, $self->y, 0, 0);
386 my ($self, $rect) = (@_);
388 unless ($rect->isa('SDL::Rect')) {
389 croak "must receive an SDL::Rect-based object";
392 my ($x, $y, $w, $h) = _get_intersection_coordinates($self, $rect);
394 return $self->new($x, $y, $w, $h);
398 my ($self, $rect) = (@_);
400 unless ($rect->isa('SDL::Rect')) {
401 croak "must receive an SDL::Rect-based object";
404 my ($x, $y, $w, $h) = _get_intersection_coordinates($self, $rect);
416 my ($self, $rect) = (@_);
419 $x = $self->x < $rect->x ? $self->x : $rect->x; # MIN
420 $y = $self->y < $rect->y ? $self->y : $rect->y; # MIN
422 $w = ($self->x + $self->w) > ($rect->x + $rect->w)
423 ? ($self->x + $self->w) - $x
424 : ($rect->x + $rect->w) - $x
427 $h = ($self->y + $self->h) > ($rect->y + $rect->h)
428 ? ($self->y + $self->h) - $y
429 : ($rect->y + $rect->h) - $y
432 return ($x, $y, $w, $h);
436 my ($self, $rect) = (@_);
438 unless ($rect->isa('SDL::Rect')) {
439 croak "must receive an SDL::Rect-based object";
442 my ($x, $y, $w, $h) = _test_union($self, $rect);
443 return $self->new($x, $y, $w, $h);
447 my ($self, $rect) = (@_);
449 unless ($rect->isa('SDL::Rect')) {
450 croak "must receive an SDL::Rect-based object";
453 my ($x, $y, $w, $h) = _test_union($self, $rect);
464 my ($self, $rects) = (@_);
466 # initial values for union rect
469 my $right = $self->x + $self->w;
470 my $bottom = $self->y + $self->h;
472 foreach my $rect (@{$rects}) {
473 unless ($rect->isa('SDL::Rect')) {
474 # TODO: better error message, maybe saying which item
475 # is the bad one (by list position)
476 croak "must receive an array reference of SDL::Rect-based objects";
479 $left = $rect->x if $rect->x < $left; # MIN
480 $top = $rect->y if $rect->y < $top; # MIN
481 $right = ($rect->x + $rect->w) if ($rect->x + $rect->w) > $right; # MAX
482 $bottom = ($rect->y + $rect->h) if ($rect->y + $rect->h) > $bottom; # MAX
485 return ($left, $top, $right - $left, $bottom - $top);
489 my ($self, $rects) = (@_);
491 unless (defined $rects and ref $rects eq 'ARRAY') {
492 croak "must receive an array reference of SDL::Rect-based objects";
495 my ($x, $y, $w, $h) = _test_unionall($self, $rects);
497 return $self->new($x, $y, $w, $h);
501 my ($self, $rects) = (@_);
503 unless (defined $rects and ref $rects eq 'ARRAY') {
504 croak "must receive an array reference of SDL::Rect-based objects";
507 my ($x, $y, $w, $h) = _test_unionall($self, $rects);
518 my ($self, $rect) = (@_);
520 my $x_ratio = $self->w / $rect->w;
521 my $y_ratio = $self->h / $rect->h;
522 my $max_ratio = ($x_ratio > $y_ratio) ? $x_ratio : $y_ratio;
524 my $w = int ($self->w / $max_ratio);
525 my $h = int ($self->h / $max_ratio);
527 my $x = $rect->x + int (($rect->w - $w) / 2);
528 my $y = $rect->y + int (($rect->h - $h) / 2);
530 return ($x, $y, $w, $h);
534 my ($self, $rect) = (@_);
536 unless ($rect->isa('SDL::Rect')) {
537 croak "must receive an SDL::Rect-based object";
540 my ($x, $y, $w, $h) = _check_fit($self, $rect);
542 return $self->new ($x, $y, $w, $h);
546 my ($self, $rect) = (@_);
548 unless ($rect->isa('SDL::Rect')) {
549 croak "must receive an SDL::Rect-based object";
552 my ($x, $y, $w, $h) = _check_fit($self, $rect);
566 $self->x($self->x + $self->w);
571 $self->y( $self->y + $self->h);
578 my ($self, $rect) = (@_);
580 unless ($rect->isa('SDL::Rect')) {
581 croak "must receive an SDL::Rect-based object";
584 my $contained = ($self->x <= $rect->x)
585 && ($self->y <= $rect->y)
586 && ($self->x + $self->w >= $rect->x + $rect->w)
587 && ($self->y + $self->h >= $rect->y + $rect->h)
588 && ($self->x + $self->w > $rect->x)
589 && ($self->y + $self->h > $rect->y)
596 my ($self, $x, $y) = (@_);
598 unless (defined $x and defined $y) {
599 croak "must receive (x,y) as arguments";
602 my $inside = $x >= $self->x
603 && $x < $self->x + $self->w
605 && $y < $self->y + $self->h
611 sub _do_rects_intersect {
612 my ($rect_A, $rect_B) = (@_);
615 ($rect_A->x >= $rect_B->x && $rect_A->x < $rect_B->x + $rect_B->w)
616 || ($rect_B->x >= $rect_A->x && $rect_B->x < $rect_A->x + $rect_A->w)
620 ($rect_A->y >= $rect_B->y && $rect_A->y < $rect_B->y + $rect_B->h)
621 || ($rect_B->y >= $rect_A->y && $rect_B->y < $rect_A->y + $rect_A->h)
628 my ($self, $rect) = (@_);
630 unless ($rect->isa('SDL::Rect')) {
631 croak "must receive an SDL::Rect-based object";
634 return _do_rects_intersect($self, $rect);
638 my ($self, $rects) = (@_);
640 unless (defined $rects and ref $rects eq 'ARRAY') {
641 croak "must receive an array reference of SDL::Rect-based objects";
644 for(my $i = 0; $i < @{$rects}; $i++) {
645 if ( _do_rects_intersect($self, $rects->[$i]) ) {
653 my ($self, $rects) = (@_);
655 unless (defined $rects and ref $rects eq 'ARRAY') {
656 croak "must receive an array reference of SDL::Rect-based objects";
660 for(my $i = 0; $i < @{$rects}; $i++) {
661 if ( _do_rects_intersect($self, $rects->[$i]) ) {
662 push @collisions, $i;
669 my ($self, $rects) = (@_);
671 unless (defined $rects and ref $rects eq 'HASH') {
672 croak "must receive an hash reference of SDL::Rect-based objects";
675 while ( my ($key, $value) = each %{$rects} ) {
676 unless ($value->isa('SDL::Rect')) {
677 croak "hash element of key '$key' is not an SDL::Rect-based object";
680 if ( _do_rects_intersect($self, $value) ) {
681 return ($key, $value);
684 return (undef, undef);
692 SDL::Game::Rect - SDL::Game object for storing and manipulating rectangular coordinates
699 C<< SDL::Game::Rect >> object are used to store and manipulate rectangular areas. Rect objects are created from a combination of left (or x), top (or y), width (or w) and height (or h) values, just like raw C<< SDL::Rect objects >>.
701 All C<< SDL::Game::Rect >> methods that change either position or size of a Rect return B<a new copy> of the Rect with the affected changes. The original Rect is B<not> modified. If you wish to modify the current Rect object, you can use the equivalent "in-place" methods that do not return but instead affects the original Rect. These "in-place" methods are denoted with the "ip" suffix. Note that changing a Rect's attribute is I<always> an in-place operation.
706 All Rect attributes are acessors, meaning you can get them by name, and set them by passing a value:
711 The Rect object has several attributes which can be used to resize, move and align the Rect.
716 =item * width, w - gets/sets object's width
718 =item * height, h - gets/sets object's height
720 =item * left, x - moves the object left position to match the given coordinate
722 =item * top, y - moves the object top position to match the given coordinate
724 =item * bottom - moves the object bottom position to match the given coordinate
726 =item * right - moves the object right position to match the given coordinate
728 =item * centerx - moves the object's horizontal center to match the given coordinate
730 =item * centery - moves the object's vertical center to match the given coordinate
734 Some of the attributes above can be fetched or set in pairs:
736 $rect->topleft(10, 15); # top is now 10, left is now 15
738 my ($width, $height) = $rect->size;
743 =item * size - gets/sets object's size (width, height)
745 =item * topleft - gets/sets object's top and left positions
747 =item * midleft - gets/sets object's vertical center and left positions
749 =item * bottomleft - gets/sets object's bottom and left positions
751 =item * center - gets/sets object's center (horizontal(x), vertical(y))
753 =item * topright - gets/sets object's top and right positions
755 =item * midright - gets/sets object's vertical center and right positions
757 =item * bottomright - gets/sets object's bottom and right positions
759 =item * midtop - gets/sets object's horizontal center and top positions
761 =item * midbottom - gets/sets object's horizontal center and bottom positions
768 Methods denoted as receiving Rect objects can receive either C<<SDL::Game::Rect>> or raw C<<SDL::Rect>> objects.
770 =head3 new ($left, $top, $width, $height)
772 Returns a new Rect object with the given coordinates. If any value is omitted (by passing undef), 0 is used instead.
778 Returns a new Rect object having the same position and size as the original
782 Returns a new Rect that is moved by the given offset. The x and y arguments can be any integer value, positive or negative.
786 Same as C<<move>> above, but moves the current Rect in place and returns nothing.
790 Grows or shrinks the rectangle. Returns a new Rect with the size changed by the given offset. The rectangle remains centered around its current center. Negative values will return a shrinked rectangle instead.
792 =head3 inflate_ip(x, y)
794 Same as C<<inflate>> above, but grows/shrinks the current Rect in place and returns nothing.
798 Returns a new Rect moved to be completely inside the Rect object passed as an argument. If the current Rect is too large to fit inside the passed Rect, it is centered inside it, but its size is not changed.
800 =head3 clamp_ip($rect)
802 Same as C<<clamp>> above, but moves the current Rect in place and returns nothing.
806 Returns a new Rect with the intersection between the two Rect objects, that is, returns a new Rect cropped to be completely inside the Rect object passed as an argument. If the two rectangles do not overlap to begin with, a Rect with 0 size is returned, in the original Rect's (x,y) coordinates.
808 =head3 clip_ip($rect)
810 Same as C<<clip>> above, but crops the current Rect in place and returns nothing. As the original method, the Rect becomes zero-sized if the two rectangles do not overlap to begin with, retaining its (x, y) coordinates.
814 Returns a new rectangle that completely covers the area of the current Rect and the one passed as an argument. There may be area inside the new Rect that is not covered by the originals.
816 =head3 union_ip($rect)
818 Same as C<<union>> above, but resizes the current Rect in place and returns nothing.
820 =head3 unionall( [$rect1, $rect2, ...] )
822 Returns the union of one rectangle with a sequence of many rectangles, passed as an ARRAY REF.
824 =head3 unionall_ip( [$rect1, $rect2, ...] )
826 Same as C<<unionall>> above, but resizes the current Rect in place and returns nothing.
830 Returns a new Rect moved and resized to fit the Rect object passed as an argument. The aspect ratio of the original Rect is preserved, so the new rectangle may be smaller than the target in either width or height.
834 Same as C<<fit>> above, but moves/resizes the current Rect in place and returns nothing.
838 Corrects negative sizes, flipping width/height of the Rect if they have a negative size. No repositioning is made so the rectangle will remain in the same place, but the negative sides will be swapped. This method returns nothing.
840 =head3 contains($rect)
842 Returns true (non-zero) when the argument is completely inside the Rect. Otherwise returns undef.
844 =head3 collidepoint(x, y)
846 Returns true (non-zero) if the given point is inside the Rect, otherwise returns undef. A point along the right or bottom edge is not considered to be inside the rectangle.
848 =head3 colliderect($rect)
850 Returns true (non-zero) if any portion of either rectangles overlap (except for the top+bottom or left+right edges).
852 =head3 collidelist( [$rect1, $rect2, ...] )
854 Test whether the rectangle collides with any in a sequence of rectangles, passed as an ARRAY REF. The index of the first collision found is returned. Returns undef if no collisions are found.
856 =head3 collidelistall( [$rect1, $rect2, ...] )
858 Returns an ARRAY REF of all the indices that contain rectangles that collide with the Rect. If no intersecting rectangles are found, an empty list ref is returned.
860 =head3 collidehash( {key1 => $rect1, key2 => $rect2, ...} )
862 Receives a HASH REF and returns the a (key, value) list with the key and value of the first hash item that collides with the Rect. If no collisions are found, returns (undef, undef).
864 =head3 collidehashall( {key1 => $rect1, key2 => $rect2, ...} )
866 Returns a HASH REF of all the key and value pairs that intersect with the Rect. If no collisions are found an empty hash ref is returned.
871 Breno G. de Oliveira, C<< <garu at cpan.org> >>
875 Please report any bugs or feature requests to the bug tracker. I will be notified, and then you'll automatically be notified of progress on your bug as we make changes.
880 You can find documentation for this module with the perldoc command.
882 perldoc SDL::Game::Rect
885 =head1 ACKNOWLEDGEMENTS
887 Many thanks to all SDL_Perl contributors, and to the authors of pygame.rect, in which this particular module is heavily based.
889 =head1 COPYRIGHT & LICENSE
891 Copyright 2009 Breno G. de Oliveira, all rights reserved.
893 This program is free software; you can redistribute it and/or modify it
894 under the same terms as Perl itself.
899 perl, L<SDL>, L<SDL::Rect>, L<SDL::Game>