Permalink
Browse files

Fixed SDLx::Rect copy, move and inflate

  • Loading branch information...
1 parent d7c2c82 commit 6a8e376bfb60f671fff92a889eb83acdca287d7c @jtpalmer jtpalmer committed with garu Aug 1, 2011
Showing with 132 additions and 14 deletions.
  1. +2 −0 CHANGELOG
  2. +14 −14 lib/SDLx/Rect.pm
  3. +116 −0 t/sdlx_rect.t
View
@@ -13,6 +13,8 @@ Revision history for Perl extension SDL_perl.
* 2.534_02 Aug 27
New features:
- SDLx::Surface: added methods draw_trigon, draw_ellipse, draw_arc and draw_bezier [jtpalmer]
+ Bug fixes:
+ - SDLx::Rect: fixed methods copy, move and inflate [jtpalmer]
* 2.534_01 June 13 2011
- Using 'perl' instead of 'SDLPerl' to run silent tests on darwin [FROGGS]
View
@@ -13,14 +13,14 @@ sub new {
my $w = shift || 0;
my $h = shift || 0;
+ $class = ref($class) || $class;
my $self = $class->SUPER::new( $x, $y, $w, $h );
unless ($$self) {
#require Carp;
Carp::confess SDL::get_error();
}
- bless $self, ref($class) || $class;
- return $self;
+ return bless $self, $class;
}
#############################
@@ -254,10 +254,10 @@ sub midbottom {
sub copy {
my $self = shift;
return $self->new(
- -top => $self->top,
- -left => $self->left,
- -width => $self->width,
- -height => $self->height,
+ $self->x,
+ $self->y,
+ $self->w,
+ $self->h,
);
}
@@ -269,10 +269,10 @@ sub move {
Carp::confess "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,
+ $self->left + $x,
+ $self->top + $y,
+ $self->width,
+ $self->height,
);
}
@@ -298,10 +298,10 @@ sub inflate {
}
return $self->new(
- -left => $self->left - ( $x / 2 ),
- -top => $self->top - ( $y / 2 ),
- -width => $self->width + $x,
- -height => $self->height + $y,
+ $self->left - ( $x / 2 ),
+ $self->top - ( $y / 2 ),
+ $self->width + $x,
+ $self->height + $y,
);
}
View
@@ -0,0 +1,116 @@
+use strict;
+use warnings;
+use SDL;
+use SDL::Rect;
+use SDLx::Rect;
+use Test::More;
+use lib 't/lib';
+use SDL::TestTool;
+
+my $videodriver = $ENV{SDL_VIDEODRIVER};
+$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
+
+if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
+ plan( skip_all => 'Failed to init video' );
+}
+
+can_ok(
+ 'SDLx::Rect', qw/
+ width
+ w
+ height
+ h
+ left
+ x
+ top
+ y
+ bottom
+ right
+ centerx
+ centery
+ size
+ topleft
+ midleft
+ bottomleft
+ center
+ topright
+ midright
+ bottomright
+ midtop
+ midbottom
+ new
+ copy
+ duplicate
+ move
+ move_ip
+ inflate
+ inflate_ip
+ clamp
+ clamp_ip
+ clip
+ clip_ip
+ union
+ union_ip
+ unionall
+ unionall_ip
+ fit
+ fit_ip
+ normalize
+ contains
+ collidepoint
+ colliderect
+ collidelist
+ collidelistall
+ collidehash
+ collidehashall
+ /
+);
+
+
+my ($x, $y, $w, $h) = (0, 1, 2, 3);
+my $rect = SDLx::Rect->new($x, $y, $w, $h);
+ok($rect, 'new');
+isa_ok($rect, 'SDLx::Rect');
+
+is($rect->width, $w, 'get width');
+is($rect->w, $w, 'get w');
+is($rect->height, $h, 'get height');
+is($rect->h, $h, 'get h');
+is($rect->left, $x, 'get left');
+is($rect->x, $x, 'get x');
+is($rect->top, $y, 'get top');
+is($rect->y, $y, 'get y');
+
+is($rect->bottom, $y + $h, 'get bottom');
+is($rect->right, $x + $w, 'get right');
+
+my $copy = $rect->copy();
+is($copy->w, $w, 'copy (w)');
+is($copy->h, $h, 'copy (h)');
+is($copy->x, $x, 'copy (x)');
+is($copy->y, $y, 'copy (y)');
+
+my ($dx, $dy) = (4, 5);
+my $moved = $rect->move($dx, $dy);
+is($moved->w, $w, 'move (w)');
+is($moved->h, $h, 'move (h)');
+is($moved->x, $x + $dx, 'move (x)');
+is($moved->y, $y + $dy, 'move (y)');
+
+my ($dw, $dh) = (6, 7);
+my $inflated = $rect->inflate($dw, $dh);
+is($inflated->w, $w + $dw, 'inflate (w)');
+is($inflated->h, $h + $dh, 'inflate (h)');
+is($inflated->x, $x - $dw / 2, 'inflate (x)');
+is($inflated->y, $y - $dw / 2, 'inflate (y)');
+
+if ($videodriver) {
+ $ENV{SDL_VIDEODRIVER} = $videodriver;
+} else {
+ delete $ENV{SDL_VIDEODRIVER};
+}
+
+pass 'Final SegFault test';
+
+
+done_testing;

0 comments on commit 6a8e376

Please sign in to comment.