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