#############################
## extra accessors
#############################
+
+sub left {
+ my $self = shift;
+ $self->x(@_);
+}
+
+sub top {
+ my $self = shift;
+ $self->y(@_);
+}
+
+sub width {
+ my $self = shift;
+ $self->w(@_);
+}
+
+sub height {
+ my $self = shift;
+ $self->h(@_);
+}
+
sub bottom {
my ($self, $val) = (@_);
if (defined $val) {
## methods ##
###############################
-sub duplicate {
+{
+ no strict 'refs';
+ *{'duplicate'} = *{copy};
}
sub copy {
sub unionall {
my ($self, $rects) = (@_);
- croak "must receive an array reference of SDL::Rect-based objects"
- unless defined $rects and ref $rects eq 'ARRAY';
+ unless (defined $rects and ref $rects eq 'ARRAY') {
+ croak "must receive an array reference of SDL::Rect-based objects";
+ }
my ($x, $y, $w, $h) = _test_unionall($self, $rects);
sub unionall_ip {
my ($self, $rects) = (@_);
- croak "must receive an array reference of SDL::Rect-based objects"
- unless defined $rects and ref $rects eq 'ARRAY';
+ unless (defined $rects and ref $rects eq 'ARRAY') {
+ croak "must receive an array reference of SDL::Rect-based objects";
+ }
my ($x, $y, $w, $h) = _test_unionall($self, $rects);
return $contained;
}
+sub collidepoint {
+ my ($self, $x, $y) = (@_);
+
+ unless (defined $x and defined $y) {
+ croak "must receive (x,y) as arguments";
+ }
+
+ my $inside = $x >= $self->x
+ && $x < $self->x + $self->w
+ && $y >= $self->y
+ && $y < $self->y + $self->h
+ ;
+
+ return $inside;
+}
+
+sub _do_rects_intersect {
+ my ($rect_A, $rect_B) = (@_);
+
+ return (
+ ($rect_A->x >= $rect_B->x && $rect_A->x < $rect_B->x + $rect_B->w)
+ || ($rect_B->x >= $rect_A->x && $rect_B->x < $rect_A->x + $rect_A->w)
+ )
+ &&
+ (
+ ($rect_A->y >= $rect_B->y && $rect_A->y < $rect_B->y + $rect_B->h)
+ || ($rect_B->y >= $rect_A->y && $rect_B->y < $rect_A->y + $rect_A->h)
+ )
+ ;
+}
+
+
+sub colliderect {
+ my ($self, $rect) = (@_);
+
+ unless ($rect->isa('SDL::Rect')) {
+ croak "must receive an SDL::Rect-based object";
+ }
+
+ return _do_rects_intersect($self, $rect);
+}
+
+sub collidelist {
+ my ($self, $rects) = (@_);
+
+ unless (defined $rects and ref $rects eq 'ARRAY') {
+ croak "must receive an array reference of SDL::Rect-based objects";
+ }
+
+ for(my $i = 0; $i < @{$rects}; $i++) {
+ if ( _do_rects_intersect($self, $rects->[$i]) ) {
+ return $i;
+ }
+ }
+ return;
+}
+
+sub collidelistall {
+ my ($self, $rects) = (@_);
+
+ unless (defined $rects and ref $rects eq 'ARRAY') {
+ croak "must receive an array reference of SDL::Rect-based objects";
+ }
+
+ my @collisions = ();
+ for(my $i = 0; $i < @{$rects}; $i++) {
+ if ( _do_rects_intersect($self, $rects->[$i]) ) {
+ push @collisions, $i;
+ }
+ }
+ return \@collisions;
+}
+
+sub collidehash {
+ my ($self, $rects) = (@_);
+
+ unless (defined $rects and ref $rects eq 'HASH') {
+ croak "must receive an hash reference of SDL::Rect-based objects";
+ }
+
+ while ( my ($key, $value) = each %{$rects} ) {
+ unless ($value->isa('SDL::Rect')) {
+ croak "hash element of key '$key' is not an SDL::Rect-based object";
+ }
+
+ if ( _do_rects_intersect($self, $value) ) {
+ return ($key, $value);
+ }
+ }
+ return (undef, undef);
+}
+
+sub collidehashall {
+ my ($self, $rects) = (@_);
+
+ unless (defined $rects and ref $rects eq 'HASH') {
+ croak "must receive an hash reference of SDL::Rect-based objects";
+ }
+
+ my %collisions = ();
+ while ( my ($key, $value) = each %{$rects} ) {
+ unless ($value->isa('SDL::Rect')) {
+ croak "hash element of key '$key' is not an SDL::Rect-based object";
+ }
+
+ if ( _do_rects_intersect($self, $value) ) {
+ $collisions{$key} = $value;
+ }
+ }
+ return \%collisions;
+}
+
+
42;
__END__