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