Skip to content
This repository
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 116 lines (75 sloc) 2.993 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
use strict;
use warnings;
use Test::More;
use SDL;
use SDL::Surface;
use SDL::Rect;
use SDLx::Surface;
use SDL::PixelFormat;
use SDL::Video;
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' );
}

my $app = SDL::Video::set_video_mode( 400,200,32, SDL_SWSURFACE);

my $app_x = SDLx::Surface::get_display();

is_deeply( $app_x->surface->get_pixels_ptr, $app->get_pixels_ptr, '[get_display] works');



my $surface = SDL::Surface->new( SDL_SWSURFACE, 400,200, 32);
my @surfs = (
SDLx::Surface->new( surface => $surface),
SDLx::Surface->new( width=> 400, height=>200),
SDLx::Surface->new( width=> 400, height=>200, flags=> SDL_SWSURFACE, depth=>32 ),
SDLx::Surface->new( width=> 400, height=>200, flags=> SDL_SWSURFACE, depth=>32, greenmask=>0xFF000000 ),


);

foreach my $a ( @surfs)
{
isa_ok ( $a, 'SDLx::Surface');

isa_ok ( $a->surface(), 'SDL::Surface');

my $color = $a->[0][0];
is ( $color , 0, 'Right color returned');

$a->[0][0] = 0x00FF00FF;
is ( $a->[0][0] , 0x00FF00FF, 'Right color returned');

is ( @{$a} , 200 , 'Correct Y value');

is ( @{$a->[0]} , 400 , 'Correct X value');

}

#my $source = SDLx::Surface->new( width=> 400, height=>200, flags=> SDL_SWSURFACE, depth=>32 ),
 

is( $surfs[0]->[1][2], 0 , 'Checking source pixel is 0');
is( $surfs[1]->[1][2], 0 , 'Checking dest pixel is 0');

$surfs[0]->[1][2] = 0x00FF00FF;

is( $surfs[0]->[1][2], 0x00FF00FF, 'Checking that source pixel got written' );

$surfs[0]->blit( $surfs[1] );
#SDL::Video::blit_surface( $surfs[0]->surface, SDL::Rect->new(0,0,400,200), $surfs[1]->surface, SDL::Rect->new(0,0,400,200));

isnt( $surfs[1]->[1][2], 0, 'Pixel from first surface was blitted to destination');

$surfs[1]->flip();

pass 'Fliped the surface';

$surfs[0]->update();
pass 'update all surface';
$surfs[0]->update( [0,10,30,40] );
pass 'Single rect update';
$surfs[0]->update( [ SDL::Rect->new(0,1,2,3), SDL::Rect->new(2,4,5,6)] );
pass 'SDL::Rect array update';


$surfs[0]->draw_rect( [0,0,10,20], 0xFF00FFFF);
pass 'draw_rect works';

$surfs[1]->draw_line( [0,10], [ 20, 10 ], 0xff00ffff);
$surfs[1]->draw_line( [0,10], [ 20, 10 ], 0xff00ffff, 1);
$surfs[1]->draw_line( [0,10], [ 20, 10 ], [255,255,0,255]);
$surfs[1]->draw_line( [0,10], [ 20, 10 ], [255,255,0,255], 1);
pass 'draw_line works';


my $surf_dup = SDLx::Surface::duplicate( $surfs[1] );

is ( $surf_dup->w , $surfs[1]->w, 'Duplicate surf has same width' );
is ( $surf_dup->h , $surfs[1]->h, 'Duplicate surf has same flags' );
is ( $surf_dup->flags , $surfs[1]->flags, 'Duplicate surf has same flags' );
is ( $surf_dup->format->BitsPerPixel , $surfs[1]->format->BitsPerPixel, 'Duplicate surf has same bpp' );



if($videodriver)
{
$ENV{SDL_VIDEODRIVER} = $videodriver;
}
else
{
delete $ENV{SDL_VIDEODRIVER};
}

pass 'Final SegFault test';


done_testing;
Something went wrong with that request. Please try again.