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 42;
 688 __END__
 689
 690 =head1 NAME
 691
 692 SDL::Game::Rect - SDL::Game object for storing and manipulating rectangular coordinates
 693
 694 =head1 SYNOPSIS
 695
 696
 697 =head1 DESCRIPTION
 698
 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 >>.
 700
 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.
 702
 703
 704 =head2 ATTRIBUTES
 705
 706 All Rect attributes are acessors, meaning you can get them by name, and set them by passing a value:
 707
 708    $rect->left(15);
 709    $rect->left;       # 15
 710
 711 The Rect object has several attributes which can be used to resize, move and align the Rect.
 712
 713
 714 =over 4
 715
 716 =item * width, w - gets/sets object's width
 717
 718 =item * height, h - gets/sets object's height
 719
 720 =item * left, x - moves the object left position to match the given coordinate
 721
 722 =item * top, y  - moves the object top position to match the given coordinate
 723
 724 =item * bottom - moves the object bottom position to match the given coordinate
 725
 726 =item * right - moves the object right position to match the given coordinate
 727
 728 =item * centerx - moves the object's horizontal center to match the given coordinate
 729
 730 =item * centery - moves the object's vertical center to match the given coordinate
 731
 732 =back
 733
 734 Some of the attributes above can be fetched or set in pairs:
 735
 736   $rect->topleft(10, 15);   # top is now 10, left is now 15
 737
 738   my ($width, $height) = $rect->size;
 739
 740
 741 =over 4
 742
 743 =item * size - gets/sets object's size (width, height)
 744
 745 =item * topleft - gets/sets object's top and left positions
 746
 747 =item * midleft - gets/sets object's vertical center and left positions
 748
 749 =item * bottomleft - gets/sets object's bottom and left positions
 750
 751 =item * center - gets/sets object's center (horizontal(x), vertical(y))
 752
 753 =item * topright - gets/sets object's top and right positions
 754
 755 =item * midright - gets/sets object's vertical center and right positions
 756
 757 =item * bottomright - gets/sets object's bottom and right positions
 758
 759 =item * midtop - gets/sets object's horizontal center and top positions
 760
 761 =item * midbottom - gets/sets object's horizontal center and bottom positions
 762
 763 =back
 764
 765
 766 =head2 METHODS
 767
 768 Methods denoted as receiving Rect objects can receive either C<<SDL::Game::Rect>> or raw C<<SDL::Rect>> objects.
 769
 770 =head3 new ($left, $top, $width, $height)
 771
 772 Returns a new Rect object with the given coordinates. If any value is omitted (by passing undef), 0 is used instead.
 773
 774 =head3 copy
 775
 776 =head3 duplicate
 777
 778 Returns a new Rect object having the same position and size as the original
 779
 780 =head3 move(x, y)
 781
 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.
 783
 784 =head3 move_ip(x, y)
 785
 786 Same as C<<move>> above, but moves the current Rect in place and returns nothing.
 787
 788 =head3 inflate(x, y)
 789
 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.
 791
 792 =head3 inflate_ip(x, y)
 793
 794 Same as C<<inflate>> above, but grows/shrinks the current Rect in place and returns nothing.
 795
 796 =head3 clamp($rect)
 797
 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.
 799
 800 =head3 clamp_ip($rect)
 801
 802 Same as C<<clamp>> above, but moves the current Rect in place and returns nothing.
 803
 804 =head3 clip($rect)
 805
 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.
 807
 808 =head3 clip_ip($rect)
 809
 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.
 811
 812 =head3 union($rect)
 813
 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.
 815
 816 =head3 union_ip($rect)
 817
 818 Same as C<<union>> above, but resizes the current Rect in place and returns nothing.
 819
 820 =head3 unionall( [$rect1, $rect2, ...] )
 821
 822 Returns the union of one rectangle with a sequence of many rectangles, passed as an ARRAY REF.
 823
 824 =head3 unionall_ip( [$rect1, $rect2, ...] )
 825
 826 Same as C<<unionall>> above, but resizes the current Rect in place and returns nothing.
 827
 828 =head3 fit($rect)
 829
 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.
 831
 832 =head3 fit_ip($rect)
 833
 834 Same as C<<fit>> above, but moves/resizes the current Rect in place and returns nothing.
 835
 836 =head3 normalize
 837
 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.
 839
 840 =head3 contains($rect)
 841
 842 Returns true (non-zero) when the argument is completely inside the Rect. Otherwise returns undef.
 843
 844 =head3 collidepoint(x, y)
 845
 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.
 847
 848 =head3 colliderect($rect)
 849
 850 Returns true (non-zero) if any portion of either rectangles overlap (except for the top+bottom or left+right edges).
 851
 852 =head3 collidelist( [$rect1, $rect2, ...] )
 853
 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.
 855
 856 =head3 collidelistall( [$rect1, $rect2, ...] )
 857
 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.
 859
 860 =head3 collidehash( {key1 => $rect1, key2 => $rect2, ...} )
 861
 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).
 863
 864 =head3 collidehashall( {key1 => $rect1, key2 => $rect2, ...} )
 865
 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.
 867
 868
 869 =head1 AUTHOR
 870
 871 Breno G. de Oliveira, C<< <garu at cpan.org> >>
 872
 873 =head1 BUGS
 874
 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.
 876
 877
 878 =head1 SUPPORT
 879
 880 You can find documentation for this module with the perldoc command.
 881
 882     perldoc SDL::Game::Rect
 883
 884
 885 =head1 ACKNOWLEDGEMENTS
 886
 887 Many thanks to all SDL_Perl contributors, and to the authors of pygame.rect, in which this particular module is heavily based.
 888
 889 =head1 COPYRIGHT & LICENSE
 890
 891 Copyright 2009 Breno G. de Oliveira, all rights reserved.
 892
 893 This program is free software; you can redistribute it and/or modify it
 894 under the same terms as Perl itself.
 895
 896
 897 =head1 SEE ALSO
 898
 899 perl, L<SDL>, L<SDL::Rect>, L<SDL::Game>