implemented collidehashall
[sdlgit/SDL_perl.git] / lib / SDL / Game / Rect.pm
1 package SDL::Game::Rect;
2 use strict;
3 use warnings;
4 use Carp;
5 use base 'SDL::Rect';
6
7 our $VERSION = '0.01';
8
9 sub new {
10     my $class = shift;
11     my $x = shift || 0;
12     my $y = shift || 0;
13     my $w = shift || 0;
14     my $h = shift || 0;
15
16     my $self = $class->SUPER::new($x, $y, $w, $h);
17     unless ($$self) {
18         #require Carp;
19         croak SDL::GetError();
20     }
21     bless $self, $class;
22     return $self;
23 }
24
25 #############################
26 ## extra accessors
27 #############################
28 sub bottom {
29     my ($self, $val) = (@_);
30     if (defined $val) {
31         $self->top($val - $self->height); # y = val - height
32     }
33     return $self->top + $self->height; # y + height
34 }
35
36 sub right {
37     my ($self, $val) = (@_);
38     if (defined $val) {
39         $self->left($val - $self->width); # x = val - width
40     }
41     return $self->left + $self->width; # x + width
42 }
43
44 sub centerx {
45     my ($self, $val) = (@_);
46     if (defined $val) {
47         $self->left($val - ($self->width >> 1)); # x = val - (width/2)
48     }
49     return $self->left + ($self->width >> 1); # x + (width/2)
50 }
51
52 sub centery {
53     my ($self, $val) = (@_);
54     if (defined $val) {
55         $self->top($val - ($self->height >> 1)); # y = val - (height/2)
56     }
57     return $self->top + ($self->height >> 1); # y + (height/2)
58 }
59
60 sub size {
61     my ($self, $w, $h) = (@_);
62     
63     return ($self->width, $self->height)  # (width, height)
64         unless (defined $w or defined $h);
65         
66     if (defined $w) {
67         $self->width($w); # width
68     }
69     if (defined $h) {
70         $self->height($h); # height
71     }
72 }
73
74 sub topleft {
75     my ($self, $y, $x) = (@_);
76     
77     return ($self->top, $self->left) # (top, left)
78         unless (defined $y or defined $x);
79
80     if (defined $x) {
81         $self->left($x); # left
82     }
83     if (defined $y) {
84         $self->top($y); # top
85     }
86     return;
87 }
88
89 sub midleft {
90     my ($self, $centery, $x) = (@_);
91     
92     return ($self->top + ($self->height >> 1), $self->left) # (centery, left)
93         unless (defined $centery or defined $x);
94     
95     if (defined $x) {
96         $self->left($x); # left
97     }
98     if (defined $centery) {
99         $self->top($centery - ($self->height >> 1)); # y = centery - (height/2)
100     }
101     return;
102 }
103
104 sub bottomleft {
105     my ($self, $bottom, $x) = (@_);
106     
107     return ($self->top + $self->height, $self->left) # (bottom, left)
108         unless (defined $bottom or defined $x);
109
110     if (defined $x) {
111         $self->left($x); # left
112     }
113     if (defined $bottom) {
114         $self->top($bottom - $self->height); # y = bottom - height
115     }
116     return;
117 }
118
119 sub center {
120     my ($self, $centerx, $centery) = (@_);
121     
122     return ($self->left + ($self->width >> 1), $self->top + ($self->height >> 1))
123         unless (defined $centerx or defined $centery);
124
125     if (defined $centerx) {
126         $self->left($centerx - ($self->width >> 1)); # x = centerx - (width/2)        
127     }
128     if (defined $centery) {
129         $self->top($centery - ($self->height >> 1)); # y = centery - (height/2)
130     }
131     return;
132 }
133
134 sub topright {
135     my ($self, $y, $right) = (@_);
136     
137     return ($self->top, $self->left + $self->width) # (top, right)
138         unless (defined $y or defined $right);
139
140     if (defined $right) {
141         $self->left($right - $self->width); # x = right - width
142     }
143     if (defined $y) {
144         $self->top($y); # top
145     }
146     return;
147 }
148
149 sub midright {
150     my ($self, $centery, $right) = (@_);
151     
152     return ($self->top + ($self->height >> 1), $self->left + $self->width) # (centery, right)
153         unless (defined $centery or defined $right);
154     
155     if (defined $right) {
156         $self->left($right - $self->width); # x = right - width
157     }
158     if (defined $centery) {
159         $self->top($centery - ($self->height >> 1)); # y = centery - (height/2)
160     }
161     return;
162 }
163
164 sub bottomright {
165     my ($self, $bottom, $right) = (@_);
166     
167     return ($self->top + $self->height, $self->left + $self->width) # (bottom, right)
168         unless (defined $bottom or defined $right);
169
170     if (defined $right) {
171         $self->left($right - $self->width); # x = right - width
172     }
173     if (defined $bottom) {
174         $self->top($bottom - $self->height); # y = bottom - height
175     }
176     return;
177 }
178
179 sub midtop {
180     my ($self, $centerx, $y) = (@_);
181     
182     return ($self->left + ($self->width >> 1), $self->top) # (centerx, top)
183         unless (defined $centerx or defined $y);
184     
185     if (defined $y) {
186         $self->top($y); # top
187     }
188     if (defined $centerx) {
189         $self->left($centerx - ($self->width >> 1)); # x = centerx - (width/2)
190     }
191     return;
192 }
193
194 sub midbottom {
195     my ($self, $centerx, $bottom) = (@_);
196     
197     return ($self->left + ($self->width >> 1), $self->top + $self->height) # (centerx, bottom)
198         unless (defined $centerx or defined $bottom);
199     
200     if (defined $bottom) {
201         $self->top($bottom - $self->height); # y = bottom - height
202     }
203     if (defined $centerx) {
204         $self->left($centerx - ($self->width >> 1)); # x = centerx - (width/2)
205     }
206     return;    
207 }
208
209 ###############################
210 ## methods                   ##
211 ###############################
212
213 sub duplicate {
214 }
215
216 sub copy {
217     my $self = shift;
218     return $self->new(
219         -top    => $self->top,
220         -left   => $self->left,
221         -width  => $self->width,
222         -height => $self->height,
223     );
224 }
225
226 sub move {
227     my ($self, $x, $y) = (@_);
228     if (not defined $x or not defined $y) {
229         #require Carp;
230         croak "must receive x and y positions as argument";
231     }
232     return $self->new(
233         -top    => $self->top + $y,
234         -left   => $self->left + $x,
235         -width  => $self->width,
236         -height => $self->height,
237     );
238 }
239
240 sub move_ip {
241     my ($self, $x, $y) = (@_);
242     if (not defined $x or not defined $y) {
243         #require Carp;
244         croak "must receive x and y positions as argument";
245     }
246     $self->x($self->x + $x);
247     $self->y($self->y + $y);
248     
249     return;
250 }
251
252 sub inflate {
253     my ($self, $x, $y) = (@_);
254     if (not defined $x or not defined $y) {
255         #require Carp;
256         croak "must receive x and y positions as argument";
257     }
258     
259     return $self->new(
260         -left   => $self->left   - ($x / 2),
261         -top    => $self->top    - ($y / 2),
262         -width  => $self->width  + $x,
263         -height => $self->height + $y,
264     );
265 }
266
267 sub inflate_ip {
268     my ($self, $x, $y) = (@_);
269     if (not defined $x or not defined $y) {
270         #require Carp;
271         croak "must receive x and y positions as argument";
272     }
273     
274     $self->x( $self->x - ($x / 2) );
275     $self->y( $self->y - ($y / 2) );
276     
277     $self->w( $self->w + $x );
278     $self->h( $self->h + $y );
279 }
280
281 sub _get_clamp_coordinates {
282     my ($self_pos, $self_len, $rect_pos, $rect_len) = (@_);
283
284     if ($self_len >= $rect_len) {
285         return $rect_pos + ($rect_len / 2) - ($self_len / 2);
286     }
287     elsif ($self_pos < $rect_pos) {
288         return $rect_pos;
289     }
290     elsif ( ($self_pos + $self_len) > ($rect_pos + $rect_len) ) {
291         return $rect_pos + $rect_len - $self_len;
292     }
293     else {
294         return $self_pos;
295     }
296 }
297
298 sub clamp {
299     my ($self, $rect) = (@_);
300     
301     unless ($rect->isa('SDL::Rect')) {
302         croak "must receive an SDL::Rect-based object";
303     }
304
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);
307     
308     return $self->new($x, $y, $self->w, $self->h);
309 }
310
311 sub clamp_ip {
312     my ($self, $rect) = (@_);
313     
314     unless ($rect->isa('SDL::Rect')) {
315         croak "must receive an SDL::Rect-based object";
316     }
317
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);
320     
321     $self->x($x);
322     $self->y($y);
323     
324     return;
325 }
326
327 sub _get_intersection_coordinates {
328     my ($self, $rect) = (@_);
329     my ($x, $y, $w, $h);
330     
331 INTERSECTION: 
332     {
333         ### Left
334         if (($self->x >= $rect->x) && ($self->x < ($rect->x + $rect->w))) {
335             $x = $self->x;
336         }
337         elsif (($rect->x >= $self->x) && ($rect->x < ($self->x + $self->w))) {
338             $x = $rect->x;
339         }
340         else {
341             last INTERSECTION;
342         }
343
344         ## Right
345         if ((($self->x + $self->w) > $rect->x) && (($self->x + $self->w) <= ($rect->x + $rect->w))) {
346             $w = ($self->x + $self->w) - $x;
347         }
348         elsif ((($rect->x + $rect->w) > $self->x) && (($rect->x + $rect->w) <= ($self->x + $self->w))) {
349             $w = ($rect->x + $rect->w) - $x;
350         }
351         else {
352             last INTERSECTION;
353         }
354
355         ## Top
356         if (($self->y >= $rect->y) && ($self->y < ($rect->y + $rect->h))) {
357             $y = $self->y;
358         }
359         elsif (($rect->y >= $self->y) && ($rect->y < ($self->y + $self->h))) {
360             $y = $rect->y;
361         }
362         else {
363             last INTERSECTION;
364         }
365
366         ## Bottom
367         if ((($self->y + $self->h) > $rect->y) && (($self->y + $self->h) <= ($rect->y + $rect->h))) {
368             $h = ($self->y + $self->h) - $y;
369         }
370         elsif ((($rect->y + $rect->h) > $self->y) && (($rect->y + $rect->h) <= ($self->y + $self->h))) {
371             $h = ($rect->y + $rect->h) - $y;
372         }
373         else {
374             last INTERSECTION;
375         }
376
377         return ($x, $y, $w, $h);
378     }
379     
380     # if we got here, the two rects do not intersect
381     return ($self->x, $self->y, 0, 0);
382
383 }
384
385 sub clip {
386     my ($self, $rect) = (@_);
387     
388     unless ($rect->isa('SDL::Rect')) {
389         croak "must receive an SDL::Rect-based object";
390     }
391
392     my ($x, $y, $w, $h) = _get_intersection_coordinates($self, $rect);
393     
394     return $self->new($x, $y, $w, $h);
395 }
396
397 sub clip_ip {
398     my ($self, $rect) = (@_);
399     
400     unless ($rect->isa('SDL::Rect')) {
401         croak "must receive an SDL::Rect-based object";
402     }
403
404     my ($x, $y, $w, $h) = _get_intersection_coordinates($self, $rect);
405     
406     $self->x($x);
407     $self->y($y);
408     $self->w($w);
409     $self->h($h);
410     
411     return;
412 }
413
414
415 sub _test_union {
416     my ($self, $rect) = (@_);
417     my ($x, $y, $w, $h);
418
419     $x = $self->x < $rect->x ? $self->x : $rect->x;  # MIN
420     $y = $self->y < $rect->y ? $self->y : $rect->y;  # MIN
421     
422     $w = ($self->x + $self->w) > ($rect->x + $rect->w)
423        ? ($self->x + $self->w) - $x
424        : ($rect->x + $rect->w) - $x
425        ;  # MAX
426        
427     $h = ($self->y + $self->h) > ($rect->y + $rect->h)
428        ? ($self->y + $self->h) - $y
429        : ($rect->y + $rect->h) - $y
430        ;  # MAX
431
432     return ($x, $y, $w, $h);
433 }
434
435 sub union {
436     my ($self, $rect) = (@_);
437     
438     unless ($rect->isa('SDL::Rect')) {
439         croak "must receive an SDL::Rect-based object";
440     }
441     
442     my ($x, $y, $w, $h) = _test_union($self, $rect);
443     return $self->new($x, $y, $w, $h);
444 }
445
446 sub union_ip {
447     my ($self, $rect) = (@_);
448     
449     unless ($rect->isa('SDL::Rect')) {
450         croak "must receive an SDL::Rect-based object";
451     }
452     
453     my ($x, $y, $w, $h) = _test_union($self, $rect);
454     
455     $self->x($x);
456     $self->y($y);
457     $self->w($w);
458     $self->y($h);
459     
460     return;
461 }
462
463 sub _test_unionall {
464     my ($self, $rects) = (@_);
465     
466     # initial values for union rect
467     my $left   = $self->x;
468     my $top    = $self->y;
469     my $right  = $self->x + $self->w;
470     my $bottom = $self->y + $self->h;
471     
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";
477         }
478
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 
483     }
484     
485     return ($left, $top, $right - $left, $bottom - $top);
486 }
487
488 sub unionall {
489     my ($self, $rects) = (@_);
490     
491     unless (defined $rects and ref $rects eq 'ARRAY') {
492         croak "must receive an array reference of SDL::Rect-based objects";
493     }
494
495     my ($x, $y, $w, $h) = _test_unionall($self, $rects);
496     
497     return $self->new($x, $y, $w, $h);
498 }
499
500 sub unionall_ip {
501     my ($self, $rects) = (@_);
502     
503     unless (defined $rects and ref $rects eq 'ARRAY') {
504         croak "must receive an array reference of SDL::Rect-based objects";
505     }
506
507     my ($x, $y, $w, $h) = _test_unionall($self, $rects);
508     
509     $self->x($x);
510     $self->y($y);
511     $self->w($w);
512     $self->h($h);
513     
514     return;
515 }
516
517 sub _check_fit {
518     my ($self, $rect) = (@_);
519     
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;
523
524     my $w = int ($self->w / $max_ratio);
525     my $h = int ($self->h / $max_ratio);
526
527     my $x = $rect->x + int (($rect->w - $w) / 2);
528     my $y = $rect->y + int (($rect->h - $h) / 2);
529     
530     return ($x, $y, $w, $h);
531 }
532
533 sub fit {
534     my ($self, $rect) = (@_);
535     
536     unless ($rect->isa('SDL::Rect')) {
537         croak "must receive an SDL::Rect-based object";
538     }
539
540     my ($x, $y, $w, $h) = _check_fit($self, $rect);
541     
542     return $self->new ($x, $y, $w, $h);
543 }
544
545 sub fit_ip {
546     my ($self, $rect) = (@_);
547     
548     unless ($rect->isa('SDL::Rect')) {
549         croak "must receive an SDL::Rect-based object";
550     }
551
552     my ($x, $y, $w, $h) = _check_fit($self, $rect);
553     
554     $self->x($x);
555     $self->y($y);
556     $self->w($w);
557     $self->h($h);
558     
559     return;
560 }
561
562 sub normalize {
563     my $self = shift;
564     
565     if ($self->w < 0) {
566         $self->x($self->x + $self->w);
567         $self->w(-$self->w);
568     }
569     
570     if ($self->h < 0) {
571         $self->y( $self->y + $self->h);
572         $self->h(-$self->h);
573     }
574     return;
575 }
576
577 sub contains {
578     my ($self, $rect) = (@_);
579     
580     unless ($rect->isa('SDL::Rect')) {
581         croak "must receive an SDL::Rect-based object";
582     }
583     
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)
590                  ;
591                  
592     return $contained;
593 }
594
595 sub collidepoint {
596     my ($self, $x, $y) = (@_);
597
598     unless (defined $x and defined $y) {
599         croak "must receive (x,y) as arguments";
600     }
601     
602     my $inside = $x >= $self->x 
603               && $x < $self->x + $self->w 
604               && $y >= $self->y 
605               && $y < $self->y + $self->h
606               ;
607
608     return $inside;
609 }
610
611 sub _do_rects_intersect {
612     my ($rect_A, $rect_B) = (@_);
613     
614     return (
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)
617            ) 
618            &&
619            (
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)
622            )
623            ;
624 }
625
626
627 sub colliderect {
628     my ($self, $rect) = (@_);
629
630     unless ($rect->isa('SDL::Rect')) {
631         croak "must receive an SDL::Rect-based object";
632     }
633     
634     return _do_rects_intersect($self, $rect);
635 }
636
637 sub collidelist {
638     my ($self, $rects) = (@_);
639
640     unless (defined $rects and ref $rects eq 'ARRAY') {
641         croak "must receive an array reference of SDL::Rect-based objects";
642     }
643
644     for(my $i = 0; $i < @{$rects}; $i++) {
645         if ( _do_rects_intersect($self, $rects->[$i]) ) {
646             return $i;
647         }
648     }
649     return;
650 }
651
652 sub collidelistall {
653     my ($self, $rects) = (@_);
654
655     unless (defined $rects and ref $rects eq 'ARRAY') {
656         croak "must receive an array reference of SDL::Rect-based objects";
657     }
658
659     my @collisions = ();
660     for(my $i = 0; $i < @{$rects}; $i++) {
661         if ( _do_rects_intersect($self, $rects->[$i]) ) {
662             push @collisions, $i;
663         }
664     }
665     return \@collisions;
666 }
667
668 sub collidehash {
669     my ($self, $rects) = (@_);
670
671     unless (defined $rects and ref $rects eq 'HASH') {
672         croak "must receive an hash reference of SDL::Rect-based objects";
673     }
674     
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";
678         }
679         
680         if ( _do_rects_intersect($self, $value) ) {
681             return ($key, $value);
682         }
683     }
684     return (undef, undef);
685 }
686
687 sub collidehashall {
688     my ($self, $rects) = (@_);
689
690     unless (defined $rects and ref $rects eq 'HASH') {
691         croak "must receive an hash reference of SDL::Rect-based objects";
692     }
693     
694     my %collisions = ();
695     while ( my ($key, $value) = each %{$rects} ) {
696         unless ($value->isa('SDL::Rect')) {
697             croak "hash element of key '$key' is not an SDL::Rect-based object";
698         }
699         
700         if ( _do_rects_intersect($self, $value) ) {
701             $collisions{$key} = $value;
702         }
703     }
704     return \%collisions;
705 }
706
707
708 42;
709 __END__
710
711 =head1 NAME
712
713 SDL::Game::Rect - SDL::Game object for storing and manipulating rectangular coordinates
714
715 =head1 SYNOPSIS
716
717
718 =head1 DESCRIPTION
719
720 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 >>.
721
722 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.
723
724
725 =head2 ATTRIBUTES
726
727 All Rect attributes are acessors, meaning you can get them by name, and set them by passing a value:
728
729    $rect->left(15);
730    $rect->left;       # 15
731
732 The Rect object has several attributes which can be used to resize, move and align the Rect.
733
734
735 =over 4
736
737 =item * width, w - gets/sets object's width
738
739 =item * height, h - gets/sets object's height
740
741 =item * left, x - moves the object left position to match the given coordinate
742
743 =item * top, y  - moves the object top position to match the given coordinate
744
745 =item * bottom - moves the object bottom position to match the given coordinate
746
747 =item * right - moves the object right position to match the given coordinate
748
749 =item * centerx - moves the object's horizontal center to match the given coordinate
750
751 =item * centery - moves the object's vertical center to match the given coordinate
752
753 =back
754
755 Some of the attributes above can be fetched or set in pairs:
756
757   $rect->topleft(10, 15);   # top is now 10, left is now 15
758
759   my ($width, $height) = $rect->size;
760
761
762 =over 4
763
764 =item * size - gets/sets object's size (width, height)
765
766 =item * topleft - gets/sets object's top and left positions
767
768 =item * midleft - gets/sets object's vertical center and left positions
769
770 =item * bottomleft - gets/sets object's bottom and left positions
771
772 =item * center - gets/sets object's center (horizontal(x), vertical(y))
773
774 =item * topright - gets/sets object's top and right positions
775
776 =item * midright - gets/sets object's vertical center and right positions
777
778 =item * bottomright - gets/sets object's bottom and right positions
779
780 =item * midtop - gets/sets object's horizontal center and top positions
781
782 =item * midbottom - gets/sets object's horizontal center and bottom positions
783
784 =back
785
786
787 =head2 METHODS 
788
789 Methods denoted as receiving Rect objects can receive either C<<SDL::Game::Rect>> or raw C<<SDL::Rect>> objects.
790
791 =head3 new ($left, $top, $width, $height)
792
793 Returns a new Rect object with the given coordinates. If any value is omitted (by passing undef), 0 is used instead.
794
795 =head3 copy
796
797 =head3 duplicate
798
799 Returns a new Rect object having the same position and size as the original
800
801 =head3 move(x, y)
802
803 Returns a new Rect that is moved by the given offset. The x and y arguments can be any integer value, positive or negative.
804
805 =head3 move_ip(x, y)
806
807 Same as C<<move>> above, but moves the current Rect in place and returns nothing.
808
809 =head3 inflate(x, y)
810
811 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.
812
813 =head3 inflate_ip(x, y)
814
815 Same as C<<inflate>> above, but grows/shrinks the current Rect in place and returns nothing.
816
817 =head3 clamp($rect)
818
819 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.
820
821 =head3 clamp_ip($rect)
822
823 Same as C<<clamp>> above, but moves the current Rect in place and returns nothing.
824
825 =head3 clip($rect)
826
827 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.
828
829 =head3 clip_ip($rect)
830
831 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.
832
833 =head3 union($rect)
834
835 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.
836
837 =head3 union_ip($rect)
838
839 Same as C<<union>> above, but resizes the current Rect in place and returns nothing.
840
841 =head3 unionall( [$rect1, $rect2, ...] )
842
843 Returns the union of one rectangle with a sequence of many rectangles, passed as an ARRAY REF.
844
845 =head3 unionall_ip( [$rect1, $rect2, ...] )
846
847 Same as C<<unionall>> above, but resizes the current Rect in place and returns nothing.
848
849 =head3 fit($rect)
850
851 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. 
852
853 =head3 fit_ip($rect)
854
855 Same as C<<fit>> above, but moves/resizes the current Rect in place and returns nothing.
856
857 =head3 normalize
858
859 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.
860
861 =head3 contains($rect)
862
863 Returns true (non-zero) when the argument is completely inside the Rect. Otherwise returns undef.
864
865 =head3 collidepoint(x, y)
866
867 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.
868
869 =head3 colliderect($rect)
870
871 Returns true (non-zero) if any portion of either rectangles overlap (except for the top+bottom or left+right edges).
872
873 =head3 collidelist( [$rect1, $rect2, ...] )
874
875 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.
876
877 =head3 collidelistall( [$rect1, $rect2, ...] )
878
879 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. 
880
881 =head3 collidehash( {key1 => $rect1, key2 => $rect2, ...} )
882
883 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).
884
885 =head3 collidehashall( {key1 => $rect1, key2 => $rect2, ...} )
886
887 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. 
888
889
890 =head1 AUTHOR
891
892 Breno G. de Oliveira, C<< <garu at cpan.org> >>
893
894 =head1 BUGS
895
896 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.
897
898
899 =head1 SUPPORT
900
901 You can find documentation for this module with the perldoc command.
902
903     perldoc SDL::Game::Rect
904
905
906 =head1 ACKNOWLEDGEMENTS
907
908 Many thanks to all SDL_Perl contributors, and to the authors of pygame.rect, in which this particular module is heavily based.
909
910 =head1 COPYRIGHT & LICENSE
911
912 Copyright 2009 Breno G. de Oliveira, all rights reserved.
913
914 This program is free software; you can redistribute it and/or modify it
915 under the same terms as Perl itself.
916
917
918 =head1 SEE ALSO
919
920 perl, L<SDL>, L<SDL::Rect>, L<SDL::Game>