X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fcore_video.t;h=81001ef086b7ca175dab1b82279cbddcc904986e;hb=b3cdeb39a431b026168c4060bf74001fcee07493;hp=d7cf95545a62ca1bc92409b8d207f85ccf2c6da8;hpb=b9125226e1a2240a047fc28b69e8471626d6c147;p=sdlgit%2FSDL_perl.git diff --git a/t/core_video.t b/t/core_video.t index d7cf955..81001ef 100644 --- a/t/core_video.t +++ b/t/core_video.t @@ -1,6 +1,7 @@ #!/usr/bin/perl -w use strict; use SDL; +use SDL::Color; use SDL::Surface; use SDL::Config; use Devel::Peek; @@ -8,11 +9,12 @@ use Data::Dumper; use Test::More; use SDL::Rect; -plan ( tests => 10 ); +plan ( tests => 21 ); use_ok( 'SDL::Video' ); - -can_ok ('SDL::Video', qw/ + +my @done = + qw/ get_video_surface get_video_info video_driver_name @@ -22,12 +24,24 @@ can_ok ('SDL::Video', qw/ update_rect update_rects flip - /); + set_colors + set_palette + set_gamma + set_gamma_ramp + map_RGB + map_RGBA + /; + +can_ok ('SDL::Video', @done); #testing get_video_surface -SDL::Init(SDL_INIT_VIDEO); +SDL::init(SDL_INIT_VIDEO); -my $display = SDL::SetVideoMode(640,480,32, SDL_SWSURFACE ); +my $display = SDL::Video::set_video_mode(640,480,32, SDL_SWSURFACE ); + +if(!$display){ + plan skip_all => 'Couldn\'t set video mode: '. SDL::geterror(); + } #diag('Testing SDL::Video'); @@ -48,7 +62,6 @@ cmp_ok(SDL::Video::video_mode_ok( 100, 100, 16, SDL_SWSURFACE), '>=', 0, "[video isa_ok(SDL::Video::set_video_mode( 100, 100 ,16, SDL_SWSURFACE), 'SDL::Surface', '[set_video_more] Checking if we get a surface ref back'); - #TODO: Write to surface and check inf pixel in that area got updated. SDL::Video::update_rect($display, 0, 0, 0, 0); @@ -59,25 +72,50 @@ SDL::Video::update_rects($display, SDL::Rect->new(0, 10, 20, 20)); my $value = SDL::Video::flip($display); is( ($value == 0) || ($value == -1), 1, '[flip] returns 0 or -1' ); -pass "Are we still alive?"; +$value = SDL::Video::set_colors($display, 0, SDL::Color->new(0,0,0)); +is( $value , 0, '[set_colors] returns 0 trying to write to 32 bit display' ); -=skip - get_video_surface - get_video_info - video_driver_name - list_modes - set_video_mode - video_mode_ok - update_rect - update_rects - flip - set_colors - set_palette - set_gamma +$value = SDL::Video::set_palette($display, SDL_LOGPAL|SDL_PHYSPAL, 0); + +is( $value , 0, '[set_palette] returns 0 trying to write to 32 bit surface' ); + +my $zero = [0,0,0,0]; +SDL::Video::set_gamma_ramp($zero, $zero, $zero); pass '[set_gamma_ramp] ran'; + +SDL::Video::set_gamma( 1.0, 1.0, 1.0 ); pass '[set_gamma] ran '; + +my @b_w_colors; + +for(my $i=0;$i<256;$i++){ + $b_w_colors[$i] = SDL::Color->new($i,$i,$i); + } +my $hwdisplay = SDL::Video::set_video_mode(640,480,8, SDL_HWSURFACE ); + +if(!$hwdisplay){ + plan skip_all => 'Couldn\'t set video mode: '. SDL::geterror(); + } + +$value = SDL::Video::set_colors($hwdisplay, 0); +is( $value , 0, '[set_colors] returns 0 trying to send empty colors to 8 bit surface' ); + +$value = SDL::Video::set_palette($hwdisplay, SDL_LOGPAL|SDL_PHYSPAL, 0); + +is( $value , 0, '[set_palette] returns 0 trying to send empty colors to 8 bit surface' ); + + +$value = SDL::Video::set_colors($hwdisplay, 0, @b_w_colors); +is( $value , 1, '[set_colors] returns '.$value ); + +$value = SDL::Video::set_palette($hwdisplay, SDL_LOGPAL|SDL_PHYSPAL, 0, @b_w_colors ); + +is( $value , 1, '[set_palette] returns 1' ); + + +is( SDL::Video::map_RGB($hwdisplay->format, 10, 10 ,10) > 0, 1, '[map_RGB] maps correctly to 8-bit surface'); +is( SDL::Video::map_RGBA($hwdisplay->format, 10, 10 ,10, 10) > 0, 1, '[map_RGBA] maps correctly to 8-bit surface'); + +my @left = qw/ get_gamma_ramp - set_gmmma_ramp - map_RGB - map_RGBA get_RGB get_RGBA create_RGB_surface_from @@ -103,5 +141,16 @@ pass "Are we still alive?"; lock_YUV_overlay unlock_YUV_overlay display_YUV_overlay - /); + /; + +my $why = '[Percentage Completion] '.int( 100 * $#done / ($#done + $#left) ) ."\% implementation. $#done / ".($#done+$#left); + +TODO: +{ + local $TODO = $why; + pass "\nThe following functions:\n".join ",", @left; +} + diag $why; + +pass 'Are we still alive? Checking for segfaults';