lib/SDL/Game/Rect.pm

   1 package SDL::Game::Rect;
   2 use strict;
   3 use warnings;
   4
   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         Carp::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         Carp::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         Carp::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         Carp::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         Carp::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
 282 42;
 283 __END__
 284
 285 =head1 NAME
 286
 287 SDL::Game::Rect - SDL::Game object for storing and manipulating rectangular coordinates
 288
 289 =head1 SYNOPSIS
 290
 291
 292 =head1 DESCRIPTION
 293
 294 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 >>.
 295
 296 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.
 297
 298
 299 =head2 ATTRIBUTES
 300
 301 All Rect attributes are acessors, meaning you can get them by name, and set them by passing a value:
 302
 303    $rect->left(15);
 304    $rect->left;       # 15
 305
 306 The Rect object has several attributes which can be used to resize, move and align the Rect.
 307
 308
 309 =over 4
 310
 311 =item * width, w - gets/sets object's width
 312
 313 =item * height, h - gets/sets object's height
 314
 315 =item * left, x - moves the object left position to match the given coordinate
 316
 317 =item * top, y  - moves the object top position to match the given coordinate
 318
 319 =item * bottom - moves the object bottom position to match the given coordinate
 320
 321 =item * right - moves the object right position to match the given coordinate
 322
 323 =item * centerx - moves the object's horizontal center to match the given coordinate
 324
 325 =item * centery - moves the object's vertical center to match the given coordinate
 326
 327 =back
 328
 329 Some of the attributes above can be fetched or set in pairs:
 330
 331   $rect->topleft(10, 15);   # top is now 10, left is now 15
 332
 333   my ($width, $height) = $rect->size;
 334
 335
 336 =over 4
 337
 338 =item * size - gets/sets object's size (width, height)
 339
 340 =item * topleft - gets/sets object's top and left positions
 341
 342 =item * midleft - gets/sets object's vertical center and left positions
 343
 344 =item * bottomleft - gets/sets object's bottom and left positions
 345
 346 =item * center - gets/sets object's center (horizontal(x), vertical(y))
 347
 348 =item * topright - gets/sets object's top and right positions
 349
 350 =item * midright - gets/sets object's vertical center and right positions
 351
 352 =item * bottomright - gets/sets object's bottom and right positions
 353
 354 =item * midtop - gets/sets object's horizontal center and top positions
 355
 356 =item * midbottom - gets/sets object's horizontal center and bottom positions
 357
 358 =back
 359
 360
 361 =head2 METHODS
 362
 363 Methods denoted as receiving Rect objects can receive either C<<SDL::Game::Rect>> or raw C<<SDL::Rect>> objects.
 364
 365 =head3 new ($left, $top, $width, $height)
 366
 367 Returns a new Rect object with the given coordinates. If any value is omitted (by passing undef), 0 is used instead.
 368
 369 =head3 copy
 370
 371 =head3 duplicate
 372
 373 Returns a new Rect object having the same position and size as the original
 374
 375 =head3 move(x, y)
 376
 377 Returns a new Rect that is moved by the given offset. The x and y arguments can be any integer value, positive or negative.
 378
 379 =head3 move_ip(x, y)
 380
 381 Same as C<<move>> above, but moves the current Rect in place and returns nothing.
 382
 383 =head3 inflate(x, y)
 384
 385 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.
 386
 387 =head3 inflate_ip(x, y)
 388
 389 Same as C<<inflate>> above, but grows/shrinks the current Rect in place and returns nothing.
 390
 391 =head3 clamp($rect)
 392
 393 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.
 394
 395 =head3 clamp_ip($rect)
 396
 397 Same as C<<clamp>> above, but moves the current Rect in place and returns nothing.
 398
 399 =head3 clip($rect)
 400
 401 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.
 402
 403 =head3 clip_ip($rect)
 404
 405 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.
 406
 407 =head3 union($rect)
 408
 409 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.
 410
 411 =head3 union_ip($rect)
 412
 413 Same as C<<union>> above, but resizes the current Rect in place and returns nothing.
 414
 415 =head3 unionall( [$rect1, $rect2, ...] )
 416
 417 Returns the union of one rectangle with a sequence of many rectangles, passed as an ARRAY REF.
 418
 419 =head3 unionall_ip( [$rect1, $rect2, ...] )
 420
 421 Same as C<<unionall>> above, but resizes the current Rect in place and returns nothing.
 422
 423 =head3 fit($rect)
 424
 425 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.
 426
 427 =head3 fit_ip($rect)
 428
 429 Same as C<<fit>> above, but moves/resizes the current Rect in place and returns nothing.
 430
 431 =head3 normalize
 432
 433 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.
 434
 435 =head3 contains($rect)
 436
 437 Returns true (non-zero) when the argument is completely inside the Rect. Otherwise returns undef.
 438
 439 =head3 collidepoint(x, y)
 440
 441 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.
 442
 443 =head3 colliderect($rect)
 444
 445 Returns true (non-zero) if any portion of either rectangles overlap (except for the top+bottom or left+right edges).
 446
 447 =head3 collidelist( [$rect1, $rect2, ...] )
 448
 449 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.
 450
 451 =head3 collidelistall( [$rect1, $rect2, ...] )
 452
 453 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.
 454
 455 =head3 collidehash( {key1 => $rect1, key2 => $rect2, ...} )
 456
 457 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).
 458
 459 =head3 collidehashall( {key1 => $rect1, key2 => $rect2, ...} )
 460
 461 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.
 462
 463
 464 =head1 AUTHOR
 465
 466 Breno G. de Oliveira, C<< <garu at cpan.org> >>
 467
 468 =head1 BUGS
 469
 470 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.
 471
 472
 473 =head1 SUPPORT
 474
 475 You can find documentation for this module with the perldoc command.
 476
 477     perldoc SDL::Game::Rect
 478
 479
 480 =head1 ACKNOWLEDGEMENTS
 481
 482 Many thanks to all SDL_Perl contributors, and to the authors of pygame.rect, in which this particular module is heavily based.
 483
 484 =head1 COPYRIGHT & LICENSE
 485
 486 Copyright 2009 Breno G. de Oliveira, all rights reserved.
 487
 488 This program is free software; you can redistribute it and/or modify it
 489 under the same terms as Perl itself.
 490
 491
 492 =head1 SEE ALSO
 493
 494 perl, L<SDL>, L<SDL::Rect>, L<SDL::Game>