X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSDL%2FGame%2FRect.pm;h=a552f756c7962950a0f7b6aa62472bc5976b52d5;hb=50d0e9aca27e76457937927dd6ead320674bbe22;hp=b3070d74e260f542fdb2a26ed3f3c5ccb19c5ca9;hpb=71854fd9905f17049619e6738b2a97b2cd39dca2;p=sdlgit%2FSDL_perl.git diff --git a/lib/SDL/Game/Rect.pm b/lib/SDL/Game/Rect.pm index b3070d7..a552f75 100644 --- a/lib/SDL/Game/Rect.pm +++ b/lib/SDL/Game/Rect.pm @@ -512,6 +512,126 @@ sub unionall_ip { return; } +sub _check_fit { + my ($self, $rect) = (@_); + + my $x_ratio = $self->w / $rect->w; + my $y_ratio = $self->h / $rect->h; + my $max_ratio = ($x_ratio > $y_ratio) ? $x_ratio : $y_ratio; + + my $w = int ($self->w / $max_ratio); + my $h = int ($self->h / $max_ratio); + + my $x = $rect->x + int (($rect->w - $w) / 2); + my $y = $rect->y + int (($rect->h - $h) / 2); + + return ($x, $y, $w, $h); +} + +sub fit { + my ($self, $rect) = (@_); + + unless ($rect->isa('SDL::Rect')) { + croak "must receive an SDL::Rect-based object"; + } + + my ($x, $y, $w, $h) = _check_fit($self, $rect); + + return $self->new ($x, $y, $w, $h); +} + +sub fit_ip { + my ($self, $rect) = (@_); + + unless ($rect->isa('SDL::Rect')) { + croak "must receive an SDL::Rect-based object"; + } + + my ($x, $y, $w, $h) = _check_fit($self, $rect); + + $self->x($x); + $self->y($y); + $self->w($w); + $self->h($h); + + return; +} + +sub normalize { + my $self = shift; + + if ($self->w < 0) { + $self->x($self->x + $self->w); + $self->w(-$self->w); + } + + if ($self->h < 0) { + $self->y( $self->y + $self->h); + $self->h(-$self->h); + } + return; +} + +sub contains { + my ($self, $rect) = (@_); + + unless ($rect->isa('SDL::Rect')) { + croak "must receive an SDL::Rect-based object"; + } + + my $contained = ($self->x <= $rect->x) + && ($self->y <= $rect->y) + && ($self->x + $self->w >= $rect->x + $rect->w) + && ($self->y + $self->h >= $rect->y + $rect->h) + && ($self->x + $self->w > $rect->x) + && ($self->y + $self->h > $rect->y) + ; + + 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); +} + 42; __END__