/t/sdlx_app.t

http://github.com/PerlGameDev/SDL · Perl · 79 lines · 62 code · 15 blank · 2 comment · 2 complexity · 1a4d9d07d6da1952b9eb2d95f8fe1bd7 MD5 · raw file

  1. #!/usr/bin/perl -w
  2. # basic testing of SDLx::App
  3. use strict;
  4. use warnings;
  5. use SDL;
  6. use SDL::Config;
  7. use SDL::Rect;
  8. use SDLx::Rect;
  9. use SDL::Color;
  10. use SDL::Video;
  11. use Test::More;
  12. use lib 't/lib';
  13. use SDL::TestTool;
  14. plan( tests => 2 );
  15. use SDLx::App;
  16. can_ok(
  17. 'SDLx::App', qw/
  18. new
  19. resize
  20. title
  21. delay
  22. ticks
  23. error
  24. warp
  25. fullscreen
  26. iconify
  27. grab_input
  28. sync
  29. attribute
  30. /
  31. );
  32. my $videodriver = $ENV{SDL_VIDEODRIVER};
  33. $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
  34. SKIP:
  35. {
  36. skip 'No Video', 1 unless SDL::TestTool->init(SDL_INIT_VIDEO);
  37. my $app = SDLx::App->new(
  38. title => "Test",
  39. width => 640,
  40. height => 480,
  41. init => SDL_INIT_VIDEO
  42. );
  43. my $rect = SDL::Rect->new( 0, 0, $app->w, $app->h );
  44. my $pixel_format = $app->format;
  45. my $blue_pixel = SDL::Video::map_RGB( $pixel_format, 0x00, 0x00, 0xff );
  46. my $col_pixel = SDL::Video::map_RGB( $pixel_format, 0xf0, 0x00, 0x33 );
  47. my $grect = SDLx::Rect->new( 10, 10, 30, 35 );
  48. foreach ( 0 .. 80 ) {
  49. $grect->x($_);
  50. $grect->centery( $_ * 3 );
  51. $grect->size( ( $_ / 40 ) * $_, ( $_ / 38 ) * $_ );
  52. SDL::Video::fill_rect( $app, $rect, $blue_pixel );
  53. SDL::Video::fill_rect( $app, $grect, $col_pixel );
  54. SDL::Video::update_rect( $app, 0, 0, 640, 480 );
  55. SDL::delay(10);
  56. }
  57. SDL::delay(100);
  58. pass 'Ran';
  59. }
  60. if ($videodriver) {
  61. $ENV{SDL_VIDEODRIVER} = $videodriver;
  62. } else {
  63. delete $ENV{SDL_VIDEODRIVER};
  64. }