implemented clamp and clamp_ip

[sdlgit/SDL_perl.git] / lib / SDL / Game / Rect.pm

diff --git a/lib/SDL/Game/Rect.pm b/lib/SDL/Game/Rect.pm
index 7d443ae..95332df 100644 (file)
--- a/lib/SDL/Game/Rect.pm
+++ b/lib/SDL/Game/Rect.pm
@@ -1,7 +1,7 @@
 package SDL::Game::Rect;
 use strict;
 use warnings;
-
+use Carp;
 use base 'SDL::Rect';
 
 our $VERSION = '0.01';
@@ -13,10 +13,10 @@ sub new {
     my $w = shift || 0;
     my $h = shift || 0;
 
-    my $self = SDL::Rect->new($x, $y, $w, $h);
+    my $self = $class->SUPER::new($x, $y, $w, $h);
     unless ($$self) {
-        require Carp;
-        Carp::croak SDL::GetError();
+        #require Carp;
+        croak SDL::GetError();
     }
     bless $self, $class;
     return $self;
@@ -206,6 +206,123 @@ sub midbottom {
     return;    
 }
 
+###############################
+## methods                   ##
+###############################
+
+sub duplicate {
+}
+
+sub copy {
+    my $self = shift;
+    return $self->new(
+        -top    => $self->top,
+        -left   => $self->left,
+        -width  => $self->width,
+        -height => $self->height,
+    );
+}
+
+sub move {
+    my ($self, $x, $y) = (@_);
+    if (not defined $x or not defined $y) {
+        #require Carp;
+        croak "must receive x and y positions as argument";
+    }
+    return $self->new(
+        -top    => $self->top + $y,
+        -left   => $self->left + $x,
+        -width  => $self->width,
+        -height => $self->height,
+    );
+}
+
+sub move_ip {
+    my ($self, $x, $y) = (@_);
+    if (not defined $x or not defined $y) {
+        #require Carp;
+        croak "must receive x and y positions as argument";
+    }
+    $self->x($self->x + $x);
+    $self->y($self->y + $y);
+    
+    return;
+}
+
+sub inflate {
+    my ($self, $x, $y) = (@_);
+    if (not defined $x or not defined $y) {
+        #require Carp;
+        croak "must receive x and y positions as argument";
+    }
+    
+    return $self->new(
+        -left   => $self->left   - ($x / 2),
+        -top    => $self->top    - ($y / 2),
+        -width  => $self->width  + $x,
+        -height => $self->height + $y,
+    );
+}
+
+sub inflate_ip {
+    my ($self, $x, $y) = (@_);
+    if (not defined $x or not defined $y) {
+        #require Carp;
+        croak "must receive x and y positions as argument";
+    }
+    
+    $self->x( $self->x - ($x / 2) );
+    $self->y( $self->y - ($y / 2) );
+    
+    $self->w( $self->w + $x );
+    $self->h( $self->h + $y );
+}
+
+sub _get_clamp_coordinates {
+    my ($self_pos, $self_len, $rect_pos, $rect_len) = (@_);
+
+    if ($self_len >= $rect_len) {
+        return $rect_pos + ($rect_len / 2) - ($self_len / 2);
+    }
+    elsif ($self_pos < $rect_pos) {
+        return $rect_pos;
+    }
+    elsif ( ($self_pos + $self_len) > ($rect_pos + $rect_len) ) {
+        return $rect_pos + $rect_len - $self_len;
+    }
+    else {
+        return $self_pos;
+    }
+}
+
+sub clamp {
+    my ($self, $rect) = (@_);
+    
+    unless ($rect->isa('SDL::Rect')) {
+        croak "must receive an SDL::Rect-based object";
+    }
+
+    my $x = _get_clamp_coordinates($self->x, $self->w, $rect->x, $rect->w);
+    my $y = _get_clamp_coordinates($self->y, $self->h, $rect->y, $rect->h);
+    
+    return $self->new($x, $y, $self->w, $self->h);
+}
+
+sub clamp_ip {
+    my ($self, $rect) = (@_);
+    
+    unless ($rect->isa('SDL::Rect')) {
+        croak "must receive an SDL::Rect-based object";
+    }
+
+    my $x = _get_clamp_coordinates($self->x, $self->w, $rect->x, $rect->w);
+    my $y = _get_clamp_coordinates($self->y, $self->h, $rect->y, $rect->h);
+    
+    $self->x($x);
+    $self->y($y);
+    
+    return;
+}
 
 42;
 __END__