/t/core_palette.t

http://github.com/PerlGameDev/SDL · Perl · 67 lines · 47 code · 19 blank · 1 comment · 4 complexity · c840f5fcaf5da3b1d9a794214bddea79 MD5 · raw file

  1. #!perl
  2. use strict;
  3. use warnings;
  4. use Test::More;
  5. use SDL;
  6. use SDL::Surface;
  7. use SDL::PixelFormat;
  8. use SDL::Video;
  9. use lib 't/lib';
  10. use SDL::TestTool;
  11. my $videodriver = $ENV{SDL_VIDEODRIVER};
  12. $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
  13. if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
  14. plan( skip_all => 'Failed to init video' );
  15. } else {
  16. plan( tests => 10 );
  17. }
  18. use_ok('SDL::Palette');
  19. can_ok( 'SDL::Palette', qw/ ncolors colors color_index / );
  20. my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
  21. isa_ok( $display->format, 'SDL::PixelFormat', 'Are we a SDL::PixelFormat?' );
  22. ok( !defined $display->format->palette,
  23. 'Palette is not defined as BitPerPixels is greater then 8'
  24. );
  25. my $disp = SDL::Video::set_video_mode( 640, 480, 8, SDL_SWSURFACE );
  26. SKIP:
  27. {
  28. skip( 'Cannot open display: ' . SDL::get_error(), 4 ) unless ($disp);
  29. isa_ok( $disp->format, 'SDL::PixelFormat', 'Are we a SDL::PixelFormat?' );
  30. isa_ok(
  31. $disp->format->palette, 'SDL::Palette',
  32. 'Palette is SDL::Palette when BitPerPixels is 8 '
  33. );
  34. is( $disp->format->palette->ncolors, 256, '256 colors in palette' );
  35. my $colors = $disp->format->palette->colors();
  36. isa_ok( $colors, 'ARRAY', 'Palette->colors is an array' );
  37. isa_ok( $colors->[0], 'SDL::Color', 'Palette->colors[x] is an SDL::Color' );
  38. isa_ok(
  39. $disp->format->palette->color_index(23),
  40. 'SDL::Color', 'Palette->color_index() is a SDL::Color'
  41. );
  42. }
  43. if ($videodriver) {
  44. $ENV{SDL_VIDEODRIVER} = $videodriver;
  45. } else {
  46. delete $ENV{SDL_VIDEODRIVER};
  47. }
  48. sleep(2);