lib/SDL/Game/Rect.pm

   1 package SDL::Game::Rect;
   2 use strict;
   3 use warnings;
   4
   5 use Class::XSAccessor::Array
   6  accessors => {
   7       x      => 0,
   8       left   => 0,
   9       y      => 1,
  10       top    => 1,
  11       width  => 2,
  12       w      => 2,
  13       height => 3,
  14       h      => 3,
  15  };
  16
  17
  18 our $VERSION = '0.01';
  19
  20 sub new {
  21     my $class = shift;
  22     my ($x, $y, $w, $h) = (@_);
  23     return bless [$x || 0, $y || 0, $w || 0, $h || 0], ref($class) || $class;
  24 }
  25
  26 #############################
  27 ## extra accessors
  28 #############################
  29 sub bottom {
  30     my ($self, $val) = (@_);
  31     if (defined $val) {
  32         $self->[1] = $val - $self->[3]; # y = val - height
  33     }
  34     return $self->[1] + $self->[3]; # y + height
  35 }
  36
  37 sub right {
  38     my ($self, $val) = (@_);
  39     if (defined $val) {
  40         $self->[0] = $val - $self->[2]; # x = val - width
  41     }
  42     return $self->[0] + $self->[2]; # x + width
  43 }
  44
  45 sub centerx {
  46     my ($self, $val) = (@_);
  47     if (defined $val) {
  48         $self->[0] = $val - ($self->[2] >> 1); # x = val - (width/2)
  49     }
  50     return $self->[0] + ($self->[2] >> 1); # x + (width/2)
  51 }
  52
  53 sub centery {
  54     my ($self, $val) = (@_);
  55     if (defined $val) {
  56         $self->[1] = $val - ($self->[3] >> 1); # y = val - (height/2)
  57     }
  58     return $self->[1] + ($self->[3] >> 1); # y + (height/2)
  59 }
  60
  61 sub size {
  62     my ($self, $w, $h) = (@_);
  63
  64     return ($self->[2], $self->[3])  # (width, height)
  65         unless (defined $w or defined $h);
  66
  67     if (defined $w) {
  68         $self->[2] = $w; # width
  69     }
  70     if (defined $h) {
  71         $self->[3] = $h; # height
  72     }
  73 }
  74
  75 sub topleft {
  76     my ($self, $y, $x) = (@_);
  77
  78     return ($self->[1], $self->[0]) # (top, left)
  79         unless (defined $y or defined $x);
  80
  81     if (defined $x) {
  82         $self->[0] = $x; # left
  83     }
  84     if (defined $y) {
  85         $self->[1] = $y; # top
  86     }
  87     return;
  88 }
  89
  90 sub midleft {
  91     my ($self, $centery, $x) = (@_);
  92
  93     return ($self->[1] + ($self->[3] >> 1), $self->[0]) # (centery, left)
  94         unless (defined $centery or defined $x);
  95
  96     if (defined $x) {
  97         $self->[0] = $x; # left
  98     }
  99     if (defined $centery) {
 100         $self->[1] = $centery - ($self->[3] >> 1); # y = centery - (height/2)
 101     }
 102     return;
 103 }
 104
 105 sub bottomleft {
 106     my ($self, $bottom, $x) = (@_);
 107
 108     return ($self->[1] + $self->[3], $self->[0]) # (bottom, left)
 109         unless (defined $bottom or defined $x);
 110
 111     if (defined $x) {
 112         $self->[0] = $x; # left
 113     }
 114     if (defined $bottom) {
 115         $self->[1] = $bottom - $self->[3]; # y = bottom - height
 116     }
 117     return;
 118 }
 119
 120 sub center {
 121     my ($self, $centerx, $centery) = (@_);
 122
 123     return ($self->[0] + ($self->[2] >> 1), $self->[1] + ($self->[3] >> 1))
 124         unless (defined $centerx or defined $centery);
 125
 126     if (defined $centerx) {
 127         $self->[0] = $centerx - ($self->[2] >> 1); # x = centerx - (width/2)
 128     }
 129     if (defined $centery) {
 130         $self->[1] = $centery - ($self->[3] >> 1); # y = centery - (height/2)
 131     }
 132     return;
 133 }
 134
 135 sub topright {
 136     my ($self, $y, $right) = (@_);
 137
 138     return ($self->[1], $self->[0] + $self->[2]) # (top, right)
 139         unless (defined $y or defined $right);
 140
 141     if (defined $right) {
 142         $self->[0] = $right - $self->[2]; # x = right - width
 143     }
 144     if (defined $y) {
 145         $self->[1] = $y; # top
 146     }
 147     return;
 148 }
 149
 150 sub midright {
 151     my ($self, $centery, $right) = (@_);
 152
 153     return ($self->[1] + ($self->[3] >> 1), $self->[0] + $self->[2]) # (centery, right)
 154         unless (defined $centery or defined $right);
 155
 156     if (defined $right) {
 157         $self->[0] = $right - $self->[2]; # x = right - width
 158     }
 159     if (defined $centery) {
 160         $self->[1] = $centery - ($self->[3] >> 1); # y = centery - (height/2)
 161     }
 162     return;
 163 }
 164
 165 sub bottomright {
 166     my ($self, $bottom, $right) = (@_);
 167
 168     return ($self->[1] + $self->[3], $self->[0] + $self->[2]) # (bottom, right)
 169         unless (defined $bottom or defined $right);
 170
 171     if (defined $right) {
 172         $self->[0] = $right - $self->[2]; # x = right - width
 173     }
 174     if (defined $bottom) {
 175         $self->[1] = $bottom - $self->[3]; # y = bottom - height
 176     }
 177     return;
 178 }
 179
 180 sub midtop {
 181     my ($self, $centerx, $y) = (@_);
 182
 183     return ($self->[0] + ($self->[2] >> 1), $self->[1]) # (centerx, top)
 184         unless (defined $centerx or defined $y);
 185
 186     if (defined $y) {
 187         $self->[1] = $y; # top
 188     }
 189     if (defined $centerx) {
 190         $self->[0] = $centerx - ($self->[2] >> 1); # x = centerx - (width/2)
 191     }
 192     return;
 193 }
 194
 195 sub midbottom {
 196     my ($self, $centerx, $bottom) = (@_);
 197
 198     return ($self->[0] + ($self->[2] >> 1), $self->[1] + $self->[3]) # (centerx, bottom)
 199         unless (defined $centerx or defined $bottom);
 200
 201     if (defined $bottom) {
 202         $self->[1] = $bottom - $self->[3]; # y = bottom - height
 203     }
 204     if (defined $centerx) {
 205         $self->[0] = $centerx - ($self->[2] >> 1); # x = centerx - (width/2)
 206     }
 207     return;
 208 }
 209
 210
 211 42;
 212 __END__
 213
 214 =head1 NAME
 215
 216 SDL::Game::Rect - SDL::Game object for storing and manipulating rectangular coordinates
 217
 218 =head1 SYNOPSIS
 219
 220
 221 =head1 DESCRIPTION
 222
 223 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 >>.
 224
 225 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.
 226
 227
 228 =head2 ATTRIBUTES
 229
 230 All Rect attributes are acessors, meaning you can get them by name, and set them by passing a value:
 231
 232    $rect->left(15);
 233    $rect->left;       # 15
 234
 235 The Rect object has several attributes which can be used to resize, move and align the Rect.
 236
 237
 238 =over 4
 239
 240 =item * width, w - gets/sets object's width
 241
 242 =item * height, h - gets/sets object's height
 243
 244 =item * left, x - moves the object left position to match the given coordinate
 245
 246 =item * top, y  - moves the object top position to match the given coordinate
 247
 248 =item * bottom - moves the object bottom position to match the given coordinate
 249
 250 =item * right - moves the object right position to match the given coordinate
 251
 252 =item * centerx - moves the object's horizontal center to match the given coordinate
 253
 254 =item * centery - moves the object's vertical center to match the given coordinate
 255
 256 =back
 257
 258 Some of the attributes above can be fetched or set in pairs:
 259
 260   $rect->topleft(10, 15);   # top is now 10, left is now 15
 261
 262   my ($width, $height) = $rect->size;
 263
 264
 265 =over 4
 266
 267 =item * size - gets/sets object's size (width, height)
 268
 269 =item * topleft - gets/sets object's top and left positions
 270
 271 =item * midleft - gets/sets object's vertical center and left positions
 272
 273 =item * bottomleft - gets/sets object's bottom and left positions
 274
 275 =item * center - gets/sets object's center (horizontal(x), vertical(y))
 276
 277 =item * topright - gets/sets object's top and right positions
 278
 279 =item * midright - gets/sets object's vertical center and right positions
 280
 281 =item * bottomright - gets/sets object's bottom and right positions
 282
 283 =item * midtop - gets/sets object's horizontal center and top positions
 284
 285 =item * midbottom - gets/sets object's horizontal center and bottom positions
 286
 287 =back
 288
 289
 290 =head2 METHODS
 291
 292 Methods denoted as receiving Rect objects can receive either C<<SDL::Game::Rect>> or raw C<<SDL::Rect>> objects.
 293
 294 =head3 new ($left, $top, $width, $height)
 295
 296 Returns a new Rect object with the given coordinates. If any value is omitted (by passing undef), 0 is used instead.
 297
 298 =head3 copy
 299
 300 =head3 duplicate
 301
 302 Returns a new Rect object having the same position and size as the original
 303
 304 =head3 move(x, y)
 305
 306 Returns a new Rect that is moved by the given offset. The x and y arguments can be any integer value, positive or negative.
 307
 308 =head3 move_ip(x, y)
 309
 310 Same as C<<move>> above, but moves the current Rect in place and returns nothing.
 311
 312 =head3 inflate(x, y)
 313
 314 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.
 315
 316 =head3 inflate_ip(x, y)
 317
 318 Same as C<<inflate>> above, but grows/shrinks the current Rect in place and returns nothing.
 319
 320 =head3 clamp($rect)
 321
 322 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.
 323
 324 =head3 clamp_ip($rect)
 325
 326 Same as C<<clamp>> above, but moves the current Rect in place and returns nothing.
 327
 328 =head3 clip($rect)
 329
 330 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.
 331
 332 =head3 clip_ip($rect)
 333
 334 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.
 335
 336 =head3 union($rect)
 337
 338 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.
 339
 340 =head3 union_ip($rect)
 341
 342 Same as C<<union>> above, but resizes the current Rect in place and returns nothing.
 343
 344 =head3 unionall( [$rect1, $rect2, ...] )
 345
 346 Returns the union of one rectangle with a sequence of many rectangles, passed as an ARRAY REF.
 347
 348 =head3 unionall_ip( [$rect1, $rect2, ...] )
 349
 350 Same as C<<unionall>> above, but resizes the current Rect in place and returns nothing.
 351
 352 =head3 fit($rect)
 353
 354 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.
 355
 356 =head3 fit_ip($rect)
 357
 358 Same as C<<fit>> above, but moves/resizes the current Rect in place and returns nothing.
 359
 360 =head3 normalize
 361
 362 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.
 363
 364 =head3 contains($rect)
 365
 366 Returns true (non-zero) when the argument is completely inside the Rect. Otherwise returns undef.
 367
 368 =head3 collidepoint(x, y)
 369
 370 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.
 371
 372 =head3 colliderect($rect)
 373
 374 Returns true (non-zero) if any portion of either rectangles overlap (except for the top+bottom or left+right edges).
 375
 376 =head3 collidelist( [$rect1, $rect2, ...] )
 377
 378 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.
 379
 380 =head3 collidelistall( [$rect1, $rect2, ...] )
 381
 382 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.
 383
 384 =head3 collidehash( {key1 => $rect1, key2 => $rect2, ...} )
 385
 386 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).
 387
 388 =head3 collidehashall( {key1 => $rect1, key2 => $rect2, ...} )
 389
 390 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.
 391
 392
 393 =head1 AUTHOR
 394
 395 Breno G. de Oliveira, C<< <garu at cpan.org> >>
 396
 397 =head1 BUGS
 398
 399 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.
 400
 401
 402 =head1 SUPPORT
 403
 404 You can find documentation for this module with the perldoc command.
 405
 406     perldoc SDL::Game::Rect
 407
 408
 409 =head1 ACKNOWLEDGEMENTS
 410
 411 Many thanks to all SDL_Perl contributors, and to the authors of pygame.rect, in which this particular module is heavily based.
 412
 413 =head1 COPYRIGHT & LICENSE
 414
 415 Copyright 2009 Breno G. de Oliveira, all rights reserved.
 416
 417 This program is free software; you can redistribute it and/or modify it
 418 under the same terms as Perl itself.
 419
 420
 421 =head1 SEE ALSO
 422
 423 perl, L<SDL>, L<SDL::Rect>, L<SDL::Game>