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 42;
 211 __END__
 212
 213 =head1 NAME
 214
 215 SDL::Game::Rect - SDL::Game object for storing and manipulating rectangular coordinates
 216
 217 =head1 SYNOPSIS
 218
 219
 220 =head1 DESCRIPTION
 221
 222 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 >>.
 223
 224 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.
 225
 226
 227 =head2 ATTRIBUTES
 228
 229 All Rect attributes are acessors, meaning you can get them by name, and set them by passing a value:
 230
 231    $rect->left(15);
 232    $rect->left;       # 15
 233
 234 The Rect object has several attributes which can be used to resize, move and align the Rect.
 235
 236
 237 =over 4
 238
 239 =item * width, w - gets/sets object's width
 240
 241 =item * height, h - gets/sets object's height
 242
 243 =item * left, x - moves the object left position to match the given coordinate
 244
 245 =item * top, y  - moves the object top position to match the given coordinate
 246
 247 =item * bottom - moves the object bottom position to match the given coordinate
 248
 249 =item * right - moves the object right position to match the given coordinate
 250
 251 =item * centerx - moves the object's horizontal center to match the given coordinate
 252
 253 =item * centery - moves the object's vertical center to match the given coordinate
 254
 255 =back
 256
 257 Some of the attributes above can be fetched or set in pairs:
 258
 259   $rect->topleft(10, 15);   # top is now 10, left is now 15
 260
 261   my ($width, $height) = $rect->size;
 262
 263
 264 =over 4
 265
 266 =item * size - gets/sets object's size (width, height)
 267
 268 =item * topleft - gets/sets object's top and left positions
 269
 270 =item * midleft - gets/sets object's vertical center and left positions
 271
 272 =item * bottomleft - gets/sets object's bottom and left positions
 273
 274 =item * center - gets/sets object's center (horizontal(x), vertical(y))
 275
 276 =item * topright - gets/sets object's top and right positions
 277
 278 =item * midright - gets/sets object's vertical center and right positions
 279
 280 =item * bottomright - gets/sets object's bottom and right positions
 281
 282 =item * midtop - gets/sets object's horizontal center and top positions
 283
 284 =item * midbottom - gets/sets object's horizontal center and bottom positions
 285
 286 =back
 287
 288
 289 =head2 METHODS
 290
 291 Methods denoted as receiving Rect objects can receive either C<<SDL::Game::Rect>> or raw C<<SDL::Rect>> objects.
 292
 293 =head3 new ($left, $top, $width, $height)
 294
 295 Returns a new Rect object with the given coordinates. If any value is omitted (by passing undef), 0 is used instead.
 296
 297 =head3 copy
 298
 299 =head3 duplicate
 300
 301 Returns a new Rect object having the same position and size as the original
 302
 303 =head3 move(x, y)
 304
 305 Returns a new Rect that is moved by the given offset. The x and y arguments can be any integer value, positive or negative.
 306
 307 =head3 move_ip(x, y)
 308
 309 Same as C<<move>> above, but moves the current Rect in place and returns nothing.
 310
 311 =head3 inflate(x, y)
 312
 313 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.
 314
 315 =head3 inflate_ip(x, y)
 316
 317 Same as C<<inflate>> above, but grows/shrinks the current Rect in place and returns nothing.
 318
 319 =head3 clamp($rect)
 320
 321 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.
 322
 323 =head3 clamp_ip($rect)
 324
 325 Same as C<<clamp>> above, but moves the current Rect in place and returns nothing.
 326
 327 =head3 clip($rect)
 328
 329 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.
 330
 331 =head3 clip_ip($rect)
 332
 333 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.
 334
 335 =head3 union($rect)
 336
 337 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.
 338
 339 =head3 union_ip($rect)
 340
 341 Same as C<<union>> above, but resizes the current Rect in place and returns nothing.
 342
 343 =head3 unionall( [$rect1, $rect2, ...] )
 344
 345 Returns the union of one rectangle with a sequence of many rectangles, passed as an ARRAY REF.
 346
 347 =head3 unionall_ip( [$rect1, $rect2, ...] )
 348
 349 Same as C<<unionall>> above, but resizes the current Rect in place and returns nothing.
 350
 351 =head3 fit($rect)
 352
 353 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.
 354
 355 =head3 fit_ip($rect)
 356
 357 Same as C<<fit>> above, but moves/resizes the current Rect in place and returns nothing.
 358
 359 =head3 normalize
 360
 361 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.
 362
 363 =head3 contains($rect)
 364
 365 Returns true (non-zero) when the argument is completely inside the Rect. Otherwise returns undef.
 366
 367 =head3 collidepoint(x, y)
 368
 369 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.
 370
 371 =head3 colliderect($rect)
 372
 373 Returns true (non-zero) if any portion of either rectangles overlap (except for the top+bottom or left+right edges).
 374
 375 =head3 collidelist( [$rect1, $rect2, ...] )
 376
 377 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.
 378
 379 =head3 collidelistall( [$rect1, $rect2, ...] )
 380
 381 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.
 382
 383 =head3 collidehash( {key1 => $rect1, key2 => $rect2, ...} )
 384
 385 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).
 386
 387 =head3 collidehashall( {key1 => $rect1, key2 => $rect2, ...} )
 388
 389 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.
 390
 391
 392 =head1 AUTHOR
 393
 394 Breno G. de Oliveira, C<< <garu at cpan.org> >>
 395
 396 =head1 BUGS
 397
 398 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.
 399
 400
 401 =head1 SUPPORT
 402
 403 You can find documentation for this module with the perldoc command.
 404
 405     perldoc SDL::Game::Rect
 406
 407
 408 =head1 ACKNOWLEDGEMENTS
 409
 410 Many thanks to all SDL_Perl contributors, and to the authors of pygame.rect, in which this particular module is heavily based.
 411
 412 =head1 COPYRIGHT & LICENSE
 413
 414 Copyright 2009 Breno G. de Oliveira, all rights reserved.
 415
 416 This program is free software; you can redistribute it and/or modify it
 417 under the same terms as Perl itself.
 418
 419
 420 =head1 SEE ALSO
 421
 422 perl, L<SDL>, L<SDL::Rect>, L<SDL::Game>