/t/lib/SDL/TestTool.pm

http://github.com/PerlGameDev/SDL · Perl · 64 lines · 54 code · 10 blank · 0 comment · 12 complexity · 98690f71d515a9a59abfb1195a9b2e78 MD5 · raw file

  1. package SDL::TestTool;
  2. use strict;
  3. use warnings;
  4. use Capture::Tiny qw(capture);
  5. use SDL;
  6. use SDL::AudioSpec;
  7. use SDL::Audio;
  8. my %inits = (
  9. 0x00000001 => 'SDL_INIT_TIMER',
  10. 0x00000010 => 'SDL_INIT_AUDIO',
  11. 0x00000020 => 'SDL_INIT_VIDEO',
  12. 0x00000100 => 'SDL_INIT_CDROM',
  13. 0x00000200 => 'SDL_INIT_JOYSTICK',
  14. 0x00100000 => 'SDL_INIT_NOPARACHUTE',
  15. 0x01000000 => 'SDL_INIT_EVENTTHREAD',
  16. 0x0000FFFF => 'SDL_INIT_EVERYTHING'
  17. );
  18. sub init {
  19. my ( $self, $init ) = @_;
  20. my $stdout = '';
  21. my $stderr = '';
  22. my $result = 0;
  23. if ( $init == SDL_INIT_VIDEO ) {
  24. if ( $^O !~ /win/i && !$ENV{DISPLAY} && !$ENV{SDL_VIDEODRIVER} ) {
  25. warn '$DISPLAY is not set! Cannot Init Video';
  26. return;
  27. }
  28. }
  29. if ( $init == SDL_INIT_AUDIO ) {
  30. if ( test_audio_open() != 0 ) {
  31. warn "Couldn't use a valid audio device: " . SDL::get_error();
  32. return;
  33. }
  34. SDL::quit();
  35. }
  36. ($stdout, $stderr, $result ) = capture { SDL::init($init) };
  37. if ( $result != 0 ) {
  38. warn 'Init ' . $inits{$init} . ' failed with SDL error: ' . SDL::get_error() . "\nand stderr $stderr\n";
  39. }
  40. return $result == 0;
  41. }
  42. sub test_audio_open {
  43. my $desired = SDL::AudioSpec->new;
  44. $desired->freq(44100);
  45. $desired->format(SDL::Audio::AUDIO_S16SYS);
  46. $desired->channels(2);
  47. $desired->samples(4096);
  48. $desired->callback('main::audio_callback');
  49. my $obtained = SDL::AudioSpec->new;
  50. return SDL::Audio::open( $desired, $obtained );
  51. }
  52. sub audio_callback {
  53. }
  54. 1;