/t/core_video_convert_surface.t

http://github.com/PerlGameDev/SDL · Raku · 58 lines · 46 code · 12 blank · 0 comment · 7 complexity · 39c014efb86fe2c18212b20036043876 MD5 · raw file

  1. use strict;
  2. use warnings;
  3. use SDL;
  4. use SDL::Rect;
  5. use SDL::Color;
  6. use SDL::Video;
  7. use SDL::Surface;
  8. use SDL::PixelFormat;
  9. use SDL::Palette;
  10. use Test::More;
  11. use Data::Dumper;
  12. use Devel::Peek;
  13. use lib 't/lib';
  14. use SDL::TestTool;
  15. my $videodriver = $ENV{SDL_VIDEODRIVER};
  16. $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
  17. if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
  18. plan( skip_all => 'Failed to init video' );
  19. }
  20. my $hwdisplay = SDL::Video::set_video_mode( 640, 480, 8, SDL_HWSURFACE );
  21. my $surface = SDL::Video::convert_surface( $hwdisplay, $hwdisplay->format, 0 );
  22. isa_ok(
  23. $surface, 'SDL::Surface',
  24. '[convert_surface] makes copy of surface correctly'
  25. );
  26. warn 'Copy conversion failed: ' . SDL::get_error if !$surface;
  27. my $display = SDL::Surface->new( SDL_HWSURFACE, 640, 480, 8, 0, 0, 0, 0 );
  28. my $surface2 = SDL::Video::convert_surface( $display, $hwdisplay->format, 0 );
  29. isa_ok(
  30. $surface2, 'SDL::Surface',
  31. '[convert_surface] makes copy of surface converted surface HW->HW'
  32. );
  33. warn 'HW->HW conversion failed: ' . SDL::get_error if !$surface2;
  34. $display = SDL::Surface->new( SDL_SWSURFACE, 640, 480, 8, 0, 0, 0, 0 );
  35. my $surface3 = SDL::Video::convert_surface( $display, $hwdisplay->format, 0 );
  36. isa_ok(
  37. $surface3, 'SDL::Surface',
  38. '[convert_surface] makes copy of surface converted surface SW->SW'
  39. );
  40. warn 'SW->SW conversion failed: ' . SDL::get_error if !$surface3;
  41. if ($videodriver) {
  42. $ENV{SDL_VIDEODRIVER} = $videodriver;
  43. } else {
  44. delete $ENV{SDL_VIDEODRIVER};
  45. }
  46. done_testing;