/t/sdlx_controller_interface.t

http://github.com/PerlGameDev/SDL · Raku · 131 lines · 89 code · 40 blank · 2 comment · 3 complexity · 46fe7819d52ea598ab910dbc25f92a4a MD5 · raw file

  1. use strict;
  2. use warnings;
  3. use Test::More;
  4. use SDL;
  5. use SDLx::App;
  6. use SDLx::Controller;
  7. use SDLx::Controller::State;
  8. use SDLx::Controller::Interface;
  9. use lib 't/lib';
  10. use SDL::TestTool;
  11. use Data::Dumper;
  12. my $videodriver = $ENV{SDL_VIDEODRIVER};
  13. $ENV{SDL_VIDEODRIVER} = 'dummy';
  14. can_ok(
  15. 'SDLx::Controller::Interface',
  16. qw( new ) #meh, put the rest in later
  17. );
  18. TODO: {
  19. local $TODO = 'methods not implemented yet';
  20. can_ok( 'SDLx::Controller::Interface', qw( foo ) );
  21. }
  22. my $obj = SDLx::Controller::Interface->new( x => 1, y => 2, v_x => 3, v_y => 4, rot => 5, ang_v => 6 );
  23. isa_ok( $obj, 'SDLx::Controller::Interface' );
  24. my $s = sub { pass 'ran accel'; return ( 0.0, 10, 19 ) };
  25. $obj->set_acceleration($s);
  26. my $av = $obj->acceleration(1);
  27. isa_ok( $av, 'ARRAY' );
  28. ## This is reversed, maybe we fix this ... or not because acceleration will
  29. #be called internal
  30. is( $av->[0], 19 );
  31. is( $av->[1], 10 );
  32. is( $av->[2], 0.0 );
  33. my $hv = $obj->interpolate(0.5);
  34. isa_ok( $hv, 'SDLx::Controller::State', '[interpolate] provides state back out' );
  35. is( $hv->x, 1 );
  36. is( $hv->y, 2 );
  37. is( $hv->rotation, 5 );
  38. $obj->update( 2, 0.5 );
  39. $hv = $obj->interpolate(0.5);
  40. isa_ok( $hv, 'SDLx::Controller::State', '[interpolate] provides state back out' );
  41. is( $hv->x, 1.75 );
  42. is( $hv->y, 3.625 );
  43. is( $hv->rotation, 7.6875 );
  44. $obj = SDLx::Controller::Interface->new( x => 1, y => 2, v_x => 3, v_y => 4, rot => 5, ang_v => 6 );
  45. $obj->set_acceleration( sub { $_[1]->x(2); pass '[state] is mutable'; return ( 0.0, 10, 19 ) } );
  46. $obj->acceleration(1);
  47. my $a = $obj->current;
  48. my $a_x = $a->x();
  49. is( $a_x, 2, '[obj/state] acceleration callback copies state back to current' );
  50. my $dummy = SDLx::App->new( init => SDL_INIT_VIDEO );
  51. my $controller = SDLx::Controller->new( dt => 1, delay => 200 );
  52. my $interface = SDLx::Controller::Interface->new();
  53. my $event_called = 0;
  54. require SDL::Event;
  55. require SDL::Events;
  56. my $eve = SDL::Event->new();
  57. SDL::Events::push_event($eve);
  58. my $counts = [ 0, 0, 0 ];
  59. $controller->add_event_handler(
  60. sub {
  61. $counts->[0]++;
  62. return 0;
  63. }
  64. );
  65. $interface->set_acceleration(
  66. sub {
  67. $controller->stop() if $counts->[0] && $counts->[1] && $counts->[2];
  68. $counts->[1]++;
  69. isa_ok( $_[1], 'SDLx::Controller::State', '[Controller] called acceleration and gave us a state' ),
  70. return ( 10, 10, 10 );
  71. }
  72. );
  73. $interface->attach(
  74. $controller,
  75. sub {
  76. $counts->[2]++;
  77. isa_ok( $_[0], 'SDLx::Controller::State', '[Controller] called render and gave us a state' );
  78. }
  79. );
  80. $controller->run();
  81. cmp_ok( $counts->[0], '>', 0, '$counts->[0] is >0' );
  82. cmp_ok( $counts->[1], '>', 0, '$counts->[1] is >0' );
  83. cmp_ok( $counts->[2], '>', 0, '$counts->[2] is >0' );
  84. $interface->detach();
  85. pass('Interface was able to deattach ');
  86. if ($videodriver) {
  87. $ENV{SDL_VIDEODRIVER} = $videodriver;
  88. } else {
  89. delete $ENV{SDL_VIDEODRIVER};
  90. }
  91. done_testing;