PageRenderTime 27ms CodeModel.GetById 17ms RepoModel.GetById 0ms app.codeStats 0ms

/t/sdlx_controller.t

http://github.com/PerlGameDev/SDL
Unknown | 154 lines | 123 code | 31 blank | 0 comment | 0 complexity | c2b95800bccca0ef862f34b474144271 MD5 | raw file
Possible License(s): AGPL-1.0, GPL-2.0
  1. use strict;
  2. use warnings;
  3. use Test::More;
  4. use SDL;
  5. use SDL::Config;
  6. use SDL::Video;
  7. use SDL::Color;
  8. use SDLx::Controller;
  9. use Scalar::Util 'refaddr';
  10. use lib 't/lib';
  11. use SDL::TestTool;
  12. can_ok(
  13. 'SDLx::Controller',
  14. qw(
  15. new run stop pause dt min_t current_time
  16. add_move_handler add_event_handler add_show_handler
  17. remove_move_handler remove_event_handler remove_show_handler
  18. remove_all_move_handlers remove_all_event_handlers remove_all_show_handlers
  19. move_handlers event_handlers show_handlers eoq exit_on_quit
  20. )
  21. );
  22. TODO: {
  23. local $TODO = 'methods not implemented yet';
  24. can_ok( 'SDLx::Controller', qw( ) );
  25. }
  26. my $app = SDLx::Controller->new;
  27. isa_ok( $app, 'SDLx::Controller', 'default controller can be spawned' );
  28. is($app->dt, 0.1, 'default dt set to 0.1');
  29. is($app->min_t, 1 / 60, 'default min_t set to 1/60' );
  30. is($app->eoq, 0, 'no eoq by default');
  31. is($app->exit_on_quit, 0, 'no exit_on_quit by default');
  32. is( scalar @{ $app->move_handlers }, 0, 'no motion handlers by default' );
  33. is( scalar @{ $app->show_handlers }, 0, 'no show handlers by default' );
  34. is( scalar @{ $app->event_handlers }, 0, 'no event handlers by default' );
  35. is( $app->exit_on_quit, 0, 'exit_on_quit is not set by default' );
  36. is( $app->eoq, 0, 'eoq() is a method alias to exit_on_quit()' );
  37. $app->exit_on_quit(1);
  38. is( scalar @{ $app->event_handlers }, 0, 'exit_on_quit does not trigger event handlers' );
  39. is( $app->exit_on_quit, 1, 'exit_on_quit can be set dynamically' );
  40. is( $app->eoq, 1, 'eoq() follows exit_on_quit()' );
  41. $app->remove_all_event_handlers;
  42. is( $app->exit_on_quit, 1, 'exit_on_quit is not an event handler' );
  43. is( $app->eoq, 1, 'eoq() still follows exit_on_quit()' );
  44. $app->eoq(0);
  45. is( $app->eoq, 0, 'eoq can be set dynamically' );
  46. is( $app->exit_on_quit, 0, 'exit_on_quit() follows eoq()' );
  47. $app = SDLx::Controller->new(
  48. dt => 0.1,
  49. min_t => 0.5,
  50. );
  51. isa_ok( $app, 'SDLx::Controller' );
  52. is($app->dt, 0.1, 'new dt set to 0.1');
  53. is($app->min_t, 0.5, 'new min_t set to 0.5' );
  54. sub dummy_sub {1}
  55. sub dummy_sub2 {1}
  56. my @kinds = qw(move show);
  57. # SDL events need a video surface to work
  58. my $videodriver = $ENV{SDL_VIDEODRIVER};
  59. $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
  60. push @kinds, 'event'
  61. if SDL::TestTool->init(SDL_INIT_VIDEO)
  62. and SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
  63. foreach my $kind (@kinds) {
  64. my $method = "add_${kind}_handler";
  65. my $index_1 = $app->$method( \&dummy_sub );
  66. my $index_2 = $app->$method( \&dummy_sub2 );
  67. is($index_1 , 0, "got index 0 from added $kind handler" );
  68. is($index_2 , 1, "got index 0 from added $kind handler" );
  69. $method = "${kind}_handlers";
  70. is( scalar @{ $app->$method }, 2, "$kind handlers added" );
  71. is( $app->$method->[0], \&dummy_sub, "$kind handler 0 added correctly" );
  72. is( $app->$method->[1], \&dummy_sub2, "$kind handler 1 added correctly" );
  73. $method = "remove_${kind}_handler";
  74. $app->$method( \&dummy_sub );
  75. $app->$method( $index_2 );
  76. $method = "${kind}_handlers";
  77. is( scalar @{ $app->$method }, 0, "$kind handlers removed correctly" );
  78. }
  79. my $move_inc = 0;
  80. my $move_inc2 = 0;
  81. my $show_inc = 0;
  82. my $show_inc2 = 0;
  83. sub test_event {
  84. my ($event, $application) = @_;
  85. }
  86. sub test_move_first {
  87. cmp_ok($move_inc, '==', $move_inc2, 'test_move_first called first');
  88. $move_inc++;
  89. }
  90. sub test_move {
  91. my ($part, $application, $t) = @_;
  92. ok(defined $part, 'got step value');
  93. ok(defined $application, 'got our app (motion handler)');
  94. ok(defined $t, 'got out time');
  95. ok( do {$part > 0 and $part <= 1}, "move handle \$_[0] of $part was > 0 and <= 1" );
  96. is(refaddr $application, refaddr $app, 'app and application are the same (motion handler)');
  97. cmp_ok($move_inc, '>', $move_inc2, 'test_move called second');
  98. $move_inc2++;
  99. }
  100. sub test_show_first {
  101. cmp_ok($show_inc, '==', $show_inc2, 'test_show_first called first');
  102. $show_inc++;
  103. }
  104. sub test_show {
  105. my ($ticks, $application) = @_;
  106. ok(defined $ticks, 'got our ticks');
  107. ok(defined $application, 'got our app (show handler)');
  108. ok( $ticks >= 0.5, "show handle \$_[0] of $ticks was >= 0.5" );
  109. is(refaddr $application, refaddr $app, 'app and application are the same (show handler)');
  110. cmp_ok($show_inc, '>', $show_inc2, 'test_show called second');
  111. $show_inc2++;
  112. if ($show_inc2 >= 30) {
  113. $application->stop();
  114. }
  115. }
  116. $app->add_move_handler(\&test_move_first);
  117. $app->add_move_handler(\&test_move);
  118. $app->add_show_handler(\&test_show_first);
  119. $app->add_show_handler(\&test_show);
  120. $app->run();
  121. cmp_ok($move_inc, '>=', 30, 'called our motion handlers at least 30 times');
  122. is($show_inc, 30, 'called our show handlers exactly 30 times');
  123. done_testing;